packages feed

streamly 0.8.2 → 0.11.1

raw patch · 467 files changed

Files

CHANGELOG.md view
@@ -2,6 +2,161 @@  <!-- See rendered changelog at https://streamly.composewell.com --> +## 0.11.1 (May 2026)++* Fix `parDemuxScan` deadlock when a worker throws an exception while the+  driver is blocked on a full input buffer.++## 0.11.0 (Sep 2025)++See+[0.10.1-0.11.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.11.0/docs/User/Project/ApiChangelogs/0.10.1-0.11.0.txt)+for detailed API changes in this release.++### Breaking Changes++* Concurrent streams and folds now use separate concurrency config types. If you+  were importing `Config` from the wrong module, you will need to update it.++### Enhancements++* Support for prompt cleanup of concurrent threads, allowing guaranteed+  cleanup as an alternative to GC-based cleanup.+* Introduced `Streamly.Data.Scanl.Prelude` for using concurrent+  operations with the new `Scanl` type. Scans can split a stream into+  multiple streams, process them concurrently, and merge the results.+* Added new concurrent fold combinators in `Streamly.Data.Fold.Prelude`.+* Fixed rate control for ordered streams.++### Internal++* Internal `FileSystem.Event.*` modules are deprecated; use the+  [streamly-fsevents](https://github.com/composewell/streamly-fsevents) package.+  instead.++## 0.10.1 (Jan 2024)++* Fix TH macros in `Streamly.Data.Stream.MkType` for GHC 9.6 and above.++## 0.10.0 (Nov 2023)++See+[0.9.0-0.10.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txt)+for a full list of API changes in this release. Only a few significant+changes are mentioned here.  For changes to the core functionality+please see the changelog of the `streamly-core` package.++### Breaking Changes++* `MonadTrans` and `MonadBase` instances have been removed for `AsyncT`,+  `ParallelT`, `AheadT` for GHC versions 9.6 onwards. This is due to a+  breaking change in `transformers` 0.6. You can replace `lift` with+  `fromEffect` when using these as top level monads in a monad stack.++### Enhancements++* __Concurrent Folds__: `Streamly.Data.Fold.Prelude` module added with+  concurrent fold APIs and a container fold API to fold a key value+  stream to a HashMap.++## 0.9.0 (Mar 2023)++Also see the following:++* [streamly-0.9.0 Upgrade Guide](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md) or+  https://hackage.haskell.org/package/streamly-0.9.0/docs/docs/User/ProjectRelated/Upgrading.md+* [streamly-0.9.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt) or+  https://hackage.haskell.org/package/streamly-0.9.0/docs/docs/User/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt+* [streamly-core-0.1.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0.txt) or+  https://hackage.haskell.org/package/streamly-core-0.1.0/docs/docs/ApiChangelogs/0.1.0.txt++### Package split++`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. Make sure you add a dependency on `streamly-core` to keep old+code working.++* 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++### Breaking Changes++* Unboxed arrays now require `Unbox` constraint instead of `Storable`.+  The `Unbox` typeclass can be imported from `Streamly.Data.Array`. You+  can use generic deriving to derive Unbox instances.+* Stream type in all modules has been changed to the new `Stream` type+  replacing the existing `IsStream t` or `SerialT` types. Use `fromStream`,+  `toStream` from `Streamly.Prelude` module to adapt the types.+* Signatures changed in `Streamly.Data.Unfold`:+  * `fromStream`+  * `replicateM`++### Major Changes++`Streamly.Prelude` module has been deprecated, equivalent+functionality is covered by the `Streamly.Data.Stream`,+`Streamly.Data.Stream.Prelude`, and `Streamly.Data.Fold` modules. The+new modules use a monomorphic `Stream` type instead of the polymorphic+`IsStream t` type.++`Streamly.Data.Stream` module and the `Stream` type are meant for+writing high-performance fused pipelines not involving explicit+recursion. For writing code that may require recursive function calls,+`Streamly.Data.Stream.StreamK` module and the `StreamK` type have been+added which provide a CPS based stream implementation. `Stream` and+`StreamK` types can be easily interconverted.++The old code can be adapted to use the new modules with some changes.+See the+[streamly-0.9.0 Upgrade Guide](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md)+for more details on how to adapt your existing code to the new release.++### Enhancements++* Added the following new modules to the `streamly` package:+  * Streamly.Data.Stream.MkType+  * Streamly.Data.Stream.Prelude+* Added the following new modules to the `streamly-core` package:+  * 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++### Deprecations++* Remove support for GHC 8.4.*++Several modules and functions have been deprecated, equivalent modules or+functions are suggested in the deprecation warning messages by the compiler.++### Internal module changes++If you cannot find an internal module that you were using, it may have+been moved to the `streamly-core` package or may have been renamed.++Following modules are moved to `streamly-core` package and renamed:+  * Streamly.Internal.Data.Array.Stream.Foreign -> Streamly.Internal.Data.Stream.Chunked+  * Streamly.Internal.Data.Array.Stream.Mut.Foreign -> Streamly.Internal.Data.Array.Mut.Stream++## 0.8.3 (September 2022)++* Fix build with GHC 9.4+ ## 0.8.2 (Mar 2022)  * Fix performance issues for GHC-9. These changes coupled with GHC changes@@ -14,7 +169,7 @@  ## 0.8.1 (Nov 2021) -See API-changelog.txt for new APIs introduced.+See ApiChangelogs/0.8.0-0.8.1.txt for new APIs introduced.  ### Bug Fixes @@ -42,7 +197,7 @@  ## 0.8.0 (Jun 2021) -See [API Changelog](/docs/API-changelog.txt) for a complete list of signature+See [API Changelog](/docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt) for a complete list of signature changes and new APIs introduced.  ### Breaking changes@@ -81,7 +236,7 @@  ### Enhancements -* See [API Changelog](/docs/API-changelog.txt) for a complete list of new+* See [API Changelog](/docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt) for a complete list of new   modules and APIs introduced. * The Fold type is now more powerful, the new termination behavior allows   to express basic parsing of streams using folds.
CONTRIBUTING.md view
@@ -34,8 +34,8 @@ and benchmarking tasks conveniently. They support running a group of tests or benchmarks, coverage, using correct optimization flags for benchmarking, benchmark comparison reports etc. Use the `--help` option-to see how to use these.  See [benchmark/README.md](/benchmark/README.md)-and [test/README.md](/test/README.md) for more details.+to see how to use these.  See [benchmark/README.md](/docs/Developer/Benchmarks.md)+and [test/README.md](/docs/Developer/Tests.md) for more details.  You can also run tests or benchmarks directly for example: @@ -88,11 +88,10 @@ * Tests are added to cover the changed parts * All [tests](/test) pass * [Performance benchmarks](/benchmark) are added, where applicable-* No significant regressions are reported by [performance benchmarks](/benchmark/README.md)+* No significant regressions are reported by [performance benchmarks](/docs/Developer/Benchmarks.md) * Haddock documentation is added to user visible APIs and data types-* Tutorial module, [Introduction](/docs/Introduction.md), and [guides](/docs) are-  updated if necessary.-* [Changelog](/docs/Changelog.md) is updated if needed+* [Docs](/docs) are updated if necessary.+* [Changelog](/docs/User/ProjectRelated/Changelog.md) is updated if needed * The code conforms to the license, it is not stolen, credit is given,   copyright notices are retained, original license is included if needed. @@ -146,7 +145,7 @@  It is a good idea to include tests for the changes where applicable. See the existing tests in the [test](/test) directory.  Also see the-[test/README.md](/test/README.md) for more details on how to run the tests.+[test/README.md](/docs/Developer/Tests.md) for more details on how to run the tests.  ### Documentation @@ -163,7 +162,7 @@ then you may want to add benchmarks to check if it performs as well as expected by the programmers to deem it usable. -See the [README](/benchmark/README.md) file in the `benchmark` directory for more+See the [README](/docs/Developer/Benchmarks.md) file in the `benchmark` directory for more details on how to run the benchmarks.  The first level of check is the regression in "allocations", this is@@ -222,7 +221,7 @@  * Use https://streamly.composewell.com/ for searching in reference docs * Build haddock docs for latest reference docs-* See [the dev directory](/dev) for design guidelines and dev documents.+* See [the dev directory](/docs/Developer) for design guidelines and dev documents.  ## Coding Guidelines
LICENSE view
@@ -27,172 +27,6 @@ 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.--------------------------------------------------------------------------------- fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/) ------------------------------------------------------------------------------- Copyright (c) 2012, Mark Dittmer@@ -259,91 +93,3 @@ 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.
README.md view
@@ -1,590 +1,88 @@-# [Streamly][]: Idiomatic Haskell with the Performance of C+# [Streamly][]: Idiomatic Haskell with C-Like Performance  [![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)+[![Hackage](https://img.shields.io/hackage/v/streamly-core.svg?style=flat)](https://hackage.haskell.org/package/streamly-core) [![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly) -Streamly is a Haskell library that provides the building blocks to build-safe, scalable, modular and high performance software.  Streamly offers:--* The type safety of Haskell.-* The performance of C programs.-* Powerful abstractions for structuring your code.-* Idiomatic functional programming.-* Declarative concurrency for the seamless use of multiprocessing hardware.--## About This Document--This guide introduces programming with [Streamly][] using a few practical-examples:--*  We will start with a simple program that [counts the number of words-   in a text](#modular-word-counting). We will then transform this program-   into a [concurrent](#concurrent-word-counting) program that can efficiently-   use multiprocessing hardware.-*  Next, we will create a [concurrent network-   server](#a-concurrent-network-server). We then show-   how to write a network server that [merges multiple-   streams](#merging-incoming-streams) concurrently.-*  Our third example shows how to list a directory tree concurrently,-   by reading [multiple directories in-   parallel](#listing-directories-recursivelyconcurrently).-*  Finally, we will look at how to [rate limit](#rate-limiting) stream-   processing.--The guide then looks at how Streamly achieves its-[performance](#performance).  It [concludes](#notes) with a brief-discussion about Streamly's design philosophy, and with suggestions for-further reading.--## Getting Started--### Installing Streamly--If you wish to follow along with this guide, you will need to have-[Streamly][] installed.--Please see the [Getting Started With The Streamly Package](/docs/getting-started.md)-guide for instructions on how to install [Streamly][].--If you wish to run benchmarks, please be sure to build your-application using the instructions in the [Build Guide](/docs/Compiling.md).--### An overview of the types used in these examples--As an expository device, we have indicated the types at the intermediate-stages of stream computations as comments in the examples below.-The meaning of these types are:--* A `SerialT IO a` is a serial stream of values of type `a` in the IO Monad.-* An `AsyncT IO a` is a concurrent (asynchronous) stream of values of type-  `a` in the IO Monad.-* An `Unfold IO a b` is a representation of a function that converts a seed-  value of type `a` into a stream of values of type `b` in the IO Monad.-* A `Fold IO a b` is a representation of a function that converts a stream of-  type `a` to a final accumulator of type `b` in the IO Monad.--### A Note on Module Naming--Some of the examples below use modules from the `Internal` Streamly package-hierarchy.  These are not really internal to the library.  We classify-`Streamly` modules into two categories:--* _Released modules and APIs_: These modules and APIs are-  stable. Significant changes to these modules and APIs will cause-  Streamly's version number to change according to the package versioning-  policy.-* _Pre-release modules and APIs_: These modules and APIs have not been-  formally released yet.  They may change in the near future, and such-  changes will not necessarily be reflected in Streamly's package-  version number.  As yet unreleased modules and APIs reside in the-  `Internal` namespace.--Please use a minor release upper bound to adhere to the Haskell PVP when-using the pre-release (internal) modules.--## The Examples--### Modular Word Counting--A `Fold` in Streamly is a composable stream consumer.  For our first-example, we will use `Fold`s to count the number of bytes, words and lines-present in a file.  We will then compose individual `Fold`s together to-count words, bytes and lines at the same time.--Please see the file [WordCountModular.hs][] for the complete example-program, including the imports that we have omitted here.--#### Count Bytes (wc -c)--We start with a code fragment that counts the number of bytes in a file:--```haskell-import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Internal.FileSystem.File as File-import qualified Streamly.Prelude as Stream--wcb :: String -> IO Int-wcb file =-    File.toBytes file        -- SerialT IO Word8-  & Stream.fold Fold.length  -- IO Int-```--### Count Lines (wc -l)--The next code fragment shows how to count the number of lines in a file:--```haskell--- ASCII character 10 is a newline.-countl :: Int -> Word8 -> Int-countl n ch = if ch == 10 then n + 1 else n---- The fold accepts a stream of `Word8` and returns a line count (`Int`).-nlines :: Monad m => Fold m Word8 Int-nlines = Fold.foldl' countl 0--wcl :: String -> IO Int-wcl file =-    File.toBytes file  -- SerialT IO Word8-  & Stream.fold nlines -- IO Int-```--### Count Words (wc -w)--Our final code fragment counts the number of whitespace-separated words-in a stream:--```haskell-countw :: (Int, Bool) -> Word8 -> (Int, Bool)-countw (n, wasSpace) ch =-    if isSpace $ chr $ fromIntegral ch-    then (n, True)-    else (if wasSpace then n + 1 else n, False)---- The fold accepts a stream of `Word8` and returns a word count (`Int`).-nwords :: Monad m => Fold m Word8 Int-nwords = fst <$> Fold.foldl' countw (0, True)--wcw :: String -> IO Int-wcw file =-    File.toBytes file   -- SerialT IO Word8-  & Stream.fold nwords  -- IO Int-```--### Counting Bytes, Words and Lines Together--By using the `Tee` combinator we can compose the three folds that count-bytes, lines and words individually into a single fold that counts all-three at once.  The applicative instance of `Tee` distributes its input-to all the supplied folds (`Fold.length`, `nlines`, and `nwords`) and-then combines the outputs from the folds using the supplied combiner-function (`(,,)`).--```haskell-import qualified Streamly.Internal.Data.Fold.Tee as Tee---- The fold accepts a stream of `Word8` and returns the three counts.-countAll :: Fold IO Word8 (Int, Int, Int)-countAll = Tee.toFold $ (,,) <$> Tee Fold.length <*> Tee nlines <*> Tee nwords--wc :: String -> IO (Int, Int, Int)-wc file =-    File.toBytes file    -- SerialT IO Word8-  & Stream.fold countAll -- IO (Int, Int, Int)-```--This example demonstrates the excellent modularity offered by-[Streamly][]'s simple and concise API.  Experienced Haskellers will-notice that we have not used bytestrings&mdash;we instead used a stream of-`Word8` values, simplifying our program.--### The Performance of Word Counting--We compare two equivalent implementations: one using [Streamly][],-and the other using C.--The performance of the [Streamly word counting-implementation][WordCount.hs] is:--```-$ time WordCount-hs gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m1.825s-user    0m1.697s-sys     0m0.128s-```--The performance of an equivalent [wc implementation in C][WordCount.c] is:--```-$ time WordCount-c gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m2.100s-user    0m1.935s-sys     0m0.165s-```--### Concurrent Word Counting--In our next example we show how the task of counting words, lines,-and bytes could be done in parallel on multiprocessor hardware.--To count words in parallel we first divide the stream into chunks-(arrays), do the counting within each chunk, and then add all the-counts across chunks.  We use the same code as above except that we use-arrays for our input data.--Please see the file [WordCountParallel.hs][] for the complete working-code for this example, including the imports that we have omitted below.--The `countArray` function counts the line, word, char counts in one chunk:--```haskell-import qualified Streamly.Data.Array.Foreign as Array--countArray :: Array Word8 -> IO Counts-countArray arr =-      Stream.unfold Array.read arr            -- SerialT IO Word8-    & Stream.decodeLatin1                     -- SerialT IO Char-    & Stream.foldl' count (Counts 0 0 0 True) -- IO Counts-```--Here the function `count` and the `Counts` data type are defined in the-`WordCount` helper module defined in [WordCount.hs][].--When combining the counts in two contiguous chunks, we need to check-whether the first element of the next chunk is a whitespace character-in order to determine if the same word continues in the next chunk or-whether the chunk starts with a new word. The `partialCounts` function-adds a `Bool` flag to `Counts` returned by `countArray` to indicate-whether the first character in the chunk is a space.--```haskell-partialCounts :: Array Word8 -> IO (Bool, Counts)-partialCounts arr = do-    let r = Array.getIndex arr 0-    case r of-        Just x -> do-            counts <- countArray arr-            return (isSpace (chr (fromIntegral x)), counts)-        Nothing -> return (False, Counts 0 0 0 True)-```--`addCounts` then adds the counts from two consecutive chunks:--```haskell-addCounts :: (Bool, Counts) -> (Bool, Counts) -> (Bool, Counts)-addCounts (sp1, Counts l1 w1 c1 ws1) (sp2, Counts l2 w2 c2 ws2) =-    let wcount =-            if not ws1 && not sp2 -- No space between two chunks.-            then w1 + w2 - 1-            else w1 + w2-     in (sp1, Counts (l1 + l2) wcount (c1 + c2) ws2)-```--To count in parallel we now only need to divide the stream into arrays,-apply our counting function to each array, and then combine the counts-from each chunk.--```haskell-wc :: String -> IO (Bool, Counts)-wc file = do-      Stream.unfold File.readChunks file -- AheadT IO (Array Word8)-    & Stream.mapM partialCounts          -- AheadT IO (Bool, Counts)-    & Stream.maxThreads numCapabilities  -- AheadT IO (Bool, Counts)-    & Stream.fromAhead                   -- SerialT IO (Bool, Counts)-    & Stream.foldl' addCounts (False, Counts 0 0 0 True) -- IO (Bool, Counts)-```--Please note that the only difference between a concurrent and a-non-concurrent program lies in the use of the `Stream.fromAhead`-combinator.  If we remove the call to `Stream.fromAhead`, we would-still have a perfectly valid and performant serial program. Notice-how succinctly and idiomatically we have expressed the concurrent word-counting problem.--A benchmark with 2 CPUs:--```-$ time WordCount-hs-parallel gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m1.284s-user    0m1.952s-sys     0m0.140s-```--These example programs have assumed ASCII encoded input data.  For UTF-8-streams, we have a [concurrent wc implementation][WordCountParallelUTF8.hs]-with UTF-8 decoding.  This concurrent implementation performs as well-as the standard `wc` program in serial benchmarks. In concurrent mode-[Streamly][]'s implementation can utilise multiple processing cores if-these are present, and can thereby run much faster than the standard-binary.--Streamly provides concurrency facilities similar-to [OpenMP](https://en.wikipedia.org/wiki/OpenMP) and-[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative-style of expression.  With Streamly you can write concurrent programs-with ease, with support for different types of concurrent scheduling.--### A Concurrent Network Server--We now move to a slightly more complicated example: we simulate a-dictionary lookup server which can serve word meanings to multiple-clients concurrently.  This example demonstrates the use of the concurrent-`mapM` combinator.--Please see the file [WordServer.hs][] for the complete code for this-example, including the imports that we have omitted below.--```haskell-import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Network.Inet.TCP as TCP-import qualified Streamly.Network.Socket as Socket-import qualified Streamly.Unicode.Stream as Unicode---- Simulate network/db query by adding a delay.-fetch :: String -> IO (String, String)-fetch w = threadDelay 1000000 >> return (w,w)---- Read lines of whitespace separated list of words from a socket, fetch the--- meanings of each word concurrently and return the meanings separated by--- newlines, in same order as the words were received. Repeat until the--- connection is closed.-lookupWords :: Socket -> IO ()-lookupWords sk =-      Stream.unfold Socket.read sk               -- SerialT IO Word8-    & Unicode.decodeLatin1                       -- SerialT IO Char-    & Stream.wordsBy isSpace Fold.toList         -- SerialT IO String-    & Stream.fromSerial                          -- AheadT  IO String-    & Stream.mapM fetch                          -- AheadT  IO (String, String)-    & Stream.fromAhead                           -- SerialT IO (String, String)-    & Stream.map show                            -- SerialT IO String-    & Stream.intersperse "\n"                    -- SerialT IO String-    & Unicode.encodeStrings Unicode.encodeLatin1 -- SerialT IO (Array Word8)-    & Stream.fold (Socket.writeChunks sk)        -- IO ()--serve :: Socket -> IO ()-serve sk = finally (lookupWords sk) (close sk)---- | Run a server on port 8091. Accept and handle connections concurrently. The--- connection handler is "serve" (i.e. lookupWords).  You can use "telnet" or--- "nc" as a client to try it out.-main :: IO ()-main =-      Stream.unfold TCP.acceptOnPort 8091 -- SerialT IO Socket-    & Stream.fromSerial                   -- AsyncT IO ()-    & Stream.mapM serve                   -- AsyncT IO ()-    & Stream.fromAsync                    -- SerialT IO ()-    & Stream.drain                        -- IO ()-```--### Merging Incoming Streams--In the next example, we show how to merge logs coming from multiple-nodes in your network.  These logs are merged at line boundaries and-the merged logs are written to a file or to a network destination.-This example uses the `concatMapWith` combinator to merge multiple-streams concurrently.--Please see the file [MergeServer.hs][] for the complete working code,-including the imports that we have omitted below.--```haskell-import qualified Streamly.Data.Unfold as Unfold-import qualified Streamly.Network.Socket as Socket---- | Read a line stream from a socket.--- Note: lines are buffered, and we could add a limit to the--- buffering for safety.-readLines :: Socket -> SerialT IO (Array Char)-readLines sk =-    Stream.unfold Socket.read sk                 -- SerialT IO Word8-  & Unicode.decodeLatin1                         -- SerialT IO Char-  & Stream.splitWithSuffix (== '\n') Array.write -- SerialT IO String--recv :: Socket -> SerialT IO (Array Char)-recv sk = Stream.finally (liftIO $ close sk) (readLines sk)---- | Starts a server at port 8091 listening for lines with space separated--- words. Multiple clients can connect to the server and send streams of lines.--- The server handles all the connections concurrently, merges the incoming--- streams at line boundaries and writes the merged stream to a file.-server :: Handle -> IO ()-server file =-      Stream.unfold TCP.acceptOnPort 8090        -- SerialT IO Socket-    & Stream.concatMapWith Stream.parallel recv  -- SerialT IO (Array Char)-    & Stream.unfoldMany Array.read               -- SerialT IO Char-    & Unicode.encodeLatin1                       -- SerialT IO Word8-    & Stream.fold (Handle.write file)            -- IO ()--main :: IO ()-main = withFile "output.txt" AppendMode server-```--### Listing Directories Recursively/Concurrently--Our next example lists a directory tree recursively, reading-multiple directories concurrently.--This example uses the tree traversing combinator `iterateMapLeftsWith`.-This combinator maps a stream generator on the `Left` values in its-input stream (directory names in this case), feeding the resulting `Left`-values back to the input, while it lets the `Right` values (file names-in this case) pass through to the output. The `Stream.ahead` stream-joining combinator then makes it iterate on the directories concurrently.--Please see the file [ListDir.hs][] for the complete working code,-including the imports that we have omitted below.--```haskell-import Streamly.Internal.Data.Stream.IsStream (iterateMapLeftsWith)--import qualified Streamly.Prelude as Stream-import qualified Streamly.Internal.FileSystem.Dir as Dir (toEither)---- Lists a directory as a stream of (Either Dir File).-listDir :: String -> SerialT IO (Either String String)-listDir dir =-      Dir.toEither dir               -- SerialT IO (Either String String)-    & Stream.map (bimap mkAbs mkAbs) -- SerialT IO (Either String String)--    where mkAbs x = dir ++ "/" ++ x---- | List the current directory recursively using concurrent processing.-main :: IO ()-main = do-    hSetBuffering stdout LineBuffering-    let start = Stream.fromPure (Left ".")-    Stream.iterateMapLeftsWith Stream.ahead listDir start-        & Stream.mapM_ print-```--### Rate Limiting--For bounded concurrent streams, a stream yield rate can be specified-easily.  For example, to print "tick" once every second you can simply-write:--```haskell-main :: IO ()-main =-      Stream.repeatM (pure "tick")  -- AsyncT IO String-    & Stream.timestamped            -- AsyncT IO (AbsTime, String)-    & Stream.avgRate 1              -- AsyncT IO (AbsTime, String)-    & Stream.fromAsync              -- SerialT IO (AbsTime, String)-    & Stream.mapM_ print            -- IO ()-```--Please see the file [Rate.hs][] for the complete working code.--The concurrency of the stream is automatically controlled to match the-specified rate. [Streamly][]'s rate control works precisely even at-throughputs as high as millions of yields per second.--For more sophisticated rate control needs please see the Streamly [reference-documentation][Streamly].--### Reactive Programming--Streamly supports reactive (time domain) programming because of its-support for declarative concurrency. Please see the `Streamly.Prelude`-module for time-specific combinators like `intervalsOf`, and-folds like `takeInterval` in `Streamly.Internal.Data.Fold`.-Please also see the pre-release sampling combinators in the-`Streamly.Internal.Data.Stream.IsStream.Top` module for `throttle` and-`debounce` like operations.--The examples [AcidRain.hs][] and [CirclingSquare.hs][] demonstrate-reactive programming using [Streamly][].--### More Examples--If you would like to view more examples, please visit the [Streamly-Examples][streamly-examples] web page.--### Further Reading+## Upgrading to 0.9.0+ -* [Streaming Benchmarks][streaming-benchmarks]-* [Concurrency Benchmarks][concurrency-benchmarks]-* Functional Conf 2019 [Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)-* [Other Guides](/)-* [Streamly Homepage][Streamly]+Please read the [Streamly 0.9.0 Upgrade Guide](/docs/User/Project/Upgrading-0.8-to-0.9.md). -## Performance+## Overview -As you have seen in the word count example above, [Streamly][] offers-highly modular abstractions for building programs while also offering-the performance close to an equivalent (imperative) C program.+Streamly is a powerful Haskell library that provides developers with+the essential building blocks to create safe, scalable, modular, and+high-performance software. With Streamly, developers can enjoy the+benefits of Haskell's type safety while leveraging C-like program+performance.  Streamly offers a comprehensive range of features,+comprising: -Streamly offers excellent performance even for byte-at-a-time stream-operations using efficient abstractions like `Unfold`s and terminating-`Fold`s.  Byte-at-a-time stream operations can simplify programming-because the developer does not have to deal explicitly with chunking-and re-combining data.+* Haskell's strong type safety.+* C-program-like performance capabilities.+* Flexible, modular building blocks.+* Idiomatic functional programming.+* Fearless, declarative concurrency for seamless parallel execution.+* A collection of ecosystem libraries for fast and efficient development. -Streamly exploits GHC's stream fusion optimizations (`case-of-case` and-`spec-constr`) aggressively to achieve C-like speed, while also offering-highly modular abstractions to developers.+Check out the [Learn By Examples](/docs/User/Tutorials/learn-by-examples.md)+page for an introduction to the library. For more detailed documentation, visit+the [Haskell Streamly website][Streamly]. -[Streamly][] will usually perform very well without any-compiler plugins.  However, we have fixed some deficiencies-that we had noticed in GHC's optimizer using a [compiler-plugin](https://github.com/composewell/fusion-plugin).  We hope to fold-these optimizations into GHC in the future; until then we recommend that-you use this plugin for applications that are performance sensitive.+## Blazing Fast -### Benchmarks+Streamly delivers C-like speed in Haskell by fusing stream pipelines+using the stream-fusion technique, resulting in compiled code that is+equivalent to handwritten C code, eliminating intermediate allocations+and function calls. -We measured several Haskell streaming implementations-using various micro-benchmarks. Please see the [streaming-benchmarks][streaming-benchmarks] page for a detailed comparison of-Streamly against other streaming libraries.+For a comprehensive comparison of Streamly to other Haskell streaming+libraries, check out our [streaming benchmarks][streaming-benchmarks]+page. In fact, Streamly's fused loops can be up to 100 times faster than+those of libraries without stream fusion. -Our results show that [Streamly][] is the fastest effectful streaming-implementation on almost all the measured microbenchmarks. In many cases-it runs up to 100x faster, and in some cases even 1000x faster than-some of the tested alternatives. In some composite operation benchmarks-[Streamly][] turns out to be significantly faster than Haskell's list-implementation.+## Declarative Concurrency -*Note*: If you can write a program in some other way or with some other-language that runs significantly faster than what [Streamly][] offers,-please let us know and we will improve.+Streamly introduces declarative concurrency to standard functional+streaming abstractions.  Declarative concurrency abstracts away the+low-level details of concurrency management, such as locks and threads,+and allows for easier and safer parallelization of code.  For example,+with Streamly you can do things like repeat actions concurrently to+generate a stream of results, map functions concurrently on a stream,+and combine multiple streams concurrently to create a single output+stream. -## Notes+## Unified API -Streamly comes equipped with a very powerful set of abstractions to-accomplish many kinds of programming tasks: it provides support for-programming with streams and arrays, for reading and writing from the-file system and from the network, for time domain programming (reactive-programming), and for reacting to file system events using `fsnotify`.+Streamly provides a comprehensive and unified API for basic programming+needs, covering a wide range of areas including streaming, concurrency,+logic programming, reactive programming, pinned and unpinned arrays,+serialization, builders, parsers, unicode processing, file-io, file+system events, and network-io. By unifying functionality from disparate+Haskell libraries, Streamly simplifies development while delivering+equivalent or improved performance. Additionally, the complexity+of handling combinations of lazy, strict, bytestring, and text is+eliminated by using streams for lazy evaluation, and by generalizing+bytestring and text to arrays. -Please view [Streamly's documentation][Streamly] for more information+Check out [Streamly's documentation][Streamly] for more information about Streamly's features. -### Concurrency--Streamly uses lock-free synchronization for achieving concurrent-operation with low overheads.  The number of tasks performed concurrently-are determined automatically based on the rate at which a consumer-is consuming the results. In other words, you do not need to manage-thread pools or decide how many threads to use for a particular task.-For CPU-bound tasks Streamly will try to keep the number of threads-close to the number of CPUs available; for IO-bound tasks it will utilize-more threads.--The parallelism available during program execution can be utilized with-very little overhead even where the task size is very-small, because Streamly will automatically switch between-serial or batched execution of tasks on the same CPU depending-on whichever is more efficient.  Please see our [concurrency-benchmarks][concurrency-benchmarks] for more detailed performance-measurements, and for a comparison with the `async` package.--### Design Goals--Our goals for [Streamly][] from the very beginning have been:+## Batteries Included -1. To achieve simplicity by unifying abstractions.-2. To offer high performance.+In addition to the fundamental programming constructs, Streamly also+provides higher-level functionality through supporting packages such as+[streamly-process][], [streamly-shell][], and [streamly-coreutils][]+that are essential for general programming tasks. Check out the+[streamly-examples][] repository for some program snippets. -These goals are hard to achieve simultaneously because they are usually-inversely related.  We have spent many years trying to get the abstractions-right without compromising performance.+## Highly Modular -`Unfold` is an example of an abstraction that we have created to achieve-high performance when mapping streams on streams.  `Unfold` allows stream-generation to be optimized well by the compiler through stream fusion.-A `Fold` with termination capability is another example which modularizes-stream elimination operations through stream fusion.  Terminating folds-can perform many simple parsing tasks that do not require backtracking.-In Streamly, `Parser`s are a natural extension to terminating `Fold`s;-`Parser`s add the ability to backtrack to `Fold`s.  Unification leads-to simpler abstractions and lower cognitive overheads while also not-compromising performance.+Traditionally, you must choose between modularity and performance when+writing code. However, with [Haskell Streamly][Streamly], you can have+the best of both worlds. By taking advantage of GHC's stream fusion+optimizations (such as `case-of-case` and `spec-constr`), Streamly achieves+performance comparable to an equivalent C program while still allowing+for highly modular code.  ## Credits @@ -595,7 +93,7 @@   * Gabriella Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))   * Alberto G. Corona ([transient](https://hackage.haskell.org/package/transient)) -Please see the [`credits`](/docs/Credits.md) directory for a full+Please see the [`credits`](/docs/User/Project/Credits.md) directory for a full list of contributors, credits and licenses.  ## Licensing@@ -623,29 +121,19 @@ -->  [Streamly]: https://streamly.composewell.com/-[streamly-examples]: https://github.com/composewell/streamly-examples [streaming-benchmarks]: https://github.com/composewell/streaming-benchmarks [concurrency-benchmarks]: https://github.com/composewell/concurrency-benchmarks+[streamly-examples]: https://github.com/composewell/streamly-examples+[streamly-process]: https://github.com/composewell/streamly-process+[streamly-shell]: https://github.com/composewell/streamly-shell+[streamly-coreutils]: https://github.com/composewell/streamly-coreutils  <!-- Keep all the unstable links here so that they can be updated to stable links (for online docs) before we release. --> -<!-- examples -->-[WordCountModular.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountModular.hs-[WordCount.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.hs-[WordCount.c]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.c-[WordCountParallel.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallel.hs-[WordCountParallelUTF8.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallelUTF8.hs-[WordServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordServer.hs-[MergeServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/MergeServer.hs-[ListDir.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/ListDir.hs-[Rate.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/Rate.hs-[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs-[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs- <!-- local files --> [LICENSE]: /LICENSE-[CONTRIBUTING.md]: /CONTRIBUTING.md+[CONTRIBUTING.md]: /docs/Developer/Contributing.md [docs]: docs/
+ bench-test-lib/bench-test-lib.cabal view
@@ -0,0 +1,67 @@+cabal-version:      3.0+name:               bench-test-lib+version:            0.1.0.0+build-type:         Simple++common compile-options+    default-language: Haskell2010+    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 impl(ghc >= 9.8)+      ghc-options:+        -Wno-missing-role-annotations++common default-extensions+    default-extensions:+        BangPatterns+        ConstraintKinds+        DeriveDataTypeable+        DeriveGeneric+        DeriveTraversable+        ExistentialQuantification+        FlexibleContexts+        FlexibleInstances+        GeneralizedNewtypeDeriving+        InstanceSigs+        KindSignatures+        MultiParamTypeClasses+        RankNTypes+        ScopedTypeVariables+        TupleSections+        TypeApplications+        TypeOperators++        -- Not GHC2021+        CApiFFI+        CPP+        LambdaCase+        MagicHash+        RecordWildCards++library+    import:           compile-options, default-extensions+    exposed-modules:  BenchTestLib.DirIO+    build-depends:    base+                    , streamly-core+                    , streamly+                    , directory+    hs-source-dirs:   src+    default-language: Haskell2010
+ bench-test-lib/src/BenchTestLib/DirIO.hs view
@@ -0,0 +1,300 @@+-- |+-- Module      : BenchTestLib.DirIO+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE QuasiQuotes #-}++module BenchTestLib.DirIO+    ( createDirStucture+    , listDirUnfoldDfs+    , listDirUnfoldBfs+    , listDirUnfoldBfsRev+    , listDirConcatDfs+    , listDirConcatBfs+    , listDirConcatBfsRev+    , listDirAppend+    , listDirInterleave+    , listDirPar+    , listDirParInterleaved+    , listDirParOrdered+    , listDirChunkDfs+    , listDirChunkBfs+    , listDirChunkBfsRev+    , listDirChunkAppend+    , listDirChunkInterleave+    , listDirChunkPar+    , listDirChunkParInterleaved+    , listDirChunkParOrdered+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+    , listDirByteChunked+#endif+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.IORef (newIORef, modifyIORef', readIORef)+import Data.Maybe (fromJust)+import Data.Word (Word8)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Streamly.Data.Array (Array)+#endif+import Streamly.Data.Stream (Stream)+import Streamly.Data.Unfold (Unfold)+import Streamly.FileSystem.Path (Path)+import Streamly.Unicode.String (str)+import System.Directory (createDirectoryIfMissing)+import Data.Foldable (for_)++import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Data.Array as Array+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Data.StreamK as StreamK+import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Streamly.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.FileSystem.DirIO as Dir+import qualified Streamly.FileSystem.Path as Path+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import qualified Streamly.Internal.FileSystem.Posix.ReadDir as Dir+#endif++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++concatIterateWith :: Monad m =>+                           (a -> Stream m a)+                           -> (StreamK.StreamK m a+                               -> StreamK.StreamK m a -> StreamK.StreamK m a)+                           -> Stream m a+                           -> Stream m a+concatIterateWith nxt f =+      StreamK.toStream+    . StreamK.concatIterateWith f (StreamK.fromStream . nxt)+    . StreamK.fromStream++mergeIterateWith :: Monad m =>+                          (a -> Stream m a)+                          -> (StreamK.StreamK m a+                              -> StreamK.StreamK m a -> StreamK.StreamK m a)+                          -> Stream m a+                          -> Stream m a+mergeIterateWith nxt f =+      StreamK.toStream+    . StreamK.mergeIterateWith f (StreamK.fromStream . nxt)+    . StreamK.fromStream++streamDir+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either Path b -> Stream IO (Either Path Path)+streamDir f = either (Dir.readEitherPaths f) (const Stream.nil)++unfoldDir+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Unfold IO (Either Path b) (Either Path Path)+unfoldDir f = Unfold.either (Dir.eitherReaderPaths f) Unfold.nil++streamDirMaybe+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either Path b -> Maybe (Stream IO (Either Path Path))+streamDirMaybe f = either (Just . Dir.readEitherPaths f) (const Nothing)++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+_streamDirByteChunked+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either [Path] b -> Stream IO (Either [Path] (Array Word8))+_streamDirByteChunked f = either (Dir.readEitherByteChunks f) (const Stream.nil)++streamDirByteChunkedMaybe+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either [Path] b -> Maybe (Stream IO (Either [Path] (Array Word8)))+streamDirByteChunkedMaybe f =+    either (Just . Dir.readEitherByteChunks f) (const Nothing)+#endif++streamDirChunkedMaybe+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either [Path] b -> Maybe (Stream IO (Either [Path] [Path]))+streamDirChunkedMaybe f = either (Just . Dir.readEitherChunks f) (const Nothing)++streamDirChunked+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either [Path] b -> Stream IO (Either [Path] [Path])+streamDirChunked f = either (Dir.readEitherChunks f) (const Stream.nil)++--------------------------------------------------------------------------------+-- Functions+--------------------------------------------------------------------------------++createDirStucture :: FilePath -> Int -> Int -> IO [FilePath]+createDirStucture root d w = do+    ref <- newIORef [root]+    createDirStucture_ ref root d w+    readIORef ref+    where+    createDirStucture_ _ _ depth _ | depth <= 0 = pure ()+    createDirStucture_ ref parentDir depth width = do+        for_ [1..width] $ \i -> do+            let iStr = show i+                subDir = [str|#{parentDir}/dir_#{iStr}|]+            createDirectoryIfMissing True subDir+            modifyIORef' ref (subDir:)+            createDirStucture_ ref subDir (depth - 1) width++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+-- Fastest implementation, only works for posix as of now.+{-# INLINE listDirByteChunked #-}+listDirByteChunked :: FilePath -> Stream IO (Array Word8)+listDirByteChunked inp = do+     Stream.catRights+        $ Stream.concatIterate (streamDirByteChunkedMaybe id)+        $ Stream.fromPure (Left [fromJust $ Path.fromString inp])+#endif++-- Faster than the listDir implementation below+{-# INLINE listDirChunkedWith #-}+listDirChunkedWith+    :: (Stream IO (Either [Path] b) -> Stream IO (Either [Path] [Path]))+    -> [Char] -> Stream IO Word8+listDirChunkedWith act inp = do+     Stream.unfoldEachEndBy 10 Array.reader+        $ fmap (Array.asBytes . Path.toArray)+        $ Stream.unfoldEach Unfold.fromList+        $ fmap (either id id)+        $ act+        $ Stream.fromPure (Left [fromJust $ Path.fromString inp])++{-# INLINE listDirWith #-}+listDirWith+    :: (Stream IO (Either Path Path) -> Stream IO (Either Path Path))+    -> [Char] -> Stream IO Word8+listDirWith act inp = do+     Stream.unfoldEachEndBy 10 Array.reader+        $ fmap (Array.asBytes . Path.toArray . either id id)+        $ act+        $ Stream.fromPure (Left (fromJust $ Path.fromString inp))++--------------------------------------------------------------------------------+-- Non chunked+--------------------------------------------------------------------------------++{-# INLINE listDirUnfoldDfs #-}+listDirUnfoldDfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirUnfoldDfs f = listDirWith (Stream.unfoldIterate (unfoldDir f))++{-# INLINE listDirUnfoldBfs #-}+listDirUnfoldBfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirUnfoldBfs f = listDirWith (Stream.bfsUnfoldIterate (unfoldDir f))++{-# INLINE listDirUnfoldBfsRev #-}+listDirUnfoldBfsRev+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirUnfoldBfsRev f = listDirWith (Stream.altBfsUnfoldIterate (unfoldDir f))++{-# INLINE listDirConcatDfs #-}+listDirConcatDfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirConcatDfs f = listDirWith (Stream.concatIterate (streamDirMaybe f))++{-# INLINE listDirConcatBfs #-}+listDirConcatBfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirConcatBfs f = listDirWith (Stream.bfsConcatIterate (streamDirMaybe f))++{-# INLINE listDirConcatBfsRev #-}+listDirConcatBfsRev+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirConcatBfsRev f =+    listDirWith (Stream.altBfsConcatIterate (streamDirMaybe f))++{-# INLINE listDirAppend #-}+listDirAppend+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirAppend f = listDirWith (concatIterateWith (streamDir f) StreamK.append)++{-# INLINE listDirInterleave #-}+listDirInterleave+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirInterleave f =+    listDirWith (mergeIterateWith (streamDir f) StreamK.interleave)++{-# INLINE listDirPar #-}+listDirPar+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirPar f = listDirWith (Stream.parConcatIterate id (streamDir f))++{-# INLINE listDirParInterleaved #-}+listDirParInterleaved+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirParInterleaved f =+    listDirWith+        (Stream.parConcatIterate (Stream.interleaved True) (streamDir f))++{-# INLINE listDirParOrdered #-}+listDirParOrdered+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirParOrdered f =+    listDirWith (Stream.parConcatIterate (Stream.ordered True) (streamDir f))++--------------------------------------------------------------------------------+-- Chunked+--------------------------------------------------------------------------------++{-# INLINE listDirChunkDfs #-}+listDirChunkDfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkDfs f =+    listDirChunkedWith (Stream.concatIterate (streamDirChunkedMaybe f))++{-# INLINE listDirChunkBfs #-}+listDirChunkBfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkBfs f =+    listDirChunkedWith (Stream.bfsConcatIterate (streamDirChunkedMaybe f))++{-# INLINE listDirChunkBfsRev #-}+listDirChunkBfsRev+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkBfsRev f =+    listDirChunkedWith (Stream.altBfsConcatIterate (streamDirChunkedMaybe f))++{-# INLINE listDirChunkAppend #-}+listDirChunkAppend+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkAppend f =+    listDirChunkedWith (concatIterateWith (streamDirChunked f) StreamK.append)++{-# INLINE listDirChunkInterleave #-}+listDirChunkInterleave+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkInterleave f =+    listDirChunkedWith+        (mergeIterateWith (streamDirChunked f) StreamK.interleave)++{-# INLINE listDirChunkPar #-}+listDirChunkPar+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkPar f =+    listDirChunkedWith (Stream.parConcatIterate id (streamDirChunked f))++{-# INLINE listDirChunkParInterleaved #-}+listDirChunkParInterleaved+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkParInterleaved f =+    listDirChunkedWith+        (Stream.parConcatIterate (Stream.interleaved True) (streamDirChunked f))++{-# INLINE listDirChunkParOrdered #-}+listDirChunkParOrdered+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkParOrdered f =+    listDirChunkedWith+        (Stream.parConcatIterate (Stream.ordered True) (streamDirChunked f))
benchmark/NanoBenchmarks.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ ------------------------------------------------------------------------------- -- Investigate specific benchmarks more closely in isolation, possibly looking -- at GHC generated code for optimizing specific problematic cases.@@ -6,30 +8,27 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} -import Streamly.Prelude (SerialT)-import Streamly.Internal.Data.SVar (MonadAsync)+import Data.Char (ord)+import Streamly.Internal.Data.Stream (Stream)+import System.IO (hSeek, SeekMode(..), openFile, IOMode(..)) -import qualified Streamly.Data.Array.Foreign as A-import qualified Streamly.FileSystem.Handle as FH+import qualified Streamly.Data.Array as A import qualified Streamly.Internal.FileSystem.Handle as IFH import qualified Streamly.Data.Fold as FL+import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Stream.IsStream as Internal-import qualified Streamly.Prelude as S-import qualified Streamly.Internal.Data.Stream.StreamK as K -import Data.Char (ord)-import Gauge-import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))+import Test.Tasty.Bench import System.Random  maxValue :: Int maxValue = 100000 --- type Stream = K.Stream-type Stream = SerialT+drain :: Monad m => S.Stream m a -> m ()+drain = S.fold FL.drain  {-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: MonadAsync m => Stream m Int+sourceUnfoldrM :: Monad m => Stream m Int sourceUnfoldrM = S.unfoldrM step 0     where     step cnt =@@ -38,7 +37,7 @@         else return (Just (cnt, cnt + 1))  {-# INLINE sourceUnfoldrMN #-}-sourceUnfoldrMN :: MonadAsync m => Int -> Stream m Int+sourceUnfoldrMN :: Monad m => Int -> Stream m Int sourceUnfoldrMN n = S.unfoldrM step n     where     step cnt =@@ -67,7 +66,7 @@  {-# INLINE takeDrop #-} takeDrop :: Monad m => Stream m Int -> m ()-takeDrop = S.drain .+takeDrop = drain .     takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne  -------------------------------------------------------------------------------@@ -82,7 +81,7 @@  {-# INLINE dropWhileFalseX4 #-} dropWhileFalseX4 :: Monad m => Stream m Int -> m ()-dropWhileFalseX4 = S.drain+dropWhileFalseX4 = drain     . dropWhileFalse . dropWhileFalse . dropWhileFalse .  dropWhileFalse  -------------------------------------------------------------------------------@@ -91,7 +90,7 @@  {-# INLINE iterateSource #-} iterateSource-    :: MonadAsync m+    :: Monad m     => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int iterateSource g i n = f i (sourceUnfoldrMN n)     where@@ -103,20 +102,26 @@ main :: IO () main = do     defaultMain [bench "unfoldr" $ nfIO $-        randomRIO (1,1) >>= \n -> S.drain (sourceUnfoldr n)]+        randomRIO (1,1) >>= \n -> drain (sourceUnfoldr n)]     defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]     defaultMain [bench "dropWhileFalseX4" $         nfIO $ dropWhileFalseX4 sourceUnfoldrM]     defaultMain [bench "iterate-mapM" $-        nfIO $ S.drain $ iterateSource (S.mapM return) 100000 10]+        nfIO $ drain $ iterateSource (S.mapM return) 100000 10]      inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode     defaultMain [mkBenchText "splitOn abc...xyz" inText $ do-                (S.length $ Internal.splitOnSeq (A.fromList $ map (fromIntegral . ord)-                    "abcdefghijklmnopqrstuvwxyz") FL.drain-                        $ IFH.toBytes inText) >>= print+                S.fold FL.length+                    (Internal.splitOnSeq+                        (A.fromList+                            $ map (fromIntegral . ord) "abcdefghijklmnopqrstuvwxyz"+                        )+                        FL.drain+                        $ IFH.read inText+                    )+                    >>= print                 ]     where      mkBenchText name h action =-        bench name $ perRunEnv (hSeek h AbsoluteSeek 0) (\_ -> action)+        env (hSeek h AbsoluteSeek 0) (\_ -> bench name $ nfIO action)
benchmark/README.md view
@@ -1,18 +1,7 @@ # Benchmarking -## Benchmark Drivers--Two benchmark drivers are supported:--* `tasty-bench` (default)-* `gauge` (enabled by `--use-gauge` build flag)- ## Build and run benchmarks directly -The benchmark executables are `tasty-bench` executables unless you have-passed `--use-gauge` cabal flag when building in which case it is a-`gauge` executable.- ``` $ cabal run bench:Prelude.Serial  # run selected $ cabal run bench:Prelude.Serial -- --help # help on arguments@@ -26,53 +15,84 @@ $ cabal build --flag "-opt" ... # disable optimization, faster build ``` -## Building and Running Benchmarks with bench.sh+## Building and Running Benchmarks with bench-runner -`<streamly repo>/bin/bench.sh` script is the top level driver for+The executable `bench-runner` is the top level driver for running benchmarks. It runs the requested benchmarks and then creates a report from the results using the `bench-show` package. -IMPORTANT NOTE:  The first time you run this script it may take a long+IMPORTANT NOTE:  The first time you run this executable it may take a long time because it has to build the `bench-report` executable which has a-lot of dependencies.  If you are using nix then use `--use-nix` flag-for the first time so that the `bench-report` executable is built using-nix. That can save a lot of time compiling it. However, once it is built-it will be cached in the `bin` directory of the repo and used from-there every time. You can also build it manually from the cabal file in-`benchmark/bench-report` and install it in the `bin` directory.+lot of dependencies. -## bench.sh: Quick start+You can install it once in the root of the repository and use it multiple times. +You can use `cabal.project.report` to install bench-runner like so:+```+$ cabal install bench-runner --project-file=cabal.project.report --installdir=./  --overwrite-policy=always+$ ./bench-runner <bench-runner-args>+```++If you're using nix, you can install bench-runner like so:+```+$ cd benchmark/bench-runner+$ nix-shell --run 'cabal install bench-runner --installdir=../../  --overwrite-policy=always'+$ cd ../../+$ ./bench-runner <bench-runner-args>+```++You can run the `bench-runner` without installing, like so:+```+$ cabal run bench-runner --project-file=cabal.project.report -- <bench-runner-args>+```++## bench-runner: Quick start++Assuming `bench-runner` is the executable. You can replace `./bench-runner` with+`cabal run bench-runner --project-file=cabal.project.report --`++Note, you need to pass two mandatory arguments to bench-runner,+`package-version` and `package-name`. For the streamly-benchmarks package, pass+these as below:++```+bin/bench-runner --package-version 0.0.0 --package-name streamly-benchmarks+```+ Useful commands:  ```-$ bin/bench.sh --help-$ bin/bench.sh --quick # run all the benchmark suites-$ bin/bench.sh --benchmarks help # Show available benchmark suites-$ bin/bench.sh --benchmarks serial_grp # Run all serial benchmark suites-$ bin/bench.sh --benchmarks "Prelude.Serial Data.Parser" # run selected suites-$ bin/bench.sh --no-measure # don't run benchmarks just show previous results+$ ./bench-runner --help+$ ./bench-runner --quick # run all the benchmark suites+$ ./bench-runner --targets help # Show available benchmark suites+$ ./bench-runner --targets serial_grp # Run all serial benchmark suites+$ ./bench-runner --targets "Prelude.Serial Data.Parser" # run selected suites+$ ./bench-runner --no-measure # don't run benchmarks just show previous results  # Run all O(1) space complexity benchmarks in `Prelude.Serial` suite-$ bin/bench.sh --benchmarks Prelude.Serial --prefix Prelude.Serial/o-1-space+$ ./bench-runner --targets Prelude.Serial --prefix Prelude.Serial/o-1-space  # Run a specific benchmark in `Prelude.Serial` suite-$ bin/bench.sh --benchmarks Prelude.Serial --prefix Prelude.Serial/o-1-space.generation.unfoldr+$ ./bench-runner --targets Prelude.Serial --prefix Prelude.Serial/o-1-space.generation.unfoldr ``` -Note: `bench.sh` enables fusion-plugin by default.+Note: `bench-runner` enables fusion-plugin by default.  ## Comparing results with baseline  ``` # Checkout baseline commit-$ bin/bench.sh --quick+$ ./bench-runner --quick  # Checkout commit with new changes-$ bin/bench.sh --quick --append+$ ./bench-runner --quick --append  # To add another result to comparisons just repeat the above command on # desired commit++# To display the current results without running the benchmarks.+# See "Reporting without measuring" for more info.+$ ./bench-runner --no-measure ```  ## Comparing benchmark suites@@ -80,7 +100,7 @@ First see the available benchmark suites:  ```-$ bin/bench.sh --benchmarks help+$ ./bench-runner --targets help ```  You will see some benchmark suites end with `_cmp`, these are comparison@@ -89,7 +109,7 @@ all array benchmark suites:  ```-$ bin/bench.sh --benchmarks array_cmp+$ ./bench-runner --targets array_cmp ```  ## Reporting without measuring@@ -102,7 +122,7 @@  You can also manually edit the file to remove a set of results if you like or to append results from previously saved results or from some other results-file. After editing you can run `bench.sh` with the `--no-measure` option to+file. After editing you can run `bench-runner` with the `--no-measure` option to see the reports corresponding to the results.  ## Additional benchmark configuration@@ -134,7 +154,7 @@ To run the unicode benchmarks on valid utf8 input, you can do the following,  ```-$ Benchmark_FileSystem_Handle_InputFile=<valid-unicode-filepath> bin/bench.sh --benchmarks Unicode.Stream --cabal-build-options "-f include-strict-utf8"+$ Benchmark_FileSystem_Handle_InputFile=<valid-unicode-filepath> ./bench-runner --benchmarks Unicode.Stream --cabal-build-options "-f include-strict-utf8" ```  ## Benchmarking notes@@ -145,7 +165,8 @@  ### Gotchas -Gauge forces a GC before and after the measurement. However, we have observed+The benchmark driver forces a GC before and after the measurement.+However, we have observed that sometimes the GC stats may not be accurate when the number of iterations in the measurement is small (e.g. 1 iteration).  In such cases usually the number of GCs and GC times would also be 0.@@ -168,10 +189,10 @@  There are two ways to find problematic code: -1. Run performance benchmarks using `bench.sh`, select the benchmarks+1. Run performance benchmarks using `bench-runner`, select the benchmarks    that are taking more than expected time. 2. When making a new change, compare with the baseline and select benchmarks-   with the most regression reported by `bench.sh`.+   with the most regression reported by `bench-runner`.  Number of allocations are the most stable measure that do not vary from run to run. `cpuTime` and `bytesCopied` may vary. When comparing two@@ -310,7 +331,7 @@ ### Resolving the problem  Review the problematic code, see [the optimization-guide](/dev/optimization-guidelines.md) for common problems and how to+guide](/docs/Developer/optimization-guidelines.md) for common problems and how to solve those. If no obvious issues are found on review, then generate and examine the core.
benchmark/Streamly/Benchmark/Data/Array.hs view
@@ -1,22 +1,43 @@+{-# OPTIONS_GHC -Wno-orphans #-}+ {-# LANGUAGE CPP #-}  #include "Streamly/Benchmark/Data/Array/CommonImports.hs"  import Control.DeepSeq (deepseq)+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif  import qualified Streamly.Internal.Data.Array as IA+import qualified GHC.Exts as GHC++-- import qualified Streamly.Data.Array as A import qualified Streamly.Internal.Data.Array as A++#if __GLASGOW_HASKELL__ >= 810+type Stream :: Type -> Type+#endif type Stream = A.Array  #include "Streamly/Benchmark/Data/Array/Common.hs" +instance NFData (A.Array a) where+    {-# INLINE rnf #-}+    rnf _ = ()+ ------------------------------------------------------------------------------- -- Benchmark helpers ------------------------------------------------------------------------------- +-- Drain a source that generates a pure array+{-# INLINE benchPureSrc #-}+benchPureSrc :: String -> (Int -> Stream a) -> Benchmark+benchPureSrc name src = benchPure name src id+ -- Drain a source that generates an array in the IO monad {-# INLINE benchIOSrc #-}-benchIOSrc :: NFData a => String -> (Int -> IO (Stream a)) -> Benchmark+benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark benchIOSrc name src = benchIO name src id  -------------------------------------------------------------------------------@@ -27,7 +48,6 @@ sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int) sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value] - {-# INLINE readInstance #-} readInstance :: P.String -> Stream Int readInstance str =@@ -48,9 +68,17 @@ -} #endif +{-# INLINE sourceIsList #-}+sourceIsList :: Int -> Int -> Stream Int+sourceIsList value n = GHC.fromList [n..n+value]++{-# INLINE sourceIsString #-}+sourceIsString :: Int -> Int -> Stream P.Char+sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')+ {-# INLINE sourceIntFromToFromStream #-} sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)+sourceIntFromToFromStream value n = S.fold A.create $ S.enumerateFromTo n (n + value)  ------------------------------------------------------------------------------- -- Bench groups@@ -61,18 +89,24 @@     [ bgroup         "generation"         [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)-        , let testStr = mkListString value+        , let testStr = "fromList " ++ mkListString value            in testStr `deepseq` bench "read" (nf readInstance testStr)+        , benchPureSrc "writeN . IsList.fromList" (sourceIsList value)+        , benchPureSrc+              "writeN . IsString.fromString"+              (sourceIsString value)+         ]     ]  o_1_space_elimination :: Int -> [Benchmark] o_1_space_elimination value =     [ bgroup "elimination"-        [ benchFold "writeLastN.1"-            (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)-        , benchFold "writeLastN.10"-            (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)+        [ benchPureSink value "length . IsList.toList" (length . GHC.toList)+        , benchFold "createOfLast.1"+            (S.fold (IA.createOfLast 1)) (P.sourceUnfoldrM value)+        , benchFold "createOfLast.10"+            (S.fold (IA.createOfLast 10)) (P.sourceUnfoldrM value) #ifdef DEVBUILD {-           benchPureSink value "foldable/foldl'" foldableFoldl'@@ -87,7 +121,7 @@     [ bgroup "elimination"         [         -- Converting the stream to an array-            benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))+            benchFold "createOfLast.Max" (S.fold (IA.createOfLast (value + 1)))                 (P.sourceUnfoldrM value)          ]     ]
benchmark/Streamly/Benchmark/Data/Array/Common.hs view
@@ -1,5 +1,3 @@-- ------------------------------------------------------------------------------- -- Benchmark helpers -------------------------------------------------------------------------------@@ -28,7 +26,7 @@  {-# INLINE sourceUnfoldr #-} sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)-sourceUnfoldr value n = S.fold (A.writeN value) $ S.unfoldr step n+sourceUnfoldr value n = S.fold (A.createOf value) $ S.unfoldr step n     where     step cnt =         if cnt > n + value@@ -37,11 +35,11 @@  {-# INLINE sourceIntFromTo #-} sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromTo value n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)+sourceIntFromTo value n = S.fold (A.createOf value) $ S.enumerateFromTo n (n + value)  {-# INLINE sourceFromList #-} sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)-sourceFromList value n = S.fold (A.writeN value) $ S.fromList [n..n+value]+sourceFromList value n = S.fold (A.createOf value) $ S.fromList [n..n+value]  ------------------------------------------------------------------------------- -- Transformation@@ -68,14 +66,14 @@  {-# INLINE onArray #-} onArray-    :: MonadIO m => Int -> (S.SerialT m Int -> S.SerialT m Int)+    :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)     -> Stream Int     -> m (Stream Int)-onArray value f arr = S.fold (A.writeN value) $ f $ S.unfold A.read arr+onArray value f arr = S.fold (A.createOf value) $ f $ S.unfold A.reader arr -scanl'  value n = composeN n $ onArray value $ S.scanl' (+) 0-scanl1' value n = composeN n $ onArray value $ S.scanl1' (+)-map     value n = composeN n $ onArray value $ S.map (+1)+scanl'  value n = composeN n $ onArray value $ S.scanl (Scanl.mkScanl (+) 0)+scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)+map     value n = composeN n $ onArray value $ fmap (+1) -- map           n = composeN n $ A.map (+1)  {-# INLINE eqInstance #-}@@ -100,8 +98,7 @@  {-# INLINE pureFoldl' #-} pureFoldl' :: MonadIO m => Stream Int -> m Int-pureFoldl' = S.foldl' (+) 0 . S.unfold A.read-+pureFoldl' = S.fold (Fold.foldl' (+) 0) . S.unfold A.reader  ------------------------------------------------------------------------------- -- Elimination@@ -109,11 +106,11 @@  {-# INLINE unfoldReadDrain #-} unfoldReadDrain :: MonadIO m => Stream Int -> m ()-unfoldReadDrain = S.drain . S.unfold A.read+unfoldReadDrain = S.fold Fold.drain . S.unfold A.reader  {-# INLINE toStreamRevDrain #-} toStreamRevDrain :: MonadIO m => Stream Int -> m ()-toStreamRevDrain = S.drain . A.toStreamRev+toStreamRevDrain = S.fold Fold.drain . A.readRev  ------------------------------------------------------------------------------- -- Bench groups@@ -152,7 +149,7 @@     [ bgroup "elimination"         [         -- Converting the stream to an array-            benchFold "writeN" (S.fold (A.writeN value))+            benchFold "writeN" (S.fold (A.createOf value))                 (P.sourceUnfoldrM value)          ]     ]
benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs view
@@ -1,17 +1,17 @@ {-# LANGUAGE FlexibleContexts #-}  import Control.DeepSeq (NFData(..))+import Control.Monad.IO.Class (MonadIO)+import Data.Functor ((<&>)) import System.Random (randomRIO) -import qualified Streamly.Prelude  as S+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl+import qualified Streamly.Data.Stream as S+import qualified Streamly.Internal.Data.Stream as Stream -import Gauge+import Test.Tasty.Bench import Streamly.Benchmark.Common hiding (benchPureSrc)-import qualified Streamly.Benchmark.Prelude as P---import Control.Monad.IO.Class (MonadIO)+import qualified Stream.Common as P  import Prelude as P hiding (map)--import Data.Functor ((<&>))
− benchmark/Streamly/Benchmark/Data/Array/Foreign.hs 
@@ -1,132 +0,0 @@-{-# LANGUAGE CPP #-}--#include "Streamly/Benchmark/Data/Array/CommonImports.hs"--import Control.DeepSeq (deepseq)--import qualified Streamly.Internal.Data.Array.Foreign as IA-import qualified GHC.Exts as GHC--import qualified Streamly.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Foreign as A-type Stream = A.Array--#include "Streamly/Benchmark/Data/Array/Common.hs"------------------------------------------------------------------------------------ Benchmark helpers------------------------------------------------------------------------------------ Drain a source that generates a pure array-{-# INLINE benchPureSrc #-}-benchPureSrc :: String -> (Int -> Stream a) -> Benchmark-benchPureSrc name src = benchPure name src id---- Drain a source that generates an array in the IO monad-{-# INLINE benchIOSrc #-}-benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark-benchIOSrc name src = benchIO name src id------------------------------------------------------------------------------------ Bench Ops----------------------------------------------------------------------------------{-# INLINE sourceIntFromToFromList #-}-sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]--{-# INLINE readInstance #-}-readInstance :: P.String -> Stream Int-readInstance str =-    let r = P.reads str-    in case r of-        [(x,"")] -> x-        _ -> P.error "readInstance: no parse"--#ifdef DEVBUILD-{--{-# INLINE foldableFoldl' #-}-foldableFoldl' :: Stream Int -> Int-foldableFoldl' = F.foldl' (+) 0--{-# INLINE foldableSum #-}-foldableSum :: Stream Int -> Int-foldableSum = P.sum--}-#endif--{-# INLINE sourceIsList #-}-sourceIsList :: Int -> Int -> Stream Int-sourceIsList value n = GHC.fromList [n..n+value]--{-# INLINE sourceIsString #-}-sourceIsString :: Int -> Int -> Stream P.Char-sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')--{-# INLINE sourceIntFromToFromStream #-}-sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)------------------------------------------------------------------------------------ Bench groups----------------------------------------------------------------------------------o_1_space_generation :: Int -> [Benchmark]-o_1_space_generation value =-    [ bgroup-        "generation"-        [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)-        , let testStr = mkListString value-           in testStr `deepseq` bench "read" (nf readInstance testStr)-        , benchPureSrc "writeN . IsList.fromList" (sourceIsList value)-        , benchPureSrc-              "writeN . IsString.fromString"-              (sourceIsString value)--        ]-    ]--o_1_space_elimination :: Int -> [Benchmark]-o_1_space_elimination value =-    [ bgroup "elimination"-        [ benchPureSink value "length . IsList.toList" (length . GHC.toList)-        , benchFold "writeLastN.1"-            (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)-        , benchFold "writeLastN.10"-            (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)-#ifdef DEVBUILD-{--          benchPureSink value "foldable/foldl'" foldableFoldl'-        , benchPureSink value "foldable/sum" foldableSum--}-#endif-        ]-      ]--o_n_heap_serial :: Int -> [Benchmark]-o_n_heap_serial value =-    [ bgroup "elimination"-        [-        -- Converting the stream to an array-            benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))-                (P.sourceUnfoldrM value)-         ]-    ]--moduleName :: String-moduleName = "Data.Array.Foreign"--defStreamSize :: Int-defStreamSize = defaultStreamSize--main :: IO ()-main = runWithCLIOpts defStreamSize allBenchmarks--    where--    allBenchmarks size =-        [ bgroup (o_1_space_prefix moduleName) $-             o_1_space_generation size ++ o_1_space_elimination size-        , bgroup (o_n_space_prefix moduleName) $-             o_n_heap_serial size-        ] ++ commonBenchmarks size
− benchmark/Streamly/Benchmark/Data/Array/Foreign/Mut.hs 
@@ -1,82 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.Array.Foreign.Mut--- Copyright   : (c) 2021 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Main (main) where--import Control.DeepSeq (NFData(..))-import Streamly.Prelude (MonadAsync, SerialT, IsStream)-import System.Random (randomRIO)--import qualified Streamly.Prelude as Stream-import qualified Streamly.Internal.Data.Array.Foreign.Mut as MArray--import Gauge hiding (env)-import Streamly.Benchmark.Common------------------------------------------------------------------------------------ Utilities----------------------------------------------------------------------------------{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int-sourceUnfoldrM value n = Stream.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else return (Just (cnt, cnt + 1))--{-# INLINE benchIO #-}-benchIO-    :: NFData b-    => String -> (Int -> a) -> (a -> IO b) -> Benchmark-benchIO name src sink =-    bench name $ nfIO $ randomRIO (1,1) >>= sink . src--o_n_space_serial_marray :: Int -> MArray.Array Int -> [Benchmark]-o_n_space_serial_marray value array =-    [ benchIO "partitionBy (< 0)" (const array)-        $ MArray.partitionBy (< 0)-    , benchIO "partitionBy (> 0)" (const array)-        $ MArray.partitionBy (> 0)-    , benchIO "partitionBy (< value/2)" (const array)-        $ MArray.partitionBy (< (value `div` 2))-    , benchIO "partitionBy (> value/2)" (const array)-        $ MArray.partitionBy (> (value `div` 2))-    ]------------------------------------------------------------------------------------ Driver----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Array.Foreign.Mut"--main :: IO ()-main = do-    runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks--    where--    alloc value = MArray.fromStream (sourceUnfoldrM value 0 :: SerialT IO Int)--    allBenchmarks array value =-        [ bgroup (o_1_space_prefix moduleName) $-            o_n_space_serial_marray value array-        ]
+ benchmark/Streamly/Benchmark/Data/Array/Generic.hs view
@@ -0,0 +1,118 @@+{-# OPTIONS_GHC -Wno-orphans #-}++{-# LANGUAGE CPP #-}++#include "Streamly/Benchmark/Data/Array/CommonImports.hs"++import Control.DeepSeq (deepseq)++import qualified Streamly.Internal.Data.Array.Generic as IA+import qualified Streamly.Internal.Data.Array.Generic as A++type Stream = A.Array++#include "Streamly/Benchmark/Data/Array/Common.hs"++instance NFData a => NFData (A.Array a) where+    {-# INLINE rnf #-}+    rnf = A.foldl' (\_ x -> rnf x) ()++-------------------------------------------------------------------------------+-- Benchmark helpers+-------------------------------------------------------------------------------++-- Drain a source that generates an array in the IO monad+{-# INLINE benchIOSrc #-}+benchIOSrc :: NFData a => String -> (Int -> IO (Stream a)) -> Benchmark+benchIOSrc name src = benchIO name src id++-------------------------------------------------------------------------------+-- Bench Ops+-------------------------------------------------------------------------------++{-# INLINE sourceIntFromToFromList #-}+sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)+sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]++{-# INLINE readInstance #-}+readInstance :: P.String -> Stream Int+readInstance str =+    let r = P.reads str+    in case r of+        [(x,"")] -> x+        _ -> P.error "readInstance: no parse"++#ifdef DEVBUILD+{-+{-# INLINE foldableFoldl' #-}+foldableFoldl' :: Stream Int -> Int+foldableFoldl' = F.foldl' (+) 0++{-# INLINE foldableSum #-}+foldableSum :: Stream Int -> Int+foldableSum = P.sum+-}+#endif++{-# INLINE sourceIntFromToFromStream #-}+sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)+sourceIntFromToFromStream value n =+    S.fold A.create $ S.enumerateFromTo n (n + value)++-------------------------------------------------------------------------------+-- Bench groups+-------------------------------------------------------------------------------++o_1_space_generation :: Int -> [Benchmark]+o_1_space_generation value =+    [ bgroup+        "generation"+        [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)+        , let testStr = "fromList " ++ mkListString value+           in testStr `deepseq` bench "read" (nf readInstance testStr)+        ]+    ]++o_1_space_elimination :: Int -> [Benchmark]+o_1_space_elimination value =+    [ bgroup "elimination"+        [ benchFold "createOfLast.1"+            (S.fold (IA.createOfLast 1)) (P.sourceUnfoldrM value)+        , benchFold "createOfLast.10"+            (S.fold (IA.createOfLast 10)) (P.sourceUnfoldrM value)+#ifdef DEVBUILD+{-+          benchPureSink value "foldable/foldl'" foldableFoldl'+        , benchPureSink value "foldable/sum" foldableSum+-}+#endif+        ]+      ]++o_n_heap_serial :: Int -> [Benchmark]+o_n_heap_serial value =+    [ bgroup "elimination"+        [+        -- Converting the stream to an array+            benchFold "createOfLast.Max" (S.fold (IA.createOfLast (value + 1)))+                (P.sourceUnfoldrM value)+         ]+    ]++moduleName :: String+moduleName = "Data.Array.Generic"++defStreamSize :: Int+defStreamSize = defaultStreamSize++main :: IO ()+main = runWithCLIOpts defStreamSize allBenchmarks++    where++    allBenchmarks size =+        [ bgroup (o_1_space_prefix moduleName) $+             o_1_space_generation size ++ o_1_space_elimination size+        , bgroup (o_n_space_prefix moduleName) $+             o_n_heap_serial size+        ] ++ commonBenchmarks size
− benchmark/Streamly/Benchmark/Data/Array/Prim.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE CPP #-}--#include "Streamly/Benchmark/Data/Array/CommonImports.hs"--import qualified Streamly.Internal.Data.Array.Prim as A-type Stream = A.Array--#include "Streamly/Benchmark/Data/Array/Common.hs"------------------------------------------------------------------------------------ Benchmark helpers------------------------------------------------------------------------------------ Drain a source that generates an array in the IO monad-{-# INLINE benchIOSrc #-}-benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark-benchIOSrc name src = benchIO name src id------------------------------------------------------------------------------------ Bench Ops----------------------------------------------------------------------------------{-# INLINE sourceIntFromToFromList #-}-sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]---- CPP:-{-# INLINE sourceIntFromToFromStream #-}-sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)------------------------------------------------------------------------------------ Bench groups----------------------------------------------------------------------------------o_1_space_generation :: Int -> [Benchmark]-o_1_space_generation value =-    [ bgroup-        "generation"-        [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)-        ]-    ]--moduleName :: String-moduleName = "Data.Array.Prim"--defStreamSize :: Int-defStreamSize = defaultStreamSize--main :: IO ()-main = runWithCLIOpts defStreamSize allBenchmarks--    where--    allBenchmarks size =-        bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)-            : commonBenchmarks size
− benchmark/Streamly/Benchmark/Data/Array/Prim/Pinned.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE CPP #-}--#include "Streamly/Benchmark/Data/Array/CommonImports.hs"--import qualified Streamly.Internal.Data.Array.Prim.Pinned as A-type Stream = A.Array--#include "Streamly/Benchmark/Data/Array/Common.hs"------------------------------------------------------------------------------------ Benchmark helpers------------------------------------------------------------------------------------ Drain a source that generates an array in the IO monad-{-# INLINE benchIOSrc #-}-benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark-benchIOSrc name src = benchIO name src id------------------------------------------------------------------------------------ Bench Ops----------------------------------------------------------------------------------{-# INLINE sourceIntFromToFromList #-}-sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]---- CPP:-{-# INLINE sourceIntFromToFromStream #-}-sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)------------------------------------------------------------------------------------ Bench groups----------------------------------------------------------------------------------o_1_space_generation :: Int -> [Benchmark]-o_1_space_generation value =-    [ bgroup-        "generation"-        [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)-        ]-    ]--moduleName :: String-moduleName = "Data.Array.Prim.Pinned"--defStreamSize :: Int-defStreamSize = defaultStreamSize--main :: IO ()-main = runWithCLIOpts defStreamSize allBenchmarks--    where--    allBenchmarks size =-        bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)-            : commonBenchmarks size
benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ {-# LANGUAGE CPP #-}  #include "Streamly/Benchmark/Data/Array/CommonImports.hs"
+ benchmark/Streamly/Benchmark/Data/Array/Stream.hs view
@@ -0,0 +1,309 @@++-- |+-- Module      : Streamly.Benchmark.Data.ParserD+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Main+  (+    main+  ) where++import Control.DeepSeq (NFData(..))+import Control.Monad (void, when)+import Control.Monad.Catch (MonadCatch)+import Data.Functor.Identity (runIdentity)+import Data.Maybe (isJust)+import Data.Word (Word8)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.StreamK (StreamK)+import System.IO (Handle)+import System.Random (randomRIO)+import Prelude hiding ()++import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Parser as Parser+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Streamly.Internal.FileSystem.Handle as Handle+import qualified Streamly.Internal.Unicode.Stream as Unicode++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common+import Streamly.Benchmark.Common.Handle+import Control.Monad.IO.Class (MonadIO)++#ifdef INSPECTION+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Internal.Data.Stream (Step(..))+import Test.Inspection+#endif++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++-- XXX these can be moved to the common module++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream.Stream m Int+sourceUnfoldrM value n = Stream.unfoldrM step n+    where+    step cnt =+        if cnt > n + value+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE benchIO #-}+benchIO+    :: NFData b+    => String -> (Int -> Stream IO a) -> (Stream IO a -> IO b) -> Benchmark+benchIO name src sink =+    bench name $ nfIO $ randomRIO (1,1) >>= sink . src++-------------------------------------------------------------------------------+-- read chunked using toChunks+-------------------------------------------------------------------------------++-- | Get the last byte from a file bytestream.+toChunksLast :: Handle -> IO (Maybe Word8)+toChunksLast inh = do+    let s = Handle.readChunks inh+    larr <- Stream.last s+    return $ case larr of+        Nothing -> Nothing+        Just arr -> Array.getIndex (Array.length arr - 1) arr++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'toChunksLast+inspect $ 'toChunksLast `hasNoType` ''Step+#endif++-- | Count the number of bytes in a file.+toChunksSumLengths :: Handle -> IO Int+toChunksSumLengths inh =+    let s = Handle.readChunks inh+    in Stream.fold Fold.sum (Stream.map Array.length s)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'toChunksSumLengths+inspect $ 'toChunksSumLengths `hasNoType` ''Step+#endif++-- | Sum the bytes in a file.+toChunksCountBytes :: Handle -> IO Word8+toChunksCountBytes inh = do+    let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.read+    let s = Handle.readChunks inh+    Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'toChunksCountBytes+inspect $ 'toChunksCountBytes `hasNoType` ''Step+#endif++toChunksDecodeUtf8Arrays :: Handle -> IO ()+toChunksDecodeUtf8Arrays =+   Stream.drain . Unicode.decodeUtf8Chunks . Handle.readChunks++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays+-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step+#endif++-------------------------------------------------------------------------------+-- Splitting+-------------------------------------------------------------------------------++-- | Count the number of lines in a file.+toChunksSplitOnSuffix :: Handle -> IO Int+toChunksSplitOnSuffix =+    Stream.fold Fold.length+        . Array.compactEndByByte_ 10+        . Handle.readChunks++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix+inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step+#endif++-- XXX use a word splitting combinator instead of splitOn and test it.+-- | Count the number of words in a file.+toChunksSplitOn :: Handle -> IO Int+toChunksSplitOn =+    Stream.fold Fold.length+        . Array.compactSepByByte_ 32+        . Handle.readChunks++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'toChunksSplitOn+inspect $ 'toChunksSplitOn `hasNoType` ''Step+#endif++o_1_space_read_chunked :: BenchEnv -> [Benchmark]+o_1_space_read_chunked env =+    -- read using toChunks instead of read+    [ bgroup "reduce/toChunks"+        [ mkBench "Stream.last" env $ \inH _ ->+            toChunksLast inH+        -- Note: this cannot be fairly compared with GNU wc -c or wc -m as+        -- wc uses lseek to just determine the file size rather than reading+        -- and counting characters.+        , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ ->+            toChunksSumLengths inH+        , mkBench "splitOnSuffix" env $ \inH _ ->+            toChunksSplitOnSuffix inH+        , mkBench "splitOn" env $ \inH _ ->+            toChunksSplitOn inH+        , mkBench "countBytes" env $ \inH _ ->+            toChunksCountBytes inH+        , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->+            toChunksDecodeUtf8Arrays inH+        ]+    ]++-------------------------------------------------------------------------------+-- copy with group/ungroup transformations+-------------------------------------------------------------------------------++-- | Lines and unlines+{-# NOINLINE copyChunksSplitInterposeSuffix #-}+copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()+copyChunksSplitInterposeSuffix inh outh =+    Stream.fold (Handle.write outh)+        $ Array.concatEndBy 10 . Array.compactEndByByte_ 10+        $ Handle.readChunks inh++#ifdef INSPECTION+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Unbox]+inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step+#endif++-- | Words and unwords+{-# NOINLINE copyChunksSplitInterpose #-}+copyChunksSplitInterpose :: Handle -> Handle -> IO ()+copyChunksSplitInterpose inh outh =+    Stream.fold (Handle.write outh)+        -- XXX this is not correct word splitting combinator+        $ Array.concatSepBy 32 . Array.compactSepByByte_ 32+        $ Handle.readChunks inh++#ifdef INSPECTION+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox]+inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step+#endif++o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]+o_1_space_copy_toChunks_group_ungroup env =+    [ bgroup "copy/toChunks/group-ungroup"+        [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh ->+            copyChunksSplitInterposeSuffix inh outh+        , mkBenchSmall "interpose . splitOn" env $ \inh outh ->+            copyChunksSplitInterpose inh outh+        ]+    ]++-------------------------------------------------------------------------------+-- Parsers+-------------------------------------------------------------------------------++{-# INLINE drainWhile #-}+drainWhile :: MonadCatch m => (a -> Bool) -> Parser.Parser a m ()+drainWhile p = Parser.takeWhile p Fold.drain++-------------------------------------------------------------------------------+-- Folds and parsers+-------------------------------------------------------------------------------++{-# INLINE fold #-}+fold :: Stream IO (Array.Array Int) -> IO ()+fold s = void $ Array.foldBreak Fold.drain $ StreamK.fromStream s++{-# INLINE parse #-}+parse :: Int -> Stream IO (Array.Array Int) -> IO ()+parse value s =+    void $ Array.parseBreak+            (Array.toParserK (drainWhile (< value)))+            (StreamK.fromStream s)++{-# INLINE foldBreak #-}+foldBreak :: StreamK IO (Array.Array Int) -> IO ()+foldBreak s = do+    (r, s1) <- Array.foldBreak Fold.one s+    when (isJust r) $ foldBreak s1++{-# INLINE parseBreak #-}+parseBreak :: StreamK IO (Array.Array Int) -> IO ()+parseBreak s = do+    r <- Array.parseBreak (Array.toParserK Parser.one) s+    case r of+        (Left _, _) -> return ()+        (Right _, s1) -> parseBreak s1++o_1_space_serial_array ::+    Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]+o_1_space_serial_array bound arraysSmall arraysBig =+    [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold+    , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold+    , benchIO+        "foldBreak (recursive, small arrays)"+        (\_ -> Stream.fromList arraysSmall)+        (foldBreak . StreamK.fromStream)+    , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)+        $ parse bound+    , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)+        $ parse bound+    , benchIO+        "parseBreak (recursive, small arrays)"+        (\_ -> Stream.fromList arraysSmall)+        (parseBreak . StreamK.fromStream)+    ]++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Array.Stream"++main :: IO ()+main = do+    env <- mkHandleBenchEnv+    runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)++    where++    alloc value =+        if value <= 0+        then return  (undefined, undefined)+        else+            do+            small <- Stream.toList $ Array.chunksOf 100 $ sourceUnfoldrM value 0+            big <- Stream.toList $ Array.chunksOf value $ sourceUnfoldrM value 0+            return (small, big)++    allBenchmarks env arrays value =+        let (arraysSmall, arraysBig) = arrays+        in [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat+          [ o_1_space_read_chunked env+          , o_1_space_serial_array value arraysSmall arraysBig+          , o_1_space_copy_toChunks_group_ungroup env+          ]+        ]
− benchmark/Streamly/Benchmark/Data/Array/Stream/Foreign.hs 
@@ -1,273 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.ParserD--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Main-  (-    main-  ) where--import Control.DeepSeq (NFData(..))-import Control.Monad (void)-import Control.Monad.Catch (MonadThrow)-import Data.Functor.Identity (runIdentity)-import Data.Word (Word8)-import System.IO (Handle)-import System.Random (randomRIO)-import Prelude hiding ()--import qualified Streamly.Prelude  as Stream-import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Array.Stream.Foreign as ArrayStream-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD-import qualified Streamly.Internal.Data.Stream.IsStream as Stream (arraysOf)-import qualified Streamly.Internal.FileSystem.Handle as Handle-import qualified Streamly.Internal.Unicode.Stream as Unicode--import Gauge hiding (env)-import Streamly.Prelude (SerialT, MonadAsync, IsStream)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Common.Handle--#ifdef INSPECTION-import Foreign.Storable (Storable)-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))-import Test.Inspection-#endif------------------------------------------------------------------------------------ Utilities------------------------------------------------------------------------------------ XXX these can be moved to the common module--{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int-sourceUnfoldrM value n = Stream.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else return (Just (cnt, cnt + 1))--{-# INLINE benchIO #-}-benchIO-    :: NFData b-    => String -> (Int -> t IO a) -> (t IO a -> IO b) -> Benchmark-benchIO name src sink =-    bench name $ nfIO $ randomRIO (1,1) >>= sink . src------------------------------------------------------------------------------------ read chunked using toChunks------------------------------------------------------------------------------------ | Get the last byte from a file bytestream.-toChunksLast :: Handle -> IO (Maybe Word8)-toChunksLast inh = do-    let s = Handle.toChunks inh-    larr <- Stream.last s-    return $ case larr of-        Nothing -> Nothing-        Just arr -> Array.getIndex arr (Array.length arr - 1)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'toChunksLast-inspect $ 'toChunksLast `hasNoType` ''Step-#endif---- | Count the number of bytes in a file.-toChunksSumLengths :: Handle -> IO Int-toChunksSumLengths inh =-    let s = Handle.toChunks inh-    in Stream.sum (Stream.map Array.length s)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'toChunksSumLengths-inspect $ 'toChunksSumLengths `hasNoType` ''Step-#endif---- | Sum the bytes in a file.-toChunksCountBytes :: Handle -> IO Word8-toChunksCountBytes inh = do-    let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.toStream-    let s = Handle.toChunks inh-    Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'toChunksCountBytes-inspect $ 'toChunksCountBytes `hasNoType` ''Step-#endif--toChunksDecodeUtf8Arrays :: Handle -> IO ()-toChunksDecodeUtf8Arrays =-   Stream.drain . Unicode.decodeUtf8Arrays . Handle.toChunks--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays--- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step-#endif------------------------------------------------------------------------------------ Splitting------------------------------------------------------------------------------------ | Count the number of lines in a file.-toChunksSplitOnSuffix :: Handle -> IO Int-toChunksSplitOnSuffix =-    Stream.length . ArrayStream.splitOnSuffix 10 . Handle.toChunks--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix-inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step-#endif---- XXX use a word splitting combinator instead of splitOn and test it.--- | Count the number of words in a file.-toChunksSplitOn :: Handle -> IO Int-toChunksSplitOn = Stream.length . ArrayStream.splitOn 32 . Handle.toChunks--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'toChunksSplitOn-inspect $ 'toChunksSplitOn `hasNoType` ''Step-#endif--o_1_space_read_chunked :: BenchEnv -> [Benchmark]-o_1_space_read_chunked env =-    -- read using toChunks instead of read-    [ bgroup "reduce/toChunks"-        [ mkBench "Stream.last" env $ \inH _ ->-            toChunksLast inH-        -- Note: this cannot be fairly compared with GNU wc -c or wc -m as-        -- wc uses lseek to just determine the file size rather than reading-        -- and counting characters.-        , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ ->-            toChunksSumLengths inH-        , mkBench "splitOnSuffix" env $ \inH _ ->-            toChunksSplitOnSuffix inH-        , mkBench "splitOn" env $ \inH _ ->-            toChunksSplitOn inH-        , mkBench "countBytes" env $ \inH _ ->-            toChunksCountBytes inH-        , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->-            toChunksDecodeUtf8Arrays inH-        ]-    ]------------------------------------------------------------------------------------ copy with group/ungroup transformations------------------------------------------------------------------------------------ | Lines and unlines-{-# NOINLINE copyChunksSplitInterposeSuffix #-}-copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()-copyChunksSplitInterposeSuffix inh outh =-    Stream.fold (Handle.write outh)-        $ ArrayStream.interposeSuffix 10-        $ ArrayStream.splitOnSuffix 10-        $ Handle.toChunks inh--#ifdef INSPECTION-inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]-inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step-#endif---- | Words and unwords-{-# NOINLINE copyChunksSplitInterpose #-}-copyChunksSplitInterpose :: Handle -> Handle -> IO ()-copyChunksSplitInterpose inh outh =-    Stream.fold (Handle.write outh)-        $ ArrayStream.interpose 32-        -- XXX this is not correct word splitting combinator-        $ ArrayStream.splitOn 32-        $ Handle.toChunks inh--#ifdef INSPECTION-inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]-inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step-#endif--o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]-o_1_space_copy_toChunks_group_ungroup env =-    [ bgroup "copy/toChunks/group-ungroup"-        [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh ->-            copyChunksSplitInterposeSuffix inh outh-        , mkBenchSmall "interpose . splitOn" env $ \inh outh ->-            copyChunksSplitInterpose inh outh-        ]-    ]------------------------------------------------------------------------------------ Parsers----------------------------------------------------------------------------------{-# INLINE drainWhile #-}-drainWhile :: MonadThrow m => (a -> Bool) -> ParserD.Parser m a ()-drainWhile p = ParserD.takeWhile p Fold.drain------------------------------------------------------------------------------------ Folds and parsers----------------------------------------------------------------------------------{-# INLINE fold #-}-fold :: SerialT IO (Array.Array Int) -> IO ()-fold s = void $ ArrayStream.fold Fold.drain s--{-# INLINE parseArray #-}-parseArray :: Int -> SerialT IO (Array.Array Int) -> IO ()-parseArray value s = void $ ArrayStream.parse (drainWhile (< value)) s--o_1_space_serial_array ::-    Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]-o_1_space_serial_array bound arraysSmall arraysBig =-    [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold-    , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold-    , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)-        $ parseArray bound-    , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)-        $ parseArray bound-    ]------------------------------------------------------------------------------------ Driver----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Array.Stream.Foreign"--main :: IO ()-main = do-    env <- mkHandleBenchEnv-    runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)--    where--    alloc value = do-        small <- Stream.toList $ Stream.arraysOf 100 $ sourceUnfoldrM value 0-        big <- Stream.toList $ Stream.arraysOf value $ sourceUnfoldrM value 0-        return (small, big)--    allBenchmarks env arrays value =-        let (arraysSmall, arraysBig) = arrays-        in [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat-          [ o_1_space_read_chunked env-          , o_1_space_serial_array value arraysSmall arraysBig-          , o_1_space_copy_toChunks_group_ungroup env-          ]-        ]
benchmark/Streamly/Benchmark/Data/Fold.hs view
@@ -5,36 +5,78 @@ -- License     : MIT -- Maintainer  : streamly@composewell.com +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-} +#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif+ module Main (main) where  import Control.DeepSeq (NFData(..))-import Data.Functor.Identity (Identity)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Char (ord)+import Streamly.Internal.Data.Array (Array)+import Data.Functor.Identity (Identity(..)) import Data.Map.Strict (Map)+import Data.IntMap.Strict (IntMap) import Data.Monoid (Last(..), Sum(..))+import Data.Word (Word8)+import System.IO (Handle) import System.Random (randomRIO) -import Streamly.Prelude (SerialT)+import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.MutArray (MutArray) -import qualified Data.Map.Strict as Map+import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.Pipe as Pipe-import qualified Streamly.Internal.Data.Sink as Sink-import qualified Streamly.Internal.Data.Stream.IsStream as IP-import qualified Streamly.Prelude as S+-- import qualified Streamly.Internal.Data.Scan as Scan+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.FileSystem.Handle as Handle+import qualified Streamly.Internal.Unicode.Stream as Unicode -import Gauge+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common-import Prelude hiding (all, any, take, unzip, sequence_)+import Streamly.Benchmark.Common.Handle+import Prelude hiding (last, length, all, any, take, unzip, sequence_, filter) +#ifdef INSPECTION+import Streamly.Internal.Data.Stream (Step(..))++import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Unfold as Unfold++import Test.Inspection+#endif+ -- We need a monadic bind here to make sure that the function f does not get -- completely optimized out by the compiler in some cases.  {-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int-sourceUnfoldrM value n = S.unfoldrM step n+sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrM value n = Stream.unfoldrM step n     where     step cnt =         if cnt > n + value@@ -42,14 +84,14 @@         else return (Just (cnt, cnt + 1))  {-# INLINE source #-}-source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int+source :: Monad m => Int -> Int -> Stream m Int source = sourceUnfoldrM  -- | Takes a fold method, and uses it with a default source. {-# INLINE benchIOSink #-} benchIOSink-    :: (S.IsStream t, NFData b)-    => Int -> String -> (t IO Int -> IO b) -> Benchmark+    :: NFData b+    => Int -> String -> (Stream IO Int -> IO b) -> Benchmark benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value  -------------------------------------------------------------------------------@@ -57,16 +99,16 @@ -------------------------------------------------------------------------------  {-# INLINE any #-}-any :: (Monad m, Ord a) => a -> SerialT m a -> m Bool-any value = IP.fold (FL.any (> value))+any :: (Monad m, Ord a) => a -> Stream m a -> m Bool+any value = Stream.fold (FL.any (> value))  {-# INLINE all #-}-all :: (Monad m, Ord a) => a -> SerialT m a -> m Bool-all value = IP.fold (FL.all (<= value))+all :: (Monad m, Ord a) => a -> Stream m a -> m Bool+all value = Stream.fold (FL.all (<= value))  {-# INLINE take #-}-take :: Monad m => Int -> SerialT m a -> m ()-take value = IP.fold (FL.take value FL.drain)+take :: Monad m => Int -> Stream m a -> m ()+take value = Stream.fold (FL.take value FL.drain)  {-# INLINE sequence_ #-} sequence_ :: Monad m => Int -> Fold m a ()@@ -79,54 +121,266 @@     f m k = FL.concatMap (const k) m  ---------------------------------------------------------------------------------- Splitting by serial application+-- Filter ------------------------------------------------------------------------------- -{-# INLINE takeEndBy_ #-}-takeEndBy_ :: Monad m => Int -> SerialT m Int -> m ()-takeEndBy_ value = IP.fold (FL.takeEndBy_ (>= value) FL.drain)+{-# INLINE filter #-}+filter :: Monad m => Int -> Stream m Int -> m ()+filter _ = Stream.fold (FL.filter even FL.drain) -{-# INLINE many #-}-many :: Monad m => SerialT m Int -> m ()-many = IP.fold (FL.many (FL.take 1 FL.drain) FL.drain)+{-# INLINE scanMaybe #-}+scanMaybe :: Monad m => Int -> Stream m Int -> m ()+scanMaybe _ = Stream.fold (FL.postscanlMaybe (Scanl.filtering even) FL.drain) +{-# INLINE scanMaybe2 #-}+scanMaybe2 :: Monad m => Int -> Stream m Int -> m ()+scanMaybe2 _ =+    Stream.fold+        $ FL.postscanlMaybe (Scanl.filtering even)+        $ FL.postscanlMaybe (Scanl.filtering odd) FL.drain++-------------------------------------------------------------------------------+-- Splitting in two+-------------------------------------------------------------------------------+ {-# INLINE splitAllAny #-}-splitAllAny :: Monad m => Int -> SerialT m Int -> m (Bool, Bool)+splitAllAny :: Monad m => Int -> Stream m Int -> m (Bool, Bool) splitAllAny value =-    IP.fold-        (FL.serialWith (,)+    Stream.fold+        (FL.splitWith (,)             (FL.all (<= (value `div` 2)))             (FL.any (> value))         ) -{-# INLINE serial_ #-}-serial_ :: Monad m => Int -> SerialT m Int -> m Bool-serial_ value =-    IP.fold-        (FL.serial_+{-# INLINE split_ #-}+split_ :: Monad m => Int -> Stream m Int -> m Bool+split_ value =+    Stream.fold+        (FL.split_             (FL.all (<= (value `div` 2)))             (FL.any (> value))         )  {-# INLINE shortest #-}-shortest :: Monad m => SerialT m Int -> m (Either Int Int)-shortest = IP.fold (FL.shortest FL.sum FL.length)+shortest :: Monad m => Stream m Int -> m (Either Int Int)+shortest = Stream.fold (FL.shortest FL.sum FL.length)  {-# INLINE longest #-}-longest :: Monad m => SerialT m Int -> m (Either Int Int)-longest = IP.fold (FL.longest FL.sum FL.length)+longest :: Monad m => Stream m Int -> m (Either Int Int)+longest = Stream.fold (FL.longest FL.sum FL.length) +{-# INLINE foldBreak #-}+foldBreak :: Monad m => Stream m Int -> m ()+foldBreak s = do+    (r, s1) <- Stream.foldBreak (FL.take 1 FL.length) s+    when (r /= 0) $ foldBreak s1+ -------------------------------------------------------------------------------+-- Split generated streams (not a file)+-------------------------------------------------------------------------------++{-# INLINE many #-}+many :: Monad m => Stream m Int -> m ()+many = Stream.fold (FL.many (FL.take 1 FL.drain) FL.drain)++{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m => Int -> Stream m Int -> m ()+takeEndBy_ value = Stream.fold (FL.takeEndBy_ (>= value) FL.drain)++-------------------------------------------------------------------------------+-- Splitting a file stream into a stream by serial application+-------------------------------------------------------------------------------++lf :: Word8+lf = fromIntegral (ord '\n')++toarr :: String -> Array Word8+toarr = Array.fromList . map (fromIntegral . ord)++-- | Split on line feed.+fileInfixTakeEndBy_ :: Handle -> IO Int+fileInfixTakeEndBy_ inh =+    Stream.fold Fold.length+        $ Stream.foldManyPost (FL.takeEndBy_ (== lf) Fold.drain)+        $ Handle.read inh -- >>= print++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'fileInfixTakeEndBy_+inspect $ 'fileInfixTakeEndBy_ `hasNoType` ''Step+inspect $ 'fileInfixTakeEndBy_ `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'fileInfixTakeEndBy_ `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Split on line feed.+fileSuffixTakeEndBy_ :: Handle -> IO Int+fileSuffixTakeEndBy_ inh =+    Stream.fold Fold.length+        $ Stream.foldMany+            (Fold.takeEndBy_ (== lf) Fold.drain)+            (Handle.read inh)+     -- >>= print++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'fileSuffixTakeEndBy_+inspect $ 'fileSuffixTakeEndBy_ `hasNoType` ''Step+inspect $ 'fileSuffixTakeEndBy_ `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'fileSuffixTakeEndBy_ `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Split on line feed.+parseFileSuffixTakeEndBy_ :: Handle -> IO Int+parseFileSuffixTakeEndBy_ inh =+    Stream.fold Fold.length+        $ Stream.parseMany+            (Parser.fromFold $ Fold.takeEndBy_ (== lf) Fold.drain)+            (Handle.read inh)+     -- >>= print++-- | Split suffix with line feed.+fileSuffixTakeEndBy :: Handle -> IO Int+fileSuffixTakeEndBy inh =+    Stream.fold Fold.length+        $ Stream.foldMany+            (Fold.takeEndBy (== lf) Fold.drain)+            (Handle.read inh)+     -- >>= print++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'fileSuffixTakeEndBy+inspect $ 'fileSuffixTakeEndBy `hasNoType` ''Step+inspect $ 'fileSuffixTakeEndBy `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'fileSuffixTakeEndBy `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Infix split on a word8 sequence.+splitOnSeq :: String -> Handle -> IO Int+splitOnSeq str inh =+    Stream.fold Fold.length+        $ Stream.foldManyPost (Fold.takeEndBySeq_ (toarr str) Fold.drain)+        $ Handle.read inh -- >>= print++#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'splitOnSeq+-- inspect $ 'splitOnSeq `hasNoType` ''Step+#endif++-- | Infix split on a word8 sequence.+splitOnSeq100k :: Handle -> IO Int+splitOnSeq100k inh = do+    arr <- Stream.fold Array.create $ Stream.replicate 100000 123+    Stream.fold Fold.length+        $ Stream.foldManyPost (Fold.takeEndBySeq_ arr Fold.drain)+        $ Handle.read inh -- >>= print++-- | Split on suffix sequence.+splitOnSuffixSeq :: String -> Handle -> IO Int+splitOnSuffixSeq str inh =+    Stream.fold Fold.length+        $ Stream.foldMany (Fold.takeEndBySeq_ (toarr str) Fold.drain)+        $ Handle.read inh -- >>= print++#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq+-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step+#endif++-- | Split on suffix sequence.+splitWithSuffixSeq :: String -> Handle -> IO Int+splitWithSuffixSeq str inh =+    Stream.fold Fold.length+        $ Stream.foldMany (Fold.takeEndBySeq (toarr str) Fold.drain)+        $ Handle.read inh -- >>= print++o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]+o_1_space_reduce_read_split env =+    -- NOTE: keep the benchmark names consistent with Data.Stream.split*+    [ bgroup "FileSplitElem"+        -- Splitting on single element+        [+          mkBench "takeEndBy_ infix (splitOn)" env $ \inh _ ->+            fileInfixTakeEndBy_ inh+        , mkBench "takeEndBy_ suffix (splitOnSuffix)" env $ \inh _ ->+            fileSuffixTakeEndBy_ inh+        , mkBench "takeEndBy_ suffix parseMany (splitOnSuffix)" env+            $ \inh _ -> parseFileSuffixTakeEndBy_ inh+        , mkBench "takeEndBy suffix (splitWithSuffix)" env $ \inh _ ->+            fileSuffixTakeEndBy inh+        ]++    -- Splitting on sequence+    , bgroup "FileSplitSeq"+        [+          -- Infix takeEndBySeq_+          mkBench "takeEndBySeq_ infix empty pattern" env $ \inh _ ->+            splitOnSeq "" inh+        , mkBench "takeEndBySeq_ infix lf" env $ \inh _ ->+            splitOnSeq "\n" inh+        , mkBench "takeEndBySeq_ infix a" env $ \inh _ ->+            splitOnSeq "a" inh+        , mkBench "takeEndBySeq_ infix crlf" env $ \inh _ ->+            splitOnSeq "\r\n" inh+        , mkBench "takeEndBySeq_ infix aa" env $ \inh _ ->+            splitOnSeq "aa" inh+        , mkBench "takeEndBySeq_ infix aaaa" env $ \inh _ ->+            splitOnSeq "aaaa" inh+        , mkBench "takeEndBySeq_ infix abcdefgh" env $ \inh _ ->+            splitOnSeq "abcdefgh" inh+        , mkBench "takeEndBySeq_ infix abcdefghi" env $ \inh _ ->+            splitOnSeq "abcdefghi" inh+        , mkBench "takeEndBySeq_ infix catcatcatcatcat" env $ \inh _ ->+            splitOnSeq "catcatcatcatcat" inh+        , mkBench "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh+        , mkBench "takeEndBySeq_ infix 100k long pattern"+            env $ \inh _ -> splitOnSeq100k inh++          -- Suffix takeEndBySeq_+        , mkBench "takeEndBySeq_ suffix empty pattern" env $ \inh _ ->+            splitOnSuffixSeq "" inh+        , mkBench "takeEndBySeq_ suffix lf" env $ \inh _ ->+            splitOnSuffixSeq "\n" inh+        , mkBench "takeEndBySeq_ suffix crlf" env $ \inh _ ->+            splitOnSuffixSeq "\r\n" inh+        , mkBenchSmall "takeEndBySeq_ suffix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh++          -- Suffix takeEndBySeq+        , mkBench "takeEndBySeq suffix crlf" env $ \inh _ ->+            splitWithSuffixSeq "\r\n" inh+        , mkBenchSmall "takeEndBySeq suffix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh+        ]+    ]++-- | Infix split on a character sequence.+splitOnSeqUtf8 :: String -> Handle -> IO Int+splitOnSeqUtf8 str inh =+    Stream.fold Fold.length+        $ Stream.foldManyPost (Fold.takeEndBySeq_ (Array.fromList str) Fold.drain)+        $ Unicode.decodeUtf8Chunks+        $ Handle.readChunks inh -- >>= print++o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]+o_1_space_reduce_toChunks_split env =+    [ bgroup "FileSplitSeqUtf8"+        [ mkBenchSmall "takeEndBySeq_ infix abcdefgh"+            env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh+        , mkBenchSmall "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh+        ]+    ]++------------------------------------------------------------------------------- -- Distributing by parallel application -------------------------------------------------------------------------------  {-# INLINE teeSumLength #-}-teeSumLength :: Monad m => SerialT m Int -> m (Int, Int)-teeSumLength = IP.fold (FL.teeWith (,) FL.sum FL.length)+teeSumLength :: Monad m => Stream m Int -> m (Int, Int)+teeSumLength = Stream.fold (FL.teeWith (,) FL.sum FL.length)  {-# INLINE teeAllAny #-}-teeAllAny :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)-teeAllAny value = IP.fold (FL.teeWith (,) all_ any_)+teeAllAny :: (Monad m, Ord a) => a -> Stream m a -> m (Bool, Bool)+teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)      where @@ -134,16 +388,16 @@     any_ = FL.any (> value)  {-# INLINE teeWithFst #-}-teeWithFst :: Monad m => SerialT m Int -> m (Int, Int)-teeWithFst = IP.fold (FL.teeWithFst (,) FL.sum FL.length)+teeWithFst :: Monad m => Stream m Int -> m (Int, Int)+teeWithFst = Stream.fold (FL.teeWithFst (,) FL.sum FL.length)  {-# INLINE teeWithMin #-}-teeWithMin :: Monad m => SerialT m Int -> m (Int, Int)-teeWithMin = IP.fold (FL.teeWithMin (,) FL.sum FL.length)+teeWithMin :: Monad m => Stream m Int -> m (Int, Int)+teeWithMin = Stream.fold (FL.teeWithMin (,) FL.sum FL.length)  {-# INLINE distribute #-}-distribute :: Monad m => SerialT m Int -> m [Int]-distribute = IP.fold (FL.distribute [FL.sum, FL.length])+distribute :: Monad m => Stream m Int -> m [Int]+distribute = Stream.fold (FL.distribute [FL.sum, FL.length])  ------------------------------------------------------------------------------- -- Partitioning@@ -154,163 +408,214 @@ oddEven x = if odd x then Left x else Right x  {-# INLINE partition #-}-partition :: Monad m => SerialT m Int -> m (Int, Int)-partition = IP.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)+partition :: Monad m => Stream m Int -> m (Int, Int)+partition = Stream.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)  {-# INLINE partitionByFstM #-}-partitionByFstM :: Monad m => SerialT m Int -> m (Int, Int)+partitionByFstM :: Monad m => Stream m Int -> m (Int, Int) partitionByFstM =-    IP.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)+    Stream.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)  {-# INLINE partitionByMinM #-}-partitionByMinM :: Monad m => SerialT m Int -> m (Int, Int)+partitionByMinM :: Monad m => Stream m Int -> m (Int, Int) partitionByMinM =-    IP.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)+    Stream.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length) -{-# INLINE demuxWith  #-}-demuxWith ::-       (Monad m, Ord k)-    => (a -> (k, a'))-    -> Map k (Fold m a' b)-    -> SerialT m a-    -> m (Map k b)-demuxWith f mp = S.fold (FL.demuxWith f mp)+{-# INLINE demuxToMap  #-}+demuxToMap :: (Monad m, Ord k) =>+    (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Stream m a -> m (Map k b)+demuxToMap f g = Stream.fold (FL.demuxerToContainer f g) -{-# INLINE demuxDefaultWith #-}-demuxDefaultWith ::-       (Monad m, Ord k, Num b)-    => (a -> (k, b))-    -> Map k (Fold m b b)-    -> SerialT m a-    -> m (Map k b, b)-demuxDefaultWith f mp = S.fold (FL.demuxDefaultWith f mp (FL.lmap snd FL.sum))+{-# INLINE demuxToIntMap  #-}+demuxToIntMap :: Monad m =>+    (a -> Int) -> (Int -> m (Maybe (Fold m a b))) -> Stream m a -> m (IntMap b)+demuxToIntMap f g = Stream.fold (FL.demuxerToContainer f g) -{-# INLINE classifyWith #-}-classifyWith ::-       (Monad m, Ord k, Num a) => (a -> k) -> SerialT m a -> m (Map k a)-classifyWith f = S.fold (FL.classifyWith f FL.sum)+{-# INLINE demuxToMapIO  #-}+demuxToMapIO :: (MonadIO m, Ord k) =>+    (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Stream m a -> m (Map k b)+demuxToMapIO f g = Stream.fold (FL.demuxerToContainerIO f g) +{-# INLINE toMap #-}+toMap ::+       (Monad m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)+toMap f = Stream.fold (FL.toContainer f FL.sum)++{-# INLINE toIntMap #-}+toIntMap ::+       (Monad m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)+toIntMap f = Stream.fold (FL.toContainer f FL.sum)++{-# INLINE toMapIO #-}+toMapIO ::+       (MonadIO m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)+toMapIO f = Stream.fold (FL.toContainerIO f FL.sum)++{-# INLINE toIntMapIO #-}+toIntMapIO ::+       (MonadIO m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)+toIntMapIO f = Stream.fold (FL.toContainerIO f FL.sum)+ ------------------------------------------------------------------------------- -- unzip -------------------------------------------------------------------------------  {-# INLINE unzip #-}-unzip :: Monad m => SerialT m Int -> m (Int, Int)-unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)+unzip :: Monad m => Stream m Int -> m (Int, Int)+unzip = Stream.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)  {-# INLINE unzipWithFstM #-}-unzipWithFstM :: Monad m => SerialT m Int -> m (Int, Int)+unzipWithFstM :: Monad m => Stream m Int -> m (Int, Int) unzipWithFstM = do-    let f = \a -> return (a + 1, a)-    IP.fold (FL.unzipWithFstM f FL.sum FL.length)+    let f a = return (a + 1, a)+    Stream.fold (FL.unzipWithFstM f FL.sum FL.length)  {-# INLINE unzipWithMinM #-}-unzipWithMinM :: Monad m => SerialT m Int -> m (Int, Int)+unzipWithMinM :: Monad m => Stream m Int -> m (Int, Int) unzipWithMinM = do-    let f = \a -> return (a + 1, a)-    IP.fold (FL.unzipWithMinM f FL.sum FL.length)+    let f a = return (a + 1, a)+    Stream.fold (FL.unzipWithMinM f FL.sum FL.length)  -------------------------------------------------------------------------------+-- Nested+-------------------------------------------------------------------------------++{-# INLINE unfoldMany #-}+unfoldMany :: Int -> Benchmarkable+unfoldMany val =+    nfIO+        $ Stream.fold (FL.unfoldMany Unfold.replicateM FL.drain)+        $ Stream.fromPure (val, randomRIO (1, 1 :: Int))++------------------------------------------------------------------------------- -- Benchmarks -------------------------------------------------------------------------------  moduleName :: String moduleName = "Data.Fold" +instance NFData (MutArray a) where+    {-# INLINE rnf #-}+    rnf _ = ()++instance NFData a => NFData (Stream Identity a) where+    {-# INLINE rnf #-}+    rnf xs = runIdentity $ Stream.fold (FL.foldl' (\_ x -> rnf x) ()) xs+ o_1_space_serial_elimination :: Int -> [Benchmark] o_1_space_serial_elimination value =     [ bgroup "elimination"-        [ benchIOSink value "drain" (S.fold FL.drain)-        , benchIOSink value "drainBy" (S.fold (FL.drainBy return))-        , benchIOSink value "drainN" (S.fold (FL.drainN value))-        , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)-        , benchIOSink value "last" (S.fold FL.last)-        , benchIOSink value "length" (S.fold FL.length)-        , benchIOSink value "sum" (S.fold FL.sum)-        , benchIOSink value "sum (foldMap)" (S.fold (FL.foldMap Sum))-        , benchIOSink value "product" (S.fold FL.product)-        , benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))-        , benchIOSink value "maximum" (S.fold FL.maximum)-        , benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))-        , benchIOSink value "minimum" (S.fold FL.minimum)+        [ benchIOSink value "drain" (Stream.fold FL.drain)+        , benchIOSink value "drainBy" (Stream.fold (FL.drainMapM return))+        , benchIOSink value "drainN" (Stream.fold (FL.drainN value))+        , benchIOSink value "last" (Stream.fold FL.latest)+        , benchIOSink value "length" (Stream.fold FL.length)+        , benchIOSink value "top" (Stream.fold $ FL.top 10)+        , benchIOSink value "bottom" (Stream.fold $ FL.bottom 10)+        , benchIOSink value "sum" (Stream.fold FL.sum)+        , benchIOSink value "sum (foldMap)" (Stream.fold (FL.foldMap Sum))+        , benchIOSink value "product" (Stream.fold FL.product)+        , benchIOSink value "maximumBy" (Stream.fold (FL.maximumBy compare))+        , benchIOSink value "maximum" (Stream.fold FL.maximum)+        , benchIOSink value "minimumBy" (Stream.fold (FL.minimumBy compare))+        , benchIOSink value "minimum" (Stream.fold FL.minimum)         , benchIOSink               value               "mean"-              (S.fold FL.mean . S.map (fromIntegral :: Int -> Double))+              (Stream.fold FL.mean . fmap (fromIntegral :: Int -> Double))+{-+        -- These are already benchmarked in streamly-statistics package. If we+        -- still want to keep these tests here, perhaps we should move them to a+        -- different module so we can remove -fno-warn-warnings-deprecations.+         , benchIOSink               value               "variance"-              (S.fold FL.variance . S.map (fromIntegral :: Int -> Double))+              (Stream.fold FL.variance . fmap (fromIntegral :: Int -> Double))         , benchIOSink               value               "stdDev"-              (S.fold FL.stdDev . S.map (fromIntegral :: Int -> Double))+              (Stream.fold FL.stdDev . fmap (fromIntegral :: Int -> Double))+-}         , benchIOSink               value               "mconcat"-              (S.fold FL.mconcat . S.map (Last . Just))+              (Stream.fold FL.mconcat . fmap (Last . Just))         , benchIOSink               value               "foldMap"-              (S.fold (FL.foldMap (Last . Just)))+              (Stream.fold (FL.foldMap (Last . Just)))         , benchIOSink               value               "foldMapM"-              (S.fold (FL.foldMapM (return . Last . Just)))-        , benchIOSink value "index" (S.fold (FL.index (value + 1)))-        , benchIOSink value "head" (S.fold FL.head)-        , benchIOSink value "find" (S.fold (FL.find (== (value + 1))))+              (Stream.fold (FL.foldMapM (return . Last . Just)))+        , benchIOSink value "index" (Stream.fold (FL.index (value + 1)))+        -- , benchIOSink value "head" (Stream.fold FL.head)+        , benchIOSink value "find" (Stream.fold (FL.find (== (value + 1))))         , benchIOSink               value               "lookup"-              (S.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))+              (Stream.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))         , benchIOSink               value               "findIndex"-              (S.fold (FL.findIndex (== (value + 1))))+              (Stream.fold (FL.findIndex (== (value + 1))))         , benchIOSink               value               "elemIndex"-              (S.fold (FL.elemIndex (value + 1)))-        , benchIOSink value "null" (S.fold FL.null)-        , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))-        , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))+              (Stream.fold (FL.elemIndex (value + 1)))+        -- , benchIOSink value "null" (Stream.fold FL.null)+        , benchIOSink value "elem" (Stream.fold (FL.elem (value + 1)))+        , benchIOSink value "notElem" (Stream.fold (FL.notElem (value + 1)))         , benchIOSink value "all" $ all value         , benchIOSink value "any" $ any value         , benchIOSink value "take" $ take value         , benchIOSink value "takeEndBy_" $ takeEndBy_ value-        , benchIOSink value "and" (S.fold FL.and . S.map (<= (value + 1)))-        , benchIOSink value "or" (S.fold FL.or . S.map (> (value + 1)))+        , benchIOSink value "and" (Stream.fold FL.and . fmap (<= (value + 1)))+        , benchIOSink value "or" (Stream.fold FL.or . fmap (> (value + 1)))         ]     ]  o_1_space_serial_transformation :: Int -> [Benchmark] o_1_space_serial_transformation value =     [ bgroup "transformation"-        [ benchIOSink value "map" (S.fold (FL.lmap (+ 1) FL.drain))+        [ benchIOSink value "map" (Stream.fold (FL.lmap (+ 1) FL.drain))         , let f x = if even x then Just x else Nothing               fld = FL.mapMaybe f FL.drain-           in benchIOSink value "mapMaybe" (S.fold fld)+           in benchIOSink value "mapMaybe" (Stream.fold fld)         , benchIOSink               value               "rsequence"-              (S.fold (FL.rmapM id (return <$> FL.drain)))-        , benchIOSink value "rmapM" (S.fold (FL.rmapM return FL.drain))+              (Stream.fold (FL.rmapM id (return <$> FL.drain)))+        , benchIOSink value "rmapM" (Stream.fold (FL.rmapM return FL.drain))         , benchIOSink               value               "pipe-mapM"-              (S.fold-                   (FL.transform+              (Stream.fold+                   (FL.pipe                         (Pipe.mapM (\x -> return $ x + 1))                         FL.drain))+{-         , benchIOSink+              value+              "fold-runScan"+              (Stream.fold+                   (FL.runScan+                        (Scan.functionM (\x -> return $ x + 1))+                        FL.drain))+-}+        , benchIOSink             value             "fold-scan"-            (S.fold $ FL.scan FL.sum FL.drain)+            (Stream.fold $ FL.scanl Scanl.sum FL.drain)         , benchIOSink             value+            "fold-scanMany"+            (Stream.fold $ FL.scanlMany (Scanl.take 2 Scanl.drain) FL.drain)+        , benchIOSink+            value             "fold-postscan"-            (S.fold $ FL.postscan FL.sum FL.drain)+            (Stream.fold $ FL.postscanl Scanl.sum FL.drain)         ]     ] @@ -318,10 +623,15 @@ o_1_space_serial_composition value =       [ bgroup             "composition"-            [ benchIOSink value "serialWith (all, any)" $ splitAllAny value-            , benchIOSink value "serial_ (all, any)" $ serial_ value+            [ benchIOSink value "filter even" $ filter value+            , benchIOSink value "scanMaybe even" $ scanMaybe value+            , benchIOSink value "scanMaybe even, odd" $ scanMaybe2 value+            , benchIOSink value "foldBreak (recursive)" foldBreak+            , benchIOSink value "splitWith (all, any)" $ splitAllAny value+            , benchIOSink value "split_ (all, any)" $ split_ value             , benchIOSink value "tee (all, any)" $ teeAllAny value             , benchIOSink value "many drain (take 1)" many+            , bench "unfoldMany" $ unfoldMany value             , benchIOSink value "shortest (sum, length)" shortest             , benchIOSink value "longest (sum, length)" longest             , benchIOSink value "tee (sum, length)" teeSumLength@@ -334,23 +644,12 @@             , benchIOSink value "unzip (sum, length)" unzip             , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM             , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM-            , benchIOSink value "demuxDefaultWith [sum, length] sum"-                  $ demuxDefaultWith fn mp-            , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp-            , benchIOSink value "classifyWith sum" $ classifyWith (fst . fn)             ]       ] -    where--    -- We use three keys 0, 1, and 2. 0 and 1 are mapped and 3 is unmapped.-    fn x = (x `mod` 3, x)--    mp = Map.fromList [(0, FL.sum), (1, FL.length)]- o_n_space_serial :: Int -> [Benchmark] o_n_space_serial value =-    [ benchIOSink value "sequence_/100" $ S.fold (sequence_ (value `div` 100))+    [ benchIOSink value "sequence_/100" $ Stream.fold (sequence_ (value `div` 100))     ]  o_n_heap_serial :: Int -> [Benchmark]@@ -359,32 +658,90 @@       -- Left folds for building a structure are inherently non-streaming       -- as the structure cannot be lazily consumed until fully built.             [-              benchIOSink value "toList" (S.fold FL.toList)-            , benchIOSink value "toListRev" (S.fold FL.toListRev)+              benchIOSink value "toList" (Stream.fold FL.toList)+            , benchIOSink value "toListRev" (Stream.fold FL.toListRev)             , benchIOSink value "toStream"-                (S.fold FL.toStream-                    :: SerialT IO a -> IO (SerialT Identity a))+                (Stream.fold FL.toStream+                    :: Stream IO a -> IO (Stream Identity a))             , benchIOSink value "toStreamRev"-                (S.fold FL.toStreamRev-                    :: SerialT IO a -> IO (SerialT Identity a))+                (Stream.fold FL.toStreamRev+                    :: Stream IO a -> IO (Stream Identity a))+            , benchIOSink value "nub" (Stream.fold FL.nub)             ]+    , bgroup "key-value"+            [+              benchIOSink value "demuxToMap (64 buckets) [sum, length]"+                $ demuxToMap (getKey 64) getFold+            , benchIOSink value "demuxToIntMap (64 buckets) [sum, length]"+                $ demuxToIntMap (getKey 64) getFold+            , benchIOSink value "demuxToMapIO (64 buckets) [sum, length]"+                $ demuxToMapIO (getKey 64) getFold++            -- classify: immutable+            , benchIOSink value "toMap (64 buckets) sum"+                $ toMap (getKey 64)+            , benchIOSink value "toIntMap (64 buckets) sum"+                $ toIntMap (getKey 64)++            -- classify: mutable cells+            , benchIOSink value "toMapIO (single bucket) sum"+                $ toMapIO (getKey 1)+            , benchIOSink value "toMapIO (64 buckets) sum"+                $ toMapIO (getKey 64)+            , benchIOSink value "toMapIO (max buckets) sum"+                $ toMapIO (getKey value)+            , benchIOSink value "toIntMapIO (64 buckets) sum"+                $ toIntMapIO (getKey 64)+            ]     ] +    where++    getKey buckets = (`mod` buckets)++    getFold k =+        return $ Just $ case k of+            0 -> FL.sum+            1 -> FL.length+            _ -> FL.length+ ------------------------------------------------------------------------------- -- Driver -------------------------------------------------------------------------------  main :: IO ()-main = runWithCLIOpts defaultStreamSize allBenchmarks+main = do+#ifndef FUSION_CHECK+    env <- mkHandleBenchEnv+    runWithCLIOpts defaultStreamSize (allBenchmarks env)      where -    allBenchmarks value =+    allBenchmarks env value =         [ bgroup (o_1_space_prefix moduleName) $ concat             [ o_1_space_serial_elimination value             , o_1_space_serial_transformation value             , o_1_space_serial_composition value+            , o_1_space_reduce_read_split env+            , o_1_space_reduce_toChunks_split env             ]         , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)         , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)         ]+#else+    -- Enable FUSION_CHECK macro at the beginning of the file+    -- Enable one benchmark below, and run the benchmark+    -- Check the .dump-simpl output+    let value = 100000+    let input = source value 1+    let getKey buckets = (`mod` buckets)+    let getFold k =+            return $ case k of+                0 -> FL.sum+                1 -> FL.length+                _ -> FL.length++    -- demuxToMap (getKey 64) (getFold . getKey 64) input+    toIntMapIO (getKey 64) input+    return ()+#endif
+ benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs view
@@ -0,0 +1,172 @@+-- |+-- Module      : Streamly.Benchmark.Data.Fold.Prelude+-- Copyright   : (c) 2018 Composewell+--+-- License     : MIT+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif++module Main (main) where++import Control.DeepSeq (NFData(..))+import Control.Monad.IO.Class (MonadIO(..))+import Data.Functor.Identity (Identity(..))+import Data.Hashable (Hashable)+import Data.HashMap.Strict (HashMap)+import System.Random (randomRIO)++import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.IsMap.HashMap ()+import Streamly.Internal.Data.MutArray (MutArray)++import qualified Streamly.Data.Fold.Prelude as Fold+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common+import Streamly.Benchmark.Common.Handle++-- We need a monadic bind here to make sure that the function f does not get+-- completely optimized out by the compiler in some cases.++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrM value n = Stream.unfoldrM step n+    where+    step cnt =+        if cnt > n + value+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE source #-}+source :: Monad m => Int -> Int -> Stream m Int+source = sourceUnfoldrM++-- | Takes a fold method, and uses it with a default source.+{-# INLINE benchIOSink #-}+benchIOSink+    :: NFData b+    => Int -> String -> (Stream IO Int -> IO b) -> Benchmark+benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value++-------------------------------------------------------------------------------+-- Partitioning+-------------------------------------------------------------------------------++{-# INLINE demuxToHashMap  #-}+demuxToHashMap :: (Monad m, Hashable k+#if __GLASGOW_HASKELL__ == 810+    , Eq k+#endif+    ) =>+    (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)+demuxToHashMap f g = Stream.fold (Fold.demuxToContainer f g)++{-# INLINE demuxToHashMapIO  #-}+demuxToHashMapIO :: (MonadIO m, Hashable k+#if __GLASGOW_HASKELL__ == 810+    , Eq k+#endif+    ) =>+    (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)+demuxToHashMapIO f g = Stream.fold (Fold.demuxToContainerIO f g)++{-# INLINE toHashMapIO #-}+toHashMapIO :: (MonadIO m, Num a, Hashable k+#if __GLASGOW_HASKELL__ == 810+    , Eq k+#endif+    ) =>+    (a -> k) -> Stream m a -> m (HashMap k a)+toHashMapIO f = Stream.fold (Fold.toHashMapIO f Fold.sum)++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Fold.Prelude"++instance NFData (MutArray a) where+    {-# INLINE rnf #-}+    rnf _ = ()++instance NFData a => NFData (Stream Identity a) where+    {-# INLINE rnf #-}+    rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs++o_n_heap_serial :: Int -> [Benchmark]+o_n_heap_serial value =+    [ bgroup "key-value"+            [+              benchIOSink value "demuxToHashMap (64 buckets) [sum, length]"+                $ demuxToHashMap (getKey 64) (getFold . getKey 64)+            , benchIOSink value "demuxToHashMapIO (64 buckets) [sum, length]"+                $ demuxToHashMapIO (getKey 64) (getFold . getKey 64)++            -- classify: mutable cells+            , benchIOSink value "toHashMapIO (single bucket) sum"+                $ toHashMapIO (getKey 1)+            , benchIOSink value "toHashMapIO (64 buckets) sum"+                $ toHashMapIO (getKey 64)+            , benchIOSink value "toHashMapIO (max buckets) sum"+                $ toHashMapIO (getKey value)+            ]+    ]++    where++    getKey buckets = (`mod` buckets)++    getFold k =+        return $ case k of+            0 -> Fold.sum+            1 -> Fold.length+            _ -> Fold.length++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++main :: IO ()+main = do+#ifndef FUSION_CHECK+    env <- mkHandleBenchEnv+    runWithCLIOpts defaultStreamSize (allBenchmarks env)++    where++    allBenchmarks _env value =+        [ bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)+        ]+#else+    -- Enable FUSION_CHECK macro at the beginning of the file+    -- Enable one benchmark below, and run the benchmark+    -- Check the .dump-simpl output+    let value = 100000+    let input = source value 1+    let getKey buckets = (`mod` buckets)+    let getFold k =+            return $ case k of+                0 -> Fold.sum+                1 -> Fold.length+                _ -> Fold.length++    -- demuxToMap (getKey 64) (getFold . getKey 64) input+    toIntMapIO (getKey 64) input+    return ()+#endif
+ benchmark/Streamly/Benchmark/Data/Fold/Window.hs view
@@ -0,0 +1,191 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++module Main (main) where++import Control.DeepSeq (NFData)+import Streamly.Data.Fold (Fold)+import Streamly.Internal.Data.Stream (Stream)+import System.Random (randomRIO)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Fold as Window+import qualified Streamly.Internal.Data.RingArray as RingArray+import qualified Streamly.Internal.Data.Stream as Stream++import Streamly.Benchmark.Common+import Test.Tasty.Bench++{-# INLINE source #-}+source :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+source len from =+    Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)++{-# INLINE sourceDescending #-}+sourceDescending :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+sourceDescending len from =+    Stream.enumerateFromThenTo+        (from + fromIntegral len)+        (from + fromIntegral (len - 1))+        from++{-# INLINE sourceDescendingInt #-}+sourceDescendingInt :: Monad m => Int -> Int -> Stream m Int+sourceDescendingInt = sourceDescending++{-# INLINE benchWith #-}+benchWith :: (Num a, NFData b) =>+    (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark+benchWith src len name f =+    bench name+        $ nfIO+        $ randomRIO (1, 1 :: Int) >>= Stream.fold f . src len . fromIntegral++{-# INLINE benchWithFold #-}+benchWithFold :: NFData a => Int -> String -> Fold IO Double a -> Benchmark+benchWithFold = benchWith source++{-# INLINE benchWithFoldInt #-}+benchWithFoldInt :: Int -> String -> Fold IO Int Int -> Benchmark+benchWithFoldInt = benchWith source++{-# INLINE benchScanWith #-}+benchScanWith :: Num a =>+    (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark+benchScanWith src len name f =+    bench name+        $ nfIO+        $ randomRIO (1, 1 :: Int)+            >>= Stream.fold Fold.drain+                . Stream.postscan f+                . src len+                . fromIntegral++{-# INLINE benchWithPostscan #-}+benchWithPostscan :: Int -> String -> Fold IO Double a -> Benchmark+benchWithPostscan = benchScanWith source++o_1_space_folds :: Int -> [Benchmark]+o_1_space_folds numElements =+    [ bgroup "fold"+        [ benchWithFold numElements "minimum (window size 100)"+            (Window.windowMinimum 100)+        , benchWithFold numElements "minimum (window size 1000)"+            (Window.windowMinimum 1000)+        , benchWith sourceDescendingInt numElements+            "minimum descending (window size 1000)"+            (Window.windowMinimum 1000)++        , benchWithFold numElements "maximum (window size 100)"+            (Window.windowMaximum 100)+        , benchWithFold numElements "maximum (window size 1000)"+            (Window.windowMaximum 1000)+        , benchWith sourceDescendingInt numElements+            "maximum descending (window size 1000)"+            (Window.windowMaximum 1000)++        , benchWithFold numElements "range (window size 100)"+            (Window.windowRange 100)+        , benchWithFold numElements "range (window size 1000)"+            (Window.windowRange 1000)+        , benchWith sourceDescendingInt numElements+            "range descending (window size 1000)"+            (Window.windowRange 1000)++        , benchWithFoldInt numElements "sumInt (window size 100)"+            (RingArray.slidingWindow 100 Window.windowSumInt)+        , benchWithFoldInt numElements "sum for Int (window size 100)"+            (RingArray.slidingWindow 100 Window.windowSum)+        , benchWithFold numElements "sum (window size 100)"+            (RingArray.slidingWindow 100 Window.windowSum)+        , benchWithFold numElements "sum (window size 1000)"+            (RingArray.slidingWindow 1000 Window.windowSum)+        , benchWithFold numElements "sum (entire stream)"+            (Window.cumulative Window.windowSum)+        , benchWithFold numElements "sum (Data.Fold)"+            Fold.sum++        , benchWithFold numElements "mean (window size 100)"+            (RingArray.slidingWindow 100 Window.windowMean)+        , benchWithFold numElements "mean (window size 1000)"+            (RingArray.slidingWindow 1000 Window.windowMean)+        , benchWithFold numElements "mean (entire stream)"+            (Window.cumulative Window.windowMean)+        , benchWithFold numElements "mean (Data.Fold)"+            Fold.mean++        , benchWithFold numElements "powerSum 2 (window size 100)"+            (RingArray.slidingWindow 100 (Window.windowPowerSum 2))+        , benchWithFold numElements "powerSum 2 (entire stream)"+            (Window.cumulative (Window.windowPowerSum 2))++        ]+    ]++o_1_space_scans :: Int -> [Benchmark]+o_1_space_scans numElements =+    [ bgroup "scan"+        [ benchWithPostscan numElements "minimum (window size 10)"+            (Window.windowMinimum 10)+        -- Below window size 30 the linear search based impl performs better+        -- than the dequeue based implementation.+        , benchWithPostscan numElements "minimum (window size 30)"+            (Window.windowMinimum 30)+        , benchWithPostscan numElements "minimum (window size 1000)"+            (Window.windowMinimum 1000)+        , benchScanWith sourceDescendingInt numElements+            "minimum descending (window size 1000)"+            (Window.windowMinimum 1000)++        , benchWithPostscan numElements "maximum (window size 10)"+            (Window.windowMaximum 10)+        , benchWithPostscan numElements "maximum (window size 30)"+            (Window.windowMaximum 30)+        , benchWithPostscan numElements "maximum (window size 1000)"+            (Window.windowMaximum 1000)+        , benchScanWith sourceDescendingInt numElements+            "maximum descending (window size 1000)"+            (Window.windowMaximum 1000)++        , benchWithPostscan numElements "range (window size 10)"+            (Window.windowRange 10)+        , benchWithPostscan numElements "range (window size 30)"+            (Window.windowRange 30)+        , benchWithPostscan numElements "range (window size 1000)"+            (Window.windowRange 1000)+        , benchScanWith sourceDescendingInt numElements+            "range descending (window size 1000)"+            (Window.windowRange 1000)++        , benchWithPostscan numElements "sum (window size 100)"+            (RingArray.slidingWindow 100 Window.windowSum)+        , benchWithPostscan numElements "sum (window size 1000)"+            (RingArray.slidingWindow 1000 Window.windowSum)++        , benchWithPostscan numElements "mean (window size 100)"+            (RingArray.slidingWindow 100 Window.windowMean)+        , benchWithPostscan numElements "mean (window size 1000)"+            (RingArray.slidingWindow 1000 Window.windowMean)++        , benchWithPostscan numElements "powerSum 2 (window size 100)"+            (RingArray.slidingWindow 100 (Window.windowPowerSum 2))+        , benchWithPostscan numElements "powerSum 2 (window size 1000)"+            (RingArray.slidingWindow 1000 (Window.windowPowerSum 2))+        ]+    ]++moduleName :: String+moduleName = "Data.Fold.Window"++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_folds value+            , o_1_space_scans value+            ]+        ]
+ benchmark/Streamly/Benchmark/Data/MutArray.hs view
@@ -0,0 +1,306 @@+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module      : Streamly.Benchmark.Data.Array.Unboxed.Mut+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++import Control.DeepSeq (NFData(..))+import Control.Monad.IO.Class (MonadIO)+import Data.Functor ((<&>))+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif+import System.Random (randomRIO)+import Prelude+    ( IO+    , Int+    , Integral(..)+    , Maybe(..)+    , Monad(..)+    , Num(..)+    , Ord(..)+    , String+    , ($)+    , (.)+    , (||)+    , concat+    , const+    , fmap+    , id+    , undefined+    )+import Streamly.Internal.Data.MutArray (MutArray)++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutArray as MArray+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Stream as Stream++import Test.Tasty.Bench+import Streamly.Benchmark.Common hiding (benchPureSrc)++#if __GLASGOW_HASKELL__ >= 810+type Stream :: Type -> Type+#endif+type Stream = MutArray++instance NFData (MutArray a) where+    {-# INLINE rnf #-}+    rnf _ = ()++-------------------------------------------------------------------------------+-- Benchmark helpers+-------------------------------------------------------------------------------++{-# INLINE benchIO #-}+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark+benchIO name src f = bench name $ nfIO $+    (randomRIO (1,1) >>= src) <&> f++{-# INLINE benchPureSink #-}+benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark+benchPureSink value name = benchIO name (sourceIntFromTo value)++{-# INLINE benchIO' #-}+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark+benchIO' name src f = bench name $ nfIO $+    randomRIO (1,1) >>= src >>= f++{-# INLINE benchIOSink #-}+benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark+benchIOSink value name = benchIO' name (sourceIntFromTo value)++-- Drain a source that generates an array in the IO monad+{-# INLINE benchIOSrc #-}+benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark+benchIOSrc name src = benchIO name src id++drain :: Monad m => Stream.Stream m a -> m ()+drain = Stream.fold Fold.drain++-------------------------------------------------------------------------------+-- Bench Ops+-------------------------------------------------------------------------------++{-# INLINE sourceUnfoldr #-}+sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)+sourceUnfoldr value n =+    Stream.fold (MArray.createOf value) $ Stream.unfoldr step n++    where++    step cnt =+        if cnt > n + value+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE sourceIntFromTo #-}+sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)+sourceIntFromTo value n =+    Stream.fold (MArray.createOf value) $ Stream.enumerateFromTo n (n + value)++{-# INLINE sourceFromList #-}+sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)+sourceFromList value n =+    Stream.fold (MArray.createOf value) $ Stream.fromList [n .. n + value]++{-# INLINE sourceIntFromToFromList #-}+sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)+sourceIntFromToFromList value n = MArray.fromListN value [n..n + value]++{-# INLINE sourceIntFromToFromStream #-}+sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)+sourceIntFromToFromStream value n =+    Stream.fold MArray.create $ Stream.enumerateFromTo n (n + value)++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Int -> Stream.Stream m Int+sourceUnfoldrM value n = Stream.unfoldrM step n+    where+    step cnt =+        if cnt > n + value+        then return Nothing+        else return (Just (cnt, cnt + 1))++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE composeN #-}+composeN :: Monad m+    => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)+composeN n f x =+    case n of+        1 -> f x+        2 -> f x >>= f+        3 -> f x >>= f >>= f+        4 -> f x >>= f >>= f >>= f+        _ -> undefined++{-# INLINE scanl' #-}+scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)+scanl' value n = composeN n $ onArray value $ Stream.scanl (Scanl.mkScanl (+) 0)++{-# INLINE scanl1' #-}+scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)+scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)++{-# INLINE map #-}+map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)+map value n = composeN n $ onArray value $ fmap (+ 1)++{-# INLINE onArray #-}+onArray+    :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)+    -> Stream Int+    -> m (Stream Int)+onArray value f arr =+    Stream.fold (MArray.createOf value) $ f $ Stream.unfold MArray.reader arr++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE unfoldReadDrain #-}+unfoldReadDrain :: MonadIO m => Stream Int -> m ()+unfoldReadDrain = drain . Stream.unfold MArray.reader++{-# INLINE unfoldReadRevDrain #-}+unfoldReadRevDrain :: MonadIO m => Stream Int -> m ()+unfoldReadRevDrain = drain . Stream.unfold MArray.readerRev++{-# INLINE toStreamDRevDrain #-}+toStreamDRevDrain :: MonadIO m => Stream Int -> m ()+toStreamDRevDrain = drain . MArray.readRev++{-# INLINE toStreamDDrain #-}+toStreamDDrain :: MonadIO m => Stream Int -> m ()+toStreamDDrain = drain . MArray.read++{-# INLINE unfoldFold #-}+unfoldFold :: MonadIO m => Stream Int -> m Int+unfoldFold = Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader++-------------------------------------------------------------------------------+-- Bench groups+-------------------------------------------------------------------------------++o_1_space_generation :: Int -> [Benchmark]+o_1_space_generation value =+    [ bgroup+        "generation"+        [ benchIOSrc "createOf . intFromTo" (sourceIntFromTo value)+        , benchIOSrc+              "fromList . intFromTo"+              (sourceIntFromToFromList value)+        , benchIOSrc "createOf . unfoldr" (sourceUnfoldr value)+        , benchIOSrc "createOf . fromList" (sourceFromList value)+        , benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)+        ]+    ]++o_1_space_elimination :: Int -> [Benchmark]+o_1_space_elimination value =+    [ bgroup "elimination"+        [ benchPureSink value "id" id+        , benchIOSink value "foldl'" unfoldFold+        , benchIOSink value "read" unfoldReadDrain+        , benchIOSink value "readRev" unfoldReadRevDrain+        , benchIOSink value "toStream" toStreamDDrain+        , benchIOSink value "toStreamRev" toStreamDRevDrain+        ]+      ]++o_n_heap_serial :: Int -> [Benchmark]+o_n_heap_serial value =+    [ bgroup "elimination"+        [+        -- Converting the stream to an array+            benchFold "createOf" (Stream.fold (MArray.createOf value))+                (sourceUnfoldrM value)+         ]+    ]++o_1_space_transformation :: Int -> [Benchmark]+o_1_space_transformation value =+   [ bgroup "transformation"+        [ benchIOSink value "scanl'" (scanl' value 1)+        , benchIOSink value "scanl1'" (scanl1' value 1)+        , benchIOSink value "map" (map value 1)+        ]+   ]++o_1_space_transformationX4 :: Int -> [Benchmark]+o_1_space_transformationX4 value =+    [ bgroup "transformationX4"+        [ benchIOSink value "scanl'" (scanl' value 4)+        , benchIOSink value "scanl1'" (scanl1' value 4)+        , benchIOSink value "map" (map value 4)+        ]+      ]++o_1_space_serial_marray ::+    Int -> (MutArray Int, Array.Array Int) -> [Benchmark]+o_1_space_serial_marray value ~(array, indices) =+    [ benchIO' "partitionBy (< 0)" (const (return array))+        $ MArray.partitionBy (< 0)+    , benchIO' "partitionBy (> 0)" (const (return array))+        $ MArray.partitionBy (> 0)+    , benchIO' "partitionBy (< value/2)" (const (return array))+        $ MArray.partitionBy (< (value `div` 2))+    , benchIO' "partitionBy (> value/2)" (const (return array))+        $ MArray.partitionBy (> (value `div` 2))+    , benchIO' "strip (< value/2 || > value/2)" (const (return array))+        $ MArray.dropAround (\x -> x < value `div` 2 || x > value `div` 2)+    , benchIO' "strip (> 0)" (const (return array))+        $ MArray.dropAround (> 0)+    , benchIO' "modifyIndices (+ 1)" (const (return indices))+        $ Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1))+        . Stream.unfold Array.reader+    ]++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.MutArray"++main :: IO ()+main = do+    runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks++    where++    alloc value = do+        marr <- MArray.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)+        indices <- Array.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)+        return (marr, indices)++    allBenchmarks array value =+        [ bgroup (o_1_space_prefix moduleName)+              $ concat+                    [ o_1_space_serial_marray value array+                    , o_1_space_generation value+                    , o_1_space_elimination value+                    , o_1_space_transformation value+                    , o_1_space_transformationX4 value+                    ]+        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)+        ]
benchmark/Streamly/Benchmark/Data/Parser.hs view
@@ -1,3 +1,9 @@++#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif+ -- | -- Module      : Streamly.Benchmark.Data.Parser -- Copyright   : (c) 2020 Composewell Technologies@@ -7,43 +13,42 @@  {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module Main   (     main   ) where +import Control.Applicative ((<|>)) import Control.DeepSeq (NFData(..))-import Control.Monad.Catch (MonadCatch)-import Data.Foldable (asum)+import Data.Function ((&)) import Data.Functor (($>))-import Data.Maybe (fromMaybe) import Data.Monoid (Sum(..)) import GHC.Magic (inline)-#if __GLASGOW_HASKELL__ >= 802 import GHC.Magic (noinline)-#else-#define noinline-#endif import System.IO (Handle) import System.Random (randomRIO)-import Prelude-       hiding (any, all, take, sequence, sequence_, sequenceA, takeWhile)+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.Parser+    (ParseError(..), Parser(..), Initial(..), Step(..), Final(..))+import Streamly.Internal.Data.Stream (Stream)+import Prelude hiding+    (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile, span) -import qualified Data.Traversable as TR-import qualified Data.Foldable as F import qualified Control.Applicative as AP+import qualified Data.Foldable as F+import qualified Data.Traversable as TR import qualified Streamly.FileSystem.Handle as Handle-import qualified Streamly.Prelude  as S-import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Stream.IsStream as IP+import qualified Streamly.Data.Stream as Stream import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Producer.Source as Source+import qualified Streamly.Internal.Data.Stream as Stream -import Gauge hiding (env)-import Streamly.Prelude (SerialT)+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common import Streamly.Benchmark.Common.Handle @@ -54,19 +59,59 @@ -- XXX these can be moved to the common module  {-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int-sourceUnfoldrM value n = S.unfoldrM step n+sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrM value n = Stream.unfoldrM step n     where     step cnt =         if cnt > n + value         then return Nothing         else return (Just (cnt, cnt + 1)) +-- | Generates something like this: { { \{ \{ } }.  The stream consists of+-- three parts, the first part is contains a sequence of `{`. The second part+-- contains a sequence pf escaped values `\{`. The third part contains a+-- sequence of `}`.+{-# INLINE sourceEscapedFrames #-}+sourceEscapedFrames ::+    Monad m+    => Int+    -> Int+    -> Stream m Char+sourceEscapedFrames value n = Stream.unfoldrM step n+    where++    bs = '\\'+    cbOpen = '{'+    cbClose = '}'+    value1 = value `div` 4++    step cnt+        | cnt > 4 * value1 = return Nothing+        | cnt <= value1 = return $ Just (cbOpen, cnt + 1)+        | cnt > 3 * value1 = return $ Just (cbClose, cnt + 1)+        | otherwise =+            return+                $ Just+                $ if (cnt - value1) `mod` 2 == 1+                  then (bs, cnt + 1)+                  else (cbOpen, cnt + 1)++{-# INLINE benchIOSrc #-}+benchIOSrc+    :: NFData b+    => (Int -> Int -> Stream IO a)+    -> Int+    -> String+    -> (Stream IO a -> IO b)+    -> Benchmark+benchIOSrc src value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f . src value+ -- | Takes a fold method, and uses it with a default source. {-# INLINE benchIOSink #-} benchIOSink-    :: (S.IsStream t, NFData b)-    => Int -> String -> (t IO Int -> IO b) -> Benchmark+    :: NFData b+    => Int -> String -> (Stream IO Int -> IO b) -> Benchmark benchIOSink value name f =     bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value @@ -74,200 +119,453 @@ -- Parsers ------------------------------------------------------------------------------- -{-# INLINE next #-}-next :: MonadCatch m => Int -> SerialT m Int -> m (Maybe Int)-next value = IP.parse p- where-  p = do-    m <- PR.next-    case m of-      Just i -> if i >= value then pure m else p-      Nothing -> pure Nothing- {-# INLINE takeBetween #-}-takeBetween :: MonadCatch m => Int -> SerialT m a -> m ()-takeBetween value =  IP.parse (PR.takeBetween 0 value FL.drain)+takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())+takeBetween value = Stream.parse (PR.takeBetween 0 value Fold.drain)  {-# INLINE takeEQ #-}-takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()-takeEQ value = IP.parse (PR.takeEQ value FL.drain)+takeEQ :: Monad m => Int -> Stream m a -> m (Either ParseError ())+takeEQ value = Stream.parse (PR.takeEQ value Fold.drain) -{-# INLINE drainWhile #-}-drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()-drainWhile value = IP.parse (PR.drainWhile (<= value))+{-# INLINE takeGE #-}+takeGE :: Monad m => Int -> Stream m a -> m (Either ParseError ())+takeGE value = Stream.parse (PR.takeGE value Fold.drain) -{-# INLINE sliceBeginWith #-}-sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()-sliceBeginWith value stream = do-    stream1 <- return . fromMaybe (S.fromPure (value + 1)) =<< S.tail stream-    let stream2 = value `S.cons` stream1-    IP.parse (PR.sliceBeginWith (== value) FL.drain) stream2+{-# INLINE dropWhile #-}+dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+dropWhile value = Stream.parse (PR.dropWhile (<= value)) +{-# INLINE takeBeginBy #-}+takeBeginBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+takeBeginBy value stream = do+    let stream2 = value `Stream.cons` stream+    Stream.parse (PR.takeBeginBy (== value) Fold.drain) stream2++takeFramedByEsc_ :: Monad m => Int -> Stream m Char -> m (Either ParseError ())+takeFramedByEsc_ _ = Stream.parse parser++    where++    isEsc = (== '\\')+    isBegin = (== '{')+    isEnd = (== '}')++    parser = PR.takeFramedByEsc_ isEsc isBegin isEnd Fold.drain++{-# INLINE listEqBy #-}+listEqBy :: Int -> Stream IO Int -> IO (Either ParseError [Int])+listEqBy len = Stream.parse (PR.listEqBy (==) [1 .. len])++{-# INLINE streamEqBy #-}+streamEqBy :: Int -> Stream IO Int -> IO (Either ParseError ())+streamEqBy len = Stream.parse (PR.streamEqBy (==) (Stream.enumerateFromTo 1 len))+ {-# INLINE takeWhile #-}-takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()-takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)+takeWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+takeWhile value = Stream.parse (PR.takeWhile (<= value) Fold.drain) +takeWhileP :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+takeWhileP value =+    Stream.parse (PR.takeWhileP (<= value) (PR.takeWhile (<= value - 1) Fold.drain))+ {-# INLINE takeP #-}-takeP :: MonadCatch m => Int -> SerialT m a -> m ()-takeP value = IP.parse (PR.takeP value (PR.fromFold FL.drain))+takeP :: Monad m => Int -> Stream m a -> m (Either ParseError ())+takeP value = Stream.parse (PR.takeP value (PR.fromFold Fold.drain))  {-# INLINE groupBy #-}-groupBy :: MonadCatch m => SerialT m Int -> m ()-groupBy = IP.parse (PR.groupBy (<=) FL.drain)+groupBy :: Monad m => Stream m Int -> m (Either ParseError ())+groupBy = Stream.parse (PR.groupBy (<=) Fold.drain)  {-# INLINE groupByRolling #-}-groupByRolling :: MonadCatch m => SerialT m Int -> m ()-groupByRolling = IP.parse (PR.groupByRolling (<=) FL.drain)+groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())+groupByRolling = Stream.parse (PR.groupByRolling (<=) Fold.drain)  {-# INLINE wordBy #-}-wordBy :: MonadCatch m => Int -> SerialT m Int -> m ()-wordBy value = IP.parse (PR.wordBy (>= value) FL.drain)+wordBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+wordBy value = Stream.parse (PR.wordBy (>= value) Fold.drain) +{-# INLINE sepByWords #-}+sepByWords :: Monad m => Stream m Int -> m (Either ParseError ())+sepByWords = Stream.parse (wrds even Fold.drain)+    where+    wrds p = PR.sepBy (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)++{-# INLINE sepByAllWords #-}+sepByAllWords :: Monad m => Stream m Int -> m (Either ParseError ())+sepByAllWords = Stream.parse (wrds even Fold.drain)+    where+    wrds p = PR.sepByAll (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)++-- Returning a list to compare with the sepBy1 in ParserK+{-# INLINE sepBy1 #-}+sepBy1 :: Monad m => Stream m Int -> m (Either ParseError [Int])+sepBy1 xs = do+    Stream.parse (PR.sepBy1 (PR.satisfy odd) (PR.satisfy even) Fold.toList) xs++{-# INLINE sepByWords1 #-}+sepByWords1 :: Monad m => Stream m Int -> m (Either ParseError ())+sepByWords1 = Stream.parse (wrds even Fold.drain)+    where+    wrds p = PR.sepBy1 (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)++{-# INLINE deintercalate #-}+deintercalate :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+deintercalate _ = Stream.parse (partition even)++    where++    partition p =+        PR.deintercalate+            (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain++{-# INLINE deintercalate1 #-}+deintercalate1 :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+deintercalate1 _ = Stream.parse (partition even)++    where++    partition p =+        PR.deintercalate1+            (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain++{-# INLINE deintercalateAll #-}+deintercalateAll :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+deintercalateAll _ = Stream.parse (partition even)++    where++    partition p =+        PR.deintercalateAll+            (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain+ {-# INLINE manyWordByEven #-}-manyWordByEven :: MonadCatch m => SerialT m Int -> m ()-manyWordByEven = IP.parse (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)+manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())+manyWordByEven = Stream.parse (PR.many (PR.wordBy even Fold.drain) Fold.drain)  {-# INLINE many #-}-many :: MonadCatch m => SerialT m Int -> m Int-many = IP.parse (PR.many (PR.satisfy (> 0)) FL.length)+many :: Monad m => Stream m Int -> m (Either ParseError Int)+many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)  {-# INLINE manyAlt #-}-manyAlt :: MonadCatch m => SerialT m Int -> m Int+manyAlt :: Monad m => Stream m Int -> m Int manyAlt xs = do-    x <- IP.parse (AP.many (PR.satisfy (> 0))) xs+    x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs     return $ Prelude.length x  {-# INLINE some #-}-some :: MonadCatch m => SerialT m Int -> m Int-some = IP.parse (PR.some (PR.satisfy (> 0)) FL.length)+some :: Monad m => Stream m Int -> m (Either ParseError Int)+some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)  {-# INLINE someAlt #-}-someAlt :: MonadCatch m => SerialT m Int -> m Int+someAlt :: Monad m => Stream m Int -> m Int someAlt xs = do-    x <- IP.parse (AP.some (PR.satisfy (> 0))) xs+    x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs     return $ Prelude.length x  {-# INLINE manyTill #-}-manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int+manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int) manyTill value =-    IP.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) FL.length)+    Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length) -{-# INLINE splitAp #-}-splitAp :: MonadCatch m-    => Int -> SerialT m Int -> m ((), ())-splitAp value =-    IP.parse+{-# INLINE splitAp2 #-}+splitAp2 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ((), ()))+splitAp2 value =+    Stream.parse         ((,)-            <$> PR.drainWhile (<= (value `div` 2))-            <*> PR.drainWhile (<= value)+            <$> PR.dropWhile (<= (value `div` 2))+            <*> PR.dropWhile (<= value)         ) +{-# INLINE splitAp4 #-}+splitAp4 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+splitAp4 value =+    Stream.parse+        (      (\() () () () -> ())+            <$> PR.dropWhile (<= (value * 1 `div` 4))+            <*> PR.dropWhile (<= (value * 2 `div` 4))+            <*> PR.dropWhile (<= (value * 3 `div` 4))+            <*> PR.dropWhile (<= value)+        )++{-# INLINE splitAp8 #-}+splitAp8 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+splitAp8 value =+    Stream.parse+        (      (\() () () () () () () () -> ())+            <$> PR.dropWhile (<= (value * 1 `div` 8))+            <*> PR.dropWhile (<= (value * 2 `div` 8))+            <*> PR.dropWhile (<= (value * 3 `div` 8))+            <*> PR.dropWhile (<= (value * 4 `div` 8))+            <*> PR.dropWhile (<= (value * 5 `div` 8))+            <*> PR.dropWhile (<= (value * 6 `div` 8))+            <*> PR.dropWhile (<= (value * 7 `div` 8))+            <*> PR.dropWhile (<= value)+        )+ {-# INLINE splitApBefore #-}-splitApBefore :: MonadCatch m-    => Int -> SerialT m Int -> m ()+splitApBefore :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ()) splitApBefore value =-    IP.parse-        (  PR.drainWhile (<= (value `div` 2))-        *> PR.drainWhile (<= value)+    Stream.parse+        (  PR.dropWhile (<= (value `div` 2))+        *> PR.dropWhile (<= value)         )  {-# INLINE splitApAfter #-}-splitApAfter :: MonadCatch m-    => Int -> SerialT m Int -> m ()+splitApAfter :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ()) splitApAfter value =-    IP.parse-        (  PR.drainWhile (<= (value `div` 2))-        <* PR.drainWhile (<= value)+    Stream.parse+        (  PR.dropWhile (<= (value `div` 2))+        <* PR.dropWhile (<= value)         ) -{-# INLINE serialWith #-}-serialWith :: MonadCatch m-    => Int -> SerialT m Int -> m ((), ())-serialWith value =-    IP.parse-        (PR.serialWith (,)-            (PR.drainWhile (<= (value `div` 2)))-            (PR.drainWhile (<= value))+{-# INLINE splitWith2 #-}+splitWith2 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ((), ()))+splitWith2 value =+    Stream.parse+        (PR.splitWith (,)+            (PR.dropWhile (<= (value `div` 2)))+            (PR.dropWhile (<= value))         )  {-# INLINE split_ #-}-split_ :: MonadCatch m-    => Int -> SerialT m Int -> m ()+split_ :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ()) split_ value =-    IP.parse+    Stream.parse         (PR.split_-            (PR.drainWhile (<= (value `div` 2)))-            (PR.drainWhile (<= value))+            (PR.dropWhile (<= (value `div` 2)))+            (PR.dropWhile (<= value))         ) -{-# INLINE sliceSepByP #-}-sliceSepByP :: MonadCatch m-    => Int -> SerialT m Int -> m()-sliceSepByP value = IP.parse (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))+-- XXX dropWhile with applicative does not fuse+-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"+{-# INLINE takeWhileFail #-}+takeWhileFail :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+takeWhileFail predicate (Fold fstep finitial _ ffinal) =+    Parser step initial extract +    where++    initial = do+        res <- finitial+        return $ case res of+            Fold.Partial s -> IPartial s+            Fold.Done b -> IDone b++    step s a =+        if predicate a+        then do+            fres <- fstep s a+            return+                $ case fres of+                      Fold.Partial s1 -> SPartial 1 s1+                      Fold.Done b -> SDone 1 b+        else return $ SError "fail"++    extract s = fmap (FDone 0) (ffinal s)++{-# INLINE alt2 #-}+alt2 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+alt2 value =+    Stream.parse+        (PR.alt+            (takeWhileFail (<= (value `div` 2)) Fold.drain)+            (PR.dropWhile (<= value))+        )++{-# INLINE alt4 #-}+alt4 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+alt4 value =+    Stream.parse+        (   takeWhileFail (<= (value * 1 `div` 4)) Fold.drain+        <|> takeWhileFail (<= (value * 2 `div` 4)) Fold.drain+        <|> takeWhileFail (<= (value * 3 `div` 4)) Fold.drain+        <|> PR.dropWhile (<= value)+        )++{-# INLINE alt8 #-}+alt8 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+alt8 value =+    Stream.parse+        (   takeWhileFail (<= (value * 1 `div` 8)) Fold.drain+        <|> takeWhileFail (<= (value * 2 `div` 8)) Fold.drain+        <|> takeWhileFail (<= (value * 3 `div` 8)) Fold.drain+        <|> takeWhileFail (<= (value * 4 `div` 8)) Fold.drain+        <|> takeWhileFail (<= (value * 5 `div` 8)) Fold.drain+        <|> takeWhileFail (<= (value * 6 `div` 8)) Fold.drain+        <|> takeWhileFail (<= (value * 7 `div` 8)) Fold.drain+        <|> PR.dropWhile (<= value)+        )++{-# INLINE alt16 #-}+alt16 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+alt16 value =+    Stream.parse+        (   takeWhileFail (<= (value * 1 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 2 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 3 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 4 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 5 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 6 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 8 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 9 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 10 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 11 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 12 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 13 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 14 `div` 16)) Fold.drain+        <|> takeWhileFail (<= (value * 15 `div` 16)) Fold.drain+        <|> PR.dropWhile (<= value)+        )++{-# INLINE altSmall #-}+altSmall :: Monad m+    => Int -> Stream m Int -> m ()+altSmall value =+    Stream.fold Fold.drain .+        Stream.parseMany+            (PR.alt+                (PR.satisfy (>= value) *> PR.die "alt")+                (PR.satisfy (<= value))+            )++{-# INLINE monad #-}+monad :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+monad value =+    Stream.parse+        $ do+            PR.dropWhile (<= (value `div` 2))+            PR.dropWhile (<= value)++{-# INLINE monad4 #-}+monad4 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+monad4 value =+    Stream.parse $ do+        PR.dropWhile (<= (value `div` 4))+        PR.dropWhile (<= (value `div` 2))+        PR.dropWhile (<= (value * 3 `div` 4))+        PR.dropWhile (<= value)++{-# INLINE monad8 #-}+monad8 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+monad8 value =+    Stream.parse $ do+        PR.dropWhile (<= (value * 1 `div` 8))+        PR.dropWhile (<= (value * 2 `div` 8))+        PR.dropWhile (<= (value * 3 `div` 8))+        PR.dropWhile (<= (value * 4 `div` 8))+        PR.dropWhile (<= (value * 5 `div` 8))+        PR.dropWhile (<= (value * 6 `div` 8))+        PR.dropWhile (<= (value * 7 `div` 8))+        PR.dropWhile (<= value)++{-# INLINE monad16 #-}+monad16 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+monad16 value =+    Stream.parse $ do+        PR.dropWhile (<= (value * 1 `div` 16))+        PR.dropWhile (<= (value * 2 `div` 16))+        PR.dropWhile (<= (value * 3 `div` 16))+        PR.dropWhile (<= (value * 4 `div` 16))+        PR.dropWhile (<= (value * 5 `div` 16))+        PR.dropWhile (<= (value * 6 `div` 16))+        PR.dropWhile (<= (value * 7 `div` 16))+        PR.dropWhile (<= (value * 8 `div` 16))+        PR.dropWhile (<= (value * 9 `div` 16))+        PR.dropWhile (<= (value * 10 `div` 16))+        PR.dropWhile (<= (value * 11 `div` 16))+        PR.dropWhile (<= (value * 12 `div` 16))+        PR.dropWhile (<= (value * 13 `div` 16))+        PR.dropWhile (<= (value * 14 `div` 16))+        PR.dropWhile (<= (value * 15 `div` 16))+        PR.dropWhile (<= value)++{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+takeEndBy_ value = Stream.parse (PR.takeEndBy_ (>= value) (PR.fromFold Fold.drain))++{- {-# INLINE teeAllAny #-}-teeAllAny :: MonadCatch m-    => Int -> SerialT m Int -> m ((), ())+teeAllAny :: Monad m+    => Int -> Stream m Int -> m ((), ()) teeAllAny value =-    IP.parse+    Stream.parse         (PR.teeWith (,)-            (PR.drainWhile (<= value))-            (PR.drainWhile (<= value))+            (PR.dropWhile (<= value))+            (PR.dropWhile (<= value))         )  {-# INLINE teeFstAllAny #-}-teeFstAllAny :: MonadCatch m-    => Int -> SerialT m Int -> m ((), ())+teeFstAllAny :: Monad m+    => Int -> Stream m Int -> m ((), ()) teeFstAllAny value =-    IP.parse+    Stream.parse         (PR.teeWithFst (,)-            (PR.drainWhile (<= value))-            (PR.drainWhile (<= value))+            (PR.dropWhile (<= value))+            (PR.dropWhile (<= value))         )  {-# INLINE shortestAllAny #-}-shortestAllAny :: MonadCatch m-    => Int -> SerialT m Int -> m ()+shortestAllAny :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ()) shortestAllAny value =-    IP.parse+    Stream.parse         (PR.shortest-            (PR.drainWhile (<= value))-            (PR.drainWhile (<= value))+            (PR.dropWhile (<= value))+            (PR.dropWhile (<= value))         )  {-# INLINE longestAllAny #-}-longestAllAny :: MonadCatch m-    => Int -> SerialT m Int -> m ()+longestAllAny :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ()) longestAllAny value =-    IP.parse+    Stream.parse         (PR.longest-            (PR.drainWhile (<= value))-            (PR.drainWhile (<= value))+            (PR.dropWhile (<= value))+            (PR.dropWhile (<= value))         )--parseManyChunksOfSum :: Int -> Handle -> IO Int-parseManyChunksOfSum n inh =-    S.length-        $ IP.parseMany-              (PR.fromFold $ FL.take n FL.sum)-              (S.unfold Handle.read inh)+-}  ---------------------------------------------------------------------------------- Parsing with unfolds+-- Spanning ------------------------------------------------------------------------------- -{-# INLINE parseManyUnfoldArrays #-}-parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()-parseManyUnfoldArrays count arrays = do-    let src = Source.source (Just (Producer.OuterLoop arrays))-    let parser = PR.fromFold (FL.take count FL.drain)-    let readSrc =-            Source.producer-                $ Producer.concat Producer.fromList Array.producer-    let streamParser =-            Producer.simplify (Source.parseMany parser readSrc)-    S.drain $ S.unfold streamParser src+{-# INLINE span #-}+span :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))+span value = Stream.parse (PR.span (<= (value `div` 2)) Fold.drain Fold.drain) +{-# INLINE spanBy #-}+spanBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))+spanBy value =+    Stream.parse (PR.spanBy (\_ i -> i <= (value `div` 2)) Fold.drain Fold.drain)++{-# INLINE spanByRolling #-}+spanByRolling :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))+spanByRolling value =+    Stream.parse (PR.spanByRolling (\_ i -> i <= value `div` 2) Fold.drain Fold.drain)++parseManyChunksOfSum :: Int -> Handle -> IO Int+parseManyChunksOfSum n inh =+    Stream.fold Fold.length+        $ Stream.parseMany+              (PR.fromFold $ Fold.take n Fold.sum)+              (Stream.unfold Handle.reader inh)+ ------------------------------------------------------------------------------- -- Parsers in which -fspec-constr-recursive=16 is problematic -------------------------------------------------------------------------------@@ -277,64 +575,130 @@ -- not have to rely on it. -- {-# INLINE lookAhead #-}-lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()+lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ()) lookAhead value =-    IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())+    Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ()) +-- XXX The timing of this increased 3x after the stepify extract changes.+{-# INLINE sequenceA_ #-}+sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+sequenceA_ value =+    Stream.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))++-- quadratic complexity {-# INLINE sequenceA #-}-sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int+sequenceA :: Monad m => Int -> Stream m Int -> m Int sequenceA value xs = do-    x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs+    x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs     return $ length x -{-# INLINE sequenceA_ #-}-sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()-sequenceA_ value =-    IP.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))-+-- quadratic complexity {-# INLINE sequence #-}-sequence :: MonadCatch m => Int -> SerialT m Int -> m Int+sequence :: Monad m => Int -> Stream m Int -> m Int sequence value xs = do-    x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs+    x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs     return $ length x  {-# INLINE sequence_ #-}-sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()-sequence_ value =-    IP.parse (F.sequence_ $ replicate value (PR.satisfy (> 0)))+sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+sequence_ value xs =+    Stream.parse (foldr f (return ()) (replicate value (PR.takeBetween 0 1 Fold.drain))) xs +    where++    {-# INLINE f #-}+    f m k = m >>= (\_ -> k)++-- choice using the "Alternative" instance with direct style parser type has+-- quadratic performance complexity.+-- {-# INLINE choiceAsum #-}-choiceAsum :: MonadCatch m => Int -> SerialT m Int -> m Int+choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int) choiceAsum value =-    IP.parse (asum (replicate value (PR.satisfy (< 0)))+    Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))         AP.<|> PR.satisfy (> 0)) +{- {-# INLINE choice #-}-choice :: MonadCatch m => Int -> SerialT m Int -> m Int+choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int) choice value =-    IP.parse+    Stream.parse         (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))+-}  -------------------------------------------------------------------------------+-- Parsing with unfolds+-------------------------------------------------------------------------------++{-# INLINE parseManyUnfoldArrays #-}+parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()+parseManyUnfoldArrays count arrays = do+    let src = Producer.source (Just (Producer.OuterLoop arrays))+    let parser = PR.fromFold (Fold.take count Fold.drain)+    let readSrc =+            Producer.producer+                $ Producer.concat Producer.fromList Array.producer+    let streamParser =+            Producer.simplify (Producer.parseMany parser readSrc)+    Stream.fold Fold.drain $ Stream.unfold streamParser src++------------------------------------------------------------------------------- -- Stream transformation -------------------------------------------------------------------------------  {-# INLINE parseMany #-}-parseMany :: MonadCatch m => Int -> SerialT m Int -> m ()+parseMany :: Monad m => Int -> Stream m Int -> m () parseMany n =-      S.drain-    . S.map getSum-    . IP.parseMany (PR.fromFold $ FL.take n FL.mconcat)-    . S.map Sum+      Stream.fold Fold.drain+    . fmap getSum+    . Stream.catRights . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)+    . fmap Sum +{-# INLINE parseManyGroupBy #-}+parseManyGroupBy :: Monad m => (Int -> Int -> Bool) -> Stream m Int -> m ()+parseManyGroupBy cmp =+    Stream.fold Fold.drain . Stream.parseMany (PR.groupBy cmp Fold.drain)++{-# INLINE parseManyGroupsRolling #-}+parseManyGroupsRolling :: Monad m => Bool -> Stream m Int -> m ()+parseManyGroupsRolling b =+      Stream.fold Fold.drain+    . Stream.parseMany (PR.groupByRolling (\_ _ -> b) Fold.drain)++{-# INLINE parseManyGroupsRollingEither #-}+parseManyGroupsRollingEither :: Monad m =>+    (Int -> Int -> Bool) -> Int -> m ()+parseManyGroupsRollingEither cmp value = do+    sourceUnfoldrM value 1+        & Stream.parseMany (PR.groupByRollingEither cmp Fold.drain Fold.drain)+        & Stream.fold Fold.drain++{-# INLINE parseManyGroupsRollingEitherAlt #-}+parseManyGroupsRollingEitherAlt :: Monad m =>+    (Int -> Int -> Bool) -> Int -> m ()+parseManyGroupsRollingEitherAlt cmp value = do+    sourceUnfoldrM value 1+        -- Make the input unsorted.+        & fmap (\x -> if even x then x + 2 else x)+        & Stream.parseMany (PR.groupByRollingEither cmp Fold.drain Fold.drain)+        & Stream.fold Fold.drain+ {-# INLINE parseIterate #-}-parseIterate :: MonadCatch m => Int -> SerialT m Int -> m ()+parseIterate :: Monad m => Int -> Stream m Int -> m () parseIterate n =-      S.drain-    . S.map getSum-    . IP.parseIterate (PR.fromFold . FL.take n . FL.sconcat) (Sum 0)-    . S.map Sum+      Stream.fold Fold.drain+    . fmap getSum+    . Stream.catRights+    . Stream.parseIterate+        (PR.fromFold . Fold.take n . Fold.sconcat)+        (Sum 0)+    . fmap Sum +{-# INLINE concatSequence #-}+concatSequence :: Monad m => Stream m Int -> m (Either ParseError ())+concatSequence =+    Stream.parse $ PR.sequence (Stream.repeat PR.one) Fold.drain+ ------------------------------------------------------------------------------- -- Benchmarks -------------------------------------------------------------------------------@@ -342,42 +706,95 @@ moduleName :: String moduleName = "Data.Parser" +instance NFData ParseError where+    {-# INLINE rnf #-}+    rnf (ParseError x) = rnf x+ o_1_space_serial :: Int -> [Benchmark] o_1_space_serial value =-    [ benchIOSink value "next" $ next value-    , benchIOSink value "takeBetween" $ takeBetween value-    , benchIOSink value "takeEQ" $ takeEQ value+    [ benchIOSink value "takeBetween" $ takeBetween value     , benchIOSink value "takeWhile" $ takeWhile value+    , benchIOSink value "takeWhileP" $ takeWhileP value     , benchIOSink value "takeP" $ takeP value-    , benchIOSink value "drainWhile" $ drainWhile value-    , benchIOSink value "sliceBeginWith" $ sliceBeginWith value+    , benchIOSink value "dropWhile" $ dropWhile value+    , benchIOSink value "takeBeginBy" $ takeBeginBy value+    , benchIOSink value "takeEndBy_" $ takeEndBy_ value     , benchIOSink value "groupBy" $ groupBy     , benchIOSink value "groupByRolling" $ groupByRolling     , benchIOSink value "wordBy" $ wordBy value-    , benchIOSink value "splitAp" $ splitAp value+    , benchIOSink value "sepBy (words)" sepByWords+    , benchIOSink value "sepByAll (words)" sepByAllWords+    , benchIOSink value "sepBy1 (words)" sepByWords1+    , benchIOSink value "deintercalate" $ deintercalate value+    , benchIOSink value "deintercalate1" $ deintercalate1 value+    , benchIOSink value "deintercalateAll" $ deintercalateAll value+    -- Applicative and Monad+    , benchIOSink value "splitAp2" $ splitAp2 value+    , benchIOSink value "splitAp4" $ splitAp4 value+    , benchIOSink value "splitAp8" $ splitAp8 value     , benchIOSink value "splitApBefore" $ splitApBefore value     , benchIOSink value "splitApAfter" $ splitApAfter value-    , benchIOSink value "serialWith" $ serialWith value-    , benchIOSink value "sliceSepByP" $ sliceSepByP value+    , benchIOSink value "splitWith2" $ splitWith2 value+    , benchIOSink value "span" $ span value+    , benchIOSink value "spanBy" $ spanBy value+    , benchIOSink value "spanByRolling" $ spanByRolling value+    , benchIOSink value "monad2" $ monad value+    , benchIOSink value "monad4" $ monad4 value+    , benchIOSink value "monad8" $ monad8 value+    -- Alternative+    , benchIOSink value "alt2parseMany" $ altSmall value+    , benchIOSink value "alt2" $ alt2 value+    , benchIOSink value "alt4" $ alt4 value+    , benchIOSink value "alt8" $ alt8 value+    , benchIOSink value "alt16" $ alt16 value     , benchIOSink value "many" many     , benchIOSink value "many (wordBy even)" $ manyWordByEven     , benchIOSink value "some" some     , benchIOSink value "manyTill" $ manyTill value-    , benchIOSink value "tee" $ teeAllAny value-    , benchIOSink value "teeFst" $ teeFstAllAny value-    , benchIOSink value "shortest" $ shortestAllAny value-    , benchIOSink value "longest" $ longestAllAny value+    , benchIOSink value "parseMany" $ parseMany value     , benchIOSink value "parseMany (take 1)" (parseMany 1)     , benchIOSink value "parseMany (take all)" (parseMany value)+    , benchIOSink value "parseMany (groupBy (<))" (parseManyGroupBy (<))+    , benchIOSink value "parseMany (groupBy (==))" (parseManyGroupBy (==))+    , benchIOSink value "parseMany groupRollingBy (bound groups)"+          $ parseManyGroupsRolling False+    , benchIOSink value "parseMany groupRollingBy (1 group)"+          $ parseManyGroupsRolling True+    , bench "parseMany groupRollingByEither (Left)"+        $ nfIO $ parseManyGroupsRollingEitherLeft+    , bench "parseMany groupRollingByEither (Right)"+        $ nfIO $ parseManyGroupsRollingEitherRight+    , bench "parseMany groupRollingByEither (Alternating)"+        $ nfIO $ parseManyGroupsRollingEitherAlt1     , benchIOSink value "parseIterate (take 1)" (parseIterate 1)     , benchIOSink value "parseIterate (take all)" (parseIterate value)+    , benchIOSink value "concatSequence" concatSequence+    {-+    , benchIOSink value "tee" $ teeAllAny value+    , benchIOSink value "teeFst" $ teeFstAllAny value+    , benchIOSink value "shortest" $ shortestAllAny value+    , benchIOSink value "longest" $ longestAllAny value+    -}+    , benchIOSink value "streamEqBy" (streamEqBy value)     ] +    where++    {-# NOINLINE parseManyGroupsRollingEitherLeft #-}+    parseManyGroupsRollingEitherLeft = parseManyGroupsRollingEither (<) value++    {-# NOINLINE parseManyGroupsRollingEitherRight #-}+    parseManyGroupsRollingEitherRight = parseManyGroupsRollingEither (>) value++    {-# NOINLINE parseManyGroupsRollingEitherAlt1 #-}+    parseManyGroupsRollingEitherAlt1 =+        parseManyGroupsRollingEitherAlt (>) value+ o_1_space_filesystem :: BenchEnv -> [Benchmark] o_1_space_filesystem env =-    [ mkBench ("S.parseMany (FL.take " ++ show (bigSize env) ++ " FL.sum)") env+    [ mkBench ("S.parseMany (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env           $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh-    , mkBench "S.parseMany (FL.take 1 FL.sum)" env+    , mkBench "S.parseMany (Fold.take 1 Fold.sum)" env           $ \inh _ -> inline parseManyChunksOfSum 1 inh     ] @@ -392,40 +809,53 @@ o_n_heap_serial :: Int -> [Benchmark] o_n_heap_serial value =     [+      benchIOSink value "takeEQ" $ takeEQ value+    , benchIOSink value "takeGE" $ takeGE value+     -- lookahead benchmark holds the entire input till end-      benchIOSink value "lookAhead" $ lookAhead value+    , benchIOSink value "lookAhead" $ lookAhead value -    -- accumulates the results in a list-    , benchIOSink value "sequence" $ sequence value-    , benchIOSink value "sequenceA" $ sequenceA value+    -- o-n-heap because of backtracking+    , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"+        $ takeFramedByEsc_ value -    -- XXX why should this take O(n) heap, it discards the results?-    , benchIOSink value "sequence_" $ sequence_ value-    , benchIOSink value "sequenceA_" $ sequenceA_ value     -- non-linear time complexity (parserD)     , benchIOSink value "split_" $ split_ value-    -- XXX why O(n) heap?-    , benchIOSink value "choice (asum)" $ choiceAsum value-    , benchIOSink value "choice" $ choice value+    -- XXX Takes lot of space when run on a long stream, why?+    , benchIOSink value "monad16" $ monad16 value      -- These show non-linear time complexity.     -- They accumulate the results in a list.+    , benchIOSink value "sepBy1" sepBy1     , benchIOSink value "manyAlt" manyAlt     , benchIOSink value "someAlt" someAlt+    , benchIOSink value "listEqBy" (listEqBy value)     ] +-- accumulate results in a list in IO+o_n_space_serial :: Int -> [Benchmark]+o_n_space_serial value =+    [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)+    , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)+    , benchIOSink value "sequence/100" $ sequence (value `div` 100)+    , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)+    , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)+    -- , benchIOSink value "choice/100" $ choice (value `div` 100)+    ]+ ------------------------------------------------------------------------------- -- Driver -------------------------------------------------------------------------------  main :: IO () main = do+#ifndef FUSION_CHECK     env <- mkHandleBenchEnv     runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)      where -    alloc value = IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0+    alloc value = Stream.fold Fold.toList $ Array.chunksOf 100 $ sourceUnfoldrM value 0      allBenchmarks env arrays value =         [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)@@ -435,4 +865,22 @@         , bgroup (o_1_space_prefix moduleName)             (o_1_space_serial_unfold value arrays)         , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)+        , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)         ]+#else+    -- Enable FUSION_CHECK macro at the beginning of the file+    -- Enable one benchmark below, and run the benchmark+    -- Check the .dump-simpl output+    let value = 100000+    -- let input = sourceUnfoldrM value 1+    -- manyTill value input+    -- deintercalate value input+    -- deintercalate1 value input+    -- deintercalateAll value input+    -- sepByWords input+    -- sepByAllWords input+    -- sepBy1 input+    -- sepByWords1 input+    takeFramedByEsc_ value (sourceEscapedFrames value 1)+    return ()+#endif
− benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs 
@@ -1,417 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.ParserD--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}--module Main-  (-    main-  ) where--import Control.DeepSeq (NFData(..))-import Control.Monad.Catch (MonadCatch, MonadThrow)-import Data.Foldable (asum)-import Data.Functor (($>))-import Data.Maybe (fromMaybe)-import System.Random (randomRIO)-import Prelude hiding (any, all, take, sequence, sequenceA, sequence_, takeWhile, span)--import qualified Data.Traversable as TR-import qualified Data.Foldable as F-import qualified Control.Applicative as AP-import qualified Streamly.Prelude  as S-import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser.ParserD as PR-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Producer.Source as Source-import qualified Streamly.Internal.Data.Stream.IsStream as IP--import Gauge-import Streamly.Prelude (SerialT, MonadAsync, IsStream)-import Streamly.Benchmark.Common------------------------------------------------------------------------------------ Utilities------------------------------------------------------------------------------------ XXX these can be moved to the common module--{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int-sourceUnfoldrM value n = S.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else return (Just (cnt, cnt + 1))---- | Takes a fold method, and uses it with a default source.-{-# INLINE benchIOSink #-}-benchIOSink-    :: (IsStream t, NFData b)-    => Int -> String -> (t IO Int -> IO b) -> Benchmark-benchIOSink value name f =-    bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value---- Make the input unsorted.-{-# INLINE benchIOSinkRandom #-}-benchIOSinkRandom-    :: (IsStream t, NFData b)-    => Int -> String -> (t IO Int -> IO b) -> Benchmark-benchIOSinkRandom value name f =-    bench name $ nfIO $ randomRIO (1,1)-        >>= f-        . S.map (\x -> if even x then x + 2 else x)-        . sourceUnfoldrM value------------------------------------------------------------------------------------ Parsers----------------------------------------------------------------------------------{-# INLINE drainWhile #-}-drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()-drainWhile p = PR.takeWhile p FL.drain--{-# INLINE sliceBeginWith #-}-sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()-sliceBeginWith value stream = do-    stream1 <- return . fromMaybe (S.fromPure (value + 1)) =<< S.tail stream-    let stream2 = value `S.cons` stream1-    IP.parseD (PR.sliceBeginWith (== value) FL.drain) stream2--{-# INLINE takeWhile #-}-takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()-takeWhile value = IP.parseD (drainWhile (<= value))--{-# INLINE takeP #-}-takeP :: MonadThrow m => Int -> SerialT m a -> m ()-takeP value = IP.parseD (PR.takeP value (PR.fromFold FL.drain))--{-# INLINE takeBetween #-}-takeBetween :: MonadCatch m => Int -> SerialT m a -> m ()-takeBetween value =  IP.parseD (PR.takeBetween 0 value FL.drain)--{-# INLINE groupBy #-}-groupBy :: MonadThrow m => SerialT m Int -> m ()-groupBy = IP.parseD (PR.groupBy (<=) FL.drain)--{-# INLINE groupByRolling #-}-groupByRolling :: MonadThrow m => SerialT m Int -> m ()-groupByRolling = IP.parseD (PR.groupByRolling (<=) FL.drain)--{-# INLINE wordBy #-}-wordBy :: MonadThrow m => Int -> SerialT m Int -> m ()-wordBy value = IP.parseD (PR.wordBy (>= value) FL.drain)--{-# INLINE manyWordByEven #-}-manyWordByEven :: MonadCatch m => SerialT m Int -> m ()-manyWordByEven =-    IP.parseD (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)--{-# INLINE many #-}-many :: MonadCatch m => SerialT m Int -> m Int-many = IP.parseD (PR.many (PR.satisfy (> 0)) FL.length)--{-# INLINE manyAlt #-}-manyAlt :: MonadCatch m => SerialT m Int -> m Int-manyAlt xs = do-    x <- IP.parseD (AP.many (PR.satisfy (> 0))) xs-    return $ Prelude.length x--{-# INLINE some #-}-some :: MonadCatch m => SerialT m Int -> m Int-some = IP.parseD (PR.some (PR.satisfy (> 0)) FL.length)--{-# INLINE someAlt #-}-someAlt :: MonadCatch m => SerialT m Int -> m Int-someAlt xs = do-    x <- IP.parseD (AP.some (PR.satisfy (> 0))) xs-    return $ Prelude.length x--{-#INLINE sliceSepByP #-}-sliceSepByP :: MonadCatch m => Int -> SerialT m Int -> m ()-sliceSepByP value = IP.parseD (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))--{-# INLINE manyTill #-}-manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int-manyTill value =-    let p = PR.satisfy (> 0)-        pcond = PR.satisfy (== value)-    in IP.parseD (PR.manyTill FL.length p pcond)--{-# INLINE serialWith #-}-serialWith :: MonadThrow m-    => Int -> SerialT m Int -> m ((), ())-serialWith value =-    IP.parseD-        ((,)-            <$> drainWhile (<= (value `div` 2))-            <*> drainWhile (<= value)-        )--{-# INLINE teeAllAny #-}-teeAllAny :: MonadThrow m-    => Int -> SerialT m Int -> m ((), ())-teeAllAny value =-    IP.parseD-        (PR.teeWith (,)-            (drainWhile (<= value))-            (drainWhile (<= value))-        )--{-# INLINE teeFstAllAny #-}-teeFstAllAny :: MonadThrow m-    => Int -> SerialT m Int -> m ((), ())-teeFstAllAny value =-    IP.parseD-        (PR.teeWithFst (,)-            (drainWhile (<= value))-            (drainWhile (<= value))-        )--{-# INLINE shortestAllAny #-}-shortestAllAny :: MonadThrow m-    => Int -> SerialT m Int -> m ()-shortestAllAny value =-    IP.parseD-        (PR.shortest-            (drainWhile (<= value))-            (drainWhile (<= value))-        )--{-# INLINE longestAllAny #-}-longestAllAny :: MonadCatch m-    => Int -> SerialT m Int -> m ()-longestAllAny value =-    IP.parseD-        (PR.longest-            (drainWhile (<= value))-            (drainWhile (<= value))-        )------------------------------------------------------------------------------------ Spanning----------------------------------------------------------------------------------{-# INLINE span #-}-span :: MonadThrow m => Int -> SerialT m Int -> m ((), ())-span value = IP.parseD (PR.span (<= (value `div` 2)) FL.drain FL.drain)--{-# INLINE spanBy #-}-spanBy :: MonadThrow m => Int -> SerialT m Int -> m ((), ())-spanBy value =-    IP.parseD (PR.spanBy (\_ i -> i <= (value `div` 2)) FL.drain FL.drain)--{-# INLINE spanByRolling #-}-spanByRolling :: MonadThrow m => Int -> SerialT m Int -> m ((), ())-spanByRolling value =-    IP.parseD (PR.spanByRolling (\_ i -> i <= value `div` 2) FL.drain FL.drain)------------------------------------------------------------------------------------ Nested----------------------------------------------------------------------------------{-# INLINE parseMany #-}-parseMany :: MonadThrow m => Int -> SerialT m Int -> m ()-parseMany value = IP.drain . IP.parseManyD (drainWhile (<= value + 1))--{-# INLINE parseManyGroups #-}-parseManyGroups :: MonadThrow m => Bool -> SerialT m Int -> m ()-parseManyGroups b = IP.drain . IP.parseManyD (PR.groupBy (\_ _ -> b) FL.drain)--{-# INLINE parseManyGroupsRolling #-}-parseManyGroupsRolling :: MonadThrow m => Bool -> SerialT m Int -> m ()-parseManyGroupsRolling b =-    IP.drain . IP.parseManyD (PR.groupByRolling (\_ _ -> b) FL.drain)--{-# INLINE parseManyGroupsRollingEither #-}-parseManyGroupsRollingEither :: (MonadThrow m, MonadCatch m) =>-    (Int -> Int -> Bool) -> SerialT m Int -> m ()-parseManyGroupsRollingEither cmp =-       IP.drain-    .  IP.parseManyD (PR.groupByRollingEither cmp FL.drain FL.drain)------------------------------------------------------------------------------------ Parsing with unfolds----------------------------------------------------------------------------------{-# INLINE parseManyUnfoldArrays #-}-parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()-parseManyUnfoldArrays count arrays = do-    let src = Source.source (Just (Producer.OuterLoop arrays))-    let parser = PR.fromFold (FL.take count FL.drain)-    let readSrc =-            Source.producer-                $ Producer.concat Producer.fromList Array.producer-    let streamParser =-            Producer.simplify (Source.parseManyD parser readSrc)-    S.drain $ S.unfold streamParser src------------------------------------------------------------------------------------ Parsers in which -fspec-constr-recursive=16 is problematic------------------------------------------------------------------------------------ XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.--- We need to fix GHC so that we can have better control over that option or do--- not have to rely on it.----{-# INLINE lookAhead #-}-lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()-lookAhead value =-    IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())--{-# INLINE sequenceA_ #-}-sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()-sequenceA_ value =-    IP.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))---- quadratic complexity-{-# INLINE sequenceA #-}-sequenceA :: MonadThrow m => Int -> SerialT m Int -> m Int-sequenceA value xs = do-    x <- IP.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs-    return $ length x---- quadratic complexity-{-# INLINE sequence #-}-sequence :: MonadThrow m => Int -> SerialT m Int -> m Int-sequence value xs = do-    x <- IP.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs-    return $ length x--{-# INLINE sequence_ #-}-sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()-sequence_ value xs =-    IP.parseD (foldr f (return ()) (replicate value (PR.takeBetween 0 1 FL.drain))) xs--    where--    {-# INLINE f #-}-    f m k = m >>= (\_ -> k)---- choice using the "Alternative" instance with direct style parser type has--- quadratic performance complexity.----{-# INLINE choiceAsum #-}-choiceAsum :: MonadCatch m => Int -> SerialT m Int -> m Int-choiceAsum value =-    IP.parseD (asum (replicate value (PR.satisfy (< 0)))-        AP.<|> PR.satisfy (> 0))--{-# INLINE choice #-}-choice :: MonadCatch m => Int -> SerialT m Int -> m Int-choice value =-    IP.parseD-        (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Parser.ParserD"--o_1_space_serial :: Int -> [Benchmark]-o_1_space_serial value =-    [ benchIOSink value "takeWhile" $ takeWhile value-    , benchIOSink value "takeP" $ takeP value-    , benchIOSink value "takeBetween" $ takeBetween value-    , benchIOSink value "sliceBeginWith" $ sliceBeginWith value-    , benchIOSink value "groupBy" $ groupBy-    , benchIOSink value "groupByRolling" $ groupByRolling-    , benchIOSink value "wordBy" $ wordBy value-    , benchIOSink value "serialWith" $ serialWith value-    , benchIOSink value "many" many-    , benchIOSink value "many (wordBy even)" $ manyWordByEven-    , benchIOSink value "some" some-    , benchIOSink value "sliceSepByP" $ sliceSepByP value-    , benchIOSink value "manyTill" $ manyTill value-    , benchIOSink value "tee (all,any)" $ teeAllAny value-    , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value-    , benchIOSink value "shortest (all,any)" $ shortestAllAny value-    , benchIOSink value "longest (all,any)" $ longestAllAny value-    ]--o_1_space_serial_spanning :: Int -> [Benchmark]-o_1_space_serial_spanning value =-    [ benchIOSink value "span" $ span value-    , benchIOSink value "spanBy" $ spanBy value-    , benchIOSink value "spanByRolling" $ spanByRolling value-    ]--o_1_space_serial_nested :: Int -> [Benchmark]-o_1_space_serial_nested value =-    [ benchIOSink value "parseMany" $ parseMany value-    , benchIOSink value "parseMany groupBy (bound groups)"-          $ parseManyGroups False-    , benchIOSink value "parseMany groupRollingBy (bound groups)"-          $ parseManyGroupsRolling False-    , benchIOSink value "parseMany groupBy (1 group)" $ parseManyGroups True-    , benchIOSink value "parseMany groupRollingBy (1 group)"-          $ parseManyGroupsRolling True-    , benchIOSink value "parseMany groupRollingByEither (Left)"-          $ parseManyGroupsRollingEither (<)-    , benchIOSink value "parseMany groupRollingByEither (Right)"-          $ parseManyGroupsRollingEither (>)-    , benchIOSinkRandom value "parseMany groupRollingByEither (Alternating)"-          $ parseManyGroupsRollingEither (>)-    ]--o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]-o_1_space_serial_unfold bound arrays =-    [ bench "parseMany/Unfold/1000 arrays/1 parse"-        $ nfIO $ parseManyUnfoldArrays bound arrays-    , bench "parseMany/Unfold/1000 arrays/100000 parses"-        $ nfIO $ parseManyUnfoldArrays 1 arrays-    ]--o_n_heap_serial :: Int -> [Benchmark]-o_n_heap_serial value =-    [-    -- lookahead benchmark holds the entire input till end-      benchIOSink value "lookAhead" $ lookAhead value--    -- These show non-linear time complexity-    -- They accumulate the results in a list.-    , benchIOSink value "manyAlt" manyAlt-    , benchIOSink value "someAlt" someAlt-    ]---- accumulate results in a list in IO-o_n_space_serial :: Int -> [Benchmark]-o_n_space_serial value =-    [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)-    , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)-    , benchIOSink value "sequence/100" $ sequence (value `div` 100)-    , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)-    , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)-    , benchIOSink value "choice/100" $ choice (value `div` 100)-    ]------------------------------------------------------------------------------------ Driver----------------------------------------------------------------------------------main :: IO ()-main = runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks--    where--    alloc value = IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0--    allBenchmarks arraysSmall value =-        [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)-        , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_spanning value)-        , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_nested value)-        , bgroup (o_1_space_prefix moduleName)-            (o_1_space_serial_unfold value arraysSmall)-        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)-        , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)-        ]
− benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs 
@@ -1,163 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.ParserK--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}--module Main-  (-    main-  ) where--import Control.DeepSeq (NFData(..))-import Control.Monad.Catch (MonadCatch)-import Data.Foldable (asum)-import System.Random (randomRIO)-import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)--import qualified Control.Applicative as AP-import qualified Data.Foldable as F-import qualified Data.Traversable as TR-import qualified Streamly.Prelude  as S-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser.ParserK.Type as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Stream.IsStream as IP--import Gauge-import Streamly.Prelude (SerialT, MonadAsync, IsStream)-import Streamly.Benchmark.Common------------------------------------------------------------------------------------ Utilities------------------------------------------------------------------------------------ XXX these can be moved to the common module--{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int-sourceUnfoldrM value n = S.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else return (Just (cnt, cnt + 1))---- | Takes a fold method, and uses it with a default source.-{-# INLINE benchIOSink #-}-benchIOSink-    :: (IsStream t, NFData b)-    => Int -> String -> (t IO Int -> IO b) -> Benchmark-benchIOSink value name f =-    bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value------------------------------------------------------------------------------------ Parsers----------------------------------------------------------------------------------#ifdef FROM_PARSERK-#define PARSE_OP (IP.parseD . PR.fromParserK)-#else-#define PARSE_OP IP.parseK-#endif--{-# INLINE satisfy #-}-satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a-satisfy = PR.toParserK . PRD.satisfy--{-# INLINE takeWhile #-}-takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()-takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain--{-# INLINE takeWhileK #-}-takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()-takeWhileK value = PARSE_OP (takeWhile (<= value))--{-# INLINE splitApp #-}-splitApp :: MonadCatch m-    => Int -> SerialT m Int -> m ((), ())-splitApp value =-    PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))--{-# INLINE sequenceA #-}-sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int-sequenceA value xs = do-    let parser = satisfy (> 0)-        list = Prelude.replicate value parser-    x <- PARSE_OP (TR.sequenceA list) xs-    return $ Prelude.length x--{-# INLINE sequenceA_ #-}-sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()-sequenceA_ value xs = do-    let parser = satisfy (> 0)-        list = Prelude.replicate value parser-    PARSE_OP (F.sequenceA_ list) xs--{-# INLINE sequence #-}-sequence :: MonadCatch m => Int -> SerialT m Int -> m Int-sequence value xs = do-    let parser = satisfy (> 0)-        list = Prelude.replicate value parser-    x <- PARSE_OP (TR.sequence list) xs-    return $ Prelude.length x--{-# INLINE manyAlt #-}-manyAlt :: MonadCatch m => SerialT m Int -> m Int-manyAlt xs = do-    x <- PARSE_OP (AP.many (satisfy (> 0))) xs-    return $ Prelude.length x--{-# INLINE someAlt #-}-someAlt :: MonadCatch m => SerialT m Int -> m Int-someAlt xs = do-    x <- PARSE_OP (AP.some (satisfy (> 0))) xs-    return $ Prelude.length x--{-# INLINE choice #-}-choice :: MonadCatch m => Int -> SerialT m Int -> m Int-choice value =-    PARSE_OP (asum (replicate value (satisfy (< 0)))-        AP.<|> satisfy (> 0))------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Parser.ParserK"--o_1_space_serial :: Int -> [Benchmark]-o_1_space_serial value =-    [ benchIOSink value "takeWhile" $ takeWhileK value-    , benchIOSink value "splitApp" $ splitApp value-    ]---- O(n) heap beacuse of accumulation of the list in strict IO monad?-o_n_heap_serial :: Int -> [Benchmark]-o_n_heap_serial value =-    [ benchIOSink value "sequenceA" $ sequenceA value-    , benchIOSink value "sequenceA_" $ sequenceA_ value-    , benchIOSink value "sequence" $ sequence value-    , benchIOSink value "manyAlt" manyAlt-    , benchIOSink value "someAlt" someAlt-    , benchIOSink value "choice" $ choice value-    ]------------------------------------------------------------------------------------ Driver----------------------------------------------------------------------------------main :: IO ()-main = runWithCLIOpts defaultStreamSize allBenchmarks--    where--    allBenchmarks value =-        [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)-        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)-        ]
+ benchmark/Streamly/Benchmark/Data/ParserK.hs view
@@ -0,0 +1,443 @@+-- |+-- Module      : Streamly.Benchmark.Data.ParserK+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++-- BENCH_CHUNKED             -> parse from Array stream+-- BENCH_CHUNKED_GENERIC     -> parse from Generic Array stream+-- BENCH_SINGULAR            -> parse from single element stream++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Main+  (+    main+  ) where++import Control.Applicative ((<|>))+import Control.DeepSeq (NFData(..))+import Control.Monad.IO.Class (MonadIO)+import Data.Foldable (asum)+#ifdef BENCH_CHUNKED+import Streamly.Data.Array (Array, Unbox)+#endif+#ifdef BENCH_CHUNKED_GENERIC+import Streamly.Data.Array.Generic (Array)+#endif+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Data.StreamK (StreamK)+import Streamly.Internal.Data.Parser+    (ParseError(..), Parser(..), Initial(..), Step(..), Final(..))+import Streamly.Internal.Data.Stream (Stream)+import System.Random (randomRIO)+import Prelude hiding+    (any, all, take, sequence, sequence_, sequenceA, takeWhile)++import qualified Control.Applicative as AP+import qualified Data.Foldable as F+import qualified Data.Traversable as TR+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as FL+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Data.Parser as PRD+import qualified Streamly.Internal.Data.ParserK as PR+import qualified Streamly.Internal.Data.StreamK as StreamK+#ifdef BENCH_CHUNKED+import qualified Streamly.Internal.Data.Array as Array+#elif defined(BENCH_CHUNKED_GENERIC)+import qualified Streamly.Internal.Data.Array.Generic as GenArr+#endif++import Test.Tasty.Bench+import Streamly.Benchmark.Common++-------------------------------------------------------------------------------+-- CPP Helpers+-------------------------------------------------------------------------------++#ifdef BENCH_CHUNKED++#define PARSE_OP Array.parse+#define FROM_PARSER Array.toParserK+#define INPUT (Array a)+#define PARSE_ELEM (Array Int)+#define CONSTRAINT_IO (MonadIO m, Unbox a)+#define CONSTRAINT (Monad m, Unbox a)+#define MODULE_NAME "Data.ParserK.Chunked"++#endif++#ifdef BENCH_CHUNKED_GENERIC++#define PARSE_OP GenArr.parse+#define FROM_PARSER GenArr.toParserK+#define INPUT (Array a)+#define PARSE_ELEM (Array Int)+#define CONSTRAINT_IO (MonadIO m)+#define CONSTRAINT (Monad m)+#define MODULE_NAME "Data.ParserK.Chunked.Generic"++#endif++#ifdef BENCH_SINGULAR++#define PARSE_OP StreamK.parse+#define FROM_PARSER PR.toParserK+#define INPUT a+#define PARSE_ELEM Int+#define CONSTRAINT_IO (MonadIO m)+#define CONSTRAINT (Monad m)+#define MODULE_NAME "Data.ParserK"++#endif++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++-- XXX these can be moved to the common module++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrM value n = Stream.unfoldrM step n+    where+    step cnt =+        if cnt > n + value+        then return Nothing+        else return (Just (cnt, cnt + 1))++-- | Takes a fold method, and uses it with a default source.+{-# INLINE benchIOSink #-}+benchIOSink+    :: NFData b+    => Int -> String -> (StreamK IO PARSE_ELEM -> IO b) -> Benchmark+benchIOSink value name f =+    bench name $ nfIO $ randomRIO (1,1)+        >>= f+            . StreamK.fromStream+#ifdef BENCH_CHUNKED+            . Array.chunksOf 4000+#endif+#ifdef BENCH_CHUNKED_GENERIC+            . GenArr.chunksOf 4000+#endif+            . sourceUnfoldrM value++-------------------------------------------------------------------------------+-- Parsers+-------------------------------------------------------------------------------++{-# INLINE one #-}+one :: MonadIO m =>+    Int -> StreamK m PARSE_ELEM -> m (Either ParseError (Maybe Int))+one value = PARSE_OP p++    where++    p = do+        m <- FROM_PARSER (PRD.fromFold FL.one)+        case m of+          Just i -> if i >= value then pure m else p+          Nothing -> pure Nothing++{-# INLINE satisfy #-}+satisfy :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m a+satisfy = FROM_PARSER . PRD.satisfy++{-# INLINE takeWhile #-}+takeWhile :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m ()+takeWhile p = FROM_PARSER $ PRD.takeWhile p FL.drain++{-# INLINE takeWhileK #-}+takeWhileK :: MonadIO m =>+    Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+takeWhileK value = PARSE_OP (takeWhile (<= value))++{-# INLINE splitAp2 #-}+splitAp2 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ((), ()))+splitAp2 value =+    PARSE_OP+        ((,)+            <$> takeWhile (<= (value `div` 2))+            <*> takeWhile (<= value)+        )++{-# INLINE splitAp8 #-}+splitAp8 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+splitAp8 value =+    PARSE_OP+        (      (\() () () () () () () () -> ())+            <$> takeWhile (<= ( value      `div` 8))+            <*> takeWhile (<= ((value * 2) `div` 8))+            <*> takeWhile (<= ((value * 3) `div` 8))+            <*> takeWhile (<= ((value * 4) `div` 8))+            <*> takeWhile (<= ((value * 5) `div` 8))+            <*> takeWhile (<= ((value * 6) `div` 8))+            <*> takeWhile (<= ((value * 7) `div` 8))+            <*> takeWhile (<= value)+        )++{-# INLINE sequenceA #-}+sequenceA :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int+sequenceA value xs = do+    let parser = satisfy (> 0)+        list = Prelude.replicate value parser+    x <- PARSE_OP (TR.sequenceA list) xs+    return $ Prelude.length x++{-# INLINE sequenceA_ #-}+sequenceA_ :: MonadIO m =>+    Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+sequenceA_ value xs = do+    let parser = satisfy (> 0)+        list = Prelude.replicate value parser+    PARSE_OP (F.sequenceA_ list) xs++{-# INLINE sequence #-}+sequence :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int+sequence value xs = do+    let parser = satisfy (> 0)+        list = Prelude.replicate value parser+    x <- PARSE_OP (TR.sequence list) xs+    return $ Prelude.length x++{-# INLINE sequence_ #-}+sequence_ :: MonadIO m =>+    Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+sequence_ value =+    let parser = satisfy (> 0)+        list = Prelude.replicate value parser+     in PARSE_OP (F.sequence_ list)++{-# INLINE takeWhileFailD #-}+takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+takeWhileFailD predicate (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        res <- finitial+        return $ case res of+            Fold.Partial s -> IPartial s+            Fold.Done b -> IDone b++    step s a =+        if predicate a+        then do+            fres <- fstep s a+            return+                $ case fres of+                      Fold.Partial s1 -> SContinue 1 s1+                      Fold.Done b -> SDone 1 b+        else return $ SError "fail"++    extract s = fmap (FDone 0) (ffinal s)++{-# INLINE takeWhileFail #-}+takeWhileFail :: CONSTRAINT =>+    (a -> Bool) -> Fold m a b -> PR.ParserK INPUT m b+takeWhileFail p f = FROM_PARSER (takeWhileFailD p f)++{-# INLINE alt2 #-}+alt2 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+alt2 value =+    PARSE_OP+        (   takeWhileFail (<= (value `div` 2)) Fold.drain+        <|> takeWhile (<= value)+        )++{-# INLINE alt8 #-}+alt8 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+alt8 value =+    PARSE_OP+        (   takeWhileFail (<= ( value      `div` 8)) Fold.drain+        <|> takeWhileFail (<= ((value * 2) `div` 8)) Fold.drain+        <|> takeWhileFail (<= ((value * 3) `div` 8)) Fold.drain+        <|> takeWhileFail (<= ((value * 4) `div` 8)) Fold.drain+        <|> takeWhileFail (<= ((value * 5) `div` 8)) Fold.drain+        <|> takeWhileFail (<= ((value * 6) `div` 8)) Fold.drain+        <|> takeWhileFail (<= ((value * 7) `div` 8)) Fold.drain+        <|> takeWhile (<= value)+        )++{-# INLINE alt16 #-}+alt16 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+alt16 value =+    PARSE_OP+        (   takeWhileFail (<= ( value      `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 2) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 3) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 4) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 5) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 6) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 7) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 8) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 9) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 10) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 11) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 12) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 13) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 14) `div` 16)) Fold.drain+        <|> takeWhileFail (<= ((value * 15) `div` 16)) Fold.drain+        <|> takeWhile (<= value)+        )++{-# INLINE manyAlt #-}+manyAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int+manyAlt xs = do+    x <- PARSE_OP (AP.many (satisfy (> 0))) xs+    return $ Prelude.length x++{-# INLINE someAlt #-}+someAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int+someAlt xs = do+    x <- PARSE_OP (AP.some (satisfy (> 0))) xs+    return $ Prelude.length x++{-# INLINE choice #-}+choice :: MonadIO m =>+    Int -> StreamK m PARSE_ELEM -> m (Either ParseError Int)+choice value =+    PARSE_OP (asum (replicate value (satisfy (< 0)))+        AP.<|> satisfy (> 0))++{-# INLINE monad2 #-}+monad2 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+monad2 value =+    PARSE_OP $ do+        takeWhile (<= (value `div` 2))+        takeWhile (<= value)++{-# INLINE monad4 #-}+monad4 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+monad4 value =+    PARSE_OP $ do+        takeWhile (<= ( value      `div` 4))+        takeWhile (<= ((value * 2) `div` 4))+        takeWhile (<= ((value * 3) `div` 4))+        takeWhile (<= value)++{-# INLINE monad8 #-}+monad8 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+monad8 value =+    PARSE_OP $ do+        takeWhile (<= ( value      `div` 8))+        takeWhile (<= ((value * 2) `div` 8))+        takeWhile (<= ((value * 3) `div` 8))+        takeWhile (<= ((value * 4) `div` 8))+        takeWhile (<= ((value * 5) `div` 8))+        takeWhile (<= ((value * 6) `div` 8))+        takeWhile (<= ((value * 7) `div` 8))+        takeWhile (<= value)++{-# INLINE monad16 #-}+monad16 :: MonadIO m+    => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())+monad16 value =+    PARSE_OP $ do+        takeWhile (<= ( value      `div` 16))+        takeWhile (<= ((value * 2) `div` 16))+        takeWhile (<= ((value * 3) `div` 16))+        takeWhile (<= ((value * 4) `div` 16))+        takeWhile (<= ((value * 5) `div` 16))+        takeWhile (<= ((value * 6) `div` 16))+        takeWhile (<= ((value * 7) `div` 16))+        takeWhile (<= ((value * 8) `div` 16))+        takeWhile (<= ((value * 9) `div` 16))+        takeWhile (<= ((value * 10) `div` 16))+        takeWhile (<= ((value * 11) `div` 16))+        takeWhile (<= ((value * 12) `div` 16))+        takeWhile (<= ((value * 13) `div` 16))+        takeWhile (<= ((value * 14) `div` 16))+        takeWhile (<= ((value * 15) `div` 16))+        takeWhile (<= value)++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = MODULE_NAME++instance NFData ParseError where+    {-# INLINE rnf #-}+    rnf (ParseError x) = rnf x++o_1_space_serial :: Int -> [Benchmark]+o_1_space_serial value =+    [ benchIOSink value "drain" (Stream.fold Fold.drain . StreamK.toStream)+    , benchIOSink value "takeWhile" $ takeWhileK value+    , benchIOSink value "splitAp2" $ splitAp2 value+    , benchIOSink value "splitAp8" $ splitAp8 value+    , benchIOSink value "alt2" $ alt2 value+    , benchIOSink value "monad2" $ monad2 value+    , benchIOSink value "monad4" $ monad4 value+    ]++{-# INLINE sepBy1 #-}+sepBy1 :: MonadIO m => StreamK m PARSE_ELEM -> m Int+sepBy1 xs = do+    x <- PARSE_OP (parser (satisfy odd) (satisfy even)) xs+    return $ Prelude.length x++    where++    parser p sep = do+        x <- p+        fmap (x :) $ AP.many (sep >> p)++-- O(n) heap beacuse of accumulation of the list in strict IO monad?+o_n_heap_serial :: Int -> [Benchmark]+o_n_heap_serial value =+    [+    -- accumulates the results in a list+    -- XXX why should this take O(n) heap, it discards the results?+      benchIOSink value "sequence_" $ sequence_ value+    , benchIOSink value "sequenceA_" $ sequenceA_ value+    , benchIOSink value "sequence" $ sequence value+    , benchIOSink value "sequenceA" $ sequenceA value+    , benchIOSink value "manyAlt" manyAlt+    , benchIOSink value "sepBy1" sepBy1+    , benchIOSink value "someAlt" someAlt+    , benchIOSink value "choice" $ choice value++    -- XXX these take too much memory with --long, need to investigate+    , benchIOSink value "alt8" $ alt8 value+    , benchIOSink value "alt16" $ alt16 value+    , benchIOSink value "monad8" $ monad8 value+    , benchIOSink value "monad16" $ monad16 value+    ]++-- O(n) heap beacuse of accumulation of the list in strict IO monad?+o_1_space_recursive :: Int -> [Benchmark]+o_1_space_recursive value =+    [ benchIOSink value "one (recursive)" $ one value+    ]++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)+        , bgroup (o_1_space_prefix moduleName) (o_1_space_recursive value)+        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)+        ]
+ benchmark/Streamly/Benchmark/Data/RingArray.hs view
@@ -0,0 +1,67 @@+-- |+-- Module      : Streamly.Benchmark.Data.RingArray+-- Copyright   : (c) 2022 Composewell+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.RingArray as RingArray++import Test.Tasty.Bench+import Streamly.Benchmark.Common++import Prelude as P++-------------------------------------------------------------------------------+-- Benchmark ops+-------------------------------------------------------------------------------++eqArrayN :: (Int, Array.Array Int, RingArray.RingArray Int) -> IO Bool+eqArrayN (value, arr, ring) = RingArray.eqArrayN ring arr value++eqArray :: (Array.Array Int, RingArray.RingArray Int) -> IO Bool+eqArray (arr, ring) = RingArray.eqArray ring arr++-------------------------------------------------------------------------------+-- Benchmark groups+-------------------------------------------------------------------------------++o_1_space_serial :: Int -> Array.Array Int -> RingArray.RingArray Int -> [Benchmark]+o_1_space_serial value arr ring =+    [ bench "eqArrayN" $ nfIO $ eqArrayN (value, arr, ring)+    , bench "eqArray" $ nfIO $ eqArray (arr, ring)+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.RingArray"++main :: IO ()+main = do+    runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks++    where++    alloc value = do+        let input = [1 .. value] :: [Int]+        let arr = Array.fromList input+        marr <- MutArray.fromList input+        let ring = maybe (error "cast failed") id (RingArray.castMutArray marr)++        return (arr, ring)++    allBenchmarks (arr, ring) value =+        [ bgroup+              (o_1_space_prefix moduleName)+              (o_1_space_serial value arr ring)+        ]
+ benchmark/Streamly/Benchmark/Data/Scanl.hs view
@@ -0,0 +1,127 @@+-- |+-- Module      : Streamly.Benchmark.Data.Scanl+-- Copyright   : (c) 2018 Composewell+--+-- License     : MIT+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Main (main) where++import Data.IORef (newIORef, readIORef, modifyIORef)+import Control.DeepSeq (NFData(..))+import Data.Functor.Identity (Identity(..))+import System.Random (randomRIO)++import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Scanl (Scanl(..))+import Streamly.Internal.Data.MutArray (MutArray)++import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Stream as Stream++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common+import Prelude hiding (last, length, all, any, take, unzip, sequence_, filter)++import qualified Data.Set as Set+import System.IO.Unsafe (unsafePerformIO)++-------------------------------------------------------------------------------+-- Helpers+-------------------------------------------------------------------------------++{-# INLINE source #-}+source :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+source len from =+    Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)++{-# INLINE benchScanWith #-}+benchScanWith :: Num a =>+    (Int -> a -> Stream IO a) -> Int -> String -> Scanl IO a b -> Benchmark+benchScanWith src len name f =+    bench name+        $ nfIO+        $ randomRIO (1, 1 :: Int)+            >>= Stream.fold FL.drain+                . Stream.postscanl f+                . src len+                . fromIntegral++{-# INLINE benchWithPostscan #-}+benchWithPostscan :: Int -> String -> Scanl IO Int a -> Benchmark+benchWithPostscan = benchScanWith source++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Scanl"++instance NFData (MutArray a) where+    {-# INLINE rnf #-}+    rnf _ = ()++instance NFData a => NFData (Stream Identity a) where+    {-# INLINE rnf #-}+    rnf xs = runIdentity $ Stream.fold (FL.foldl' (\_ x -> rnf x) ()) xs++o_1_space_serial :: Int -> [Benchmark]+o_1_space_serial value =+    [ bgroup "key-value"+            [+              benchWithPostscan value "demuxIO (1-shot) (64 buckets) [sum 100]"+                  $ Scanl.demuxIO (getKey 64) getScanl+            , benchWithPostscan value "demuxIO (64 buckets) [sum]"+                  $ Scanl.demuxIO (getKey 64) (const (pure (Just Scanl.sum)))+            , benchWithPostscan value "classifyIO (64 buckets) [sum 100]"+                  $ Scanl.classifyIO (getKey 64) (limitedSum 100)+            , benchWithPostscan value "classifyIO (64 buckets) [sum]"+                  $ Scanl.classifyIO (getKey 64) Scanl.sum+            ]+    ]++    where++    limitedSum n = Scanl.take n Scanl.sum++    getKey buckets = (`mod` buckets)++    afterDone action (Scanl.Scanl step i e f) = Scanl.Scanl step1 i e f+        where+        step1 x a = do+            res <- step x a+            case res of+                Scanl.Partial s1 -> pure $ Scanl.Partial s1+                Scanl.Done b -> action >> pure (Scanl.Done b)++    ref = unsafePerformIO $ newIORef Set.empty+    getScanl k = do+        set <- readIORef ref+        if Set.member k set+        then pure Nothing+        else pure+                 $ Just+                 $ afterDone (modifyIORef ref (Set.insert k)) (limitedSum 100)++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)+        ]
+ benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs view
@@ -0,0 +1,76 @@+module Main (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Function ((&))+-- import Streamly.Internal.Data.Scanl (Scanl)+import Streamly.Internal.Data.Stream (Stream)+import System.Random (randomRIO)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Scanl.Prelude as Scanl++import Data.IORef+import Streamly.Benchmark.Common+import Test.Tasty.Bench++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++type Seed = Int++{-# INLINE source #-}+source :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+source len from =+    Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)++{-# INLINE mkBench #-}+mkBench :: String -> (Seed -> IO ()) -> Benchmark+mkBench name f =+    bench name $ nfIO $ randomRIO (1, 1 :: Int) >>= f++--------------------------------------------------------------------------------+-- Benchmarks+--------------------------------------------------------------------------------++parDistributeScanM :: Int -> Seed -> IO ()+parDistributeScanM len seed = do+    ref <- newIORef [Scanl.latest]+    let gen = atomicModifyIORef ref (\xs -> ([], xs))+    Scanl.parDistributeScanM id gen (source len seed)+        & Stream.fold Fold.drain++--------------------------------------------------------------------------------+-- Groups+--------------------------------------------------------------------------------++o_1_space_scans :: Int -> [Benchmark]+o_1_space_scans numElements =+    [ bgroup "scan"+        [ mkBench "parDistributeScanM" (parDistributeScanM numElements)+        ]+    ]++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Scanl.Concurrent"++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName)+            ( o_1_space_scans value+            )+        ]
+ benchmark/Streamly/Benchmark/Data/Scanl/Window.hs view
@@ -0,0 +1,113 @@+module Main (main) where++import Streamly.Internal.Data.Scanl (Scanl)+import Streamly.Internal.Data.Stream (Stream)+import System.Random (randomRIO)++import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Stream as Stream++import Streamly.Benchmark.Common+import Test.Tasty.Bench++{-# INLINE source #-}+source :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+source len from =+    Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)++{-# INLINE sourceDescending #-}+sourceDescending :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+sourceDescending len from =+    Stream.enumerateFromThenTo+        (from + fromIntegral len)+        (from + fromIntegral (len - 1))+        from++{-# INLINE sourceDescendingInt #-}+sourceDescendingInt :: Monad m => Int -> Int -> Stream m Int+sourceDescendingInt = sourceDescending++{-# INLINE benchScanWith #-}+benchScanWith :: Num a =>+    (Int -> a -> Stream IO a) -> Int -> String -> Scanl IO a b -> Benchmark+benchScanWith src len name f =+    bench name+        $ nfIO+        $ randomRIO (1, 1 :: Int)+            >>= Stream.fold Fold.drain+                . Stream.postscanl f+                . src len+                . fromIntegral++{-# INLINE benchWithPostscan #-}+benchWithPostscan :: Int -> String -> Scanl IO Double a -> Benchmark+benchWithPostscan = benchScanWith source++o_1_space_scans :: Int -> [Benchmark]+o_1_space_scans numElements =+    [ bgroup "scan"+        [ benchWithPostscan numElements "minimum (window size 10)"+            (Scanl.windowMinimum 10)+        -- Below window size 30 the linear search based impl performs better+        -- than the dequeue based implementation.+        , benchWithPostscan numElements "minimum (window size 30)"+            (Scanl.windowMinimum 30)+        , benchWithPostscan numElements "minimum (window size 1000)"+            (Scanl.windowMinimum 1000)+        , benchScanWith sourceDescendingInt numElements+            "minimum descending (window size 1000)"+            (Scanl.windowMinimum 1000)++        , benchWithPostscan numElements "maximum (window size 10)"+            (Scanl.windowMaximum 10)+        , benchWithPostscan numElements "maximum (window size 30)"+            (Scanl.windowMaximum 30)+        , benchWithPostscan numElements "maximum (window size 1000)"+            (Scanl.windowMaximum 1000)+        , benchScanWith sourceDescendingInt numElements+            "maximum descending (window size 1000)"+            (Scanl.windowMaximum 1000)++        , benchWithPostscan numElements "range (window size 10)"+            (Scanl.windowRange 10)+        , benchWithPostscan numElements "range (window size 30)"+            (Scanl.windowRange 30)+        , benchWithPostscan numElements "range (window size 1000)"+            (Scanl.windowRange 1000)+        , benchScanWith sourceDescendingInt numElements+            "range descending (window size 1000)"+            (Scanl.windowRange 1000)++        , benchWithPostscan numElements "sum (window size 100)"+            (Scanl.incrScan 100 Scanl.incrSum)+        , benchWithPostscan numElements "sum (window size 1000)"+            (Scanl.incrScan 1000 Scanl.incrSum)++        , benchWithPostscan numElements "mean (window size 100)"+            (Scanl.incrScan 100 Scanl.incrMean)+        , benchWithPostscan numElements "mean (window size 1000)"+            (Scanl.incrScan 1000 Scanl.incrMean)++        , benchWithPostscan numElements "powerSum 2 (window size 100)"+            (Scanl.incrScan 100 (Scanl.incrPowerSum 2))+        , benchWithPostscan numElements "powerSum 2 (window size 1000)"+            (Scanl.incrScan 1000 (Scanl.incrPowerSum 2))+        ]+    ]++moduleName :: String+moduleName = "Data.Scanl.Window"++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName)+            ( o_1_space_scans value+            )+        ]
+ benchmark/Streamly/Benchmark/Data/Serialize.hs view
@@ -0,0 +1,596 @@+{-# LANGUAGE TemplateHaskell #-}+{- HLINT ignore -}++#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif++-- |+-- Module      : Streamly.Benchmark.Data.Serialize+-- Copyright   : (c) 2023 Composewell+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++module Main (main) where++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import Control.DeepSeq (NFData(..), deepseq)+import Control.Monad (when, void)+import GHC.Generics (Generic)+import System.Random (randomRIO)+#ifndef USE_UNBOX+import Test.QuickCheck (Arbitrary, arbitrary)+#endif++import Streamly.Internal.Data.MutByteArray+import qualified Streamly.Internal.Data.MutByteArray as MBA+#ifdef USE_UNBOX+import Data.Proxy (Proxy(..))+#else+import Control.DeepSeq (force)+import Test.QuickCheck (oneof, generate)+#endif++import Test.Tasty.Bench+import Streamly.Benchmark.Common++#ifndef USE_UNBOX+import Streamly.Benchmark.Data.Serialize.RecCompatible+import Streamly.Benchmark.Data.Serialize.RecNonCompatible+#endif++#ifdef USE_UNBOX+#define SERIALIZE_CLASS Unbox+#define DERIVE_CLASS(typ) $(deriveUnbox [d|instance Unbox typ|])+#define SERIALIZE_OP pokeAt+#define DESERIALIZE_OP peekAt+#else+#define SERIALIZE_CLASS Serialize+#define DERIVE_CLASS(typ) $(deriveSerialize [d|instance Serialize typ|])+#define SERIALIZE_OP serializeAt+#define DESERIALIZE_OP deserializeAt+#endif++import Prelude hiding (length)+#ifndef USE_UNBOX+import qualified Prelude as P+#endif++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------++data Unit = Unit+    deriving (Generic, Show, Eq)++#ifndef USE_TH+instance SERIALIZE_CLASS Unit+#else+DERIVE_CLASS(Unit)+#endif++instance NFData Unit where+    {-# INLINE rnf #-}+    rnf _ = ()++data Sum2+    = Sum21+    | Sum22+    deriving (Generic, Show, Eq)++#ifndef USE_TH+instance SERIALIZE_CLASS Sum2+#else+DERIVE_CLASS(Sum2)+#endif++instance NFData Sum2 where+    {-# INLINE rnf #-}+    rnf _ = ()++data Sum25+    = Sum251+    | Sum252+    | Sum253+    | Sum254+    | Sum255+    | Sum256+    | Sum257+    | Sum258+    | Sum259+    | Sum2510+    | Sum2511+    | Sum2512+    | Sum2513+    | Sum2514+    | Sum2515+    | Sum2516+    | Sum2517+    | Sum2518+    | Sum2519+    | Sum2520+    | Sum2521+    | Sum2522+    | Sum2523+    | Sum2524+    | Sum2525+    deriving (Generic, Show, Eq)++#ifndef USE_TH+instance SERIALIZE_CLASS Sum25+#else+DERIVE_CLASS(Sum25)+#endif++instance NFData Sum25 where+    {-# INLINE rnf #-}+    rnf _ = ()++data Product25+    = Product25+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+        Int+    deriving (Generic, Show)++#ifndef USE_TH+instance SERIALIZE_CLASS Product25+#else+DERIVE_CLASS(Product25)+#endif++instance NFData Product25 where+    {-# INLINE rnf #-}+    rnf+        (Product25 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25)+           =   a1+            `seq` a2+            `seq` a3+            `seq` a4+            `seq` a5+            `seq` a6+            `seq` a7+            `seq` a8+            `seq` a9+            `seq` a10+            `seq` a11+            `seq` a12+            `seq` a13+            `seq` a14+            `seq` a15+            `seq` a16+            `seq` a17+            `seq` a18+            `seq` a19+            `seq` a20+            `seq` a21+            `seq` a22+            `seq` a23+            `seq` a24+            `seq` a25+            `seq` ()++-- XXX derived Eq instance is not inlined+instance Eq Product25 where+    {-# INLINE (==) #-}+    (==)+        (Product25 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25)+        (Product25 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25)+           =   a1  == b1+            && a2  == b2+            && a3  == b3+            && a4  == b4+            && a5  == b5+            && a6  == b6+            && a7  == b7+            && a8  == b8+            && a9  == b9+            && a10 == b10+            && a11 == b11+            && a12 == b12+            && a13 == b13+            && a14 == b14+            && a15 == b15+            && a16 == b16+            && a17 == b17+            && a18 == b18+            && a19 == b19+            && a20 == b20+            && a21 == b21+            && a22 == b22+            && a23 == b23+            && a24 == b24+            && a25 == b25++-------------------------------------------------------------------------------+-- Simple non-recursive ADT+-------------------------------------------------------------------------------++{-+data CustomDT1+    = CDT1C1+    | CDT1C2 Int+    | CDT1C3 Int Int+    deriving (Generic, Show, Eq)++#ifndef USE_TH+instance SERIALIZE_CLASS CustomDT1+#else+DERIVE_CLASS(CustomDT1)+#endif++instance NFData CustomDT1 where+    {-# INLINE rnf #-}+    rnf CDT1C1 = ()+    rnf (CDT1C2 i) = i `seq` ()+    rnf (CDT1C3 i1 i2) = i1 `seq` i2 `seq` ()+-}++-------------------------------------------------------------------------------+-- Recursive ADT+-------------------------------------------------------------------------------++#ifndef USE_UNBOX+data BinTree a+  = Tree (BinTree a) (BinTree a)+  | Leaf a+  deriving (Show, Read, Eq, Generic)++#ifndef USE_TH+instance Serialize (BinTree a)+#else+$(deriveSerialize [d|instance Serialize a => Serialize (BinTree a)|])+#endif++instance NFData a => NFData (BinTree a) where+  {-# INLINE rnf #-}+  rnf (Leaf a) = rnf a `seq` ()+  rnf (Tree l r) = rnf l `seq` rnf r++-- XXX This may not terminate, or could become really large.+instance Arbitrary a => Arbitrary (BinTree a) where+  arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]++mkBinTree :: (Arbitrary a) => Int -> IO (BinTree a)+mkBinTree = go (generate arbitrary)++    where++    go r 0 = Leaf <$> r+    go r n = Tree <$> go r (n - 1) <*> go r (n - 1)++#endif++-------------------------------------------------------------------------------+-- Size helpers+-------------------------------------------------------------------------------++{-# INLINE getSize #-}+getSize :: forall a. SERIALIZE_CLASS a => a -> Int+#ifdef USE_UNBOX+getSize _ = sizeOf (Proxy :: Proxy a)+#else+getSize = addSizeTo 0+#endif++-------------------------------------------------------------------------------+-- Common helpers+-------------------------------------------------------------------------------++{- HLINT ignore "Eta reduce" -}+-- Parts of "f" that are dependent on val will not be optimized out.+{-# INLINE loop #-}+loop :: Int -> (a -> IO b) -> a -> IO ()+loop count f val = go count val+    where++    go n x = when (n > 0) $ f x >> go (n-1) x++-- The first arg of "f" is the environment which is not threaded around in the+-- loop.+{-# INLINE loopWith #-}+loopWith :: Int -> (e -> a -> IO b) -> e -> a -> IO ()+loopWith count f e val = go count val+    where++    go n x = when (n > 0) $ f e x >> go (n-1) x++benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark+benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))++-------------------------------------------------------------------------------+-- Serialization Helpers+-------------------------------------------------------------------------------++{-+{-# INLINE pokeWithSize #-}+pokeWithSize :: SERIALIZE_CLASS a => MutByteArray -> a -> IO ()+pokeWithSize arr val = do+    let n = getSize val+    n `seq` SERIALIZE_OP 0 arr val >> return ()++{-# INLINE pokeTimesWithSize #-}+pokeTimesWithSize :: SERIALIZE_CLASS a => a -> Int -> IO ()+pokeTimesWithSize val times = do+    let n = getSize val+    arr <- MBA.new n+    loopWith times pokeWithSize arr val+-}++{-# INLINE poke #-}+poke :: SERIALIZE_CLASS a => MutByteArray -> a -> IO ()+poke arr val = void (SERIALIZE_OP 0 arr val)++{-# INLINE pokeTimes #-}+pokeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()+pokeTimes val times = do+    let n = getSize val+    arr <- MBA.new n+    loopWith times poke arr val++{-# INLINE encode #-}+encode :: SERIALIZE_CLASS a => a -> IO ()+encode val = do+    let n = getSize val+    arr <- MBA.new n+    void (SERIALIZE_OP 0 arr val)++{-# INLINE encodeTimes #-}+encodeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()+encodeTimes val times = loop times encode val++{-# INLINE peek #-}+peek :: forall a. (NFData a, SERIALIZE_CLASS a) =>+    (a, Int) -> MutByteArray -> IO ()+#ifdef USE_UNBOX+peek (_val, _) arr = do+        (val1 :: a) <- DESERIALIZE_OP 0 arr+#else+peek (_val, n) arr = do+        (_, val1 :: a) <- DESERIALIZE_OP 0 arr n+#endif+        -- If the datatype is not deeply strict or deepseq is not used then use+        -- Equality.+        -- Ensure that we are actually constructing the type and using it. This+        -- is important, otherwise the structure is created and discarded, the+        -- cost of creation of the structure is not accounted. Otherwise we may+        -- just read the values and discard them. The comparison adds to the+        -- cost though. We could use deepseq but then we need to write+        -- instances of NFData and ensure that they are correct and perform+        -- well. Equality check also ensures correctness.+        {-+        if (val1 /= val)+        then error "peek: no match"+        else return ()+        -}+        val1 `deepseq` return ()++{-# INLINE peekTimes #-}+peekTimes :: (NFData a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ()+peekTimes n val times = do+    arr <- MBA.new n+    _ <- SERIALIZE_OP 0 arr val+    loopWith times peek (val, n) arr++{-# INLINE trip #-}+trip :: forall a. (NFData a, SERIALIZE_CLASS a) => a -> IO ()+trip val = do+    let n = getSize val+    arr <- MBA.new n+    _ <- SERIALIZE_OP 0 arr val+#ifdef USE_UNBOX+    (val1 :: a) <- DESERIALIZE_OP 0 arr+#else+    (_, val1 :: a) <- DESERIALIZE_OP 0 arr n+#endif+    -- Do not remove this or use deepseq, see the comments in peek.+    {-+    if (val1 /= val)+    then error "roundtrip: no match"+    else return ()+    -}+    -- Note: deepseq is not needed if the datatype is strict+    val1 `deepseq` return ()++{-# INLINE roundtrip #-}+roundtrip :: (NFData a, SERIALIZE_CLASS a) => a -> Int -> IO ()+roundtrip val times = loop times trip val++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++{-# INLINE benchConst #-}+benchConst ::+       String+    -> (forall a. (NFData a, SERIALIZE_CLASS a) =>+        Int -> a -> Int -> IO ())+    -> Int+    -> Benchmark+benchConst gname f times =+    bgroup gname+       [ let !n = getSize Unit+          in benchSink "Unit" times (f n Unit)+       {-+       , let !n = getSize CDT1C1+          in benchSink "C1" times (f n CDT1C1)+       , let val = CDT1C2 5+             !n = getSize val+          in benchSink "C2" (times `div` 2) (f n val)+       , let val = CDT1C3 5 2+             !n = getSize val+          in benchSink "C3" (times `div` 3) (f n val)+       -}+       , let !n = getSize Sum21+          in benchSink "Sum2" times (f n Sum21)+       , let !n = getSize Sum2525+          in benchSink "Sum25" times (f n Sum2525)+       , let val = Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25+             !n = getSize val+          in benchSink "Product25" (times `div` 26) (f n val)+        ]++#ifndef USE_UNBOX+{-# INLINE benchVar #-}+benchVar ::+       String+    -> (forall a. (NFData a, SERIALIZE_CLASS a) =>+        Int -> a -> Int -> IO ())+    -> BinTree Int+    -> [Int]+    -> Int+    -> Benchmark+benchVar gname f tInt lInt times =+    bgroup gname+       [ let !n = getSize tInt+           in benchSink "bintree-int" times (f n tInt)+        , let !n = getSize lInt+           in benchSink "list-int" times (f n lInt)+        ]++{-+{-# INLINE benchGeneric #-}+benchGeneric+    :: (NFData b, Serialize b)+    => String+    -> String+    -> (forall a. (NFData a, Serialize a) =>+        Int -> a -> Int -> IO ())+    -> b+    -> Int+    -> Benchmark+benchGeneric gname valId f val times =+    bgroup gname+       [ let !n = getSize val+          in benchSink valId times (f n val)+       ]+-}++{-# INLINE benchLargeRec #-}+benchLargeRec ::+        String+    -> (forall a. (NFData a, Serialize a) =>+        Int -> a -> Int -> IO ())+    -> RecNonCompatible+    -> RecCompatible+    -> Int+    -> Benchmark+benchLargeRec gname f recL recR times =+    bgroup gname+       [ let !n = getSize recL+           in benchSink "RecNonCompatible" times (f n recL)+       ,  let !n = getSize recR+           in benchSink "RecCompatible" times (f n recR)+       ]+#endif++-- Times is scaled by the number of constructors to normalize+#ifdef USE_UNBOX+allBenchmarks :: Int -> [Benchmark]+allBenchmarks times =+#else+allBenchmarks ::+       BinTree Int -> [Int] -> RecNonCompatible -> RecCompatible -> Int -> [Benchmark]+allBenchmarks tInt lInt recL recR times =+#endif+    [ bgroup "sizeOf"+        [+#ifndef USE_UNBOX+          bench "bintree-int" $ nf getSize tInt+        , bench "list-int" $ nf getSize lInt+#endif+        ]+    , benchConst "poke" (const pokeTimes) times+    -- , benchConst "pokeWithSize" (const pokeTimesWithSize) times+    , benchConst "encode" (const encodeTimes) times+    , benchConst "peek" peekTimes times+    , benchConst "roundtrip" (const roundtrip) times+#ifndef USE_UNBOX+    , benchVar "poke" (const pokeTimes) tInt lInt 1+    -- , benchVar "pokeWithSize" (const pokeTimesWithSize) tInt lInt 1+    , benchVar "encode" (const encodeTimes) tInt lInt 1+    , benchVar "peek" peekTimes tInt lInt 1+    , benchVar "roundtrip" (const roundtrip) tInt lInt 1+    , benchLargeRec "poke" (const pokeTimes) recL recR times+    , benchLargeRec "encode" (const encodeTimes) recL recR times+    , benchLargeRec "peek" peekTimes recL recR times+    , benchLargeRec "roundtrip" (const roundtrip) recL recR times+#endif+    ]++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++main :: IO ()+main = do+#ifndef USE_UNBOX+    -- Approximately 100000 constructors+    -- Assuming Leaf nodes constitute two constructors (Leaf, Int) and internal+    -- nodes 1 level = log_2 (100001/3) + 1 = 16+    !(tInt :: BinTree Int) <- force <$> mkBinTree 16++    let !recL = valRecNonCompatible+    let !recR = valRecCompatible++    -- Approximately 100000 constructors, assuming two constructors (Cons, Int)+    -- per element.+    let lInt = [1..50000 :: Int]+    let !len = P.length lInt -- evaluate the list+#endif+#ifndef FUSION_CHECK+#ifdef USE_UNBOX+    runWithCLIOpts defaultStreamSize allBenchmarks+#else+    len+        `seq` runWithCLIOpts+                  defaultStreamSize+                  (allBenchmarks tInt lInt recL recR)+#endif+#else+    -- Enable FUSION_CHECK macro at the beginning of the file+    -- Enable one benchmark below, and run the benchmark+    -- Check the .dump-simpl output+    let value = 100000+    -- print $ getSize (CDT1C3 4 2)+    -- print $ getSize tInt+    -- print $ getSize lInt++    -- pokeTimes tInt 1++    -- peekTimes ((CDT1C2 (5 :: Int)) :: CustomDT1) value+    -- peekTimes (Sum2525) value+    -- peekTimes (Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25) value+    -- peekTimes tInt 1+    let !n = getSize lInt+    peekTimes n lInt 1++    -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value+    return ()+#endif
+ benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE TemplateHaskell #-}++module Streamly.Benchmark.Data.Serialize.RecCompatible+    ( RecCompatible(..)+    , valRecCompatible+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Streamly.Internal.Data.MutByteArray (Serialize)+import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)++import qualified Streamly.Internal.Data.MutByteArray as Serialize++--------------------------------------------------------------------------------+-- Code+--------------------------------------------------------------------------------++$(genLargeRecord "RecCompatible" 50)+$(Serialize.deriveSerializeWith+      (Serialize.encodeRecordFields True)+      [d|instance Serialize RecCompatible|])
+ benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TemplateHaskell #-}++module Streamly.Benchmark.Data.Serialize.RecNonCompatible+    ( RecNonCompatible(..)+    , valRecNonCompatible+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)++import qualified Streamly.Internal.Data.MutByteArray as Serialize++--------------------------------------------------------------------------------+-- Code+--------------------------------------------------------------------------------++$(genLargeRecord "RecNonCompatible" 50)+$(Serialize.deriveSerialize [d|instance Serialize.Serialize RecNonCompatible|])
+ benchmark/Streamly/Benchmark/Data/Serialize/TH.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE TemplateHaskell #-}++module Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Language.Haskell.TH++import Streamly.Internal.Data.MutByteArray (makeI)+import Control.DeepSeq (NFData(..))++--------------------------------------------------------------------------------+-- Large Record+--------------------------------------------------------------------------------++genLargeRecord :: String -> Int -> Q [Dec]+genLargeRecord tyName numFields =+    sequence+        [ dataD+               (pure [])+               (mkName tyName)+               []+               Nothing+               [mkCon tyName]+               [derivClause Nothing [conT ''Eq, conT ''Show]]+         , mkValueSigDec+         , mkValueDec+         , nfDataInstance tyName+         ]++    where++    fieldTypeChoices = [conT ''()]+    chooseCycle i xs = xs !! (i `mod` length xs)+    nfDataInstance nm =+        instanceD+            (pure [])+            (appT (conT ''NFData) (conT (mkName nm)))+            [ funD+                  'rnf+                  [ clause+                        [ conP+                              (mkName nm)+                              (varP . makeI <$> [0 .. (numFields - 1)])+                        ]+                        (normalB+                             (foldl+                                  (\b a -> [|rnf $(b) `seq` rnf $(a)|])+                                  [|()|]+                                  (varE . makeI <$> [0 .. (numFields - 1)])))+                        []+                  ]+            ]+    valueName = mkName $ "val" ++ tyName+    mkValueSigDec = sigD valueName [t|$(conT (mkName tyName))|]+    mkValueDec =+        funD+            valueName+            [ clause+                  []+                  (normalB+                       (foldl+                            (\b a -> [|$(b) $(a)|])+                            (conE (mkName tyName))+                            (conE '() <$ [0 .. (numFields - 1)])))+                  []+            ]+    mkCon nm = recC (mkName nm) (mkField <$> [0 .. (numFields - 1)])+    mkField i =+        varBangType+            (mkName ("field" ++ show i))+            (bangType+                 (bang noSourceUnpackedness noSourceStrictness)+                 (chooseCycle i fieldTypeChoices))
+ benchmark/Streamly/Benchmark/Data/Stream.hs view
@@ -0,0 +1,110 @@+-- |+-- Module      : Data.Stream+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif++module Main (main) where++import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)++import qualified Stream.Eliminate as Elimination+#ifndef USE_STREAMLY_CORE+import qualified Stream.Exceptions as Exceptions+#endif+import qualified Stream.Expand as NestedStream+import qualified Stream.Generate as Generation+import qualified Stream.Lift as Lift+import qualified Stream.Reduce as NestedFold+#ifndef USE_PRELUDE+import qualified Stream.Split as Split+#endif+import qualified Stream.Transform as Transformation++import Streamly.Benchmark.Common++#ifdef FUSION_CHECK+import Data.Function ((&))+import Streamly.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Data.Foldable as Foldable+import Stream.Common+#endif++moduleName :: String+moduleName = "Data.Stream"++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+main :: IO ()+main = do+#ifndef FUSION_CHECK+    env <- mkHandleBenchEnv+    runWithCLIOpts defaultStreamSize (allBenchmarks env)++    where++    allBenchmarks env size = Prelude.concat+        [ Generation.benchmarks moduleName size+        , Elimination.benchmarks moduleName size+#ifndef USE_STREAMLY_CORE+        , Exceptions.benchmarks moduleName env size+#endif+#ifndef USE_PRELUDE+        , Split.benchmarks moduleName env+#endif+        , Transformation.benchmarks moduleName size+        , NestedFold.benchmarks moduleName size+        , Lift.benchmarks moduleName size+        , NestedStream.benchmarks moduleName size+        ]+#else+    -- Enable FUSION_CHECK macro at the beginning of the file+    -- Enable one benchmark below, and run the benchmark+    -- Check the .dump-simpl output+    let value = 100000+    let input = sourceUnfoldrM value 1++    -- Stream.foldr (:) [] input >>= print . Prelude.length+    -- Stream.fold (Fold.foldr' (:) []) input >>= print . Prelude.length++    -- Stream.toList input >>= print . Prelude.length+    -- Stream.fold Fold.toList input >>= print . Prelude.length++    -- We can automatically assert that these generate identical core++    -- Stream.drain input >>= print+    -- Stream.fold Fold.drain input >>= print++    -- Stream.last input >>= print+    -- Stream.fold Fold.latest input >>= print++    -- Stream.length input >>= print+    -- Stream.fold Fold.length input >>= print++    -- Stream.maximum input >>= print+    -- Stream.fold Fold.maximum input >>= print++    -- Stream.head input >>= print+    -- Stream.fold Fold.one input >>= print++    -- composeN 4 (Stream.scanl' (+) 0) input+    composeN 4 (Stream.scan (Fold.foldl' (+) 0)) input+    return ()+#endif
+ benchmark/Streamly/Benchmark/Data/Stream/Adaptive.hs view
@@ -0,0 +1,160 @@+-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Control.Concurrent (threadDelay)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Streamly.Data.Stream.Prelude (Stream, Config)+import System.Random (randomRIO)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream.Prelude as Stream++import Test.Tasty.Bench++-- Note that we should also compare the cpuTime especially when threaded+-- runtime is used with this benchmark because thread scheduling is not+-- predictable and can add non-deterministic delay to the total time measured.+--+-- Also, the worker dispatch depends on the worker dispatch latency which is+-- set to fixed 200 us. We need to keep that in mind when designing tests.++moduleName :: String+moduleName = "Data.Stream.Adaptive"++value :: Int+value = 1000++produce :: MonadIO m => (Int, Int) -> m Int+produce range = do+    r <- randomRIO range+    when (r /= 0) $ liftIO $ threadDelay r+    return r++consume :: MonadIO m => (Int, Int) -> Int -> m Int+consume crange x = liftIO $ do+    d <- randomRIO crange+    when (d /= 0) $ threadDelay d+    return x++{-# INLINE serialSrc #-}+serialSrc :: (Int, Int) -> Stream IO Int+serialSrc range = Stream.replicateM value $ produce range++{-# INLINE parSrc #-}+parSrc :: (Config -> Config) -> (Int, Int) -> Stream IO Int+parSrc cfg range = Stream.parReplicateM cfg value $ produce range++{-# INLINE serialRun #-}+serialRun :: (Int, Int) -> (Int, Int) -> IO ()+serialRun srange crange =+    Stream.fold Fold.drain+        $ Stream.mapM (consume crange) (serialSrc srange)++{-# INLINE parRun #-}+parRun :: (Config -> Config) -> (Int, Int) -> (Int, Int) -> IO ()+parRun cfg srange crange =+    Stream.fold Fold.drain+        $ Stream.parMapM cfg (consume crange) (parSrc cfg srange)++low, medium, high :: Int+low = 10+medium = 20+high = 30++{-# INLINE noDelaySerial #-}+noDelaySerial :: IO ()+noDelaySerial = serialRun (0,0) (0,0)++{-# INLINE noDelay #-}+noDelay :: (Config -> Config) -> IO ()+noDelay cfg = parRun cfg (0,0) (0,0)++{-# INLINE alwaysConstSlowSerial #-}+alwaysConstSlowSerial :: IO ()+alwaysConstSlowSerial = serialRun (0,0) (medium,medium)++{-# INLINE alwaysConstSlow #-}+alwaysConstSlow :: (Config -> Config) -> IO ()+alwaysConstSlow cfg = parRun cfg (low,low) (medium,medium)++{-# INLINE alwaysConstFast #-}+alwaysConstFast :: (Config -> Config) -> IO ()+alwaysConstFast cfg = parRun cfg (high,high) (medium,medium)++{-# INLINE alwaysVarSlow #-}+alwaysVarSlow :: (Config -> Config) -> IO ()+alwaysVarSlow cfg = parRun cfg (low,low) (low,high)++{-# INLINE alwaysVarFast #-}+alwaysVarFast :: (Config -> Config) -> IO ()+alwaysVarFast cfg = parRun cfg (high,high) (low,high)++-- XXX add variable producer tests as well++{-# INLINE runVarSometimesFast #-}+runVarSometimesFast :: (Config -> Config) -> IO ()+runVarSometimesFast cfg = parRun cfg (medium,medium) (low,high)++{-# INLINE randomVar #-}+randomVar :: (Config -> Config) -> IO ()+randomVar cfg = parRun cfg (low,high) (low,high)++main :: IO ()+main =+  defaultMain [bgroup moduleName allBenchmarks]++  where++  allBenchmarks =+    [+      bgroup "serialConstantSlowConsumer"+      [ bench "serial" $ nfIO alwaysConstSlowSerial+      ]+    , bgroup "default"+      [ bench "serial"      $ nfIO noDelaySerial+      , bench "async"       $ nfIO $ noDelay id+      , bench "ordered"     $ nfIO $ noDelay (Stream.ordered True)+      , bench "interleaved" $ nfIO $ noDelay (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ noDelay (Stream.eager True)+      ]+    , bgroup "constantSlowConsumer"+      [ bench "async"       $ nfIO $ alwaysConstSlow id+      , bench "ordered"     $ nfIO $ alwaysConstSlow (Stream.ordered True)+      , bench "interleaved" $ nfIO $ alwaysConstSlow (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ alwaysConstSlow (Stream.eager True)+      ]+   ,  bgroup "constantFastConsumer"+      [ bench "async"       $ nfIO $ alwaysConstFast id+      , bench "ordered"     $ nfIO $ alwaysConstFast (Stream.ordered True)+      , bench "interleaved" $ nfIO $ alwaysConstFast (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ alwaysConstFast (Stream.eager True)+      ]+   ,  bgroup "variableSlowConsumer"+      [ bench "async"       $ nfIO $ alwaysVarSlow id+      , bench "ordered"     $ nfIO $ alwaysVarSlow (Stream.ordered True)+      , bench "interleaved" $ nfIO $ alwaysVarSlow (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ alwaysVarSlow (Stream.eager True)+      ]+   ,  bgroup "variableFastConsumer"+      [ bench "async"       $ nfIO $ alwaysVarFast id+      , bench "ordered"     $ nfIO $ alwaysVarFast (Stream.ordered True)+      , bench "interleaved" $ nfIO $ alwaysVarFast (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ alwaysVarFast (Stream.eager True)+      ]+   ,  bgroup "variableSometimesFastConsumer"+      [ bench "async"       $ nfIO $ runVarSometimesFast id+      , bench "ordered"     $ nfIO $ runVarSometimesFast (Stream.ordered True)+      , bench "interleaved" $ nfIO $ runVarSometimesFast (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ runVarSometimesFast (Stream.eager True)+      ]+   ,  bgroup "variableFullOverlap"+      [ bench "async"       $ nfIO $ randomVar id+      , bench "ordered"     $ nfIO $ randomVar (Stream.ordered True)+      , bench "interleaved" $ nfIO $ randomVar (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ randomVar (Stream.eager True)+      ]+   ]
+ benchmark/Streamly/Benchmark/Data/Stream/Common.hs view
@@ -0,0 +1,576 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : Stream.Common+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++#ifdef USE_PRELUDE+#endif++module Stream.Common+    ( MonadAsync++    -- Generation+    , fromListM+    , fromFoldableM++    , append+    , append2++    -- Elimination+    , drain+    , foldl'+    , scanl'++    -- Benchmark stream generation+    , sourceUnfoldr+    , sourceUnfoldrM+    , sourceUnfoldrAction+    , sourceConcatMapId+    , sourceFromFoldable++    -- Benchmark stream elimination+    , benchIOSink+    , benchIOSinkPureSrc+    , benchIOSrc+    , benchIO++    , toNullApPure+    , toNullMPure+    , toNullM3Pure+    , filterAllOutMPure+    , filterAllInMPure++    -- Benchmarking functions+    , apDiscardFst+    , apDiscardSnd+    , apLiftA2+    , toNullAp+    , monadThen+    , toNullM+    , toNullM3+    , filterAllOutM+    , filterAllInM+    , filterSome+    , breakAfterSome+    , toListM+    , toListSome+    , composeN+    , mapN+    , mapM+    , transformMapM+    , transformComposeMapM+    , transformTeeMapM+    -- , transformZipMapM+#ifndef USE_PRELUDE+    , scanMapM+    , scanComposeMapM+    , scanTeeMapM+#endif+    )+where++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.DeepSeq (NFData)+import Control.Exception (try)+import GHC.Exception (ErrorCall)+import System.Random (randomRIO)++import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Pipe as Pipe+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Scanr as Scanr++#ifdef USE_PRELUDE+import Streamly.Prelude (foldl', scanl')+import qualified Streamly.Internal.Data.Stream.IsStream as Stream+import qualified Streamly.Prelude as Stream+import Streamly.Benchmark.Prelude+    ( composeN, sourceConcatMapId, benchIOSink+    )+#else+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.Stream as Stream+#endif++import Test.Tasty.Bench+import Prelude hiding (Foldable(..), mapM, replicate)++#ifdef USE_PRELUDE+type Stream = Stream.SerialT+type MonadAsync m = Stream.MonadAsync m+mkCross = id+unCross = id+#else+type MonadAsync = Monad++mkCross :: Stream m a -> Stream.Nested m a+mkCross = Stream.Nested++unCross :: Stream.Nested m a -> Stream m a+unCross = Stream.unNested+#endif++#ifdef USE_PRELUDE+{-# INLINE append #-}+append :: Monad m => Stream m a -> Stream m a -> Stream m a+append = Stream.serial+#else+append :: Monad m => Stream m a -> Stream m a -> Stream m a+append = Stream.append+#endif++{-# INLINE append2 #-}+append2 :: Monad m => Stream m a -> Stream m a -> Stream m a+#ifdef USE_PRELUDE+append2 = Stream.append+#else+append2 = D.append+#endif++{-# INLINE drain #-}+drain :: Monad m => Stream m a -> m ()+{-# INLINE toList #-}+toList :: Monad m => Stream m a -> m [a]+#ifdef USE_PRELUDE+drain = Stream.drain+toList = Stream.toList+#else+drain = Stream.fold Fold.drain+toList = Stream.fold Fold.toList+#endif++{-# INLINE fromListM #-}+fromListM :: MonadAsync m => [m a] -> Stream m a+#ifdef USE_PRELUDE+fromListM = Stream.fromListM+#else+fromListM = Stream.sequence . Stream.fromList+#endif++{-# INLINE fromFoldableM #-}+fromFoldableM :: MonadAsync m => [m a] -> Stream m a+#ifdef USE_PRELUDE+fromFoldableM = Stream.fromFoldableM+#else+fromFoldableM = Stream.sequence . Stream.fromFoldable+#endif++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: MonadAsync m => Int -> Int -> Stream m Int+sourceUnfoldrM count start = Stream.unfoldrM step start++    where++    step cnt =+        if cnt > start + count+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE sourceUnfoldr #-}+sourceUnfoldr :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldr count start = Stream.unfoldr step start++    where++    step cnt =+        if cnt > start + count+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE sourceUnfoldrAction #-}+sourceUnfoldrAction :: (Monad m1, Monad m) => Int -> Int -> Stream m (m1 Int)+sourceUnfoldrAction value n = Stream.unfoldr step n++    where++    step cnt =+        if cnt > n + value+        then Nothing+        else Just (return cnt, cnt + 1)++{-# INLINE sourceFromFoldable #-}+sourceFromFoldable :: Monad m => Int -> Int -> Stream m Int+sourceFromFoldable value n = Stream.fromFoldable [n..n+value]++#ifndef USE_PRELUDE+{-# INLINE benchIOSink #-}+benchIOSink+    :: (NFData b)+    => Int -> String -> (Stream IO Int -> IO b) -> Benchmark+benchIOSink value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value++{-# INLINE benchIOSinkPureSrc #-}+benchIOSinkPureSrc+    :: (NFData b)+    => Int -> String -> (Stream IO Int -> IO b) -> Benchmark+benchIOSinkPureSrc value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value+#endif++-- | Takes a source, and uses it with a default drain/fold method.+{-# INLINE benchIOSrc #-}+benchIOSrc+    :: String+    -> (Int -> Stream IO a)+    -> Benchmark+benchIOSrc name f =+    bench name $ nfIO $ randomRIO (1,1) >>= drain . f++{-# NOINLINE benchIO #-}+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f++#ifndef USE_PRELUDE+{-# INLINE sourceConcatMapId #-}+sourceConcatMapId :: (Monad m)+    => Int -> Int -> Stream m (Stream m Int)+sourceConcatMapId value n =+    Stream.fromList $ fmap (D.fromEffect . return) [n..n+value]+#endif++{-# INLINE apDiscardFst #-}+apDiscardFst :: MonadAsync m =>+    Int -> Int -> m ()+apDiscardFst linearCount start = drain $ unCross $+    mkCross (sourceUnfoldrM nestedCount2 start)+        *> mkCross (sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE apDiscardSnd #-}+apDiscardSnd :: MonadAsync m => Int -> Int -> m ()+apDiscardSnd linearCount start = drain $ unCross $+    mkCross (sourceUnfoldrM nestedCount2 start)+        <* mkCross (sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE apLiftA2 #-}+apLiftA2 :: MonadAsync m => Int -> Int -> m ()+apLiftA2 linearCount start = drain $ unCross $+    liftA2 (+) (mkCross (sourceUnfoldrM nestedCount2 start))+        (mkCross (sourceUnfoldrM nestedCount2 start))++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullAp #-}+toNullAp :: MonadAsync m => Int -> Int -> m ()+toNullAp linearCount start = drain $ unCross $+    (+) <$> mkCross (sourceUnfoldrM nestedCount2 start)+        <*> mkCross (sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullApPure #-}+toNullApPure :: MonadAsync m => Int -> Int -> m ()+toNullApPure linearCount start = drain $ unCross $+    (+) <$> mkCross (sourceUnfoldr nestedCount2 start)+        <*> mkCross (sourceUnfoldr nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE monadThen #-}+monadThen :: MonadAsync m => Int -> Int -> m ()+monadThen linearCount start = drain $ unCross $ do+    mkCross (sourceUnfoldrM nestedCount2 start) >>+        mkCross (sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullM #-}+toNullM :: MonadAsync m => Int -> Int -> m ()+toNullM linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)+    return $ x + y++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullMPure #-}+toNullMPure :: MonadAsync m => Int -> Int -> m ()+toNullMPure linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldr nestedCount2 start)+    y <- mkCross (sourceUnfoldr nestedCount2 start)+    return $ x + y++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullM3 #-}+toNullM3 :: MonadAsync m => Int -> Int -> m ()+toNullM3 linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount3 start)+    y <- mkCross (sourceUnfoldrM nestedCount3 start)+    z <- mkCross (sourceUnfoldrM nestedCount3 start)+    return $ x + y + z+  where+    nestedCount3 = round (fromIntegral linearCount**(1/3::Double))++{-# INLINE toNullM3Pure #-}+toNullM3Pure :: MonadAsync m => Int -> Int -> m ()+toNullM3Pure linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldr nestedCount3 start)+    y <- mkCross (sourceUnfoldr nestedCount3 start)+    z <- mkCross (sourceUnfoldr nestedCount3 start)+    return $ x + y + z+  where+    nestedCount3 = round (fromIntegral linearCount**(1/3::Double))++{-# INLINE filterAllOutM #-}+filterAllOutM :: MonadAsync m => Int -> Int -> m ()+filterAllOutM linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)+    let s = x + y+    if s < 0+    then return s+    else mkCross Stream.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterAllInM #-}+filterAllInM :: MonadAsync m => Int -> Int -> m ()+filterAllInM linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)+    let s = x + y+    if s > 0+    then return s+    else mkCross Stream.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterAllOutMPure #-}+filterAllOutMPure :: MonadAsync m => Int -> Int -> m ()+filterAllOutMPure linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldr nestedCount2 start)+    y <- mkCross (sourceUnfoldr nestedCount2 start)+    let s = x + y+    if s < 0+    then return s+    else mkCross Stream.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterAllInMPure #-}+filterAllInMPure :: MonadAsync m => Int -> Int -> m ()+filterAllInMPure linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldr nestedCount2 start)+    y <- mkCross (sourceUnfoldr nestedCount2 start)+    let s = x + y+    if s > 0+    then return s+    else mkCross Stream.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterSome #-}+filterSome :: MonadAsync m => Int -> Int -> m ()+filterSome linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)+    let s = x + y+    if s > 1100000+    then return s+    else mkCross Stream.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE breakAfterSome #-}+breakAfterSome :: Int -> Int -> IO ()+breakAfterSome linearCount start = do+    (_ :: Either ErrorCall ()) <- try $ drain $ unCross $ do+        x <- mkCross (sourceUnfoldrM nestedCount2 start)+        y <- mkCross (sourceUnfoldrM nestedCount2 start)+        let s = x + y+        if s > 1100000+        then error "break"+        else return s+    return ()+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toListM #-}+toListM :: MonadAsync m => Int -> Int -> m [Int]+toListM linearCount start = toList $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)+    return $ x + y+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++-- Taking a specified number of elements is very expensive in logict so we have+-- a test to measure the same.+{-# INLINE toListSome #-}+toListSome :: MonadAsync m => Int -> Int -> m [Int]+toListSome linearCount start =+    toList $ Stream.take 10000 $ unCross $ do+        x <- mkCross (sourceUnfoldrM nestedCount2 start)+        y <- mkCross (sourceUnfoldrM nestedCount2 start)+        return $ x + y+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++#ifndef USE_PRELUDE+{-# INLINE composeN #-}+composeN ::+       (Monad m)+    => Int+    -> (Stream m Int -> Stream m Int)+    -> Stream m Int+    -> m ()+composeN n f =+    case n of+        1 -> drain . f+        2 -> drain . f . f+        3 -> drain . f . f . f+        4 -> drain . f . f . f . f+        _ -> undefined+#endif++{-# INLINE mapN #-}+mapN ::+       Monad m+    => Int+    -> Stream m Int+    -> m ()+mapN n = composeN n $ fmap (+ 1)++{-# INLINE mapM #-}+mapM ::+       MonadAsync m+    => Int+    -> Stream m Int+    -> m ()+mapM n = composeN n $ Stream.mapM return++#ifndef USE_PRELUDE+foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b+foldl' f z = Stream.fold (Fold.foldl' f z)++scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+scanl' f z = Stream.scanl (Scanl.mkScanl f z)+#endif++{-# INLINE transformMapM #-}+transformMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+#ifndef USE_PRELUDE+transformMapM n = composeN n $ Stream.pipe (Pipe.mapM return)+#else+transformMapM n = composeN n $ Stream.transform (Pipe.mapM return)+#endif++#ifndef USE_PRELUDE+{-# INLINE scanMapM #-}+scanMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+scanMapM n = composeN n $ Stream.scanr (Scanr.functionM return)+#endif++{-# INLINE transformComposeMapM #-}+transformComposeMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+transformComposeMapM n =+    composeN n $+#ifndef USE_PRELUDE+    Stream.pipe+#else+    Stream.transform+#endif+        (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`+         Pipe.mapM (\x -> return (x + 2)))++#ifndef USE_PRELUDE+{-# INLINE scanComposeMapM #-}+scanComposeMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+scanComposeMapM n =+    composeN n $+    Stream.scanr+        (Scanr.functionM (\x -> return (x + 1)) `Scanr.compose`+         Scanr.functionM (\x -> return (x + 2)))+#endif++{-# INLINE transformTeeMapM #-}+transformTeeMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+transformTeeMapM n =+    composeN n $+#ifndef USE_PRELUDE+    Stream.pipe+#else+    Stream.transform+#endif+        (Pipe.mapM (\x -> return (x + 1)) `Pipe.teeMerge`+         Pipe.mapM (\x -> return (x + 2)))++#ifndef USE_PRELUDE+{-# INLINE scanTeeMapM #-}+scanTeeMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+scanTeeMapM n =+    composeN n $+    Stream.scanr+        (Scanr.teeWith (+) (Scanr.functionM (\x -> return (x + 1)))+         (Scanr.functionM (\x -> return (x + 2))))+#endif++{-+{-# INLINE transformZipMapM #-}+transformZipMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+transformZipMapM n =+    composeN n $+    Stream.pipe+        (Pipe.zipWith+             (+)+             (Pipe.mapM (\x -> return (x + 1)))+             (Pipe.mapM (\x -> return (x + 2))))+-}
+ benchmark/Streamly/Benchmark/Data/Stream/Concurrent.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Stream.ConcurrentCommon (allBenchmarks)+import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)++moduleName :: String+moduleName = "Data.Stream.Concurrent"++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize (allBenchmarks moduleName False id)
+ benchmark/Streamly/Benchmark/Data/Stream/ConcurrentCommon.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++module Stream.ConcurrentCommon+    ( allBenchmarks+    )+where++import Stream.Common+    (composeN, benchIO, benchIOSink, benchIOSrc, sourceUnfoldrM)+import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Stream.Prelude (MonadAsync, Config)++import qualified Data.List as List+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Async++import Test.Tasty.Bench+import Prelude hiding (mapM)+import Streamly.Benchmark.Common++-- XXX Write inspection tests to make sure no dictionaries are being passed+-- around to find specialization issues. Could be really bad for perf.++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++{-# INLINE mapM #-}+mapM ::+       MonadAsync m+    => (Config -> Config)+    -> Int+    -> Stream m Int+    -> m ()+mapM f n = composeN n $ Async.parMapM f return++o_1_space_mapping :: Int -> (Config -> Config) -> [Benchmark]+o_1_space_mapping value f =+    [ bgroup "mapping"+        [ benchIOSink value "mapM" $ mapM f 1+        ]+    ]++-------------------------------------------------------------------------------+-- Size conserving transformations (reordering, buffering, etc.)+-------------------------------------------------------------------------------++o_n_heap_buffering :: Int -> (Config -> Config) -> [Benchmark]+o_n_heap_buffering value f =+    [ bgroup "buffered"+        [ benchIOSink value "mkAsync"+            (Stream.fold Fold.drain . Async.parBuffered f)+        ]+    ]++-------------------------------------------------------------------------------+-- Joining+-------------------------------------------------------------------------------++{-# INLINE async2 #-}+async2 :: (Config -> Config) -> Int -> Int -> IO ()+async2 f count n =+    Stream.fold Fold.drain+        $ Async.parTwo f+            (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))++{-# INLINE concatAsync2 #-}+concatAsync2 :: (Config -> Config) -> Int -> Int -> IO ()+concatAsync2 f count n =+    Stream.fold Fold.drain+        $ Async.parConcat f+        $ Stream.fromList+            [sourceUnfoldrM count n, sourceUnfoldrM count (n + 1)]++o_1_space_joining :: Int -> (Config -> Config) -> [Benchmark]+o_1_space_joining value f =+    [ bgroup "joining"+        [ benchIOSrc1 "async (2 of n/2)" (async2 f (value `div` 2))+        , benchIOSrc1 "concat async (2 of n/2)" (concatAsync2 f (value `div` 2))+        ]+    ]++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++{-# INLINE sourceFoldMapWith #-}+sourceFoldMapWith :: (Config -> Config) -> Int -> Int -> Stream IO Int+sourceFoldMapWith f value n =+    Async.parConcatMap f Stream.fromPure $ Stream.fromList [n..n+value]++{-# INLINE sourceFoldMapWithStream #-}+sourceFoldMapWithStream :: (Config -> Config) -> Int -> Int -> Stream IO Int+sourceFoldMapWithStream f value n =+    Async.parConcatMap f Stream.fromPure+        $ Stream.enumerateFromTo n (n + value)++{-# INLINE concatFoldableWith #-}+concatFoldableWith :: (Config -> Config) -> Int -> Int -> Stream IO Int+concatFoldableWith f value n =+    let step x =+            if x <= n + value+            then Just (Stream.fromPure x, x + 1)+            else Nothing+        list = List.unfoldr step n+     in Async.parConcat f (Stream.fromList  list)++o_1_space_concatFoldable :: Int -> (Config -> Config) -> [Benchmark]+o_1_space_concatFoldable value f =+    [ bgroup "concat-foldable"+        [ benchIOSrc "foldMapWith (<>) (List)"+            (sourceFoldMapWith f value)+        , benchIOSrc "foldMapWith (<>) (Stream)"+            (sourceFoldMapWithStream f value)+        , benchIOSrc "S.concatFoldableWith (<>) (List)"+            (concatFoldableWith f value)+        ]+    ]++{-# INLINE concatMapStreamsWith #-}+concatMapStreamsWith+    :: (Config -> Config)+    -> Int+    -> Int+    -> Int+    -> IO ()+concatMapStreamsWith f outer inner n =+    Stream.fold Fold.drain+        $ Async.parConcatMap f (sourceUnfoldrM inner) (sourceUnfoldrM outer n)++{-# INLINE concatFmapStreamsWith #-}+concatFmapStreamsWith+    :: (Config -> Config)+    -> Int+    -> Int+    -> Int+    -> IO ()+concatFmapStreamsWith f outer inner n =+    Stream.fold Fold.drain+        $ Async.parConcat f+        $ fmap (sourceUnfoldrM inner) (sourceUnfoldrM outer n)++o_1_space_concatMap :: String -> Int -> (Config -> Config) -> [Benchmark]+o_1_space_concatMap label value f =+    value2 `seq`+        [ bgroup ("concat" ++ label)+            [ benchIO "parConcatMap (n of 1)"+                  (concatMapStreamsWith f value 1)+            , benchIO "parConcatMap (sqrt x of sqrt x)"+                  (concatMapStreamsWith f value2 value2)+            , benchIO "parConcatMap (1 of n)"+                  (concatMapStreamsWith f 1 value)+            , benchIO "concat . fmap (n of 1)"+                  (concatFmapStreamsWith f value 1)+            ]+        ]++    where++    value2 = round $ sqrt (fromIntegral value :: Double)++-------------------------------------------------------------------------------+-- Monadic outer product+-------------------------------------------------------------------------------++{-# INLINE toNullAp #-}+toNullAp :: (Config -> Config) -> Int -> Int -> IO ()+toNullAp f linearCount start =+    Stream.fold Fold.drain+        $ Async.parCrossApply f+            (fmap (+) (sourceUnfoldrM nestedCount2 start))+            (sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++o_1_space_outerProduct :: Int -> (Config -> Config) -> [Benchmark]+o_1_space_outerProduct value f =+    [ bgroup "monad-outer-product"+        [ benchIO "toNullAp" $ toNullAp f value+        ]+    ]++-------------------------------------------------------------------------------+-- Benchmark sets+-------------------------------------------------------------------------------++allBenchmarks :: String -> Bool -> (Config -> Config) -> Int -> [Benchmark]+allBenchmarks moduleName wide modifier value =+    [ bgroup (o_1_space_prefix moduleName) $ concat+        [ o_1_space_mapping value modifier+        , o_1_space_concatFoldable value modifier+        , o_1_space_concatMap "" value modifier+        , o_1_space_concatMap "-maxThreads-1" value (modifier . Async.maxThreads 1)+        , o_1_space_concatMap "-rate-Nothing" value (modifier . Async.rate Nothing)+        , o_1_space_joining value modifier+        ] ++ if wide then [] else o_1_space_outerProduct value modifier+    , bgroup (o_n_heap_prefix moduleName) $ concat+        [ if wide then o_1_space_outerProduct value modifier else []+        , o_n_heap_buffering value modifier+        ]+    ]
+ benchmark/Streamly/Benchmark/Data/Stream/ConcurrentEager.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Stream.ConcurrentCommon (allBenchmarks)+import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)++import qualified Streamly.Internal.Data.Stream.Prelude as Async++moduleName :: String+moduleName = "Data.Stream.ConcurrentEager"++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main =+    runWithCLIOpts+        defaultStreamSize+        (allBenchmarks moduleName True (Async.eager True))
+ benchmark/Streamly/Benchmark/Data/Stream/ConcurrentInterleaved.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module      : Main+-- Copyright   : (c) 2022 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Stream.ConcurrentCommon (allBenchmarks)+import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)++import qualified Streamly.Internal.Data.Stream.Prelude as Async++moduleName :: String+moduleName = "Data.Stream.ConcurrentInterleaved"++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main =+    runWithCLIOpts+        defaultStreamSize+        (allBenchmarks moduleName True (Async.interleaved True))
+ benchmark/Streamly/Benchmark/Data/Stream/ConcurrentOrdered.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleContexts #-}+-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Stream.ConcurrentCommon (allBenchmarks)+import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)++import qualified Streamly.Internal.Data.Stream.Prelude as Async++moduleName :: String+moduleName = "Data.Stream.ConcurrentOrdered"++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main =+    runWithCLIOpts+        defaultStreamSize+        (allBenchmarks moduleName False (Async.ordered True))
+ benchmark/Streamly/Benchmark/Data/Stream/ConcurrentThreadHeavy.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Control.Concurrent+import Control.Monad (when, replicateM)+import Streamly.Data.Stream.Prelude (Config)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream.Prelude as Stream++import Test.Tasty (localOption)+import Test.Tasty.Bench++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++-- | Run @tcount@ number of actions concurrently using the given concurrency+-- style. Each thread produces a single output after a delay of @d@+-- microseconds.+--+{-# INLINE append #-}+append :: Int -> Int -> Int -> (Config -> Config) -> IO ()+append buflen tcount d modifier =+    let work i = when (d /= 0) (threadDelay d) >> return i+        cfg =+              modifier+            . Stream.maxBuffer buflen+            . Stream.maxThreads (-1)+    in Stream.fold Fold.drain+        $ Stream.parMapM cfg work+        $ Stream.fromList [1..tcount]++-- | Run @threads@ concurrently, each producing streams of @elems@ elements+-- with a delay of @d@ microseconds between successive elements, and merge+-- their outputs in a single output stream. The individual streams are produced+-- serially but merged using the provided concurrency style.+--+{-# INLINE concated #-}+concated+    :: Int+    -> Int+    -> Int+    -> Int+    -> (Config -> Config)+    -> IO ()+concated buflen threads d elems modifier =+    let work i =+            Stream.replicateM i (when (d /= 0) (threadDelay d) >> return i)+        cfg =+              modifier+            . Stream.maxBuffer buflen+            . Stream.maxThreads (-1)+    in Stream.fold Fold.drain+        $ Stream.parConcatMap cfg work+        $ Stream.replicate threads elems++appendGroup :: Int -> Int -> Int -> [Benchmark]+appendGroup buflen threads usec =+    [ -- bench "serial"   $ nfIO $ append buflen threads delay fromSerial+      bench "async"+        $ nfIO $ append buflen threads usec id+    , bench "ordered"+        $ nfIO $ append buflen threads usec (Stream.ordered True)+    , bench "interleaved"+        $ nfIO $ append buflen threads usec (Stream.interleaved True)+    , bench "parallel"+        $ nfIO $ append buflen threads usec (Stream.eager True)+    ]++concatGroup :: Int -> Int -> Int -> Int -> [Benchmark]+concatGroup buflen threads usec n =+    [ -- bench "serial"   $ nfIO $ concated buflen threads usec n serial+      bench "async"+        $ nfIO $ concated buflen threads usec n id+    , bench "ordered"+        $ nfIO $ concated buflen threads usec n (Stream.ordered True)+    , bench "interleaved"+        $ nfIO $ concated buflen threads usec n (Stream.interleaved True)+    , bench "parallel"+        $ nfIO $ concated buflen threads usec n (Stream.eager True)+    ]++main :: IO ()+main =+    defaultMain $ map (localOption (RelStDev 100000))+    [ -- bgroup "append/buf-1-threads-10k-0sec"  (appendGroup 1 10000 0)+    -- , bgroup "append/buf-100-threads-100k-0sec"  (appendGroup 100 100000 0)+      bgroup "streamly/threads10k-delay5s-singleton(buf10k)"  (appendGroup 10000 10000 5000000)+    --  bgroup "concat/buf-1-threads-100k-count-1" (concatGroup 1 100000 0 1)+    --  bgroup "concat/buf-1-threads-1-count-10m" (concatGroup 1 1 0 10000000)+    , bgroup "streamly/threads100-delay0s-stream500k(buf100)"  (concatGroup 100 100 0 500000)++    , bench "forkIO/threads10k-delay5s-singleton" $+        let delay = threadDelay 5000000+            count = 10000 :: Int+            list = [1..count]+            work i = delay >> return i+        in nfIO $ do+            ref <- newEmptyMVar+            mapM_ (\i -> forkIO (work i >>= \j -> putMVar ref j)) list+            replicateM 10000 (takeMVar ref)+   ]
+ benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs view
@@ -0,0 +1,741 @@+-- |+-- Module      : Stream.Eliminate+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++{-# OPTIONS_GHC -Wno-orphans #-}+#ifdef USE_PRELUDE+#endif++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Stream.Eliminate (benchmarks) where++import Control.Monad (when)+import Control.DeepSeq (NFData(..))+import Data.Functor.Identity (Identity, runIdentity)+import System.Random (randomRIO)++import qualified Data.Foldable as F+import qualified GHC.Exts as GHC+import qualified Streamly.Internal.Data.Fold as Fold++#ifdef INSPECTION+import GHC.Types (SPEC(..))+import Test.Inspection+import qualified Streamly.Internal.Data.Stream as D+#endif++#ifdef USE_PRELUDE+import Streamly.Prelude (fromSerial)+import Streamly.Benchmark.Prelude+import qualified Streamly.Internal.Data.Stream.IsStream as S+#else+import Stream.Common+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as S+#endif++import Test.Tasty.Bench+import Streamly.Benchmark.Common+import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),+    lookup, repeat, minimum, maximum, product, last, mapM_, init)+import qualified Prelude++#ifdef USE_PRELUDE+type Stream = S.SerialT+fromStream = id++{-# INLINE repeat #-}+repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int+repeat count = S.take count . S.repeat+#endif++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Foldable Instance+-------------------------------------------------------------------------------++{-# INLINE foldableFoldl' #-}+foldableFoldl' :: Int -> Int -> Int+foldableFoldl' value n =+    F.foldl' (+) 0 (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableFoldrElem #-}+foldableFoldrElem :: Int -> Int -> Bool+foldableFoldrElem value n =+    F.foldr (\x xs -> x == value || xs)+            False+            (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableSum #-}+foldableSum :: Int -> Int -> Int+foldableSum value n =+    Prelude.sum (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableProduct #-}+foldableProduct :: Int -> Int -> Int+foldableProduct value n =+    Prelude.product (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE _foldableNull #-}+_foldableNull :: Int -> Int -> Bool+_foldableNull value n =+    Prelude.null (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableElem #-}+foldableElem :: Int -> Int -> Bool+foldableElem value n =+    value `Prelude.elem` (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableNotElem #-}+foldableNotElem :: Int -> Int -> Bool+foldableNotElem value n =+    value `Prelude.notElem` (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableFind #-}+foldableFind :: Int -> Int -> Maybe Int+foldableFind value n =+    F.find (== (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableAll #-}+foldableAll :: Int -> Int -> Bool+foldableAll value n =+    Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableAny #-}+foldableAny :: Int -> Int -> Bool+foldableAny value n =+    Prelude.any (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)++{- HLINT ignore "Use all"-}+{-# INLINE foldableAnd #-}+foldableAnd :: Int -> Int -> Bool+foldableAnd value n =+    Prelude.and $ fmap+        (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)++{- HLINT ignore "Use any"-}+{-# INLINE foldableOr #-}+foldableOr :: Int -> Int -> Bool+foldableOr value n =+    Prelude.or $ fmap+        (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableLength #-}+foldableLength :: Int -> Int -> Int+foldableLength value n =+    Prelude.length (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableMin #-}+foldableMin :: Int -> Int -> Int+foldableMin value n =+    Prelude.minimum (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE ordInstanceMin #-}+ordInstanceMin :: Stream Identity Int -> Stream Identity Int+ordInstanceMin src = min src src++{-# INLINE foldableMax #-}+foldableMax :: Int -> Int -> Int+foldableMax value n =+    Prelude.maximum (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableMinBy #-}+foldableMinBy :: Int -> Int -> Int+foldableMinBy value n =+    F.minimumBy compare (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableListMinBy #-}+foldableListMinBy :: Int -> Int -> Int+foldableListMinBy value n = F.minimumBy compare [1..value+n]++{-# INLINE foldableMaxBy #-}+foldableMaxBy :: Int -> Int -> Int+foldableMaxBy value n =+    F.maximumBy compare (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableToList #-}+foldableToList :: Int -> Int -> [Int]+foldableToList value n =+    F.toList (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableMapM_ #-}+foldableMapM_ :: Monad m => Int -> Int -> m ()+foldableMapM_ value n =+    F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: Stream Identity Int)++{-# INLINE foldableSequence_ #-}+foldableSequence_ :: Int -> Int -> IO ()+foldableSequence_ value n =+    F.sequence_ (sourceUnfoldrAction value n :: Stream Identity (IO Int))++{-# INLINE _foldableMsum #-}+_foldableMsum :: Int -> Int -> IO Int+_foldableMsum value n =+    F.msum (sourceUnfoldrAction value n :: Stream Identity (IO Int))++{-# INLINE showInstance #-}+showInstance :: Stream Identity Int -> String+showInstance = show++o_1_space_elimination_foldable :: Int -> [Benchmark]+o_1_space_elimination_foldable value =+    [ bgroup "foldable"+          -- Foldable instance+        [ bench "foldl'" $ nf (foldableFoldl' value) 1+        , bench "foldrElem" $ nf (foldableFoldrElem value) 1+     -- , bench "null" $ nf (_foldableNull value) 1+        , bench "elem" $ nf (foldableElem value) 1+        , bench "length" $ nf (foldableLength value) 1+        , bench "sum" $ nf (foldableSum value) 1+        , bench "product" $ nf (foldableProduct value) 1+        , bench "minimum" $ nf (foldableMin value) 1+        , benchPureSink value "min (ord)" ordInstanceMin+        , bench "maximum" $ nf (foldableMax value) 1+        , bench "minimumBy" $ nf (`foldableMinBy` 1) value+        , bench "maximumBy" $ nf (`foldableMaxBy` 1) value+        , bench "minimumByList" $ nf (`foldableListMinBy` 1) value+        , bench "length . toList"+            $ nf (Prelude.length . foldableToList value) 1+        , bench "notElem" $ nf (foldableNotElem value) 1+        , bench "find" $ nf (foldableFind value) 1+        , bench "all" $ nf (foldableAll value) 1+        , bench "any" $ nf (foldableAny value) 1+        , bench "and" $ nf (foldableAnd value) 1+        , bench "or" $ nf (foldableOr value) 1++        -- Applicative and Traversable operations+        -- TBD: traverse_+        , benchIOSink1 "mapM_" (foldableMapM_ value)+        -- TBD: for_+        -- TBD: forM_+        , benchIOSink1 "sequence_" (foldableSequence_ value)+        -- TBD: sequenceA_+        -- TBD: asum+        -- XXX needs to be fixed, results are in ns+        -- , benchIOSink1 "msum" (foldableMsum value)+        ]+    ]++-------------------------------------------------------------------------------+-- Stream folds+-------------------------------------------------------------------------------++#ifndef USE_PRELUDE+instance NFData a => NFData (Stream Identity a) where+    {-# INLINE rnf #-}+    rnf xs = runIdentity $ S.fold (Fold.foldl' (\_ x -> rnf x) ()) xs+#endif++{-# INLINE benchPureSink #-}+benchPureSink :: NFData b+    => Int -> String -> (Stream Identity Int -> b) -> Benchmark+benchPureSink value name = benchPure name (sourceUnfoldr value)++{-# INLINE benchHoistSink #-}+benchHoistSink+    :: (NFData b)+    => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark+benchHoistSink value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f .  sourceUnfoldr value++-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but+-- we can't use it as it requires MonadAsync constraint.+{-# INLINE benchIdentitySink #-}+benchIdentitySink+    :: (NFData b)+    => Int -> String -> (Stream Identity Int -> Identity b) -> Benchmark+benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1++-------------------------------------------------------------------------------+-- Reductions+-------------------------------------------------------------------------------++{-# INLINE uncons #-}+uncons :: Monad m => Stream m Int -> m ()+uncons s = do+    r <- S.uncons s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons t++#ifndef USE_PRELUDE+{-# INLINE toNull #-}+toNull :: Monad m => Stream m Int -> m ()+toNull = S.drain+#endif++#ifdef USE_PRELUDE+{-# INLINE init #-}+init :: Monad m => Stream m a -> m ()+init s = S.init s >>= Prelude.mapM_ S.drain+#endif++{-# INLINE mapM_ #-}+mapM_ :: Monad m => Stream m Int -> m ()+mapM_ = S.mapM_ (\_ -> return ())++{-# INLINE foldBreak #-}+foldBreak :: Monad m => Stream m Int -> m ()+foldBreak s = do+    (r, s1) <- S.foldBreak (Fold.take 1 Fold.length) s+    when (r /= 0) $ foldBreak s1++{-# INLINE foldrMElem #-}+foldrMElem :: Monad m => Int -> Stream m Int -> m Bool+foldrMElem e =+    S.foldrM+        (\x xs ->+             if x == e+                 then return True+                 else xs)+        (return False)++-- {-# INLINE foldrToStream #-}+-- foldrToStream :: Monad m => Stream m Int -> m (Stream Identity Int)+-- foldrToStream = S.foldr S.cons S.nil++{-# INLINE foldrMBuild #-}+foldrMBuild :: Monad m => Stream m Int -> m [Int]+foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])++{-# INLINE foldl'Reduce #-}+foldl'Reduce :: Monad m => Stream m Int -> m Int+foldl'Reduce = S.foldl' (+) 0++{-# INLINE last #-}+last :: Monad m => Stream m Int -> m (Maybe Int)+last = S.last++#ifdef USE_PRELUDE+{-# INLINE foldl1'Reduce #-}+foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int)+foldl1'Reduce = S.foldl1' (+)++{-# INLINE foldlM'Reduce #-}+foldlM'Reduce :: Monad m => Stream m Int -> m Int+foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)++{-# INLINE _head #-}+_head :: Monad m => Stream m Int -> m (Maybe Int)+_head = S.head++{-# INLINE elem #-}+elem :: Monad m => Int -> Stream m Int -> m Bool+elem value = S.elem (value + 1)++{-# INLINE notElem #-}+notElem :: Monad m => Int -> Stream m Int -> m Bool+notElem value = S.notElem (value + 1)++{-# INLINE length #-}+length :: Monad m => Stream m Int -> m Int+length = S.length++{-# INLINE all #-}+all :: Monad m => Int -> Stream m Int -> m Bool+all value = S.all (<= (value + 1))++{-# INLINE any #-}+any :: Monad m => Int -> Stream m Int -> m Bool+any value = S.any (> (value + 1))++{-# INLINE and #-}+and :: Monad m => Int -> Stream m Int -> m Bool+and value = S.and . S.map (<= (value + 1))++{-# INLINE or #-}+or :: Monad m => Int -> Stream m Int -> m Bool+or value = S.or . S.map (> (value + 1))++{-# INLINE find #-}+find :: Monad m => Int -> Stream m Int -> m (Maybe Int)+find value = S.find (== (value + 1))++{-# INLINE findM #-}+findM :: Monad m => Int -> Stream m Int -> m (Maybe Int)+findM value = S.findM (\z -> return $ z == (value + 1))++{-# INLINE findIndex #-}+findIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)+findIndex value = S.findIndex (== (value + 1))++{-# INLINE elemIndex #-}+elemIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)+elemIndex value = S.elemIndex (value + 1)++{-# INLINE maximum #-}+maximum :: Monad m => Stream m Int -> m (Maybe Int)+maximum = S.maximum++{-# INLINE minimum #-}+minimum :: Monad m => Stream m Int -> m (Maybe Int)+minimum = S.minimum++{-# INLINE sum #-}+sum :: Monad m => Stream m Int -> m Int+sum = S.sum++{-# INLINE product #-}+product :: Monad m => Stream m Int -> m Int+product = S.product++{-# INLINE minimumBy #-}+minimumBy :: Monad m => Stream m Int -> m (Maybe Int)+minimumBy = S.minimumBy compare++{-# INLINE maximumBy #-}+maximumBy :: Monad m => Stream m Int -> m (Maybe Int)+maximumBy = S.maximumBy compare++{-# INLINE the #-}+the :: Monad m => Stream m Int -> m (Maybe Int)+the = S.the++{-# INLINE drainN #-}+drainN :: Monad m => Int -> Stream m Int -> m ()+drainN = S.drainN++{-# INLINE drainWhile #-}+drainWhile :: Monad m => Stream m Int -> m ()+drainWhile = S.drainWhile (const True)++{-# INLINE (!!) #-}+(!!) :: Monad m => Int -> Stream m Int -> m (Maybe Int)+(!!) = flip (S.!!)++{-# INLINE lookup #-}+lookup :: Monad m => Int -> Stream m Int -> m (Maybe Int)+lookup val = S.lookup val . S.map (\x -> (x, x))+#endif++o_1_space_elimination_folds :: Int -> [Benchmark]+o_1_space_elimination_folds value =+    [ bgroup "elimination"+        -- Basic folds+        [+#ifdef USE_PRELUDE+            bgroup "reduce"+            [ bgroup+                  "IO"+                  [ benchIOSink value "foldl'" foldl'Reduce+                  , benchIOSink value "foldl1'" foldl1'Reduce+                  , benchIOSink value "foldlM'" foldlM'Reduce+                  ]++            , bgroup+                  "Identity"+                  [ benchIdentitySink value "foldl'" foldl'Reduce+                  , benchIdentitySink value "foldl1'" foldl1'Reduce+                  , benchIdentitySink value "foldlM'" foldlM'Reduce+                  ]+            ] ,+#endif+         bgroup "build"+            [ bgroup "IO"+                  [ benchIOSink value "foldrMElem" (foldrMElem value)+                  ]+            , bgroup "Identity"+                  [ benchIdentitySink value "foldrMElem" (foldrMElem value)+                  {-+                  , benchIdentitySink 16 "foldrToStreamLength (16)"+                        (S.fold Fold.length . runIdentity . foldrToStream)+                  -}+                  {-+                  , benchPureSink 16 "foldrMToListLength (16)"+                        (Prelude.length . runIdentity . foldrMBuild)+                  -}+                  , benchPureSink value "foldrMToListLength"+                        (Prelude.length . runIdentity . foldrMBuild)+                  ]+            ]++        -- deconstruction+        , benchIOSink value "uncons" uncons+        , benchIOSink value "mapM_" mapM_+        , benchIOSink value "last" last+#ifndef USE_PRELUDE+        , benchHoistSink value "length . generalizeInner"+              (S.fold Fold.length . S.generalizeInner)+        , benchIOSink value "toNull" toNull+        , benchIOSink value "foldBreak" foldBreak+        , benchIOSink value "foldl" foldl'Reduce+#endif+#ifdef USE_PRELUDE+        , benchIOSink value "init" init++        -- draining+        , benchIOSink value "drain" $ toNull fromSerial+        , benchIOSink value "drainN" $ drainN value+        , benchIOSink value "drainWhile" drainWhile+        , benchPureSink value "drain (pure)" id++        -- this is too fast, causes all benchmarks reported in ns+    -- , benchIOSink value "head" head+        , benchIOSink value "length" length+        , benchIOSink value "sum" sum+        , benchIOSink value "product" product+        , benchIOSink value "maximumBy" maximumBy+        , benchIOSink value "maximum" maximum+        , benchIOSink value "minimumBy" minimumBy+        , benchIOSink value "minimum" minimum++        , bench "the" $ nfIO $ randomRIO (1,1) >>= the . repeat value+        , benchIOSink value "find" (find value)+        , benchIOSink value "findM" (findM value)+        -- , benchIOSink value "lookupFirst" (lookup 1)+        , benchIOSink value "lookupNever" (lookup (value + 1))+        , benchIOSink value "(!!)" (value !!)+        , benchIOSink value "findIndex" (findIndex value)+        , benchIOSink value "elemIndex" (elemIndex value)+        -- this is too fast, causes all benchmarks reported in ns+    -- , benchIOSink value "null" S.null+        , benchIOSink value "elem" (elem value)+        , benchIOSink value "notElem" (notElem value)+        , benchIOSink value "all" (all value)+        , benchIOSink value "any" (any value)+        , benchIOSink value "and" (and value)+        , benchIOSink value "or" (or value)+#endif++        -- length is used to check for foldr/build fusion+        , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)+        ]+    ]++-------------------------------------------------------------------------------+-- Buffered Transformations by fold+-------------------------------------------------------------------------------++#ifdef USE_PRELUDE+{-# INLINE foldl'Build #-}+foldl'Build :: Monad m => Stream m Int -> m [Int]+foldl'Build = S.foldl' (flip (:)) []++{-# INLINE foldlM'Build #-}+foldlM'Build :: Monad m => Stream m Int -> m [Int]+foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])++o_n_heap_elimination_foldl :: Int -> [Benchmark]+o_n_heap_elimination_foldl value =+    [ bgroup "foldl"+        -- Left folds for building a structure are inherently non-streaming+        -- as the structure cannot be lazily consumed until fully built.+        [ benchIOSink value "foldl'/build/IO" foldl'Build+        , benchIdentitySink value "foldl'/build/Identity" foldl'Build+        , benchIOSink value "foldlM'/build/IO" foldlM'Build+        , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build+        ]+    ]+#endif++-- For comparisons+{-# INLINE showInstanceList #-}+showInstanceList :: [Int] -> String+showInstanceList = show++o_n_heap_elimination_buffered :: Int -> [Benchmark]+o_n_heap_elimination_buffered value =+    [ bgroup "buffered"+        -- Buffers the output of show/read.+        -- XXX can the outputs be streaming? Can we have special read/show+        -- style type classes, readM/showM supporting streaming effects?+        [ bench "showPrec Haskell lists" $ nf showInstanceList (mkList value)+        -- XXX This is not o-1-space for GHC-8.10+        , benchPureSink value "showsPrec pure streams" showInstance+        ]+    ]++{-# INLINE foldrMReduce #-}+foldrMReduce :: Monad m => Stream m Int -> m Int+foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)++o_n_space_elimination_foldr :: Int -> [Benchmark]+o_n_space_elimination_foldr value =+    -- Head recursive strict right folds.+    [ bgroup "foldr"+        -- accumulation due to strictness of IO monad+        [ benchIOSink value "foldrM/build/IO (toList)" foldrMBuild+        -- Right folds for reducing are inherently non-streaming as the+        -- expression needs to be fully built before it can be reduced.+        , benchIdentitySink value "foldrM/reduce/Identity (sum)" foldrMReduce+        , benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce++        -- This is horribly slow, never finishes+        -- let foldlS = composeN n $ S.foldlS (flip S.cons) S.nil+        --  in benchFold "foldlS"  (foldlS    1) sourceUnfoldrM+        ]+    ]++#ifdef USE_PRELUDE+o_n_heap_elimination_toList :: Int -> [Benchmark]+o_n_heap_elimination_toList value =+    [ bgroup "toList"+        -- Converting the stream to a list or pure stream in a strict monad+        [ benchIOSink value "toListRev" S.toListRev+        , benchIOSink value "toStreamRev"+            (S.toStreamRev :: (Stream IO Int -> IO (Stream Identity Int)))+        ]+    ]++o_n_space_elimination_toList :: Int -> [Benchmark]+o_n_space_elimination_toList value =+    [ bgroup "toList"+        -- Converting the stream to a list or pure stream in a strict monad+        [ benchIOSink value "toList" S.toList+#ifndef USE_PRELUDE+        , benchIOSink value "toStream"+            (S.toStream :: (Stream IO Int -> IO (Stream Identity Int)))+#endif+        ]+    ]+#endif++-------------------------------------------------------------------------------+-- Multi-stream folds+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Multi-stream pure+-------------------------------------------------------------------------------++{-# INLINE eqBy' #-}+eqBy' :: (Monad m, Eq a) => Stream m a -> m Bool+eqBy' src = S.eqBy (==) src src++{-# INLINE eqByPure #-}+eqByPure :: Int -> Int -> Identity Bool+eqByPure value n = eqBy' (sourceUnfoldr value n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'eqByPure+inspect $ 'eqByPure `hasNoType` ''SPEC+inspect $ 'eqByPure `hasNoType` ''D.Step+#endif++{-# INLINE eqInstance #-}+eqInstance :: Stream Identity Int -> Bool+eqInstance src = src == src++{-# INLINE eqInstanceNotEq #-}+eqInstanceNotEq :: Stream Identity Int -> Bool+eqInstanceNotEq src = src /= src++{-# INLINE cmpBy' #-}+cmpBy' :: (Monad m, Ord a) => Stream m a -> m Ordering+cmpBy' src = S.cmpBy compare src src++{-# INLINE cmpByPure #-}+cmpByPure :: Int -> Int -> Identity Ordering+cmpByPure value n = cmpBy' (sourceUnfoldr value n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'cmpByPure+inspect $ 'cmpByPure `hasNoType` ''SPEC+inspect $ 'cmpByPure `hasNoType` ''D.Step+#endif++{-# INLINE ordInstance #-}+ordInstance :: Stream Identity Int -> Bool+ordInstance src = src < src++o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]+o_1_space_elimination_multi_stream_pure value =+    [ bgroup "multi-stream-pure"+        [ benchPureSink1 "eqBy" (eqByPure value)+        , benchPureSink value "==" eqInstance+        , benchPureSink value "/=" eqInstanceNotEq+        , benchPureSink1 "cmpBy" (cmpByPure value)+        , benchPureSink value "<" ordInstance+        ]+    ]++{-# INLINE isPrefixOf #-}+isPrefixOf :: Monad m => Stream m Int -> m Bool+isPrefixOf src = S.isPrefixOf src src++{-# INLINE isSubsequenceOf #-}+isSubsequenceOf :: Monad m => Stream m Int -> m Bool+isSubsequenceOf src = S.isSubsequenceOf src src++{-# INLINE stripPrefix #-}+stripPrefix :: Monad m => Stream m Int -> m ()+stripPrefix src = do+    _ <- S.stripPrefix src src+    return ()++{-# INLINE eqBy #-}+eqBy :: Int -> Int -> IO Bool+eqBy value n = eqBy' (sourceUnfoldrM value n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'eqBy+inspect $ 'eqBy `hasNoType` ''SPEC+inspect $ 'eqBy `hasNoType` ''D.Step+#endif++{-# INLINE cmpBy #-}+cmpBy :: Int -> Int -> IO Ordering+cmpBy value n = cmpBy' (sourceUnfoldrM value n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'cmpBy+inspect $ 'cmpBy `hasNoType` ''SPEC+inspect $ 'cmpBy `hasNoType` ''D.Step+#endif++o_1_space_elimination_multi_stream :: Int -> [Benchmark]+o_1_space_elimination_multi_stream value =+    [ bgroup "multi-stream"+        [ benchIOSink1 "eqBy" (eqBy value)+        , benchIOSink1 "cmpBy" (cmpBy value)+        , benchIOSink value "isPrefixOf" isPrefixOf+        , benchIOSink value "isSubsequenceOf" isSubsequenceOf+        , benchIOSink value "stripPrefix" stripPrefix+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+benchmarks :: String -> Int -> [Benchmark]+benchmarks moduleName size =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_elimination_foldable size+            , o_1_space_elimination_folds size+            , o_1_space_elimination_multi_stream_pure size+            , o_1_space_elimination_multi_stream size+            ]++        , bgroup (o_n_heap_prefix moduleName) $+               o_n_heap_elimination_buffered size+#ifdef USE_PRELUDE+            ++ o_n_heap_elimination_foldl size+            ++ o_n_heap_elimination_toList size+            ++ o_n_space_elimination_toList size+#endif+        , bgroup (o_n_space_prefix moduleName) $+            o_n_space_elimination_foldr size+        ]
+ benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs view
@@ -0,0 +1,374 @@+-- |+-- Module      : Stream.Exceptions+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++#ifdef USE_PRELUDE+#endif++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Stream.Exceptions (benchmarks) where++import Control.Exception (Exception, throwIO)+import Stream.Common (drain)++import qualified Data.IORef as Ref+import qualified Data.Map.Strict as Map++import Control.Exception (SomeException)+import System.IO (Handle, hClose, hPutChar)+import qualified Streamly.FileSystem.Handle as FH+import qualified Streamly.Internal.FileSystem.Handle as IFH+import qualified Streamly.Internal.Data.Unfold as IUF+import qualified Streamly.Internal.Data.Unfold.Prelude as IUF++#ifdef USE_PRELUDE+import qualified Streamly.Internal.Data.Stream.IsStream as Stream+#else+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream+#endif++import Test.Tasty.Bench hiding (env)+import Prelude hiding (last, length)+import Streamly.Benchmark.Common+import Streamly.Benchmark.Common.Handle++#ifdef INSPECTION+import Control.Monad.Catch (MonadCatch)+import Test.Inspection++import qualified Streamly.Internal.Data.Stream as D+#endif++#ifdef USE_PRELUDE+type Stream = Stream.SerialT+toStreamD = Stream.toStream+fromStreamD = Stream.fromStream+#else+type Stream = Stream.Stream+toStreamD :: a -> a+toStreamD = id+fromStreamD :: a -> a+fromStreamD = id+#endif++afterUnsafe :: IO b -> Stream IO a -> Stream IO a+finallyUnsafe :: IO b -> Stream IO a -> Stream IO a+bracketUnsafe :: IO b -> (b -> IO c) -> (b -> Stream IO a) -> Stream IO a+#ifdef USE_PRELUDE+afterUnsafe = Stream.after_+finallyUnsafe = Stream.finally_+bracketUnsafe = Stream.bracket_+#else+afterUnsafe = Stream.afterUnsafe+finallyUnsafe = Stream.finallyUnsafe+bracketUnsafe = Stream.bracketUnsafe+#endif++-------------------------------------------------------------------------------+-- stream exceptions+-------------------------------------------------------------------------------++data BenchException+    = BenchException1+    | BenchException2+    deriving (Show, Eq, Ord)++instance Exception BenchException++retryNoneSimple :: Int -> Int -> IO ()+retryNoneSimple length from =+    drain+        $ Stream.retry+            (Map.singleton BenchException1 length)+            (const Stream.nil)+            source++    where++    source = Stream.enumerateFromTo from (from + length)++retryNone :: Int -> Int -> IO ()+retryNone length from = do+    ref <- Ref.newIORef (0 :: Int)+    drain+        $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)+        $ source ref++    where++    source ref =+        Stream.replicateM (from + length)+            $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref++retryAll :: Int -> Int -> IO ()+retryAll length from = do+    ref <- Ref.newIORef 0+    drain+        $ Stream.retry+            (Map.singleton BenchException1 (length + from)) (const Stream.nil)+        $ source ref++    where++    source ref =+        Stream.fromEffect+            $ do+                Ref.modifyIORef' ref (+ 1)+                val <- Ref.readIORef ref+                if val >= length+                then return length+                else throwIO BenchException1++retryUnknown :: Int -> Int -> IO ()+retryUnknown length from = do+    drain+        $ Stream.retry (Map.singleton BenchException1 length) (const source)+        $ throwIO BenchException2 `Stream.before` Stream.nil++    where++    source = Stream.enumerateFromTo from (from + length)+++o_1_space_serial_exceptions :: Int -> [Benchmark]+o_1_space_serial_exceptions length =+    [ bgroup+          "exceptions/serial"+          [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length)+          , benchIOSrc1 "retryNone" (retryNone length)+          , benchIOSrc1 "retryAll" (retryAll length)+          , benchIOSrc1 "retryUnknown" (retryUnknown length)+          ]+    ]++-- XXX Move these to FileSystem.Handle benchmarks++-------------------------------------------------------------------------------+-- copy stream exceptions+-------------------------------------------------------------------------------++-- | Send the file contents to /dev/null with exception handling+readWriteOnExceptionStream :: Handle -> Handle -> IO ()+readWriteOnExceptionStream inh devNull =+    let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)+    in Stream.fold (FH.write devNull) readEx++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'readWriteOnExceptionStream+#endif++-- | Send the file contents to /dev/null with exception handling+readWriteHandleExceptionStream :: Handle -> Handle -> IO ()+readWriteHandleExceptionStream inh devNull =+    let handler (_e :: SomeException) =+#ifndef USE_PRELUDE+            return $ Stream.fromEffect (hClose inh >> return 10)+#else+            Stream.fromEffect (hClose inh >> return 10)+#endif+        readEx = Stream.handle handler (Stream.unfold FH.reader inh)+    in Stream.fold (FH.write devNull) readEx++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream+#endif++-- | Send the file contents to /dev/null with exception handling+readWriteFinally_Stream :: Handle -> Handle -> IO ()+readWriteFinally_Stream inh devNull =+    let readEx =+            finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)+    in Stream.fold (FH.write devNull) readEx++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'readWriteFinally_Stream+#endif++readWriteFinallyStream :: Handle -> Handle -> IO ()+readWriteFinallyStream inh devNull =+    let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)+    in Stream.fold (FH.write devNull) readEx++-- | Send the file contents to /dev/null with exception handling+fromToBytesBracket_Stream :: Handle -> Handle -> IO ()+fromToBytesBracket_Stream inh devNull =+    let readEx = bracketUnsafe (return ()) (\_ -> hClose inh)+                    (\_ -> fromStreamD $ IFH.read inh)+    in IFH.putBytes devNull (toStreamD readEx)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream+#endif++fromToBytesBracketStream :: Handle -> Handle -> IO ()+fromToBytesBracketStream inh devNull =+    let readEx = Stream.bracket (return ()) (\_ -> hClose inh)+                    (\_ -> fromStreamD $ IFH.read inh)+    in IFH.putBytes devNull (toStreamD readEx)++readWriteBeforeAfterStream :: Handle -> Handle -> IO ()+readWriteBeforeAfterStream inh devNull =+    let readEx =+            Stream.after (hClose inh)+                $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)+     in Stream.fold (FH.write devNull) readEx++#ifdef INSPECTION+inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step+#endif++readWriteAfterStream :: Handle -> Handle -> IO ()+readWriteAfterStream inh devNull =+    let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)+     in Stream.fold (FH.write devNull) readEx++#ifdef INSPECTION+inspect $ 'readWriteAfterStream `hasNoType` ''D.Step+#endif++readWriteAfter_Stream :: Handle -> Handle -> IO ()+readWriteAfter_Stream inh devNull =+    let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)+     in Stream.fold (FH.write devNull) readEx++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'readWriteAfter_Stream+inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step+#endif++o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]+o_1_space_copy_stream_exceptions env =+    [ bgroup "exceptions"+       [ mkBenchSmall "Stream.onException" env $ \inh _ ->+           readWriteOnExceptionStream inh (nullH env)+       , mkBenchSmall "Stream.handle" env $ \inh _ ->+           readWriteHandleExceptionStream inh (nullH env)+       , mkBenchSmall "Stream.finally_" env $ \inh _ ->+           readWriteFinally_Stream inh (nullH env)+       , mkBenchSmall "Stream.finally" env $ \inh _ ->+           readWriteFinallyStream inh (nullH env)+       , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->+           readWriteBeforeAfterStream inh (nullH env)+       , mkBenchSmall "Stream.after" env $ \inh _ ->+           readWriteAfterStream inh (nullH env)+       , mkBenchSmall "Stream.after_" env $ \inh _ ->+           readWriteAfter_Stream inh (nullH env)+       ]+    , bgroup "exceptions/fromToBytes"+       [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->+           fromToBytesBracket_Stream inh (nullH env)+       , mkBenchSmall "Stream.bracket" env $ \inh _ ->+           fromToBytesBracketStream inh (nullH env)+        ]+    ]++ -------------------------------------------------------------------------------+-- Exceptions readChunks+-------------------------------------------------------------------------------++-- | Send the file contents to /dev/null with exception handling+readChunksOnException :: Handle -> Handle -> IO ()+readChunksOnException inh devNull =+    let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader+    in IUF.fold (IFH.writeChunks devNull) readEx inh++#ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch]+#else+inspect $ hasNoTypeClasses 'readChunksOnException+#endif+#endif++-- | Send the file contents to /dev/null with exception handling+readChunksBracket_ :: Handle -> Handle -> IO ()+readChunksBracket_ inh devNull =+    let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader+    in IUF.fold (IFH.writeChunks devNull) readEx inh++#ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch]+#else+inspect $ hasNoTypeClasses 'readChunksBracket_+#endif+#endif++readChunksBracket :: Handle -> Handle -> IO ()+readChunksBracket inh devNull =+    let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader+    in IUF.fold (IFH.writeChunks devNull) readEx inh++o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]+o_1_space_copy_exceptions_readChunks env =+    [ bgroup "exceptions/readChunks"+        [ mkBench "UF.onException" env $ \inH _ ->+            readChunksOnException inH (nullH env)+        , mkBench "UF.bracket_" env $ \inH _ ->+            readChunksBracket_ inH (nullH env)+        , mkBench "UF.bracket" env $ \inH _ ->+            readChunksBracket inH (nullH env)+        ]+    ]++-------------------------------------------------------------------------------+-- Exceptions toChunks+-------------------------------------------------------------------------------++-- | Send the file contents to /dev/null with exception handling+toChunksBracket_ :: Handle -> Handle -> IO ()+toChunksBracket_ inh devNull =+    let readEx = bracketUnsafe+            (return ())+            (\_ -> hClose inh)+            (\_ -> fromStreamD $ IFH.readChunks inh)+    in Stream.fold (IFH.writeChunks devNull) readEx++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'toChunksBracket_+#endif++toChunksBracket :: Handle -> Handle -> IO ()+toChunksBracket inh devNull =+    let readEx = Stream.bracket+            (return ())+            (\_ -> hClose inh)+            (\_ -> fromStreamD $ IFH.readChunks inh)+    in Stream.fold (IFH.writeChunks devNull) readEx++o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]+o_1_space_copy_exceptions_toChunks env =+    [ bgroup "exceptions/toChunks"+        [ mkBench "Stream.bracket_" env $ \inH _ ->+            toChunksBracket_ inH (nullH env)+        , mkBench "Stream.bracket" env $ \inH _ ->+            toChunksBracket inH (nullH env)+        ]+    ]++benchmarks :: String -> BenchEnv -> Int -> [Benchmark]+benchmarks moduleName _env size =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_serial_exceptions size+            , o_1_space_copy_exceptions_readChunks _env+            , o_1_space_copy_exceptions_toChunks _env+            , o_1_space_copy_stream_exceptions _env+            ]+        ]
+ benchmark/Streamly/Benchmark/Data/Stream/Expand.hs view
@@ -0,0 +1,734 @@+-- |+-- Module      : Stream.Expand+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++#ifdef USE_PRELUDE+#endif++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Stream.Expand (benchmarks) where++#ifdef INSPECTION+import GHC.Types (SPEC(..))+import Test.Inspection++import qualified Streamly.Internal.Data.Stream as D+#endif++import qualified Stream.Common as Common+import qualified Streamly.Internal.Data.Unfold as UF++#ifdef USE_PRELUDE+import qualified Streamly.Internal.Data.Stream.IsStream as S+import Streamly.Benchmark.Prelude+    ( sourceFoldMapM, sourceFoldMapWith, sourceFoldMapWithM+    , sourceFoldMapWithStream, concatFoldableWith, concatForFoldableWith)+#else+import Streamly.Data.Stream (Stream)+import Streamly.Data.Unfold (Unfold)+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.StreamK as StreamK+#endif++import Test.Tasty.Bench+import Stream.Common+import Streamly.Benchmark.Common+import Prelude hiding (concatMap)++-------------------------------------------------------------------------------+-- Multi-Stream+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Appending+-------------------------------------------------------------------------------++{-# INLINE serial2 #-}+serial2 :: Int -> Int -> IO ()+serial2 count n =+    drain $+        Common.append+            (sourceUnfoldrM count n)+            (sourceUnfoldrM count (n + 1))++{-# INLINE serial4 #-}+serial4 :: Int -> Int -> IO ()+serial4 count n =+    drain $+    Common.append+        (Common.append+            (sourceUnfoldrM count n)+            (sourceUnfoldrM count (n + 1)))+        (Common.append+              (sourceUnfoldrM count (n + 2))+              (sourceUnfoldrM count (n + 3)))++o_1_space_joining :: Int -> [Benchmark]+o_1_space_joining value =+    [ bgroup "joining"+        [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))+        , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))+        ]+    ]++-------------------------------------------------------------------------------+-- Concat Foldable containers+-------------------------------------------------------------------------------++#ifdef USE_PRELUDE+o_1_space_concatFoldable :: Int -> [Benchmark]+o_1_space_concatFoldable value =+    [ bgroup "concat-foldable"+        [ benchIOSrc "foldMapWith (<>) (List)"+            (sourceFoldMapWith value)+        , benchIOSrc "foldMapWith (<>) (Stream)"+            (sourceFoldMapWithStream value)+        , benchIOSrc "foldMapWithM (<>) (List)"+            (sourceFoldMapWithM value)+        , benchIOSrc "S.concatFoldableWith (<>) (List)"+            (concatFoldableWith value)+        , benchIOSrc "S.concatForFoldableWith (<>) (List)"+            (concatForFoldableWith value)+        , benchIOSrc "foldMapM (List)" (sourceFoldMapM value)+        ]+    ]+#endif++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++-- concatMap unfoldrM/unfoldrM++{-# INLINE concatMap #-}+concatMap :: Int -> Int -> Int -> IO ()+concatMap outer inner n =+    drain $ S.concatMap+        (\_ -> sourceUnfoldrM inner n)+        (sourceUnfoldrM outer n)++{-# INLINE concatMapViaUnfoldEach #-}+concatMapViaUnfoldEach :: Int -> Int -> Int -> IO ()+concatMapViaUnfoldEach outer inner n =+    drain $ cmap+        (\_ -> sourceUnfoldrM inner n)+        (sourceUnfoldrM outer n)++    where++    cmap f = Stream.unfoldEach (UF.lmap f UF.fromStream)++{-# INLINE concatMapM #-}+concatMapM :: Int -> Int -> Int -> IO ()+concatMapM outer inner n =+    drain $ S.concatMapM+        (\_ -> return $ sourceUnfoldrM inner n)+        (sourceUnfoldrM outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMap+inspect $ 'concatMap `hasNoType` ''SPEC+#endif++-- concatMap unfoldr/unfoldr++{-# INLINE concatMapPure #-}+concatMapPure :: Int -> Int -> Int -> IO ()+concatMapPure outer inner n =+    drain $ S.concatMap+        (\_ -> sourceUnfoldr inner n)+        (sourceUnfoldr outer n)++#ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]+#else+inspect $ hasNoTypeClasses 'concatMapPure+#endif+inspect $ 'concatMapPure `hasNoType` ''SPEC+#endif++{-# INLINE sourceUnfoldrMUnfold #-}+sourceUnfoldrMUnfold :: Monad m => Int -> Int -> Unfold m Int Int+sourceUnfoldrMUnfold size start = UF.unfoldrM step++    where++    step i =+        return+            $ if i < start + size+              then Just (i, i + 1)+              else Nothing++{-# INLINE unfoldEach #-}+unfoldEach :: Int -> Int -> Int -> IO ()+unfoldEach outer inner start = drain $+     -- XXX the replicateM takes much more time compared to unfoldrM, is there+     -- a perf issue or this is just because of accessing outer loop variables?+     -- S.unfoldEach (UF.lmap ((inner,) . return) UF.replicateM)+     S.unfoldEach (sourceUnfoldrMUnfold inner start)+        $ sourceUnfoldrM outer start++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'unfoldEach+inspect $ 'unfoldEach `hasNoType` ''D.ConcatMapUState+inspect $ 'unfoldEach `hasNoType` ''SPEC+#endif++{-# INLINE unfoldEach2 #-}+unfoldEach2 :: Int -> Int -> Int -> IO ()+unfoldEach2 outer inner start = drain $+     S.unfoldEach (UF.carry (sourceUnfoldrMUnfold inner start))+        $ sourceUnfoldrM outer start++{-# INLINE unfoldEach3 #-}+unfoldEach3 :: Int -> Int -> IO ()+unfoldEach3 linearCount start = drain $ do+    S.unfoldEach (UF.carry (UF.lmap snd (sourceUnfoldrMUnfold nestedCount3 start)))+         $ S.unfoldEach (UF.carry (sourceUnfoldrMUnfold nestedCount3 start))+            $ sourceUnfoldrM nestedCount3 start+    where++    nestedCount3 = round (fromIntegral linearCount**(1/3::Double))++{-# INLINE unfoldCross #-}+unfoldCross :: Int -> Int -> Int -> IO ()+unfoldCross outer inner start = drain $+    Stream.unfoldCross+        UF.identity+        (sourceUnfoldrM outer start)+        (sourceUnfoldrM inner start)++o_1_space_concat :: Int -> [Benchmark]+o_1_space_concat value = sqrtVal `seq`+    [ bgroup "concat"+        [ benchIOSrc1 "concatMapPure outer=Max inner=1"+            (concatMapPure value 1)+        , benchIOSrc1 "concatMapPure outer=inner=(sqrt Max)"+            (concatMapPure sqrtVal sqrtVal)+        , benchIOSrc1 "concatMapPure outer=1 inner=Max"+            (concatMapPure 1 value)++        , benchIOSrc1 "concatMap outer=max inner=1"+            (concatMap value 1)+        , benchIOSrc1 "concatMap outer=inner=(sqrt Max)"+            (concatMap sqrtVal sqrtVal)+        , benchIOSrc1 "concatMap outer=1 inner=Max"+            (concatMap 1 value)++        -- This is for comparison with foldMapWith+        , benchIOSrc "concatMapId outer=max inner=1 (fromFoldable)"+            (S.concatMap id . sourceConcatMapId value)++        , benchIOSrc1 "concatMapM outer=max inner=1"+            (concatMapM value 1)+        , benchIOSrc1 "concatMapM outer=inner=(sqrt Max)"+            (concatMapM sqrtVal sqrtVal)+        , benchIOSrc1 "concatMapM outer=1 inner=Max"+            (concatMapM 1 value)++        , benchIOSrc1 "concatMapViaUnfoldEach outer=max inner=1"+            (concatMapViaUnfoldEach value 1)+        , benchIOSrc1 "concatMapViaUnfoldEach outer=inner=(sqrt Max)"+            (concatMapViaUnfoldEach sqrtVal sqrtVal)+        , benchIOSrc1 "concatMapViaUnfoldEach outer=1 inner=Max"+            (concatMapViaUnfoldEach 1 value)++        , benchIOSrc1 "unfoldCross outer=max inner=1"+            (unfoldCross value 1)+        , benchIOSrc1 "unfoldCross outer=inner=(sqrt Max)"+            (unfoldCross sqrtVal sqrtVal)+        , benchIOSrc1 "unfoldCross outer=1 inner=Max"+            (unfoldCross 1 value)++        -- concatMap vs unfoldEach+        , benchIOSrc1 "unfoldEach outer=Max inner=1"+            (unfoldEach value 1)+        , benchIOSrc1 "unfoldEach outer=inner=(sqrt Max)"+            (unfoldEach sqrtVal sqrtVal)+        , benchIOSrc1 "unfoldEach outer=1 inner=Max"+            (unfoldEach 1 value)++        , benchIOSrc1 "unfoldEach2 outer=Max inner=1"+            (unfoldEach2 value 1)+        , benchIOSrc1 "unfoldEach2 outer=inner=(sqrt Max)"+            (unfoldEach2 sqrtVal sqrtVal)+        , benchIOSrc1 "unfoldEach2 outer=1 inner=Max"+            (unfoldEach2 1 value)++        , benchIOSrc1 "unfoldEach3 outer=inner=(cubert Max)"+            (unfoldEach3 value)+        ]+    ]++    where++    sqrtVal = round $ sqrt (fromIntegral value :: Double)++-------------------------------------------------------------------------------+-- Applicative+-------------------------------------------------------------------------------++{-# INLINE cross2 #-}+cross2 :: MonadAsync m => Int -> Int -> m ()+cross2 linearCount start = drain $+    Stream.crossWith (+)+        (sourceUnfoldr nestedCount2 start)+        (sourceUnfoldr nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++o_1_space_applicative :: Int -> [Benchmark]+o_1_space_applicative value =+    [ bgroup "Applicative"+        [ benchIO "(*>)" $ apDiscardFst value+        , benchIO "(<*)" $ apDiscardSnd value+        , benchIO "(<*>)" $ toNullAp value+        , benchIO "liftA2" $ apLiftA2 value+        , benchIO "pureDrain2" $ toNullApPure value+        , benchIO "pureCross2" $ cross2 value+        ]+    ]++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++o_1_space_monad :: Int -> [Benchmark]+o_1_space_monad value =+    [ bgroup "Monad"+        [ benchIO "then2" $ monadThen value+        , benchIO "drain2" $ toNullM value+        , benchIO "drain3" $ toNullM3 value+        , benchIO "filterAllOut2" $ filterAllOutM value+        , benchIO "filterAllIn2" $ filterAllInM value+        , benchIO "filterSome2" $ filterSome value+        , benchIO "breakAfterSome2" $ breakAfterSome value+        , benchIO "pureDrain2" $ toNullMPure value+        , benchIO "pureDrain3" $ toNullM3Pure value+        , benchIO "pureFilterAllIn2" $ filterAllInMPure value+        , benchIO "pureFilterAllOut2" $ filterAllOutMPure value+        ]+    ]++o_n_space_monad :: Int -> [Benchmark]+o_n_space_monad value =+    [ bgroup "Monad"+        [ benchIO "toList2" $ toListM value+        , benchIO "toListSome2" $ toListSome value+        ]+    ]++{-# INLINE drainConcatFor1 #-}+drainConcatFor1 :: Monad m => Stream m Int -> m ()+drainConcatFor1 s = drain $ do+    Stream.concatFor s $ \x ->+            Stream.fromPure $ x + 1++{-# INLINE drainConcatFor #-}+drainConcatFor :: Monad m => Stream m Int -> m ()+drainConcatFor s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            Stream.fromPure $ x + y++{-# INLINE drainConcatForM #-}+drainConcatForM :: Monad m => Stream m Int -> m ()+drainConcatForM s = drain $ do+    Stream.concatForM s $ \x ->+        pure $ Stream.concatForM s $ \y ->+            pure $ Stream.fromPure $ x + y++{-# INLINE drainConcatFor3 #-}+drainConcatFor3 :: Monad m => Stream m Int -> m ()+drainConcatFor3 s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            Stream.concatFor s $ \z ->+                Stream.fromPure $ x + y + z++{-# INLINE drainConcatFor4 #-}+drainConcatFor4 :: Monad m => Stream m Int -> m ()+drainConcatFor4 s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            Stream.concatFor s $ \z ->+                Stream.concatFor s $ \w ->+                    Stream.fromPure $ x + y + z + w++{-# INLINE drainConcatFor5 #-}+drainConcatFor5 :: Monad m => Stream m Int -> m ()+drainConcatFor5 s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            Stream.concatFor s $ \z ->+                Stream.concatFor s $ \w ->+                    Stream.concatFor s $ \u ->+                        Stream.fromPure $ x + y + z + w + u++{-# INLINE drainConcatFor3M #-}+drainConcatFor3M :: Monad m => Stream m Int -> m ()+drainConcatFor3M s = drain $ do+    Stream.concatForM s $ \x ->+        pure $ Stream.concatForM s $ \y ->+            pure $ Stream.concatForM s $ \z ->+                pure $ Stream.fromPure $ x + y + z++{-# INLINE filterAllInConcatFor #-}+filterAllInConcatFor+    :: Monad m+    => Stream m Int -> m ()+filterAllInConcatFor s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            let s1 = x + y+             in if s1 > 0+                then Stream.fromPure s1+                else Stream.nil++{-# INLINE filterAllOutConcatFor #-}+filterAllOutConcatFor+    :: Monad m+    => Stream m Int -> m ()+filterAllOutConcatFor s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            let s1 = x + y+             in if s1 < 0+                then Stream.fromPure s1+                else Stream.nil++o_1_space_bind :: Int -> [Benchmark]+o_1_space_bind streamLen =+    [ bgroup "concatFor"+        [ benchFold "drain1" drainConcatFor1   (sourceUnfoldrM streamLen)+        , benchFold "drain2" drainConcatFor   (sourceUnfoldrM streamLen2)+        , benchFold "drain3" drainConcatFor3   (sourceUnfoldrM streamLen3)+        , benchFold "drain4" drainConcatFor4   (sourceUnfoldrM streamLen4)+        , benchFold "drain5" drainConcatFor5   (sourceUnfoldrM streamLen5)+        , benchFold "drainM2" drainConcatForM   (sourceUnfoldrM streamLen2)+        , benchFold "drainM3" drainConcatFor3M   (sourceUnfoldrM streamLen3)+        , benchFold "filterAllIn2"  filterAllInConcatFor  (sourceUnfoldrM streamLen2)+        , benchFold "filterAllOut2" filterAllOutConcatFor (sourceUnfoldrM streamLen2)+        ]+    ]++    where++    streamLen2 = round (fromIntegral streamLen**(1/2::Double)) -- double nested loop+    streamLen3 = round (fromIntegral streamLen**(1/3::Double)) -- triple nested loop+    streamLen4 = round (fromIntegral streamLen**(1/4::Double)) -- 4 times nested loop+    streamLen5 = round (fromIntegral streamLen**(1/5::Double)) -- 5 times nested loop++-- search space |x| = 1000, |y| = 1000+{-# INLINE boundedInts #-}+boundedInts :: Monad m => Int -> Int -> Stream m Int+boundedInts n _ =+    Stream.interleave+        (Stream.enumerateFromTo (0 :: Int) n)+        (Stream.enumerateFromThenTo (-1) (-2) (-n))++{-# INLINE infiniteInts #-}+infiniteInts :: Monad m => Int -> Int -> Stream m Int+infiniteInts _ _ =+    Stream.interleave+        (Stream.enumerateFrom (0 :: Int))+        (Stream.enumerateFromThen (-1) (-2))++{-# INLINE boundedIntsUnfold #-}+boundedIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int+boundedIntsUnfold n _ =+    Unfold.interleave+        (Unfold.supply (0 :: Int, n) Unfold.enumerateFromTo)+        (Unfold.supply (-1, -2, -n) Unfold.enumerateFromThenTo)++{-# INLINE infiniteIntsUnfold #-}+infiniteIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int+infiniteIntsUnfold _ _ =+    Unfold.interleave+        (Unfold.supply (0 :: Int) Unfold.enumerateFrom)+        (Unfold.supply (-1, -2) Unfold.enumerateFromThen)++{-# INLINE checkStream #-}+checkStream :: Applicative m =>+    Int -> Int -> Stream m (Maybe (Maybe (Int, Int)))+checkStream x y =+    let eq1 = x + y == 0+        eq2 = x - y == 1994+     in if eq1 && eq2+        then Stream.fromPure (Just (Just (x,y)))+        else if abs x > 1000 && abs y > 1000+        then Stream.fromPure (Just Nothing)+        else Stream.fromPure Nothing++{-# INLINE checkStreamK #-}+checkStreamK :: Int -> Int -> StreamK.StreamK m (Maybe (Maybe (Int, Int)))+checkStreamK x y =+    let eq1 = x + y == 0+        eq2 = x - y == 1994+     in if eq1 && eq2+        then StreamK.fromPure (Just (Just (x,y)))+        else if abs x > 1000 && abs y > 1000+        then StreamK.fromPure (Just Nothing)+        else StreamK.fromPure Nothing++{-# INLINE checkPair #-}+checkPair :: Monad m => (Int, Int) -> m (Maybe (Maybe (Int, Int)))+checkPair (x, y) =+    let eq1 = x + y == 0+        eq2 = x - y == 1994+     in if eq1 && eq2+        then pure (Just (Just (x,y)))+        else if abs x > 1000 && abs y > 1000+        then pure (Just Nothing)+        else pure Nothing++result :: Monad m => Stream m (Maybe a) -> m ()+result = Stream.fold (Fold.take 1 Fold.drain) . Stream.catMaybes++fairConcatForEqn :: Monad m => Stream m Int -> m ()+fairConcatForEqn input =+    result+        $ Stream.fairConcatFor input $ \x ->+              Stream.fairConcatForM input $ \y -> do+                return $ checkStream x y++fairConcatForEqnK :: Monad m => Stream m Int -> m ()+fairConcatForEqnK input =+    let inputK = StreamK.fromStream input+    in result+        $ StreamK.toStream+        $ StreamK.fairConcatFor inputK $ \x ->+              StreamK.fairConcatForM inputK $ \y -> do+                return $ checkStreamK x y++concatForEqn :: Monad m => Stream m Int -> m ()+concatForEqn input =+    result+        $ Stream.concatFor input $ \x ->+              Stream.concatForM input $ \y -> do+                return $ checkStream x y++fairSchedForEqn :: Monad m => Stream m Int -> m ()+fairSchedForEqn input =+    result+        $ Stream.fairSchedFor input $ \x ->+              Stream.fairSchedForM input $ \y -> do+                return $ checkStream x y++_schedForEqn :: Monad m => Stream m Int -> m ()+_schedForEqn input =+    result+        $ Stream.schedFor input $ \x ->+              Stream.schedForM input $ \y -> do+                return $ checkStream x y++streamCrossEqn :: Monad m => Stream m Int -> m ()+streamCrossEqn input =+    result+        $ Stream.mapM checkPair+        $ Stream.cross input input++fairStreamCrossEqn :: Monad m => Stream m Int -> m ()+fairStreamCrossEqn input =+    result+        $ Stream.mapM checkPair+        $ Stream.fairCross input input++unfoldCrossEqn :: Monad m => Unfold m ((), ()) Int -> m ()+unfoldCrossEqn input =+    result+        $ Stream.mapM checkPair+        $ Stream.unfold (Unfold.cross input input) (undefined, undefined)++fairUnfoldCrossEqn :: Monad m => Unfold m ((), ()) Int -> m ()+fairUnfoldCrossEqn input =+    result+        $ Stream.mapM checkPair+        $ Stream.unfold (Unfold.fairCross input input) (undefined, undefined)++unfoldEachEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()+unfoldEachEqn input ints =+    let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input+     in result+        $ Stream.mapM checkPair+        $ Stream.unfoldEach intu ints++fairUnfoldEachEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()+fairUnfoldEachEqn input ints =+    let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input+     in result+        $ Stream.mapM checkPair+        $ Stream.fairUnfoldEach intu ints++unfoldSchedEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()+unfoldSchedEqn input ints =+    let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input+     in result+        $ Stream.mapM checkPair+        $ Stream.unfoldSched intu ints++fairUnfoldSchedEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()+fairUnfoldSchedEqn input ints =+    let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input+     in result+        $ Stream.mapM checkPair+        $ Stream.fairUnfoldSched intu ints++-- Solve simultaneous equations by exploring all possibilities+o_1_space_equations :: Int -> [Benchmark]+o_1_space_equations _ =+    [ bgroup "equations"+        [ benchFold "concatFor (bounded)" concatForEqn (boundedInts 1000)+        , benchFold "fairConcatFor (bounded)"+            fairConcatForEqn (boundedInts 1000)+        , benchFold "fairConcatForK (bounded)"+            fairConcatForEqnK (boundedInts 1000)+        , benchFold "fairConcatFor (infinite)"+            fairConcatForEqn (infiniteInts 1000)+        , benchFold "fairSchedFor (bounded)"+            fairSchedForEqn (boundedInts 1000)+        , benchFold "fairSchedFor (infinite)"+            fairSchedForEqn (infiniteInts 1000)+        , benchFold "streamCross (bounded)"+            streamCrossEqn (boundedInts 1000)+        , benchFold "fairStreamCross (bounded)"+            fairStreamCrossEqn (boundedInts 1000)+        , benchFold "fairStreamCross (infinite)"+            fairStreamCrossEqn (infiniteInts 1000)+        , bench "unfoldCross (bounded)"+            $ nfIO $ unfoldCrossEqn (boundedIntsUnfold 1000 0)+        , bench "fairUnfoldCross (bounded)"+            $ nfIO $ fairUnfoldCrossEqn (boundedIntsUnfold 1000 0)+        , bench "fairUnfoldCross (infinite)"+            $ nfIO $ fairUnfoldCrossEqn (infiniteIntsUnfold 1000 0)+        , benchFold "unfoldEach (bounded)"+            (unfoldEachEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)+        , benchFold "fairUnfoldEach (bounded)"+            (fairUnfoldEachEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)+        , benchFold "fairUnfoldEach (infinite)"+            (fairUnfoldEachEqn (infiniteIntsUnfold 1000 0)) (infiniteInts 1000)+        , benchFold "unfoldSched (bounded)"+            (unfoldSchedEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)+        , benchFold "fairUnfoldSched (bounded)"+            (fairUnfoldSchedEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)+        , benchFold "fairUnfoldSched (infinite)"+            (fairUnfoldSchedEqn (infiniteIntsUnfold 1000 0)) (infiniteInts 1000)+        ]+    ]++-------------------------------------------------------------------------------+-- Joining+-------------------------------------------------------------------------------++{-+toKv :: Int -> (Int, Int)+toKv p = (p, p)++{-# INLINE joinWith #-}+joinWith :: Common.MonadAsync m =>+       ((Int -> Int -> Bool) -> Stream m Int -> Stream m Int -> Stream m b)+    -> Int+    -> Int+    -> m ()+joinWith j val i =+    drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))++{-# INLINE joinMapWith #-}+joinMapWith :: Common.MonadAsync m =>+       (Stream m (Int, Int) -> Stream m (Int, Int) -> Stream m b)+    -> Int+    -> Int+    -> m ()+joinMapWith j val i =+    drain+        $ j+            (fmap toKv (sourceUnfoldrM val i))+            (fmap toKv (sourceUnfoldrM val (val `div` 2)))++o_n_heap_buffering :: Int -> [Benchmark]+o_n_heap_buffering value =+    [ bgroup "buffered"+        [+          benchIOSrc1 "joinInnerGeneric (sqrtVal)"+            $ joinWith S.joinInnerGeneric sqrtVal+        , benchIOSrc1 "joinInner"+            $ joinMapWith S.joinInner halfVal+        , benchIOSrc1 "joinLeftGeneric (sqrtVal)"+            $ joinWith S.joinLeftGeneric sqrtVal+        , benchIOSrc1 "joinLeft "+            $ joinMapWith S.joinLeft halfVal+        , benchIOSrc1 "joinOuterGeneric (sqrtVal)"+            $ joinWith S.joinOuterGeneric sqrtVal+        , benchIOSrc1 "joinOuter"+            $ joinMapWith S.joinOuter halfVal+        , benchIOSrc1 "filterInStreamGenericBy (sqrtVal)"+            $ joinWith S.filterInStreamGenericBy sqrtVal+        , benchIOSrc1 "filterInStreamAscBy"+            $ joinMapWith (S.filterInStreamAscBy compare) halfVal+        -- Note: schedFor does a bfs scheduling, therefore, can take a lot of+        -- memory.+        , benchFold "schedFor (bounded)" schedForEqn (boundedInts 1000)+        ]+    ]++    where++    halfVal = value `div` 2+    sqrtVal = round $ sqrt (fromIntegral value :: Double)+-}++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+{-# ANN benchmarks "HLint: ignore" #-}+benchmarks :: String -> Int -> [Benchmark]+benchmarks moduleName size =+        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat+            [+            -- multi-stream+              o_1_space_joining size+#ifdef USE_PRELUDE+            , o_1_space_concatFoldable size+#endif+            , o_1_space_concat size+            , o_1_space_applicative size+            , o_1_space_monad size+            , o_1_space_bind size+            , o_1_space_equations size+            ]+        , bgroup (o_n_space_prefix moduleName) $ Prelude.concat+            [+            -- multi-stream+              o_n_space_monad size+            ]+       {-+       , bgroup (o_n_heap_prefix moduleName) $+            -- multi-stream+            o_n_heap_buffering size+       -}+        ]
+ benchmark/Streamly/Benchmark/Data/Stream/Generate.hs view
@@ -0,0 +1,250 @@+-- |+-- Module      : Stream.Generate+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++{-# OPTIONS_GHC -Wno-orphans #-}+#ifdef USE_PRELUDE+#endif++module Stream.Generate (benchmarks) where++import Control.DeepSeq (NFData(..))+import Data.Functor.Identity (Identity(..))++import qualified GHC.Exts as GHC+import qualified Streamly.Internal.Data.Fold as Fold++#ifdef USE_PRELUDE+import Streamly.Prelude (MonadAsync)+import Stream.Common hiding (MonadAsync)+import Streamly.Benchmark.Prelude (sourceFromFoldableM, absTimes)+import qualified Streamly.Prelude as S+import qualified Streamly.Internal.Data.Stream.IsStream as Stream+#else+import Stream.Common+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as Stream+#endif++import Test.Tasty.Bench+import Streamly.Benchmark.Common+import qualified Prelude++import Prelude hiding (repeat, replicate, iterate)++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++#ifdef USE_PRELUDE+type Stream = Stream.SerialT+toStreamD = Stream.toStream+#else+toStreamD :: a -> a+toStreamD = id+#endif++-------------------------------------------------------------------------------+-- fromList+-------------------------------------------------------------------------------++{-# INLINE sourceFromList #-}+sourceFromList :: Monad m => Int -> Int -> Stream m Int+sourceFromList value n = Stream.fromList [n..n+value]++{-# INLINE sourceFromListM #-}+sourceFromListM :: MonadAsync m => Int -> Int -> Stream m Int+sourceFromListM value n = fromListM (fmap return [n..n+value])++{-# INLINE sourceIsList #-}+sourceIsList :: Int -> Int -> Stream Identity Int+sourceIsList value n = GHC.fromList [n..n+value]++{-# INLINE sourceIsString #-}+sourceIsString :: Int -> Int -> Stream Identity Char+sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')++{-# INLINE readInstance #-}+readInstance :: String -> Stream Identity Int+readInstance str =+    let r = reads str+    in case r of+        [(x,"")] -> x+        _ -> error "readInstance: no parse"++-- For comparisons+{-# INLINE readInstanceList #-}+readInstanceList :: String -> [Int]+readInstanceList str =+    let r = reads str+    in case r of+        [(x,"")] -> x+        _ -> error "readInstance: no parse"++{-# INLINE repeat #-}+repeat :: Monad m => Int -> Int -> Stream m Int+repeat count = Stream.take count . Stream.repeat++{-# INLINE replicate #-}+replicate :: Monad m => Int -> Int -> Stream m Int+replicate = Stream.replicate++-------------------------------------------------------------------------------+-- enumerate+-------------------------------------------------------------------------------++{-# INLINE sourceIntFromTo #-}+sourceIntFromTo :: Monad m => Int -> Int -> Stream m Int+sourceIntFromTo value n = Stream.enumerateFromTo n (n + value)++{-# INLINE sourceIntFromThenTo #-}+sourceIntFromThenTo :: Monad m => Int -> Int -> Stream m Int+sourceIntFromThenTo value n = Stream.enumerateFromThenTo n (n + 1) (n + value)++{-# INLINE sourceFracFromTo #-}+sourceFracFromTo :: Monad m => Int -> Int -> Stream m Double+sourceFracFromTo value n =+    Stream.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))++{-# INLINE sourceFracFromThenTo #-}+sourceFracFromThenTo :: Monad m => Int -> Int -> Stream m Double+sourceFracFromThenTo value n = Stream.enumerateFromThenTo (fromIntegral n)+    (fromIntegral n + 1.0001) (fromIntegral (n + value))++{-# INLINE sourceIntegerFromStep #-}+sourceIntegerFromStep :: Monad m => Int -> Int -> Stream m Integer+sourceIntegerFromStep value n =+    Stream.take value $ Stream.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)++{-# INLINE enumerateFrom #-}+enumerateFrom :: Monad m => Int -> Int -> Stream m Int+enumerateFrom count = Stream.take count . Stream.enumerateFrom++{-# INLINE enumerateFromTo #-}+enumerateFromTo :: Monad m => Int -> Int -> Stream m Int+enumerateFromTo = sourceIntFromTo++{-# INLINE enumerateFromThen #-}+enumerateFromThen :: Monad m => Int -> Int -> Stream m Int+enumerateFromThen count inp = Stream.take count $ Stream.enumerateFromThen inp (inp + 1)++{-# INLINE enumerateFromThenTo #-}+enumerateFromThenTo :: Monad m => Int -> Int -> Stream m Int+enumerateFromThenTo = sourceIntFromThenTo++-- n ~ 1+{-# INLINE enumerate #-}+enumerate :: Monad m => Int -> Int -> Stream m Int+enumerate count n = Stream.take (count + n) Stream.enumerate++-- n ~ 1+{-# INLINE enumerateTo #-}+enumerateTo :: Monad m => Int -> Int -> Stream m Int+enumerateTo count n = Stream.enumerateTo (minBound + count + n)++{-# INLINE iterate #-}+iterate :: Monad m => Int -> Int -> Stream m Int+iterate count = Stream.take count . Stream.iterate (+1)++{-# INLINE iterateM #-}+iterateM :: MonadAsync m => Int -> Int -> Stream m Int+iterateM count = Stream.take count . Stream.iterateM (return . (+1)) . return++{-# INLINE repeatM #-}+repeatM :: MonadAsync m => Int -> Int -> Stream m Int+repeatM count = Stream.take count . Stream.repeatM . return++{-# INLINE replicateM #-}+replicateM :: MonadAsync m => Int -> Int -> Stream m Int+replicateM count = Stream.replicateM count . return++#ifdef USE_PRELUDE+{-# INLINE fromIndices #-}+fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int+fromIndices value n = S.take value $ S.fromIndices (+ n)++{-# INLINE fromIndicesM #-}+fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int+fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))+#endif++o_1_space_generation :: Int -> [Benchmark]+o_1_space_generation value =+    [ bgroup "generation"+        [ benchIOSrc "unfoldr" (sourceUnfoldr value)+        , benchIOSrc "unfoldrM" (sourceUnfoldrM value)+        , benchIOSrc "repeat" (repeat value)+        , benchIOSrc "replicate" (replicate value)+        , benchIOSrc "iterate" (iterate value)+        , benchIOSrc "iterateM" (iterateM value)+        , benchIOSrc "intFromTo" (sourceIntFromTo value)+        , benchIOSrc "intFromThenTo" (sourceIntFromThenTo value)+        , benchIOSrc "integerFromStep" (sourceIntegerFromStep value)+        , benchIOSrc "fracFromThenTo" (sourceFracFromThenTo value)+        , benchIOSrc "fracFromTo" (sourceFracFromTo value)+        , benchIOSrc "fromList" (sourceFromList value)+        , benchIOSrc "fromListM" (sourceFromListM value)+        , benchPureSrc "IsList.fromList" (toStreamD . sourceIsList value)+        , benchPureSrc "IsString.fromString" (toStreamD . sourceIsString value)+        , benchIOSrc "enumerateFrom" (enumerateFrom value)+        , benchIOSrc "enumerateFromTo" (enumerateFromTo value)+        , benchIOSrc "enumerateFromThen" (enumerateFromThen value)+        , benchIOSrc "enumerateFromThenTo" (enumerateFromThenTo value)+        , benchIOSrc "enumerate" (enumerate value)+        , benchIOSrc "enumerateTo" (enumerateTo value)+        , benchIOSrc "repeatM" (repeatM value)+        , benchIOSrc "replicateM" (replicateM value)+#ifdef USE_PRELUDE+        , benchIOSrc "fromIndices" (fromIndices value)+        , benchIOSrc "fromIndicesM" (fromIndicesM value)+#endif++        -- These essentially test cons and consM+        -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16)++#ifdef USE_PRELUDE+        , benchIOSrc "fromFoldableM" (sourceFromFoldableM value)+        , benchIOSrc "absTimes" $ absTimes value+#endif+        ]+    ]++#ifndef USE_PRELUDE+instance NFData a => NFData (Stream Identity a) where+    {-# INLINE rnf #-}+    rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs+#endif++o_n_heap_generation :: Int -> [Benchmark]+o_n_heap_generation value =+    [ bgroup "buffered"+    -- Buffers the output of show/read.+    -- XXX can the outputs be streaming? Can we have special read/show+    -- style type classes, readM/showM supporting streaming effects?+        [ bench "readsPrec pure streams" $+          nf readInstance (mkString value)+        , bench "readsPrec Haskell lists" $+          nf readInstanceList (mkListString value)+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+benchmarks :: String -> Int -> [Benchmark]+benchmarks moduleName size =+        [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)+        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)+        ]
+ benchmark/Streamly/Benchmark/Data/Stream/Lift.hs view
@@ -0,0 +1,99 @@+-- |+-- Module      : Stream.Lift+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++#ifdef USE_PRELUDE+#endif++module Stream.Lift (benchmarks) where++import Control.DeepSeq (NFData(..))+import Control.Monad.State.Strict (StateT, get, put)+import Data.Functor.Identity (Identity)+import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc)+import System.Random (randomRIO)++import qualified Stream.Common as Common+import qualified Streamly.Internal.Data.Fold as Fold++#ifdef USE_PRELUDE+import qualified Streamly.Internal.Data.Stream.IsStream as Stream+#else+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as Stream+#endif++import Test.Tasty.Bench+import Streamly.Benchmark.Common+import Prelude hiding (reverse, tail)++#ifdef USE_PRELUDE+type Stream = Stream.SerialT+#endif++-------------------------------------------------------------------------------+-- Monad transformation (hoisting etc.)+-------------------------------------------------------------------------------++{-# INLINE sourceUnfoldrState #-}+sourceUnfoldrState :: Common.MonadAsync m =>+    Int -> Int -> Stream (StateT Int m) Int+sourceUnfoldrState value n = Stream.unfoldrM step n+    where+    step cnt =+        if cnt > n + value+        then return Nothing+        else do+            s <- get+            put (s + 1)+            return (Just (s, cnt + 1))++{-# INLINE evalStateT #-}+evalStateT :: Common.MonadAsync m => Int -> Int -> Stream m Int+evalStateT value n =+    Stream.evalStateT (return 0) (sourceUnfoldrState value n)++{-# INLINE withState #-}+withState :: Common.MonadAsync m => Int -> Int -> Stream m Int+withState value n =+    Stream.evalStateT+        (return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n))++{-# INLINE benchHoistSink #-}+benchHoistSink+    :: (NFData b)+    => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark+benchHoistSink value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f .  sourceUnfoldr value++o_1_space_hoisting :: Int -> [Benchmark]+o_1_space_hoisting value =+    [ bgroup "hoisting"+        [ benchIOSrc "evalState" (evalStateT value)+        , benchIOSrc "withState" (withState value)+#ifndef USE_PRELUDE+        , benchHoistSink value "generalizeInner"+            ((\xs -> Stream.fold Fold.length xs :: IO Int)+                . Stream.generalizeInner)+#endif+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+benchmarks :: String -> Int -> [Benchmark]+benchmarks moduleName size =+        [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)+        ]
+ benchmark/Streamly/Benchmark/Data/Stream/Rate.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Stream.Common (benchIOSrc, sourceUnfoldrM)+import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Stream.Prelude (MonadAsync, Config)++import qualified Streamly.Data.Stream.Prelude as Stream++import Streamly.Benchmark.Common+import Test.Tasty.Bench++moduleName :: String+moduleName = "Data.Stream.Rate"++-------------------------------------------------------------------------------+-- Average Rate+-------------------------------------------------------------------------------++{-# INLINE rateNothing #-}+rateNothing :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Int -> Stream m Int+rateNothing f cfg value = f (Stream.rate Nothing . cfg) . sourceUnfoldrM value++{-# INLINE avgRate #-}+avgRate :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+avgRate f cfg value rt = f (Stream.avgRate rt . cfg) . sourceUnfoldrM value++{-+-- parBuffered should be maxThreads 1 anyway+{-# INLINE avgRateThreads1 #-}+avgRateThreads1 :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+avgRateThreads1 f cfg value rt =+    f (Stream.maxThreads 1 . Stream.avgRate rt . cfg) . sourceUnfoldrM value+-}++{-# INLINE minRate #-}+minRate :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+minRate f cfg value rt = f (Stream.minRate rt . cfg) . sourceUnfoldrM value++{-# INLINE maxRate #-}+maxRate :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+maxRate f cfg value rt = f (Stream.minRate rt . cfg) . sourceUnfoldrM value++{-# INLINE constRate #-}+constRate :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+constRate f cfg value rt = f (Stream.constRate rt . cfg) . sourceUnfoldrM value++-- XXX arbitrarily large rate should be the same as rate Nothing+-- XXX Add tests for multiworker cases as well - parMapM+o_1_space_async :: Int -> [Benchmark]+o_1_space_async value =+    [ bgroup+          "default/parBuffered"+          [ bgroup+                "avgRate"+                -- benchIO "unfoldr" $ toNull+                [ benchIOSrc "baseline" (Stream.parBuffered id . sourceUnfoldrM value)+                , benchIOSrc "Nothing" $ rateNothing Stream.parBuffered id value+                , benchIOSrc "1M" $ avgRate Stream.parBuffered id value 1000000+                , benchIOSrc "3M" $ avgRate Stream.parBuffered id value 3000000+                -- , benchIOSrc "10M/maxThreads1" $ avgRateThreads1 Stream.parBuffered value 10000000+                , benchIOSrc "10M" $ avgRate Stream.parBuffered id value 10000000+                , benchIOSrc "20M" $ avgRate Stream.parBuffered id value 20000000+                ]+          , bgroup+                "minRate"+                [ benchIOSrc "1M" $ minRate Stream.parBuffered id value 1000000+                , benchIOSrc "10M" $ minRate Stream.parBuffered id value 10000000+                , benchIOSrc "20M" $ minRate Stream.parBuffered id value 20000000+                ]+          , bgroup+                "maxRate"+                [ -- benchIOSrc "10K" $ maxRate value 10000+                  benchIOSrc "10M" $ maxRate Stream.parBuffered id value 10000000+                ]+          , bgroup+                "constRate"+                [ -- benchIOSrc "10K" $ constRate value 10000+                  benchIOSrc "1M" $ constRate Stream.parBuffered id value 1000000+                , benchIOSrc "10M" $ constRate Stream.parBuffered id value 10000000+                ]+          ]+    ]++o_1_space_ahead :: Int -> [Benchmark]+o_1_space_ahead value =+    [ bgroup+        "ordered/parBuffered"+        [ benchIOSrc "avgRate/1M"+            $ avgRate Stream.parBuffered (Stream.ordered True) value 1000000+        , benchIOSrc "minRate/1M"+            $ minRate Stream.parBuffered (Stream.ordered True) value 1000000+        , benchIOSrc "maxRate/1M"+            $ maxRate Stream.parBuffered (Stream.ordered True) value 1000000+        , benchIOSrc "constRate/1M"+            $ constRate Stream.parBuffered (Stream.ordered True) value 1000000+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName)+        $ concat [o_1_space_async value, o_1_space_ahead value]]
+ benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs view
@@ -0,0 +1,581 @@+-- |+-- Module      : Stream.Reduce+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}++#ifdef USE_PRELUDE+#endif++module Stream.Reduce (benchmarks) where++import Control.DeepSeq (NFData(..))+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Maybe (isJust)+import Data.Monoid (Sum(..))+import GHC.Generics (Generic)++import qualified Streamly.Internal.Data.Refold.Type as Refold+import qualified Streamly.Internal.Data.Fold as FL+import qualified Stream.Common as Common++#ifndef USE_STREAMLY_CORE+import Data.HashMap.Strict (HashMap)+import Data.Proxy (Proxy(..))+import Streamly.Internal.Data.IsMap.HashMap ()+#endif++#ifdef USE_PRELUDE+import qualified Streamly.Internal.Data.Stream.IsStream as S+import qualified Streamly.Prelude as S+import Streamly.Prelude (fromSerial)+import Streamly.Benchmark.Prelude hiding+    ( benchIO, benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2+    , toNullAp, monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM+    , filterSome, breakAfterSome, toListM, toListSome, transformMapM+    , transformComposeMapM, transformTeeMapM, transformZipMapM)+#else++import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as S+#ifndef USE_STREAMLY_CORE+import qualified Streamly.Data.Stream.Prelude as S+import qualified Streamly.Internal.Data.Stream.Prelude as S+#endif+#endif++import Test.Tasty.Bench+import Streamly.Benchmark.Common+import Stream.Common+import Prelude hiding (reverse, tail)++#ifdef USE_PRELUDE+type Stream = S.SerialT+#endif++-- Apply transformation g count times on a stream of length len+{-# INLINE iterateSource #-}+iterateSource ::+       MonadAsync m+    => (Stream m Int -> Stream m Int)+    -> Int+    -> Int+    -> Int+    -> Stream m Int+iterateSource g count len n = f count (sourceUnfoldrM len n)++    where++    f (0 :: Int) stream = stream+    f i stream = f (i - 1) (g stream)++-------------------------------------------------------------------------------+-- Grouping transformations+-------------------------------------------------------------------------------++{-# INLINE groups #-}+groups :: MonadIO m => Stream m Int -> m ()+groups =+#ifdef USE_PRELUDE+    Common.drain . S.groups FL.drain+#else+    Common.drain . S.groupsWhile (==) FL.drain+#endif++{-# INLINE groupsWhileLT #-}+groupsWhileLT :: MonadIO m => Stream m Int -> m ()+groupsWhileLT =+#ifdef USE_PRELUDE+    Common.drain . S.groupsBy (>) FL.drain+#else+    Common.drain . S.groupsWhile (<) FL.drain+#endif++{-# INLINE groupsWhileEq #-}+groupsWhileEq :: MonadIO m => Stream m Int -> m ()+groupsWhileEq =+#ifdef USE_PRELUDE+    Common.drain . S.groupsBy (==) FL.drain+#else+    Common.drain . S.groupsWhile (==) FL.drain+#endif+++{-# INLINE groupsByRollingLT #-}+groupsByRollingLT :: MonadIO m => Stream m Int -> m ()+groupsByRollingLT =+#ifdef USE_PRELUDE+    Common.drain . S.groupsByRolling (<) FL.drain+#else+    Common.drain . S.groupsRollingBy (<) FL.drain+#endif++{-# INLINE groupsByRollingEq #-}+groupsByRollingEq :: MonadIO m => Stream m Int -> m ()+groupsByRollingEq =+#ifdef USE_PRELUDE+    Common.drain . S.groupsByRolling (==) FL.drain+#else+    Common.drain . S.groupsRollingBy (==) FL.drain+#endif++{-# INLINE foldMany #-}+foldMany :: Monad m => Stream m Int -> m ()+foldMany =+      Common.drain+    . fmap getSum+    . S.foldMany (FL.take 2 FL.mconcat)+    . fmap Sum++#ifndef USE_PRELUDE+{-# INLINE foldMany1 #-}+foldMany1 :: Monad m => Stream m Int -> m ()+foldMany1 =+      Common.drain+    . fmap getSum+    . S.foldManyPost (FL.take 2 FL.mconcat)+    . fmap Sum+#endif++{-# INLINE refoldMany #-}+refoldMany :: Monad m => Stream m Int -> m ()+refoldMany =+      Common.drain+    . fmap getSum+    . S.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)+    . fmap Sum++{-# INLINE foldIterateM #-}+foldIterateM :: Monad m => Stream m Int -> m ()+foldIterateM =+    Common.drain+        . fmap getSum+        . S.foldIterateM+            (return . FL.take 2 . FL.sconcat) (return (Sum 0))+        . fmap Sum++{-# INLINE refoldIterateM #-}+refoldIterateM :: Monad m => Stream m Int -> m ()+refoldIterateM =+    Common.drain+        . fmap getSum+        . S.refoldIterateM+            (Refold.take 2 Refold.sconcat) (return (Sum 0))+        . fmap Sum++o_1_space_grouping :: Int -> [Benchmark]+o_1_space_grouping value =+    -- Buffering operations using heap proportional to group/window sizes.+    [ bgroup "grouping"+        [+          benchIOSink value "groups" groups+        , benchIOSink value "groupsWhileLT" groupsWhileLT+        , benchIOSink value "groupsWhileEq" groupsWhileEq+        , benchIOSink value "groupsByRollingLT" groupsByRollingLT+        , benchIOSink value "groupsByRollingEq" groupsByRollingEq+        ,++        -- XXX parseMany/parseIterate benchmarks are in the Parser/ParserD+        -- modules we can bring those here. chunksOf benchmarks are in+        -- Parser/ParserD/Array.Stream/FileSystem.Handle.+          benchIOSink value "foldMany" foldMany+#ifndef USE_PRELUDE+        , benchIOSink value "foldMany1" foldMany1+#endif+        , benchIOSink value "refoldMany" refoldMany+        , benchIOSink value "foldIterateM" foldIterateM+        , benchIOSink value "refoldIterateM" refoldIterateM++#ifndef USE_STREAMLY_CORE+        , benchIOSink value "classifySessionsOf (10000 buckets)"+            (classifySessionsOf (getKey 10000))+        , benchIOSink value "classifySessionsOf (64 buckets)"+            (classifySessionsOf (getKey 64))+        , benchIOSink value "classifySessionsOfHash (10000 buckets)"+            (classifySessionsOfHash (getKey 10000))+        , benchIOSink value "classifySessionsOfHash (64 buckets)"+            (classifySessionsOfHash (getKey 64))+#endif+        ]+    ]++#ifndef USE_STREAMLY_CORE+    where++    getKey :: Int -> Int -> Int+    getKey n = (`mod` n)+#endif++-------------------------------------------------------------------------------+-- Size conserving transformations (reordering, buffering, etc.)+-------------------------------------------------------------------------------++#ifndef USE_PRELUDE+{-# INLINE reverse #-}+reverse :: MonadIO m => Int -> Stream m Int -> m ()+reverse n = composeN n S.reverse++{-# INLINE reverse' #-}+reverse' :: MonadIO m => Int -> Stream m Int -> m ()+reverse' n = composeN n S.reverseUnbox+#endif++o_n_heap_buffering :: Int -> [Benchmark]+o_n_heap_buffering value =+    [ bgroup "buffered"+        [+#ifndef USE_PRELUDE+        -- Reversing a stream+          benchIOSink value "reverse" (reverse 1)+        , benchIOSink value "reverse'" (reverse' 1)+#else+          benchIOSink value "mkAsync" (mkAsync fromSerial)+#endif+        ]+    ]++-------------------------------------------------------------------------------+-- Grouping/Splitting+-------------------------------------------------------------------------------++#ifndef USE_STREAMLY_CORE+{-# INLINE classifySessionsOf #-}+classifySessionsOf :: S.MonadAsync m => (Int -> Int) -> Stream m Int -> m ()+classifySessionsOf getKey =+      Common.drain+    . S.classifySessionsOf+        (const (return False)) 3 (FL.take 10 FL.sum)+    . S.timestamped+    . fmap (\x -> (getKey x, x))++{-# INLINE classifySessionsOfHash #-}+classifySessionsOfHash :: S.MonadAsync m =>+    (Int -> Int) -> Stream m Int -> m ()+classifySessionsOfHash getKey =+      Common.drain+    . S.classifySessionsByGeneric+        (Proxy :: Proxy (HashMap k))+        1 False (const (return False)) 3 (FL.take 10 FL.sum)+    . S.timestamped+    . fmap (\x -> (getKey x, x))+#endif++-------------------------------------------------------------------------------+-- Mixed Transformation+-------------------------------------------------------------------------------++{-# INLINE scanMap #-}+scanMap :: MonadIO m => Int -> Stream m Int -> m ()+scanMap n = composeN n $ fmap (subtract 1) . Common.scanl' (+) 0++{-# INLINE dropMap #-}+dropMap :: MonadIO m => Int -> Stream m Int -> m ()+dropMap n = composeN n $ fmap (subtract 1) . S.drop 1++{-# INLINE dropScan #-}+dropScan :: MonadIO m => Int -> Stream m Int -> m ()+dropScan n = composeN n $ Common.scanl' (+) 0 . S.drop 1++{-# INLINE takeDrop #-}+takeDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()+takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)++{-# INLINE takeScan #-}+takeScan :: MonadIO m => Int -> Int -> Stream m Int -> m ()+takeScan value n = composeN n $ Common.scanl' (+) 0 . S.take (value + 1)++{-# INLINE takeMap #-}+takeMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()+takeMap value n = composeN n $ fmap (subtract 1) . S.take (value + 1)++{-# INLINE filterDrop #-}+filterDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()+filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))++{-# INLINE filterTake #-}+filterTake :: MonadIO m => Int -> Int -> Stream m Int -> m ()+filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))++{-# INLINE filterScan #-}+filterScan :: MonadIO m => Int -> Stream m Int -> m ()+filterScan n = composeN n $ Common.scanl' (+) 0 . S.filter (<= maxBound)++#ifdef USE_PRELUDE+{-# INLINE filterScanl1 #-}+filterScanl1 :: MonadIO m => Int -> Stream m Int -> m ()+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)+#endif++{-# INLINE filterMap #-}+filterMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()+filterMap value n = composeN n $ fmap (subtract 1) . S.filter (<= (value + 1))++-------------------------------------------------------------------------------+-- Scan and fold+-------------------------------------------------------------------------------++data Pair a b =+    Pair !a !b+    deriving (Generic, NFData)++{-# INLINE sumProductFold #-}+sumProductFold :: Monad m => Stream m Int -> m (Pair Int Int)+sumProductFold =+    Common.foldl' (\(Pair s p) x -> Pair (s + x) (p * x)) (Pair 0 1)++{-# INLINE sumProductScan #-}+sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)+sumProductScan =+    Common.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .+    Common.scanl' (\(s, _) x -> (s + x, x)) (0, 0)++{-# INLINE foldl'ReduceMap #-}+foldl'ReduceMap :: Monad m => Stream m Int -> m Int+foldl'ReduceMap = fmap (+ 1) . Common.foldl' (+) 0++o_1_space_transformations_mixed :: Int -> [Benchmark]+o_1_space_transformations_mixed value =+    -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl+    -- library. If scan/fold followed by a map is efficient enough we may not+    -- need monolithic implementations of these.+    [ bgroup "mixed"+        [ benchIOSink value "scanl-map" (scanMap 1)+        , benchIOSink value "drop-map" (dropMap 1)+        , benchIOSink value "drop-scan" (dropScan 1)+        , benchIOSink value "take-drop" (takeDrop value 1)+        , benchIOSink value "take-scan" (takeScan value 1)+        , benchIOSink value "take-map" (takeMap value 1)+        , benchIOSink value "filter-drop" (filterDrop value 1)+        , benchIOSink value "filter-take" (filterTake value 1)+        , benchIOSink value "filter-scan" (filterScan 1)+        , benchIOSink value "filter-map" (filterMap value 1)+        , benchIOSink value "foldl-map" foldl'ReduceMap+        , benchIOSink value "sum-product-fold" sumProductFold+        , benchIOSink value "sum-product-scan" sumProductScan+        ]+    ]++o_1_space_transformations_mixedX2 :: Int -> [Benchmark]+o_1_space_transformations_mixedX2 value =+    [ bgroup "mixedX2"+        [ benchIOSink value "scan-map" (scanMap 2)+        , benchIOSink value "drop-map" (dropMap 2)+        , benchIOSink value "drop-scan" (dropScan 2)+        , benchIOSink value "take-drop" (takeDrop value 2)+        , benchIOSink value "take-scan" (takeScan value 2)+        , benchIOSink value "take-map" (takeMap value 2)+        , benchIOSink value "filter-drop" (filterDrop value 2)+        , benchIOSink value "filter-take" (filterTake value 2)+        , benchIOSink value "filter-scan" (filterScan 2)+#ifdef USE_PRELUDE+        , benchIOSink value "filter-scanl1" (filterScanl1 2)+#endif+        , benchIOSink value "filter-map" (filterMap value 2)+        ]+    ]++o_1_space_transformations_mixedX4 :: Int -> [Benchmark]+o_1_space_transformations_mixedX4 value =+    [ bgroup "mixedX4"+        [ benchIOSink value "scan-map" (scanMap 4)+        , benchIOSink value "drop-map" (dropMap 4)+        , benchIOSink value "drop-scan" (dropScan 4)+        , benchIOSink value "take-drop" (takeDrop value 4)+        , benchIOSink value "take-scan" (takeScan value 4)+        , benchIOSink value "take-map" (takeMap value 4)+        , benchIOSink value "filter-drop" (filterDrop value 4)+        , benchIOSink value "filter-take" (filterTake value 4)+        , benchIOSink value "filter-scan" (filterScan 4)+#ifdef USE_PRELUDE+        , benchIOSink value "filter-scanl1" (filterScanl1 4)+#endif+        , benchIOSink value "filter-map" (filterMap value 4)+        ]+    ]++-------------------------------------------------------------------------------+-- Iterating a transformation over and over again+-------------------------------------------------------------------------------++-- this is quadratic+{-# INLINE iterateScan #-}+iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int+iterateScan = iterateSource (Common.scanl' (+) 0)++#ifdef USE_PRELUDE+-- this is quadratic+{-# INLINE iterateScanl1 #-}+iterateScanl1 :: MonadAsync m => Int -> Int -> Int -> Stream m Int+iterateScanl1 = iterateSource (S.scanl1' (+))+#endif++{-# INLINE iterateMapM #-}+iterateMapM :: MonadAsync m => Int -> Int -> Int -> Stream m Int+iterateMapM = iterateSource (S.mapM return)++{-# INLINE iterateFilterEven #-}+iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> Stream m Int+iterateFilterEven = iterateSource (S.filter even)++{-# INLINE iterateTakeAll #-}+iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int+iterateTakeAll value = iterateSource (S.take (value + 1))++{-# INLINE iterateDropOne #-}+iterateDropOne :: MonadAsync m => Int -> Int -> Int -> Stream m Int+iterateDropOne = iterateSource (S.drop 1)++{-# INLINE iterateDropWhileTrue #-}+iterateDropWhileTrue :: MonadAsync m+    => Int -> Int -> Int -> Int -> Stream m Int+iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))++{-# INLINE iterateDropWhileFalse #-}+iterateDropWhileFalse :: MonadAsync m+    => Int -> Int -> Int -> Int -> Stream m Int+iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))++{-# INLINE tail #-}+tail :: Monad m => Stream m a -> m ()+tail s = S.tail s >>= mapM_ tail++{-# INLINE nullHeadTail #-}+nullHeadTail :: Monad m => Stream m Int -> m ()+nullHeadTail s = do+    r <- S.null s+    when (not r) $ do+        _ <- S.head s+        S.tail s >>= mapM_ nullHeadTail++nullTail :: Monad m => Stream m Int -> m ()+nullTail s = do+    r <- S.null s+    when (not r) $ S.tail s >>= mapM_ nullTail++headTail :: Monad m => Stream m Int -> m ()+headTail s = do+    h <- S.head s+    when (isJust h) $ S.tail s >>= mapM_ headTail++-- Head recursive operations.+o_n_stack_iterated :: Int -> [Benchmark]+o_n_stack_iterated value = by10 `seq` by100 `seq`+    [ bgroup "iterated"+        [ benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10+        , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $+            iterateScan by100 100+#ifdef USE_PRELUDE+        , benchIOSrc "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10+#endif+        , benchIOSrc "filterEven (n/10 x 10)" $+            iterateFilterEven by10 10+        , benchIOSrc "takeAll (n/10 x 10)" $+            iterateTakeAll value by10 10+        , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10+        , benchIOSrc "dropWhileTrue (n/10 x 10)" $+            iterateDropWhileTrue value by10 10+        , benchIOSrc "dropWhileFalse (n/10 x 10)" $+            iterateDropWhileFalse value by10 10+        , benchIOSink value "tail" tail+        , benchIOSink value "nullTail" nullTail+        , benchIOSink value "headTail" headTail+        , benchIOSink value "nullHeadTail" nullHeadTail+     ]+    ]++    where++    by10 = value `div` 10+    by100 = value `div` 100++-------------------------------------------------------------------------------+-- Pipes+-------------------------------------------------------------------------------++o_1_space_pipes :: Int -> [Benchmark]+o_1_space_pipes value =+    [ bgroup "pipes"+        [ benchIOSink value "mapM" (transformMapM 1)+        , benchIOSink value "compose" (transformComposeMapM 1)+        , benchIOSink value "tee" (transformTeeMapM 1)+#ifdef DEVBUILD+        -- XXX this take 1 GB memory to compile+        -- , benchIOSink value "zip" (transformZipMapM 1)+#endif+        ]+    ]++o_1_space_pipesX4 :: Int -> [Benchmark]+o_1_space_pipesX4 value =+    [ bgroup "pipesX4"+        [ benchIOSink value "mapM" (transformMapM 4)+        , benchIOSink value "compose" (transformComposeMapM 4)+        , benchIOSink value "tee" (transformTeeMapM 4)+#ifdef DEVBUILD+        -- XXX this take 1 GB memory to compile+        -- , benchIOSink value "zip" (transformZipMapM 4)+#endif+        ]+    ]++-------------------------------------------------------------------------------+-- Scans+-------------------------------------------------------------------------------++#ifndef USE_PRELUDE+o_1_space_scans :: Int -> [Benchmark]+o_1_space_scans value =+    [ bgroup "scans"+        [+          benchIOSink value "mapM" (scanMapM 1)+        , benchIOSink value "compose" (scanComposeMapM 1)+        , benchIOSink value "tee" (scanTeeMapM 1)+        ]+    ]++o_1_space_scansX4 :: Int -> [Benchmark]+o_1_space_scansX4 value =+    [ bgroup "scansX4"+        [ benchIOSink value "mapM" (scanMapM 4)+        , benchIOSink value "compose" (scanComposeMapM 4)+        , benchIOSink value "tee" (scanTeeMapM 4)+        ]+    ]+#endif++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+benchmarks :: String -> Int -> [Benchmark]+benchmarks moduleName size =+        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat+            [ o_1_space_grouping size+            , o_1_space_transformations_mixed size+            , o_1_space_transformations_mixedX2 size+            , o_1_space_transformations_mixedX4 size++            -- pipes+            , o_1_space_pipes size+            , o_1_space_pipesX4 size++#ifndef USE_PRELUDE+            -- scans+            , o_1_space_scans size+            , o_1_space_scansX4 size+#endif+            ]+        , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)+        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering size)+        ]
+ benchmark/Streamly/Benchmark/Data/Stream/Split.hs view
@@ -0,0 +1,304 @@++-- |+-- Module      : Stream.Split+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Stream.Split (benchmarks) where++import Data.Char (ord)+import Data.Word (Word8)+import System.IO (Handle)+import Streamly.Internal.Data.Array (Array)++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.FileSystem.Handle as Handle+import qualified Streamly.Internal.Unicode.Stream as Unicode++import Test.Tasty.Bench hiding (env)+import Prelude hiding (last, length)+import Streamly.Benchmark.Common+import Streamly.Benchmark.Common.Handle++#ifdef INSPECTION+import Streamly.Internal.Data.Stream (Step(..))++import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Unfold as Unfold++import Test.Inspection+#endif++ -------------------------------------------------------------------------------+-- reduce with splitting transformations+-------------------------------------------------------------------------------++lf :: Word8+lf = fromIntegral (ord '\n')++toarr :: String -> Array Word8+toarr = Array.fromList . map (fromIntegral . ord)++-- | Split on line feed.+splitOn :: Handle -> IO Int+splitOn inh =+    (Stream.fold Fold.length+        $ Stream.splitSepBy_ (== lf) Fold.drain+        $ Handle.read inh) -- >>= print++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'splitOn+inspect $ 'splitOn `hasNoType` ''Step+inspect $ 'splitOn `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'splitOn `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Words by space+wordsBy :: Handle -> IO Int+wordsBy inh =+    Stream.fold Fold.length+        $ Stream.wordsBy isSp Fold.drain+        $ Handle.read inh -- >>= print++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'wordsBy+inspect $ 'wordsBy `hasNoType` ''Step+inspect $ 'wordsBy `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'wordsBy `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Split on a word8 sequence.+splitOnSeq :: String -> Handle -> IO Int+splitOnSeq str inh =+    (Stream.fold Fold.length $ Stream.splitSepBySeq_ (toarr str) Fold.drain+        $ Handle.read inh) -- >>= print++#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'splitOnSeq+-- inspect $ 'splitOnSeq `hasNoType` ''Step+#endif++takeEndBy :: Word8 -> Handle -> IO Int+takeEndBy c inh =+    (Stream.fold Fold.length+        $ Stream.takeEndBy (== c)+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBy_ :: Word8 -> Handle -> IO Int+takeEndBy_ c inh =+    (Stream.fold Fold.length+        $ Stream.takeEndBy_ (== c)+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBySeq :: String -> Handle -> IO Int+takeEndBySeq str inh =+    (Stream.fold Fold.length+        $ Stream.takeEndBySeq (toarr str)+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBySeq_ :: String -> Handle -> IO Int+takeEndBySeq_ str inh =+    (Stream.fold Fold.length+        $ Stream.takeEndBySeq_ (toarr str)+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBySeq100k :: Handle -> IO Int+takeEndBySeq100k inh = do+    arr <- Stream.fold Array.create $ Stream.replicate 100000 123+    (Stream.fold Fold.length+        $ Stream.takeEndBySeq arr+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBySeq_100k :: Handle -> IO Int+takeEndBySeq_100k inh = do+    arr <- Stream.fold Array.create $ Stream.replicate 100000 123+    (Stream.fold Fold.length+        $ Stream.takeEndBySeq_ arr+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++-- | Split on a word8 sequence.+splitOnSeq100k :: Handle -> IO Int+splitOnSeq100k inh = do+    arr <- Stream.fold Array.create $ Stream.replicate 100000 123+    (Stream.fold Fold.length+        $ Stream.splitSepBySeq_ arr Fold.drain+        $ Handle.read inh) -- >>= print++-- | Split on suffix sequence.+splitOnSuffixSeq :: String -> Handle -> IO Int+splitOnSuffixSeq str inh =+    (Stream.fold Fold.length+        $ Stream.splitOnSuffixSeq False (toarr str) Fold.drain+        $ Handle.read inh) -- >>= print++#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq+-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step+#endif++-- | Split on suffix sequence.+splitWithSuffixSeq :: String -> Handle -> IO Int+splitWithSuffixSeq str inh =+    Stream.fold Fold.length+        $ Stream.splitOnSuffixSeq True (toarr str) Fold.drain+        $ Handle.read inh -- >>= print++o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]+o_1_space_reduce_read_split env =+    -- NOTE: keep the benchmark names consistent with Data.Fold.takeEndBy*+    [ bgroup "FileSplitElem"+        [ mkBench "splitOn infix lf" env $ \inh _ ->+            splitOn inh+        ]+    -- splitting on a sequence+    , bgroup "FileSplitSeq"+        [+          mkBench "wordsBy infix isSpace" env $ \inh _ ->+            wordsBy inh++        -- Infix+        , mkBench "splitOnSeq empty infix" env $ \inh _ ->+            splitOnSeq "" inh+        , mkBench "splitOnSeq single infix lf" env $ \inh _ ->+            splitOnSeq "\n" inh+        , mkBench "splitOnSeq single infix a" env $ \inh _ ->+            splitOnSeq "a" inh+        , mkBench "splitOnSeq word infix crlf" env $ \inh _ ->+            splitOnSeq "\r\n" inh+        , mkBench "splitOnSeq word infix aa" env $ \inh _ ->+            splitOnSeq "aa" inh+        , mkBench "splitOnSeq word infix aaaa" env $ \inh _ ->+            splitOnSeq "aaaa" inh+        , mkBench "splitOnSeq word infix abcdefgh" env $ \inh _ ->+            splitOnSeq "abcdefgh" inh+        , mkBench "splitOnSeq KR infix abcdefghi" env $ \inh _ ->+            splitOnSeq "abcdefghi" inh+        , mkBench "splitOnSeq KR infix catcatcatcatcat" env $ \inh _ ->+            splitOnSeq "catcatcatcatcat" inh+        , mkBench "splitOnSeq KR infix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh+        , mkBench "splitOnSeq KR infix 100k long pattern"+            env $ \inh _ -> splitOnSeq100k inh++        -- Suffix+        , mkBench "splitOnSuffixSeq empty suffix" env $ \inh _ ->+            splitOnSuffixSeq "" inh+        , mkBench "splitOnSuffixSeq single suffix lf" env $ \inh _ ->+            splitOnSuffixSeq "\n" inh+        , mkBench "splitOnSuffixSeq word suffix crlf" env $ \inh _ ->+            splitOnSuffixSeq "\r\n" inh+        , mkBenchSmall "splitOnSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh++        -- Suffix with separator+        , mkBench "splitWithSuffixSeq single suffix lf" env $ \inh _ ->+            splitWithSuffixSeq "\n" inh+        , mkBench "splitWithSuffixSeq word suffix crlf" env $ \inh _ ->+            splitWithSuffixSeq "\r\n" inh+        , mkBench "splitWithSuffixSeq KR suffix abcdefghi" env $ \inh _ ->+            splitWithSuffixSeq "abcdefghi" inh+        , mkBenchSmall "splitWithSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh+        ]++    , bgroup "FileTakeSeq"+        [+        {-+          mkBench "takeEndBySeq empty" env $ \inh _ ->+                takeEndBySeq "" inh+        -}+        -- IMPORTANT: the pattern must contain a, because we filter a's out+        -- from the stream so that we do not terminate too early and+        -- unpredictably.+          mkBench "takeEndBy" env $ \inh _ ->+            takeEndBy (fromIntegral $ ord 'a') inh+        , mkBench "takeEndBy_" env $ \inh _ ->+            takeEndBy_ (fromIntegral $ ord 'a') inh+        , mkBench "takeEndBySeq single a" env $ \inh _ ->+            takeEndBySeq "a" inh+        , mkBench "takeEndBySeq word aa" env $ \inh _ ->+            takeEndBySeq "aa" inh+        , mkBench "takeEndBySeq word aaaa" env $ \inh _ ->+            takeEndBySeq "aaaa" inh+        , mkBench "takeEndBySeq word abcdefgh" env $ \inh _ ->+            takeEndBySeq "abcdefgh" inh+        , mkBench "takeEndBySeq KR abcdefghi" env $ \inh _ ->+            takeEndBySeq "abcdefghi" inh+        , mkBench "takeEndBySeq KR catcatcatcatcat" env $ \inh _ ->+            takeEndBySeq "catcatcatcatcat" inh+        , mkBench "takeEndBySeq KR abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> takeEndBySeq "abcdefghijklmnopqrstuvwxyz" inh+        , mkBench "takeEndBySeq KR 100k long pattern"+            env $ \inh _ -> takeEndBySeq100k inh++        {-+        , mkBench "takeEndBySeq_ empty" env $ \inh _ ->+            takeEndBySeq_ "" inh+        -}+        , mkBench "takeEndBySeq_ single a" env $ \inh _ ->+            takeEndBySeq_ "a" inh+        , mkBench "takeEndBySeq_ word aa" env $ \inh _ ->+            takeEndBySeq_ "aa" inh+        , mkBench "takeEndBySeq_ word aaaa" env $ \inh _ ->+            takeEndBySeq_ "aaaa" inh+        , mkBench "takeEndBySeq_ word abcdefgh" env $ \inh _ ->+            takeEndBySeq_ "abcdefgh" inh+        , mkBench "takeEndBySeq_ KR abcdefghi" env $ \inh _ ->+            takeEndBySeq_ "abcdefghi" inh+        , mkBench "takeEndBySeq_ KR catcatcatcatcat" env $ \inh _ ->+            takeEndBySeq_ "catcatcatcatcat" inh+        , mkBench "takeEndBySeq_ KR abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> takeEndBySeq_ "abcdefghijklmnopqrstuvwxyz" inh+        , mkBench "takeEndBySeq_ KR 100k long pattern"+            env $ \inh _ -> takeEndBySeq_100k inh+        ]+    ]++-- | Split on a character sequence.+splitOnSeqUtf8 :: String -> Handle -> IO Int+splitOnSeqUtf8 str inh =+    (Stream.fold Fold.length+        $ Stream.splitSepBySeq_ (Array.fromList str) Fold.drain+        $ Unicode.decodeUtf8Chunks+        $ Handle.readChunks inh) -- >>= print++o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]+o_1_space_reduce_toChunks_split env =+    [ bgroup "FileSplitSeqUtf8"+        [ mkBenchSmall "splitOnSeqUtf8 word abcdefgh"+            env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh+        , mkBenchSmall "splitOnSeqUtf8 KR abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh+        ]+    ]++benchmarks :: String -> BenchEnv -> [Benchmark]+benchmarks moduleName env =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_reduce_read_split env+            , o_1_space_reduce_toChunks_split env+            ]+        ]
benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs view
@@ -8,6 +8,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -Wno-orphans #-}  #ifdef __HADDOCK_VERSION__ #undef INSPECTION@@ -20,15 +22,19 @@  module Main (main) where +#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif import Control.Monad (when) import Data.Maybe (isJust)-import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain) import System.Random (randomRIO) import Prelude hiding (tail, mapM_, foldl, last, map, mapM, concatMap, zip)  import qualified Prelude as P-import qualified Streamly.Internal.Data.Stream.StreamD as S+import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Unfold as UF+import qualified Streamly.Internal.Data.Fold as FL  import Streamly.Benchmark.Common @@ -125,6 +131,12 @@         Nothing -> return ()         Just (_, t) -> uncons t +{-# INLINE foldBreak #-}+foldBreak :: Monad m => Stream m Int -> m ()+foldBreak s = do+    (r, s1) <- S.foldBreak (FL.take 1 FL.length) s+    when (r /= 0) $ foldBreak s1+ {-# INLINE tail #-} tail :: Monad m => Stream m a -> m () tail s = S.tail s >>= P.mapM_ tail@@ -314,6 +326,34 @@ -- Nested Composition ------------------------------------------------------------------------------- +instance Monad f => Applicative (S.Stream f) where+    {-# INLINE pure #-}+    pure = S.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = S.crossApply++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>) = S.crossApplySnd++    {-# INLINE (<*) #-}+    (<*) = S.crossApplyFst++-- 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 (S.Stream m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip S.concatMap++    {-# INLINE (>>) #-}+    (>>) = (*>)+ {-# INLINE toNullApNested #-} toNullApNested :: Monad m => Stream m Int -> m () toNullApNested s = runStream $ do@@ -408,9 +448,9 @@ unfoldManyRepl :: Int -> Int -> Int -> IO () unfoldManyRepl outer inner n =     S.drain-         $ S.unfoldMany-               (UF.lmap return (UF.replicateM inner))-               (sourceUnfoldrMN outer n)+         $ S.unfoldEach+               UF.replicateM+               (S.map ((inner,) . return) (sourceUnfoldrMN outer n))  #ifdef INSPECTION inspect $ hasNoTypeClasses 'unfoldManyRepl@@ -423,7 +463,7 @@ -------------------------------------------------------------------------------  moduleName :: String-moduleName = "Data.Stream.StreamD"+moduleName = "Data.StreamD"  o_1_space :: [Benchmark] o_1_space =@@ -439,6 +479,7 @@         [ benchFold "toNull"   toNull   sourceUnfoldrM         , benchFold "mapM_"    mapM_    sourceUnfoldrM         , benchFold "uncons"   uncons   sourceUnfoldrM+        , benchFold "foldBreak" foldBreak sourceUnfoldrM         , benchFold "foldl'" foldl    sourceUnfoldrM         , benchFold "last"   last     sourceUnfoldrM         ]
− benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs 
@@ -1,453 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.Stream.StreamDK--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where---- import Control.Monad (when)--- import Data.Maybe (isJust)-import Prelude hiding ()--- import qualified Prelude as P--- import qualified Data.List as List--import qualified Streamly.Internal.Data.Stream.StreamDK as S--- import qualified Streamly.Internal.Data.Stream.Prelude as SP--- import qualified Streamly.Internal.Data.SVar as S--import Streamly.Benchmark.Common-import Gauge (bgroup, Benchmark, defaultMain)--value :: Int-value = 100000-{--value2, value3, value16, maxValue :: Int-value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop-value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop-value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop-maxValue = value--}------------------------------------------------------------------------------------ Benchmark ops-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.Stream m a--{-# INLINE sourceUnfoldr #-}-sourceUnfoldr :: Monad m => Int -> Stream m Int-sourceUnfoldr n = S.unfoldr step n-    where-    step cnt =-        if cnt > n + value-        then Nothing-        else Just (cnt, cnt + 1)--{--{-# INLINE sourceUnfoldrN #-}-sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int-sourceUnfoldrN m n = S.unfoldr step n-    where-    step cnt =-        if cnt > n + m-        then Nothing-        else Just (cnt, cnt + 1)--}--{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: Monad m => Int -> Stream m Int-sourceUnfoldrM n = S.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else return (Just (cnt, cnt + 1))--{--{-# INLINE sourceUnfoldrMN #-}-sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int-sourceUnfoldrMN m n = S.unfoldrM step n-    where-    step cnt =-        if cnt > n + m-        then return Nothing-        else return (Just (cnt, cnt + 1))--}--{--{-# INLINE sourceFromEnum #-}-sourceFromEnum :: Monad m => Int -> Stream m Int-sourceFromEnum n = S.enumFromStepN n 1 value--}--{--{-# INLINE sourceFromFoldable #-}-sourceFromFoldable :: Int -> Stream m Int-sourceFromFoldable n = S.fromFoldable [n..n+value]--}--{--{-# INLINE sourceFromFoldableM #-}-sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int-sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])--}--{--{-# INLINE sourceFoldMapWith #-}-sourceFoldMapWith :: Int -> Stream m Int-sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]--{-# INLINE sourceFoldMapWithM #-}-sourceFoldMapWithM :: Monad m => Int -> Stream m Int-sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]--}------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.drain--- runStream = S.mapM_ (\_ -> return ())--{--{-# INLINE mapM_ #-}-mapM_ :: Monad m => Stream m a -> m ()-mapM_ = S.mapM_ (\_ -> return ())--}--{-# INLINE toNull #-}-toNull :: Monad m => Stream m Int -> m ()-toNull = runStream--{-# INLINE uncons #-}-uncons :: Monad m => Stream m Int -> m ()-uncons s = do-    r <- S.uncons s-    case r of-        Nothing -> return ()-        Just (_, t) -> uncons t--{--{-# INLINE init #-}-init :: (Monad m, S.IsStream t) => t m a -> m ()-init s = do-    t <- S.init s-    P.mapM_ S.drain t--{-# INLINE tail #-}-tail :: (Monad m, S.IsStream t) => t m a -> m ()-tail s = S.tail s >>= P.mapM_ tail--{-# INLINE nullTail #-}-{-# INLINE headTail #-}-{-# INLINE zip #-}-nullTail, headTail, zip-    :: Monad m-    => Stream m Int -> m ()--nullTail s = do-    r <- S.null s-    when (not r) $ S.tail s >>= P.mapM_ nullTail--headTail s = do-    h <- S.head s-    when (isJust h) $ S.tail s >>= P.mapM_ headTail--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-toList = S.toList--{-# INLINE foldl #-}-foldl :: Monad m => Stream m Int -> m Int-foldl  = S.foldl' (+) 0--{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)-last   = S.last--}------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{--{-# INLINE transform #-}-transform :: Monad m => Stream m a -> m ()-transform = runStream--{-# INLINE composeN #-}-composeN-    :: Monad m-    => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-composeN n f =-    case n of-        1 -> transform . f-        2 -> transform . f . f-        3 -> transform . f . f . f-        4 -> transform . f . f . f . f-        _ -> undefined--}--{--{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE fmap #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropOne #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE dropWhileFalse #-}-{-# INLINE foldlS #-}-{-# INLINE concatMap #-}-scan, map, fmap, filterEven, filterAllOut,-    filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,-    dropWhileTrue, dropWhileFalse, foldlS, concatMap-    :: Monad m-    => Int -> Stream m Int -> m ()--{-# INLINE mapM #-}-{-# INLINE mapMSerial #-}-{-# INLINE intersperse #-}-mapM, mapMSerial, intersperse-    :: S.MonadAsync m => Int -> Stream m Int -> m ()--scan           n = composeN n $ S.scanl' (+) 0-map            n = composeN n $ P.fmap (+1)-fmap           n = composeN n $ P.fmap (+1)-mapM           n = composeN n $ S.mapM return-mapMSerial     n = composeN n $ S.mapMSerial return-filterEven     n = composeN n $ S.filter even-filterAllOut   n = composeN n $ S.filter (> maxValue)-filterAllIn    n = composeN n $ S.filter (<= maxValue)-takeOne        n = composeN n $ S.take 1-takeAll        n = composeN n $ S.take maxValue-takeWhileTrue  n = composeN n $ S.takeWhile (<= maxValue)-dropOne        n = composeN n $ S.drop 1-dropAll        n = composeN n $ S.drop maxValue-dropWhileTrue  n = composeN n $ S.dropWhile (<= maxValue)-dropWhileFalse n = composeN n $ S.dropWhile (<= 1)-foldlS         n = composeN n $ S.foldlS (flip S.cons) S.nil--- We use a (sqrt n) element stream as source and then concat the same stream--- for each element to produce an n element stream.-concatMap      n = composeN n $ (\s -> S.concatMap (\_ -> s) s)-intersperse    n = composeN n $ S.intersperse maxValue------------------------------------------------------------------------------------ Iteration----------------------------------------------------------------------------------iterStreamLen, maxIters :: Int-iterStreamLen = 10-maxIters = 10000--{-# INLINE iterateSource #-}-iterateSource-    :: S.MonadAsync m-    => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int-iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)-    where-        f (0 :: Int) m = g m-        f x m = g (f (x P.- 1) m)--{-# INLINE iterateMapM #-}-{-# INLINE iterateScan #-}-{-# INLINE iterateFilterEven #-}-{-# INLINE iterateTakeAll #-}-{-# INLINE iterateDropOne #-}-{-# INLINE iterateDropWhileFalse #-}-{-# INLINE iterateDropWhileTrue #-}-iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,-    iterateDropWhileFalse, iterateDropWhileTrue-    :: S.MonadAsync m-    => Int -> Stream m Int---- this is quadratic-iterateScan            = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)-iterateDropWhileFalse  = iterateSource (S.dropWhile (> maxValue))-                                       (maxIters `div` 10)--iterateMapM            = iterateSource (S.mapM return) maxIters-iterateFilterEven      = iterateSource (S.filter even) maxIters-iterateTakeAll         = iterateSource (S.take maxValue) maxIters-iterateDropOne         = iterateSource (S.drop 1) maxIters-iterateDropWhileTrue   = iterateSource (S.dropWhile (<= maxValue)) maxIters------------------------------------------------------------------------------------ Zipping and concat----------------------------------------------------------------------------------zip src       = transform $ S.zipWith (,) src src--{-# INLINE concatMapRepl4xN #-}-concatMapRepl4xN :: Monad m => Stream m Int -> m ()-concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)------------------------------------------------------------------------------------ Mixed Composition----------------------------------------------------------------------------------{-# INLINE scanMap #-}-{-# INLINE dropMap #-}-{-# INLINE dropScan #-}-{-# INLINE takeDrop #-}-{-# INLINE takeScan #-}-{-# INLINE takeMap #-}-{-# INLINE filterDrop #-}-{-# INLINE filterTake #-}-{-# INLINE filterScan #-}-{-# INLINE filterMap #-}-scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,-    filterTake, filterScan, filterMap-    :: Monad m => Int -> Stream m Int -> m ()--scanMap    n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0-dropMap    n = composeN n $ S.map (subtract 1) . S.drop 1-dropScan   n = composeN n $ S.scanl' (+) 0 . S.drop 1-takeDrop   n = composeN n $ S.drop 1 . S.take maxValue-takeScan   n = composeN n $ S.scanl' (+) 0 . S.take maxValue-takeMap    n = composeN n $ S.map (subtract 1) . S.take maxValue-filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)-filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)-filterMap  n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)------------------------------------------------------------------------------------ Nested Composition----------------------------------------------------------------------------------{-# INLINE toNullApNested #-}-toNullApNested :: Monad m => Stream m Int -> m ()-toNullApNested s = runStream $ do-    (+) <$> s <*> s--{-# INLINE toNullNested #-}-toNullNested :: Monad m => Stream m Int -> m ()-toNullNested s = runStream $ do-    x <- s-    y <- s-    return $ x + y--{-# INLINE toNullNested3 #-}-toNullNested3 :: Monad m => Stream m Int -> m ()-toNullNested3 s = runStream $ do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutNested #-}-filterAllOutNested-    :: Monad m-    => Stream m Int -> m ()-filterAllOutNested str = runStream $ do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else S.nil--{-# INLINE filterAllInNested #-}-filterAllInNested-    :: Monad m-    => Stream m Int -> m ()-filterAllInNested str = runStream $ do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else S.nil------------------------------------------------------------------------------------ Nested Composition Pure lists----------------------------------------------------------------------------------{-# INLINE sourceUnfoldrList #-}-sourceUnfoldrList :: Int -> Int -> [Int]-sourceUnfoldrList maxval n = List.unfoldr step n-    where-    step cnt =-        if cnt > n + maxval-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE toNullApNestedList #-}-toNullApNestedList :: [Int] -> [Int]-toNullApNestedList s = (+) <$> s <*> s--{-# INLINE toNullNestedList #-}-toNullNestedList :: [Int] -> [Int]-toNullNestedList s = do-    x <- s-    y <- s-    return $ x + y--{-# INLINE toNullNestedList3 #-}-toNullNestedList3 :: [Int] -> [Int]-toNullNestedList3 s = do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutNestedList #-}-filterAllOutNestedList :: [Int] -> [Int]-filterAllOutNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else []--{-# INLINE filterAllInNestedList #-}-filterAllInNestedList :: [Int] -> [Int]-filterAllInNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else []--}------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Stream.StreamDK"--o_1_space :: [Benchmark]-o_1_space =-    [ bgroup (o_1_space_prefix moduleName)-      [ bgroup "generation"-        [ benchFold "unfoldr"       toNull sourceUnfoldr-        , benchFold "unfoldrM"      toNull sourceUnfoldrM-        ]-      , bgroup "elimination"-        [ benchFold "toNull"   toNull   sourceUnfoldrM-        , benchFold "uncons"   uncons   sourceUnfoldrM-        ]-      ]-    ]--main :: IO ()-main = defaultMain $ concat [o_1_space]
− benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs 
@@ -1,906 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.Stream.StreamK--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Main (main) where--import Control.Monad (when)-import Data.Maybe (isJust)-import System.Random (randomRIO)-import Prelude hiding-    ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate-    , repeat, replicate-    )--import qualified Prelude as P-import qualified Data.List as List--import qualified Streamly.Internal.Control.Concurrent as S-import qualified Streamly.Internal.Data.Stream.StreamK.Type as S-import qualified Streamly.Internal.Data.Stream.StreamK as S--import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)--import Streamly.Benchmark.Common--#ifdef INSPECTION-import Test.Inspection-#endif--{---Benchmarks that need to be added---- fromList---- bindWith--- concatPairsWith--- apWith--- apSerial--- apSerialDiscardFst--- apSerialDiscardSnd---- the--- serial--- consMStream--- withLocal--- mfix---- elem--- notElem--- all--- any--- minimum--- minimumBy--- maximum--- maximumBy--- findIndices--- lookup--- findM--- find--- (!!)---- foldlM'--- foldlT--- foldlx'--- foldlMx'--- fold---- sequence---- foldrSM--- buildS--- buildM--- augmentS--- augmentSM--- foldr--- foldr1--- foldrM--- foldrT---- intersperseM--- insertBy--- deleteBy--- reverse--- mapMaybe---- zipWithM--- mergeBy--- mergeByM---- toStreamK (Probably can be skipped)--- hoist---- scanlx'---}------------------------------------------------------------------------------------ Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.Stream m a--{-# INLINE unfoldr #-}-unfoldr :: Int -> Int -> Stream m Int-unfoldr streamLen n = S.unfoldr step n-    where-    step cnt =-        if cnt > n + streamLen-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE unfoldrM #-}-unfoldrM :: S.MonadAsync m => Int -> Int -> Stream m Int-unfoldrM streamLen n = S.unfoldrMWith S.consM step n-    where-    step cnt =-        if cnt > n + streamLen-        then return Nothing-        else return (Just (cnt, cnt + 1))--{-# INLINE repeat #-}-repeat :: Int -> Int -> Stream m Int-repeat streamLen = S.take streamLen . S.repeat--{-# INLINE repeatM #-}-repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int-repeatM streamLen = S.take streamLen . S.repeatM . return--{-# INLINE replicate #-}-replicate :: Int -> Int -> Stream m Int-replicate = S.replicate--{-# INLINE replicateM #-}-replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int-replicateM streamLen = S.replicateMWith S.consM streamLen . return--{-# INLINE iterate #-}-iterate :: Int -> Int -> Stream m Int-iterate streamLen = S.take streamLen . S.iterate (+1)--{-# INLINE iterateM #-}-iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int-iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return--{-# INLINE fromFoldable #-}-fromFoldable :: Int -> Int -> Stream m Int-fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]--{-# INLINE fromFoldableM #-}-fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int-fromFoldableM streamLen n =-    Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])--{-# INLINABLE concatMapFoldableWith #-}-concatMapFoldableWith :: Foldable f-    => (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> f a-    -> Stream m b-concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil--{-# INLINE concatMapFoldableSerial #-}-concatMapFoldableSerial :: Int -> Int -> Stream m Int-concatMapFoldableSerial streamLen n = concatMapFoldableWith S.serial S.fromPure [n..n+streamLen]--{-# INLINE concatMapFoldableSerialM #-}-concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int-concatMapFoldableSerialM streamLen n =-    concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE drain #-}-drain :: Monad m => Stream m a -> m ()-drain = S.drain--{-# INLINE mapM_ #-}-mapM_ :: Monad m => Stream m a -> m ()-mapM_ = S.mapM_ (\_ -> return ())--{-# INLINE uncons #-}-uncons :: Monad m => Stream m Int -> m ()-uncons s = do-    r <- S.uncons s-    case r of-        Nothing -> return ()-        Just (_, t) -> uncons t--{-# INLINE init #-}-init :: Monad m => Stream m a -> m ()-init s = do-    t <- S.init s-    P.mapM_ S.drain t--{-# INLINE tail #-}-tail :: Monad m => Stream m a -> m ()-tail s = S.tail s >>= P.mapM_ tail--{-# INLINE nullTail #-}-nullTail :: Monad m => Stream m Int -> m ()-nullTail s = do-    r <- S.null s-    when (not r) $ S.tail s >>= P.mapM_ nullTail--{-# INLINE headTail #-}-headTail :: Monad m => Stream m Int -> m ()-headTail s = do-    h <- S.head s-    when (isJust h) $ S.tail s >>= P.mapM_ headTail--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-toList = S.toList--{-# INLINE foldl' #-}-foldl' :: Monad m => Stream m Int -> m Int-foldl' = S.foldl' (+) 0--{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)-last = S.last------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{-# INLINE composeN #-}-composeN-    :: Monad m-    => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-composeN n f =-    case n of-        1 -> drain . f-        2 -> drain . f . f-        3 -> drain . f . f . f-        4 -> drain . f . f . f . f-        _ -> undefined--{-# INLINE scanl' #-}-scanl' :: Monad m => Int -> Stream m Int -> m ()-scanl' n = composeN n $ S.scanl' (+) 0--{-# INLINE map #-}-map :: Monad m => Int -> Stream m Int -> m ()-map n = composeN n $ S.map (+ 1)--{-# INLINE fmapK #-}-fmapK :: Monad m => Int -> Stream m Int -> m ()-fmapK n = composeN n $ P.fmap (+ 1)--{-# INLINE mapM #-}-mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()-mapM n = composeN n $ S.mapMWith S.consM return--{-# INLINE mapMSerial #-}-mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()-mapMSerial n = composeN n $ S.mapMSerial return--{-# INLINE filterEven #-}-filterEven :: Monad m => Int -> Stream m Int -> m ()-filterEven n = composeN n $ S.filter even--{-# INLINE filterAllOut #-}-filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()-filterAllOut streamLen n = composeN n $ S.filter (> streamLen)--{-# INLINE filterAllIn #-}-filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()-filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)--{-# INLINE _takeOne #-}-_takeOne :: Monad m => Int -> Stream m Int -> m ()-_takeOne n = composeN n $ S.take 1--{-# INLINE takeAll #-}-takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()-takeAll streamLen n = composeN n $ S.take streamLen--{-# INLINE takeWhileTrue #-}-takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()-takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)--{-# INLINE dropOne #-}-dropOne :: Monad m => Int -> Stream m Int -> m ()-dropOne n = composeN n $ S.drop 1--{-# INLINE dropAll #-}-dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()-dropAll streamLen n = composeN n $ S.drop streamLen--{-# INLINE dropWhileTrue #-}-dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()-dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)--{-# INLINE dropWhileFalse #-}-dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()-dropWhileFalse n = composeN n $ S.dropWhile (<= 1)--{-# INLINE foldrS #-}-foldrS :: Monad m => Int -> Stream m Int -> m ()-foldrS n = composeN n $ S.foldrS S.cons S.nil--{-# INLINE foldlS #-}-foldlS :: Monad m => Int -> Stream m Int -> m ()-foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil--{-# INLINE intersperse #-}-intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()-intersperse streamLen n = composeN n $ S.intersperse streamLen------------------------------------------------------------------------------------ Iteration----------------------------------------------------------------------------------{-# INLINE iterateSource #-}-iterateSource-    :: S.MonadAsync m-    => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int-iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)-    where-        f (0 :: Int) m = g m-        f x m = g (f (x P.- 1) m)---- this is quadratic-{-# INLINE iterateScan #-}-iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateScan iterStreamLen maxIters =-    iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)---- this is quadratic-{-# INLINE iterateDropWhileFalse #-}-iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int-iterateDropWhileFalse streamLen iterStreamLen maxIters =-    iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)--{-# INLINE iterateMapM #-}-iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateMapM iterStreamLen =-    iterateSource iterStreamLen (S.mapMWith S.consM return)--{-# INLINE iterateFilterEven #-}-iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)--{-# INLINE iterateTakeAll #-}-iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int-iterateTakeAll streamLen iterStreamLen =-    iterateSource iterStreamLen (S.take streamLen)--{-# INLINE iterateDropOne #-}-iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)--{-# INLINE iterateDropWhileTrue #-}-iterateDropWhileTrue :: S.MonadAsync m =>-    Int -> Int -> Int -> Int -> Stream m Int-iterateDropWhileTrue streamLen iterStreamLen =-    iterateSource iterStreamLen (S.dropWhile (<= streamLen))------------------------------------------------------------------------------------ Zipping----------------------------------------------------------------------------------{-# INLINE zipWith #-}-zipWith :: Monad m => Stream m Int -> m ()-zipWith src = drain $ S.zipWith (,) src src--{-# INLINE zipWithM #-}-zipWithM :: Monad m => Stream m Int -> m ()-zipWithM src = drain $ S.zipWithM (curry return) src src--{-# INLINE sortByK #-}-sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a-sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure--{-# INLINE sortBy #-}-sortBy :: Monad m => Stream m Int -> m ()-sortBy = drain . sortByK compare------------------------------------------------------------------------------------ Mixed Composition----------------------------------------------------------------------------------{-# INLINE scanMap #-}-scanMap :: Monad m => Int -> Stream m Int -> m ()-scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0--{-# INLINE dropMap #-}-dropMap :: Monad m => Int -> Stream m Int -> m ()-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1--{-# INLINE dropScan #-}-dropScan :: Monad m => Int -> Stream m Int -> m ()-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1--{-# INLINE takeDrop #-}-takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()-takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen--{-# INLINE takeScan #-}-takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()-takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen--{-# INLINE takeMap #-}-takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()-takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen--{-# INLINE filterDrop #-}-filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()-filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)--{-# INLINE filterTake #-}-filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()-filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)--{-# INLINE filterScan #-}-filterScan :: Monad m => Int -> Stream m Int -> m ()-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)--{-# INLINE filterMap #-}-filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()-filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)------------------------------------------------------------------------------------ ConcatMap------------------------------------------------------------------------------------ concatMap unfoldrM/unfoldrM--{-# INLINE concatMap #-}-concatMap :: Int -> Int -> Int -> IO ()-concatMap outer inner n =-    S.drain $ S.concatMap-        (\_ -> unfoldrM inner n)-        (unfoldrM outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMap-#endif---- concatMap unfoldr/unfoldr--{-# INLINE concatMapPure #-}-concatMapPure :: Int -> Int -> Int -> IO ()-concatMapPure outer inner n =-    S.drain $ S.concatMap-        (\_ -> unfoldr inner n)-        (unfoldr outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapPure-#endif---- concatMap replicate/unfoldrM--{-# INLINE concatMapRepl #-}-concatMapRepl :: Int -> Int -> Int -> IO ()-concatMapRepl outer inner n =-    S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapRepl-#endif---- concatMapWith--{-# INLINE sourceConcatMapId #-}-sourceConcatMapId :: Monad m-    => Int -> Int -> Stream m (Stream m Int)-sourceConcatMapId val n =-    S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]--{-# INLINE concatMapBySerial #-}-concatMapBySerial :: Int -> Int -> Int -> IO ()-concatMapBySerial outer inner n =-    S.drain $ S.concatMapWith S.serial-        (unfoldrM inner)-        (unfoldrM outer n)------------------------------------------------------------------------------------ Nested Composition----------------------------------------------------------------------------------{-# INLINE drainApplicative #-}-drainApplicative :: Monad m => Stream m Int -> m ()-drainApplicative s = drain $ do-    (+) <$> s <*> s--{-# INLINE drainMonad #-}-drainMonad :: Monad m => Stream m Int -> m ()-drainMonad s = drain $ do-    x <- s-    y <- s-    return $ x + y--{-# INLINE drainMonad3 #-}-drainMonad3 :: Monad m => Stream m Int -> m ()-drainMonad3 s = drain $ do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutMonad #-}-filterAllOutMonad-    :: Monad m-    => Stream m Int -> m ()-filterAllOutMonad str = drain $ do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else S.nil--{-# INLINE filterAllInMonad #-}-filterAllInMonad-    :: Monad m-    => Stream m Int -> m ()-filterAllInMonad str = drain $ do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else S.nil------------------------------------------------------------------------------------ Nested Composition Pure lists------------------------------------------------------------------------------------ There are several list benchmarks here for comparison with lists. It is easy--- and convenient to see the comparisons when they are here, otherwise we'll--- have to add a separate module for list benchmarks with the same names and--- then add a comparison in bench.sh.--{-# INLINE unfoldrList #-}-unfoldrList :: Int -> Int -> [Int]-unfoldrList maxval n = List.unfoldr step n-    where-    step cnt =-        if cnt > n + maxval-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE toNullApNestedList #-}-toNullApNestedList :: [Int] -> [Int]-toNullApNestedList s = (+) <$> s <*> s--{-# INLINE toNullNestedList #-}-toNullNestedList :: [Int] -> [Int]-toNullNestedList s = do-    x <- s-    y <- s-    return $ x + y--{-# INLINE toNullNestedList3 #-}-toNullNestedList3 :: [Int] -> [Int]-toNullNestedList3 s = do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutNestedList #-}-filterAllOutNestedList :: [Int] -> [Int]-filterAllOutNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else []--{-# INLINE filterAllInNestedList #-}-filterAllInNestedList :: [Int] -> [Int]-filterAllInNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else []------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Stream.StreamK"--o_1_space_generation :: Int -> Benchmark-o_1_space_generation streamLen =-    bgroup "generation"-        [ benchFold "unfoldr" drain (unfoldr streamLen)-        , benchFold "unfoldrM" drain (unfoldrM streamLen)-        , benchFold "repeat" drain (repeat streamLen)-        , benchFold "repeatM" drain (repeatM streamLen)-        , benchFold "replicate" drain (replicate streamLen)-        , benchFold "replicateM" drain (replicateM streamLen)-        , benchFold "iterate" drain (iterate streamLen)-        , benchFold "iterateM" drain (iterateM streamLen)--        , benchFold "fromFoldable"  drain (fromFoldable streamLen)-        , benchFold "fromFoldableM" drain (fromFoldableM streamLen)--        -- appends-        , benchFold "concatMapFoldableWith"  drain (concatMapFoldableSerial streamLen)-        , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)-        ]--o_1_space_elimination :: Int -> Benchmark-o_1_space_elimination streamLen =-    bgroup "elimination"-        [ benchFold "toNull"   drain   (unfoldrM streamLen)-        , benchFold "mapM_"    mapM_    (unfoldrM streamLen)-        , benchFold "uncons"   uncons   (unfoldrM streamLen)-        , benchFold "init"   init     (unfoldrM streamLen)-        , benchFold "foldl'" foldl'    (unfoldrM streamLen)-        , benchFold "last"   last     (unfoldrM streamLen)-        ]--o_1_space_nested :: Int -> Benchmark-o_1_space_nested streamLen =-    bgroup "nested"-        [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)-        , benchFold "drainMonad"   drainMonad   (unfoldrM streamLen2)-        , benchFold "drainMonad3"  drainMonad3  (unfoldrM streamLen3)-        , benchFold "filterAllInMonad"  filterAllInMonad  (unfoldrM streamLen2)-        , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)-        , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)-        , benchFold "drainMonad (pure)"   drainMonad   (unfoldr streamLen2)-        , benchFold "drainMonad3 (pure)"  drainMonad3  (unfoldr streamLen3)-        , benchFold "filterAllInMonad (pure)"  filterAllInMonad  (unfoldr streamLen2)-        , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)-        ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop--o_1_space_transformation :: Int -> Benchmark-o_1_space_transformation streamLen =-    bgroup "transformation"-        [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)-        , benchFold "scanl'"   (scanl' 1) (unfoldrM streamLen)-        , benchFold "map"    (map  1) (unfoldrM streamLen)-        , benchFold "fmap"   (fmapK 1) (unfoldrM streamLen)-        , benchFold "mapM"   (mapM 1) (unfoldrM streamLen)-        , benchFold "mapMSerial"  (mapMSerial 1) (unfoldrM streamLen)-        ]--o_1_space_transformationX4 :: Int -> Benchmark-o_1_space_transformationX4 streamLen =-    bgroup "transformationX4"-        [ benchFold "scanl'"   (scanl' 4) (unfoldrM streamLen)-        , benchFold "map"    (map  4) (unfoldrM streamLen)-        , benchFold "fmap"   (fmapK 4) (unfoldrM streamLen)-        , benchFold "mapM"   (mapM 4) (unfoldrM streamLen)-        , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)-        -- XXX this is horribly slow-        -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)-        ]--o_1_space_concat :: Int -> Benchmark-o_1_space_concat streamLen =-    bgroup "concat"-        [ benchIOSrc1 "concatMapPure (n of 1)"-            (concatMapPure streamLen 1)-        , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"-            (concatMapPure streamLen2 streamLen2)-        , benchIOSrc1 "concatMapPure (1 of n)"-            (concatMapPure 1 streamLen)--        , benchIOSrc1 "concatMap (n of 1)"-            (concatMap streamLen 1)-        , benchIOSrc1 "concatMap (sqrt n of sqrt n)"-            (concatMap streamLen2 streamLen2)-        , benchIOSrc1 "concatMap (1 of n)"-            (concatMap 1 streamLen)--        , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"-            (concatMapRepl streamLen2 streamLen2)--        -- This is for comparison with concatMapFoldableWith-        , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"-            (S.drain-                . S.concatMapWith S.serial id-                . sourceConcatMapId streamLen)--        , benchIOSrc1 "concatMapBy serial (n of 1)"-            (concatMapBySerial streamLen 1)-        , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"-            (concatMapBySerial streamLen2 streamLen2)-        , benchIOSrc1 "concatMapBy serial (1 of n)"-            (concatMapBySerial 1 streamLen)-        , benchFold "sortBy" sortBy (unfoldrM streamLen)-        ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop--o_1_space_filtering :: Int -> Benchmark-o_1_space_filtering streamLen =-    bgroup "filtering"-        [ benchFold "filter-even"     (filterEven     1) (unfoldrM streamLen)-        , benchFold "filter-all-out"  (filterAllOut streamLen   1) (unfoldrM streamLen)-        , benchFold "filter-all-in"   (filterAllIn streamLen    1) (unfoldrM streamLen)-        , benchFold "take-all"        (takeAll streamLen        1) (unfoldrM streamLen)-        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  1) (unfoldrM streamLen)-        , benchFold "drop-one"        (dropOne        1) (unfoldrM streamLen)-        , benchFold "drop-all"        (dropAll streamLen        1) (unfoldrM streamLen)-        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  1) (unfoldrM streamLen)-        , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)-        ]--o_1_space_filteringX4 :: Int -> Benchmark-o_1_space_filteringX4 streamLen =-    bgroup "filteringX4"-        [ benchFold "filter-even"     (filterEven     4) (unfoldrM streamLen)-        , benchFold "filter-all-out"  (filterAllOut streamLen   4) (unfoldrM streamLen)-        , benchFold "filter-all-in"   (filterAllIn streamLen    4) (unfoldrM streamLen)-        , benchFold "take-all"        (takeAll streamLen        4) (unfoldrM streamLen)-        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  4) (unfoldrM streamLen)-        , benchFold "drop-one"        (dropOne        4) (unfoldrM streamLen)-        , benchFold "drop-all"        (dropAll streamLen        4) (unfoldrM streamLen)-        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  4) (unfoldrM streamLen)-        , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)-        ]--o_1_space_zipping :: Int -> Benchmark-o_1_space_zipping streamLen =-    bgroup "zipping"-        [ benchFold "zipWith" zipWith (unfoldrM streamLen)-        , benchFold "zipWithM" zipWithM (unfoldrM streamLen)-        ]--o_1_space_mixed :: Int -> Benchmark-o_1_space_mixed streamLen =-    bgroup "mixed"-        [ benchFold "scan-map"    (scanMap    1) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    1) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   1) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   1) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   1) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   1) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 1) (unfoldrM streamLen)-        ]--o_1_space_mixedX2 :: Int -> Benchmark-o_1_space_mixedX2 streamLen =-    bgroup "mixedX2"-        [ benchFold "scan-map"    (scanMap    2) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    2) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   2) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   2) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   2) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   2) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 2) (unfoldrM streamLen)-        ]--o_1_space_mixedX4 :: Int -> Benchmark-o_1_space_mixedX4 streamLen =-    bgroup "mixedX4"-        [ benchFold "scan-map"    (scanMap    4) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    4) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   4) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   4) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   4) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   4) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 4) (unfoldrM streamLen)-        ]--o_1_space_list :: Int -> Benchmark-o_1_space_list streamLen =-    bgroup "list"-      [ bgroup "elimination"-        [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)-        ]-      , bgroup "nested"-        [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)-        , benchList "toNull"   toNullNestedList (unfoldrList streamLen2)-        , benchList "toNull3"  toNullNestedList3 (unfoldrList streamLen3)-        , benchList "filterAllIn"  filterAllInNestedList (unfoldrList streamLen2)-        , benchList "filterAllOut"  filterAllOutNestedList (unfoldrList streamLen2)-        ]-      ]-    where--    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop--o_1_space :: Int -> Benchmark-o_1_space streamLen =-    bgroup (o_1_space_prefix moduleName)-      [ o_1_space_generation streamLen-      , o_1_space_elimination streamLen-      , o_1_space_nested streamLen-      , o_1_space_transformation streamLen-      , o_1_space_transformationX4 streamLen-      , o_1_space_concat streamLen-      , o_1_space_filtering streamLen-      , o_1_space_filteringX4 streamLen-      , o_1_space_zipping streamLen-      , o_1_space_mixed streamLen-      , o_1_space_mixedX2 streamLen-      , o_1_space_mixedX4 streamLen-      , o_1_space_list streamLen-      ]--o_n_heap :: Int -> Benchmark-o_n_heap streamLen =-    bgroup (o_n_heap_prefix moduleName)-      [ bgroup "transformation"-        [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)-        ]-      ]--{-# INLINE benchK #-}-benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark-benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f--o_n_stack :: Int -> Int -> Int -> Benchmark-o_n_stack streamLen iterStreamLen maxIters =-    bgroup (o_n_stack_prefix moduleName)-      [ bgroup "elimination"-        [ benchFold "tail"   tail     (unfoldrM streamLen)-        , benchFold "nullTail" nullTail (unfoldrM streamLen)-        , benchFold "headTail" headTail (unfoldrM streamLen)-        ]-      , bgroup "transformation"-        [-          -- XXX why do these need so much stack-          benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)-        , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)-        ]-      , bgroup "transformationX4"-        [-          benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)-        ]-      , bgroup "iterated"-        [ benchK "mapM"                 (iterateMapM iterStreamLen maxIters)-        , benchK "scan(1/10)"           (iterateScan iterStreamLen maxIters)-        , benchK "filterEven"           (iterateFilterEven iterStreamLen maxIters)-        , benchK "takeAll"              (iterateTakeAll streamLen iterStreamLen maxIters)-        , benchK "dropOne"              (iterateDropOne iterStreamLen maxIters)-        , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)-        , benchK "dropWhileTrue"        (iterateDropWhileTrue streamLen iterStreamLen maxIters)-        ]-      ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop--o_n_space :: Int -> Benchmark-o_n_space streamLen =-    bgroup (o_n_space_prefix moduleName)-      [ bgroup "elimination"-        [ benchFold "toList" toList   (unfoldrM streamLen)-        ]-      ]--{-# INLINE benchList #-}-benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark-benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f--main :: IO ()-main =-    defaultMain-        [ o_1_space streamLen-        , o_n_stack streamLen iterStreamLen maxIters-        , o_n_heap streamLen-        , o_n_space streamLen-        ]--    where--    streamLen = 100000-    maxIters = 10000-    iterStreamLen = 10
+ benchmark/Streamly/Benchmark/Data/Stream/Transform.hs view
@@ -0,0 +1,614 @@+-- |+-- Module      : Stream.Transform+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++{-# OPTIONS_GHC -Wno-orphans #-}+#ifdef USE_PRELUDE+#endif++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Stream.Transform (benchmarks) where++import Control.Monad.IO.Class (MonadIO(..))++import System.Random (randomRIO)++import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Scanl as Scanl++import qualified Stream.Common as Common+import qualified Streamly.Internal.Data.Unfold as Unfold++#ifdef USE_PRELUDE+import Control.DeepSeq (NFData(..))+import Data.Functor.Identity (Identity(..))+import qualified Prelude+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Stream.IsStream as Stream+import Streamly.Internal.Data.Time.Units+#else+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as Stream+#ifndef USE_STREAMLY_CORE+import qualified Streamly.Internal.Data.Stream.Prelude as Stream+#endif+#endif++import Test.Tasty.Bench+import Stream.Common hiding (scanl')+import Streamly.Benchmark.Common+import Prelude hiding (sequence, mapM)++#ifdef USE_PRELUDE+type Stream = Stream.SerialT+#endif++-------------------------------------------------------------------------------+-- Pipelines (stream-to-stream transformations)+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- one-to-one transformations+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- maps and scans+-------------------------------------------------------------------------------++#ifdef USE_PRELUDE+{-# INLINE scanl' #-}+scanl' :: MonadIO m => Int -> Stream m Int -> m ()+scanl' n = composeN n $ Stream.scanl' (+) 0++{-# INLINE scanlM' #-}+scanlM' :: MonadIO m => Int -> Stream m Int -> m ()+scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0)++{-# INLINE scanl1' #-}+scanl1' :: MonadIO m => Int -> Stream m Int -> m ()+scanl1' n = composeN n $ Stream.scanl1' (+)++{-# INLINE scanl1M' #-}+scanl1M' :: MonadIO m => Int -> Stream m Int -> m ()+scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a)+#endif++#ifndef USE_PRELUDE+{-# INLINE scan #-}+scan :: MonadIO m => Int -> Stream m Int -> m ()+scan n = composeN n $ Stream.scanl Scanl.sum++{-# INLINE postscan #-}+postscan :: MonadIO m => Int -> Stream m Int -> m ()+postscan n = composeN n $ Stream.postscanl Scanl.sum+#endif++#ifdef USE_PRELUDE+{-# INLINE postscanl' #-}+postscanl' :: MonadIO m => Int -> Stream m Int -> m ()+postscanl' n = composeN n $ Stream.postscanl' (+) 0++{-# INLINE postscanlM' #-}+postscanlM' :: MonadIO m => Int -> Stream m Int -> m ()+postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0)+#endif++{-# INLINE sequence #-}+sequence :: MonadAsync m => Stream m (m Int) -> m ()+sequence = Common.drain . Stream.sequence++{-# INLINE tap #-}+tap :: MonadIO m => Int -> Stream m Int -> m ()+tap n = composeN n $ Stream.tap FL.sum++#ifdef USE_PRELUDE+{-# INLINE pollCounts #-}+pollCounts :: Int -> Stream IO Int -> IO ()+pollCounts n =+    composeN n (Stream.pollCounts (const True) f)++    where++    f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1++{-# INLINE timestamped #-}+timestamped :: (MonadAsync m) => Stream m Int -> m ()+timestamped = Stream.drain . Stream.timestamped+#endif++{-+{-# INLINE foldrT #-}+foldrT :: MonadIO m => Int -> Stream m Int -> m ()+foldrT n = composeN n (unCrossStream . Stream.foldrT cns (CrossStream Stream.nil))++    where cns x (CrossStream xs) = CrossStream (Stream.cons x xs)++{-# INLINE foldrTMap #-}+foldrTMap :: MonadIO m => Int -> Stream m Int -> m ()+foldrTMap n = composeN n $ Stream.foldrT (\x xs -> x + 1 `Stream.cons` xs) Stream.nil+-}++{-# INLINE trace #-}+trace :: MonadAsync m => Int -> Stream m Int -> m ()+trace n = composeN n $ Stream.trace return++o_1_space_mapping :: Int -> [Benchmark]+o_1_space_mapping value =+    [ bgroup+        "mapping"+        [+        -- , benchIOSink value "foldrT" (foldrT 1)+        -- , benchIOSink value "foldrTMap" (foldrTMap 1)++        -- Mapping+          benchIOSink value "map" (mapN 1)+        , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->+              sequence (sourceUnfoldrAction value n)+        , benchIOSink value "mapM" (mapM 1)+        , benchIOSink value "tap" (tap 1)+#ifdef USE_PRELUDE+        , benchIOSink value "pollCounts 1 second" (pollCounts 1)+        , benchIOSink value "timestamped" timestamped++        -- Scanning+        , benchIOSink value "scanl'" (scanl' 1)+        , benchIOSink value "scanl1'" (scanl1' 1)+        , benchIOSink value "scanlM'" (scanlM' 1)+        , benchIOSink value "scanl1M'" (scanl1M' 1)+        , benchIOSink value "postscanl'" (postscanl' 1)+        , benchIOSink value "postscanlM'" (postscanlM' 1)+#endif+#ifndef USE_PRELUDE+        , benchIOSink value "scan" (scan 1)+        , benchIOSink value "postscan" (postscan 1)+#endif+        ]+    ]++o_1_space_mappingX4 :: Int -> [Benchmark]+o_1_space_mappingX4 value =+    [ bgroup "mappingX4"+        [ benchIOSink value "map" (mapN 4)+        , benchIOSink value "mapM" (mapM 4)+        , benchIOSink value "trace" (trace 4)++#ifdef USE_PRELUDE+        , benchIOSink value "scanl'" (scanl' 4)+        , benchIOSink value "scanl1'" (scanl1' 4)+        , benchIOSink value "scanlM'" (scanlM' 4)+        , benchIOSink value "scanl1M'" (scanl1M' 4)+        , benchIOSink value "postscanl'" (postscanl' 4)+        , benchIOSink value "postscanlM'" (postscanlM' 4)+#endif+#ifndef USE_PRELUDE+        , benchIOSink value "scan" (scan 4)+        , benchIOSink value "postscan" (postscan 4)+{-+        -- XXX this is horribly slow+        , let value16 = round (fromIntegral value**(1/16::Double))+           benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)+-}+#endif+        ]+    ]++#ifndef USE_PRELUDE+{-# INLINE sieveScan #-}+sieveScan :: Monad m => Stream m Int -> Stream m Int+sieveScan =+      Stream.mapMaybe snd+    . Stream.scanl (Scanl.mkScanlM (\(primes, _) n -> do+            return $+                let ps = takeWhile (\p -> p * p <= n) primes+                 in if all (\p -> n `mod` p /= 0) ps+                    then (primes ++ [n], Just n)+                    else (primes, Nothing)) (return ([2], Just 2)))+#endif++o_n_space_mapping :: Int -> [Benchmark]+o_n_space_mapping value =+    [ bgroup "mapping"+        [+#ifndef USE_PRELUDE+          benchIO "naive prime sieve"+            (\n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n))+#endif+        ]+    ]++-------------------------------------------------------------------------------+-- Functor+-------------------------------------------------------------------------------++o_1_space_functor :: Int -> [Benchmark]+o_1_space_functor value =+    [ bgroup "Functor"+        [ benchIOSink value "fmap" (mapN 1)+        , benchIOSink value "fmap x 4" (mapN 4)+        ]+    ]++-------------------------------------------------------------------------------+-- Iteration/looping utilities+-------------------------------------------------------------------------------++{-# INLINE iterateN #-}+iterateN :: (Int -> a -> a) -> a -> Int -> a+iterateN g initial count = f count initial++    where++    f (0 :: Int) x = x+    f i x = f (i - 1) (g i x)++-- Iterate a transformation over a singleton stream+{-# INLINE iterateSingleton #-}+iterateSingleton :: Applicative m =>+       (Int -> Stream m Int -> Stream m Int)+    -> Int+    -> Int+    -> Stream m Int+iterateSingleton g count n = iterateN g (Stream.fromPure n) count++{-+-- XXX need to check why this is slower than the explicit recursion above, even+-- if the above code is written in a foldr like head recursive way. We also+-- need to try this with foldlM' once #150 is fixed.+-- However, it is perhaps best to keep the iteration benchmarks independent of+-- foldrM and any related fusion issues.+{-# INLINE _iterateSingleton #-}+_iterateSingleton ::+       Monad m+    => (Int -> Stream m Int -> Stream m Int)+    -> Int+    -> Int+    -> Stream m Int+_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n+-}++o_n_space_iterated :: Int -> [Benchmark]+o_n_space_iterated value =+    [ bgroup "iterated"+        [ benchIO "(+) (n times) (baseline)" $ \i0 ->+            iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value+        , benchIOSrc "(<$) (n times)" $+            iterateSingleton (<$) value+        , benchIOSrc "fmap (n times)" $+            iterateSingleton (fmap . (+)) value+        {-+        , benchIOSrc fromSerial "_(<$) (n times)" $+            _iterateSingleton (<$) value+        , benchIOSrc fromSerial "_fmap (n times)" $+            _iterateSingleton (fmap . (+)) value+        -}+        ]+    ]++-------------------------------------------------------------------------------+-- Size reducing transformations (filtering)+-------------------------------------------------------------------------------++{-# INLINE filterEven #-}+filterEven :: MonadIO m => Int -> Stream m Int -> m ()+filterEven n = composeN n $ Stream.filter even++{-# INLINE filterAllOut #-}+filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()+filterAllOut value n = composeN n $ Stream.filter (> (value + 1))++{-# INLINE filterAllIn #-}+filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()+filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))++{-# INLINE filterMEven #-}+filterMEven :: MonadIO m => Int -> Stream m Int -> m ()+filterMEven n = composeN n $ Stream.filterM (return . even)++{-# INLINE filterMAllOut #-}+filterMAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()+filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1))++{-# INLINE filterMAllIn #-}+filterMAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()+filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1))++{-# INLINE _takeOne #-}+_takeOne :: MonadIO m => Int -> Stream m Int -> m ()+_takeOne n = composeN n $ Stream.take 1++{-# INLINE takeAll #-}+takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()+takeAll value n = composeN n $ Stream.take (value + 1)++{-# INLINE takeWhileTrue #-}+takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()+takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))++{-# INLINE takeWhileMTrue #-}+takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()+takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))++#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)+{-# INLINE takeInterval #-}+takeInterval :: Double -> Int -> Stream IO Int -> IO ()+takeInterval i n = composeN n (Stream.takeInterval i)++-- Inspection testing is disabled for takeInterval+-- Enable it when looking at it throughly+#ifdef INSPECTION+-- inspect $ hasNoType 'takeInterval ''SPEC+-- inspect $ hasNoTypeClasses 'takeInterval+-- inspect $ 'takeInterval `hasNoType` ''D.Step+#endif++{-# INLINE dropInterval #-}+dropInterval :: Double -> Int -> Stream IO Int -> IO ()+dropInterval i n = composeN n (Stream.dropInterval i)++-- Inspection testing is disabled for dropInterval+-- Enable it when looking at it throughly+#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'dropInterval+-- inspect $ 'dropInterval `hasNoType` ''D.Step+#endif+#endif++{-# INLINE dropOne #-}+dropOne :: MonadIO m => Int -> Stream m Int -> m ()+dropOne n = composeN n $ Stream.drop 1++{-# INLINE dropAll #-}+dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()+dropAll value n = composeN n $ Stream.drop (value + 1)++{-# INLINE dropWhileTrue #-}+dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()+dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))++{-# INLINE dropWhileMTrue #-}+dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()+dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))++{-# INLINE dropWhileFalse #-}+dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()+dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))++#ifdef USE_PRELUDE+-- XXX Decide on the time interval+{-# INLINE _intervalsOfSum #-}+_intervalsOfSum :: MonadAsync m => Double -> Int -> Stream m Int -> m ()+_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)+#endif++{-# INLINE findIndices #-}+findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()+findIndices value n = composeN n $ Stream.findIndices (== (value + 1))++{-# INLINE elemIndices #-}+elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()+elemIndices value n = composeN n $ Stream.elemIndices (value + 1)++{-# INLINE deleteBy #-}+deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()+deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)++-- uniq . uniq == uniq, composeN 2 ~ composeN 1+{-# INLINE uniq #-}+uniq :: MonadIO m => Int -> Stream m Int -> m ()+uniq n = composeN n Stream.uniq++{-# INLINE mapMaybe #-}+mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()+mapMaybe n =+    composeN n $+    Stream.mapMaybe+        (\x ->+             if odd x+             then Nothing+             else Just x)++{-# INLINE mapMaybeM #-}+mapMaybeM :: MonadAsync m => Int -> Stream m Int -> m ()+mapMaybeM n =+    composeN n $+    Stream.mapMaybeM+        (\x ->+             if odd x+             then return Nothing+             else return $ Just x)++o_1_space_filtering :: Int -> [Benchmark]+o_1_space_filtering value =+    [ bgroup "filtering"+        [ benchIOSink value "filter-even" (filterEven 1)+        , benchIOSink value "filter-all-out" (filterAllOut value 1)+        , benchIOSink value "filter-all-in" (filterAllIn value 1)++        , benchIOSink value "filterM-even" (filterMEven 1)+        , benchIOSink value "filterM-all-out" (filterMAllOut value 1)+        , benchIOSink value "filterM-all-in" (filterMAllIn value 1)++        -- Trimming+        , benchIOSink value "take-all" (takeAll value 1)+        , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)+     -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)+        , benchIOSink value "drop-one" (dropOne 1)+        , benchIOSink value "drop-all" (dropAll value 1)+#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)+        , benchIOSink value "takeInterval-all" (takeInterval 10000 1)+        , benchIOSink value "dropInterval-all" (dropInterval 10000 1)+#endif+        , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)+     -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)+        , benchIOSink+              value+              "dropWhile-false"+              (dropWhileFalse value 1)+        , benchIOSink value "deleteBy" (deleteBy value 1)++        , benchIOSink value "uniq" (uniq 1)++        -- Map and filter+        , benchIOSink value "mapMaybe" (mapMaybe 1)+        , benchIOSink value "mapMaybeM" (mapMaybeM 1)++        -- Searching (stateful map and filter)+        , benchIOSink value "findIndices" (findIndices value 1)+        , benchIOSink value "elemIndices" (elemIndices value 1)+        ]+    ]++o_1_space_filteringX4 :: Int -> [Benchmark]+o_1_space_filteringX4 value =+    [ bgroup "filteringX4"+        [ benchIOSink value "filter-even" (filterEven 4)+        , benchIOSink value "filter-all-out" (filterAllOut value 4)+        , benchIOSink value "filter-all-in" (filterAllIn value 4)++        , benchIOSink value "filterM-even" (filterMEven 4)+        , benchIOSink value "filterM-all-out" (filterMAllOut value 4)+        , benchIOSink value "filterM-all-in" (filterMAllIn value 4)++        -- trimming+        , benchIOSink value "take-all" (takeAll value 4)+        , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)+        , benchIOSink value "takeWhileM-true" (takeWhileMTrue value 4)+        , benchIOSink value "drop-one" (dropOne 4)+        , benchIOSink value "drop-all" (dropAll value 4)+        , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)+        , benchIOSink value "dropWhileM-true" (dropWhileMTrue value 4)+        , benchIOSink+              value+              "dropWhile-false"+              (dropWhileFalse value 4)+        , benchIOSink value "deleteBy" (deleteBy value 4)++        , benchIOSink value "uniq" (uniq 4)++        -- map and filter+        , benchIOSink value "mapMaybe" (mapMaybe 4)+        , benchIOSink value "mapMaybeM" (mapMaybeM 4)++        -- searching+        , benchIOSink value "findIndices" (findIndices value 4)+        , benchIOSink value "elemIndices" (elemIndices value 4)+        ]+    ]++-------------------------------------------------------------------------------+-- Size increasing transformations (insertions)+-------------------------------------------------------------------------------++{-# INLINE intersperse #-}+intersperse :: MonadAsync m => Int -> Int -> Stream m Int -> m ()+intersperse value n = composeN n $ Stream.intersperse (value + 1)++{-# INLINE intersperseM #-}+intersperseM :: MonadAsync m => Int -> Int -> Stream m Int -> m ()+intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)++{-# INLINE insertBy #-}+insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()+insertBy value n = composeN n $ Stream.insertBy compare (value + 1)++{-# INLINE interposeSuffix #-}+interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()+interposeSuffix value n =+    composeN n $ Stream.unfoldEachSepBy (value + 1) Unfold.identity++{-# INLINE intercalateSuffix #-}+intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()+intercalateSuffix value n =+    composeN n $ Stream.unfoldEachSepBySeq (value + 1) Unfold.identity++o_1_space_inserting :: Int -> [Benchmark]+o_1_space_inserting value =+    [ bgroup "inserting"+        [ benchIOSink value "intersperse" (intersperse value 1)+        , benchIOSink value "intersperseM" (intersperseM value 1)+        , benchIOSink value "insertBy" (insertBy value 1)+        , benchIOSink value "interposeSuffix" (interposeSuffix value 1)+        , benchIOSink value "intercalateSuffix" (intercalateSuffix value 1)+        , benchIOSinkPureSrc value "interspersePure" (intersperse value 1)+        ]+    ]++o_1_space_insertingX4 :: Int -> [Benchmark]+o_1_space_insertingX4 value =+    [ bgroup "insertingX4"+        [ benchIOSink value "intersperse" (intersperse value 4)+        , benchIOSink value "insertBy" (insertBy value 4)+        ]+    ]++-------------------------------------------------------------------------------+-- Indexing+-------------------------------------------------------------------------------++{-# INLINE indexed #-}+indexed :: MonadIO m => Int -> Stream m Int -> m ()+indexed n = composeN n (fmap snd . Stream.indexed)++{-# INLINE indexedR #-}+indexedR :: MonadIO m => Int -> Int -> Stream m Int -> m ()+indexedR value n = composeN n (fmap snd . Stream.indexedR value)++o_1_space_indexing :: Int -> [Benchmark]+o_1_space_indexing value =+    [ bgroup "indexing"+        [ benchIOSink value "indexed" (indexed 1)+        , benchIOSink value "indexedR" (indexedR value 1)+        ]+    ]++o_1_space_indexingX4 :: Int -> [Benchmark]+o_1_space_indexingX4 value =+    [ bgroup "indexingx4"+        [ benchIOSink value "indexed" (indexed 4)+        , benchIOSink value "indexedR" (indexedR value 4)+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+benchmarks :: String -> Int -> [Benchmark]+benchmarks moduleName size =+        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat+            [ o_1_space_functor size+            , o_1_space_mapping size+            , o_1_space_mappingX4 size+            , o_1_space_filtering size+            , o_1_space_filteringX4 size+            , o_1_space_inserting size+            , o_1_space_insertingX4 size+            , o_1_space_indexing size+            , o_1_space_indexingX4 size+            ]+        , bgroup (o_n_space_prefix moduleName) $ Prelude.concat+            [+              o_n_space_mapping size+            , o_n_space_iterated size+            ]+        ]
+ benchmark/Streamly/Benchmark/Data/StreamK.hs view
@@ -0,0 +1,980 @@+-- |+-- Module      : Streamly.Benchmark.Data.StreamK+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Main (main) where++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Monad (when)+import Data.Maybe (isJust)+import Streamly.Internal.Data.StreamK (StreamK)+import System.Random (randomRIO)+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark)++import qualified Data.List as List+import qualified Prelude as P+import qualified Streamly.Internal.Data.StreamK as StreamK++import Prelude hiding+    ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init+    , iterate, repeat, replicate+    )+import Streamly.Benchmark.Common+#ifdef INSPECTION+import Test.Inspection+#endif++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++{-# INLINE unfoldr #-}+unfoldr :: Int -> Int -> StreamK m Int+unfoldr streamLen n = StreamK.unfoldr step n+    where+    step cnt =+        if cnt > n + streamLen+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE unfoldrM #-}+unfoldrM :: Monad m => Int -> Int -> StreamK m Int+unfoldrM streamLen n = StreamK.unfoldrMWith StreamK.consM step n+    where+    step cnt =+        if cnt > n + streamLen+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE repeat #-}+repeat :: Int -> Int -> StreamK m Int+repeat streamLen = StreamK.take streamLen . StreamK.repeat++{-# INLINE repeatM #-}+repeatM :: Monad m => Int -> Int -> StreamK m Int+repeatM streamLen = StreamK.take streamLen . StreamK.repeatM . return++{-# INLINE replicate #-}+replicate :: Int -> Int -> StreamK m Int+replicate = StreamK.replicate++{-# INLINE replicateM #-}+replicateM :: Monad m => Int -> Int -> StreamK m Int+replicateM streamLen = StreamK.replicateMWith StreamK.consM streamLen . return++{-# INLINE iterate #-}+iterate :: Int -> Int -> StreamK m Int+iterate streamLen = StreamK.take streamLen . StreamK.iterate (+1)++{-# INLINE iterateM #-}+iterateM :: Monad m => Int -> Int -> StreamK m Int+iterateM streamLen = StreamK.take streamLen . StreamK.iterateM (return . (+1)) . return++{-# INLINE fromFoldable #-}+fromFoldable :: Int -> Int -> StreamK m Int+fromFoldable streamLen n = StreamK.fromFoldable [n..n+streamLen]++{- HLINT ignore "Fuse foldr/fmap" -}+{-# INLINE fromFoldableM #-}+fromFoldableM :: Monad m => Int -> Int -> StreamK m Int+fromFoldableM streamLen n =+    List.foldr StreamK.consM StreamK.nil (Prelude.fmap return [n..n+streamLen])++{-# INLINABLE concatMapFoldableWith #-}+concatMapFoldableWith :: P.Foldable f+    => (StreamK m b -> StreamK m b -> StreamK m b)+    -> (a -> StreamK m b)+    -> f a+    -> StreamK m b+concatMapFoldableWith f g = P.foldr (f . g) StreamK.nil++{-# INLINE concatMapFoldableSerial #-}+concatMapFoldableSerial :: Int -> Int -> StreamK m Int+concatMapFoldableSerial streamLen n =+    concatMapFoldableWith StreamK.append StreamK.fromPure [n..n+streamLen]++{-# INLINE concatMapFoldableSerialM #-}+concatMapFoldableSerialM :: Monad m => Int -> Int -> StreamK m Int+concatMapFoldableSerialM streamLen n =+    concatMapFoldableWith StreamK.append (StreamK.fromEffect . return) [n..n+streamLen]++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE drain #-}+drain :: Monad m => StreamK m a -> m ()+drain = StreamK.drain++{-# INLINE mapM_ #-}+mapM_ :: Monad m => StreamK m a -> m ()+mapM_ = StreamK.mapM_ (\_ -> return ())++{-# INLINE uncons #-}+uncons :: Monad m => StreamK m Int -> m ()+uncons s = do+    r <- StreamK.uncons s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons t++{-# INLINE init #-}+init :: Monad m => StreamK m a -> m ()+init s = do+    t <- StreamK.init s+    P.mapM_ StreamK.drain t++{-# INLINE tail #-}+tail :: Monad m => StreamK m a -> m ()+tail s = StreamK.tail s >>= P.mapM_ tail++{-# INLINE nullTail #-}+nullTail :: Monad m => StreamK m Int -> m ()+nullTail s = do+    r <- StreamK.null s+    when (not r) $ StreamK.tail s >>= P.mapM_ nullTail++{-# INLINE headTail #-}+headTail :: Monad m => StreamK m Int -> m ()+headTail s = do+    h <- StreamK.head s+    when (isJust h) $ StreamK.tail s >>= P.mapM_ headTail++{-# INLINE toList #-}+toList :: Monad m => StreamK m Int -> m [Int]+toList = StreamK.toList++{-# INLINE foldl' #-}+foldl' :: Monad m => StreamK m Int -> m Int+foldl' = StreamK.foldl' (+) 0++{-# INLINE foldlM' #-}+foldlM' :: Monad m => StreamK m Int -> m Int+foldlM' = StreamK.foldlM' (\b a -> return (b + a)) (return 0)++{-# INLINE last #-}+last :: Monad m => StreamK m Int -> m (Maybe Int)+last = StreamK.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE composeN #-}+composeN+    :: Monad m+    => Int -> (StreamK m Int -> StreamK m Int) -> StreamK m Int -> m ()+composeN n f =+    case n of+        1 -> drain . f+        2 -> drain . f . f+        3 -> drain . f . f . f+        4 -> drain . f . f . f . f+        _ -> undefined++{-# INLINE scanl' #-}+scanl' :: Monad m => Int -> StreamK m Int -> m ()+scanl' n = composeN n $ StreamK.scanl' (+) 0++{-# INLINE map #-}+map :: Monad m => Int -> StreamK m Int -> m ()+map n = composeN n $ StreamK.map (+ 1)++{-# INLINE fmapK #-}+fmapK :: Monad m => Int -> StreamK m Int -> m ()+fmapK n = composeN n $ P.fmap (+ 1)++{-# INLINE mapM #-}+mapM :: Monad m => Int -> StreamK m Int -> m ()+mapM n = composeN n $ StreamK.mapMWith StreamK.consM return++{-# INLINE mapMSerial #-}+mapMSerial :: Monad m => Int -> StreamK m Int -> m ()+mapMSerial n = composeN n $ StreamK.mapMSerial return++{-# INLINE filterEven #-}+filterEven :: Monad m => Int -> StreamK m Int -> m ()+filterEven n = composeN n $ StreamK.filter even++{-# INLINE filterAllOut #-}+filterAllOut :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterAllOut streamLen n = composeN n $ StreamK.filter (> streamLen)++{-# INLINE filterAllIn #-}+filterAllIn :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterAllIn streamLen n = composeN n $ StreamK.filter (<= streamLen)++{-# INLINE _takeOne #-}+_takeOne :: Monad m => Int -> StreamK m Int -> m ()+_takeOne n = composeN n $ StreamK.take 1++{-# INLINE takeAll #-}+takeAll :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeAll streamLen n = composeN n $ StreamK.take streamLen++{-# INLINE takeWhileTrue #-}+takeWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeWhileTrue streamLen n = composeN n $ StreamK.takeWhile (<= streamLen)++{-# INLINE dropOne #-}+dropOne :: Monad m => Int -> StreamK m Int -> m ()+dropOne n = composeN n $ StreamK.drop 1++{-# INLINE dropAll #-}+dropAll :: Monad m => Int -> Int -> StreamK m Int -> m ()+dropAll streamLen n = composeN n $ StreamK.drop streamLen++{-# INLINE dropWhileTrue #-}+dropWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m ()+dropWhileTrue streamLen n = composeN n $ StreamK.dropWhile (<= streamLen)++{-# INLINE dropWhileFalse #-}+dropWhileFalse :: Monad m => Int -> StreamK m Int -> m ()+dropWhileFalse n = composeN n $ StreamK.dropWhile (<= 1)++{-# INLINE foldrS #-}+foldrS :: Monad m => Int -> StreamK m Int -> m ()+foldrS n = composeN n $ StreamK.foldrS StreamK.cons StreamK.nil++{-# INLINE foldlS #-}+foldlS :: Monad m => Int -> StreamK m Int -> m ()+foldlS n = composeN n $ StreamK.foldlS (flip StreamK.cons) StreamK.nil++{-# INLINE intersperse #-}+intersperse :: Monad m => Int -> Int -> StreamK m Int -> m ()+intersperse streamLen n = composeN n $ StreamK.intersperse streamLen++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++{-# INLINE iterateSource #-}+iterateSource+    :: Monad m => Int -> (StreamK m Int -> StreamK m Int) -> Int -> Int -> StreamK m Int+iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)+    where+        f (0 :: Int) m = g m+        f x m = g (f (x P.- 1) m)++-- this is quadratic+{-# INLINE iterateScan #-}+iterateScan :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateScan iterStreamLen maxIters =+    iterateSource iterStreamLen (StreamK.scanl' (+) 0) (maxIters `div` 10)++-- this is quadratic+{-# INLINE iterateDropWhileFalse #-}+iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> StreamK m Int+iterateDropWhileFalse streamLen iterStreamLen maxIters =+    iterateSource iterStreamLen (StreamK.dropWhile (> streamLen)) (maxIters `div` 10)++{-# INLINE iterateMapM #-}+iterateMapM :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateMapM iterStreamLen =+    iterateSource iterStreamLen (StreamK.mapMWith StreamK.consM return)++{-# INLINE iterateFilterEven #-}+iterateFilterEven :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (StreamK.filter even)++{-# INLINE iterateTakeAll #-}+iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> StreamK m Int+iterateTakeAll streamLen iterStreamLen =+    iterateSource iterStreamLen (StreamK.take streamLen)++{-# INLINE iterateDropOne #-}+iterateDropOne :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateDropOne iterStreamLen = iterateSource iterStreamLen (StreamK.drop 1)++{-# INLINE iterateDropWhileTrue #-}+iterateDropWhileTrue ::+    Monad m => Int -> Int -> Int -> Int -> StreamK m Int+iterateDropWhileTrue streamLen iterStreamLen =+    iterateSource iterStreamLen (StreamK.dropWhile (<= streamLen))++-------------------------------------------------------------------------------+-- Zipping+-------------------------------------------------------------------------------++{-# INLINE zipWith #-}+zipWith :: Monad m => StreamK m Int -> m ()+zipWith src = drain $ StreamK.zipWith (,) src src++{-# INLINE zipWithM #-}+zipWithM :: Monad m => StreamK m Int -> m ()+zipWithM src = drain $ StreamK.zipWithM (curry return) src src++{-# INLINE sortByK #-}+sortByK :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a+sortByK f = StreamK.mergeMapWith (StreamK.mergeBy f) StreamK.fromPure++{-# INLINE sortBy #-}+sortBy :: Monad m => StreamK m Int -> m ()+sortBy = drain . sortByK compare++-------------------------------------------------------------------------------+-- Mixed Composition+-------------------------------------------------------------------------------++{-# INLINE scanMap #-}+scanMap :: Monad m => Int -> StreamK m Int -> m ()+scanMap n = composeN n $ StreamK.map (subtract 1) . StreamK.scanl' (+) 0++{-# INLINE dropMap #-}+dropMap :: Monad m => Int -> StreamK m Int -> m ()+dropMap n = composeN n $ StreamK.map (subtract 1) . StreamK.drop 1++{-# INLINE dropScan #-}+dropScan :: Monad m => Int -> StreamK m Int -> m ()+dropScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.drop 1++{-# INLINE takeDrop #-}+takeDrop :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.take streamLen++{-# INLINE takeScan #-}+takeScan :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeScan streamLen n = composeN n $ StreamK.scanl' (+) 0 . StreamK.take streamLen++{-# INLINE takeMap #-}+takeMap :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.take streamLen++{-# INLINE filterDrop #-}+filterDrop :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.filter (<= streamLen)++{-# INLINE filterTake #-}+filterTake :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterTake streamLen n = composeN n $ StreamK.take streamLen . StreamK.filter (<= streamLen)++{-# INLINE filterScan #-}+filterScan :: Monad m => Int -> StreamK m Int -> m ()+filterScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.filter (<= maxBound)++{-# INLINE filterMap #-}+filterMap :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.filter (<= streamLen)++-------------------------------------------------------------------------------+-- ConcatMap+-------------------------------------------------------------------------------++-- concatMap unfoldrM/unfoldrM++{-# INLINE concatMap #-}+concatMap :: Int -> Int -> Int -> IO ()+concatMap outer inner n =+    StreamK.drain $ StreamK.concatMap+        (\_ -> unfoldrM inner n)+        (unfoldrM outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMap+#endif++-- concatMap unfoldr/unfoldr++{-# INLINE concatMapPure #-}+concatMapPure :: Int -> Int -> Int -> IO ()+concatMapPure outer inner n =+    StreamK.drain $ StreamK.concatMap+        (\_ -> unfoldr inner n)+        (unfoldr outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapPure+#endif++-- concatMap replicate/unfoldrM++{-# INLINE concatMapRepl #-}+concatMapRepl :: Int -> Int -> Int -> IO ()+concatMapRepl outer inner n =+    StreamK.drain $ StreamK.concatMap (StreamK.replicate inner) (unfoldrM outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapRepl+#endif++-- concatMapWith++{-# INLINE sourceConcatMapId #-}+sourceConcatMapId :: Monad m+    => Int -> Int -> StreamK m (StreamK m Int)+sourceConcatMapId val n =+    StreamK.fromFoldable $ fmap (StreamK.fromEffect . return) [n..n+val]++{-# INLINE concatMapBySerial #-}+concatMapBySerial :: Int -> Int -> Int -> IO ()+concatMapBySerial outer inner n =+    StreamK.drain $ StreamK.concatMapWith StreamK.append+        (unfoldrM inner)+        (unfoldrM outer n)++-------------------------------------------------------------------------------+-- Nested Composition+-------------------------------------------------------------------------------++instance Monad m => Applicative (StreamK.StreamK m) where+    {-# INLINE pure #-}+    pure = StreamK.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = StreamK.crossApply++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>) = StreamK.crossApplySnd++    {-# INLINE (<*) #-}+    (<*) = StreamK.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.StreamK m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip StreamK.concatMap++{-# INLINE drainApplicative #-}+drainApplicative :: Monad m => StreamK m Int -> m ()+drainApplicative s = drain $ do+    (+) <$> s <*> s++{-# INLINE drainMonad #-}+drainMonad :: Monad m => StreamK m Int -> m ()+drainMonad s = drain $ do+    x <- s+    y <- s+    return $ x + y++{-# INLINE drainConcatFor1 #-}+drainConcatFor1 :: Monad m => StreamK m Int -> m ()+drainConcatFor1 s = drain $ do+    StreamK.concatFor s $ \x ->+            StreamK.fromPure $ x + 1++{-# INLINE drainConcatFor #-}+drainConcatFor :: Monad m => StreamK m Int -> m ()+drainConcatFor s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            StreamK.fromPure $ x + y++{-# INLINE drainConcatForM #-}+drainConcatForM :: Monad m => StreamK m Int -> m ()+drainConcatForM s = drain $ do+    StreamK.concatForM s $ \x ->+        pure $ StreamK.concatForM s $ \y ->+            pure $ StreamK.fromPure $ x + y++{-# INLINE drainMonad3 #-}+drainMonad3 :: Monad m => StreamK m Int -> m ()+drainMonad3 s = drain $ do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE drainConcatFor3 #-}+drainConcatFor3 :: Monad m => StreamK m Int -> m ()+drainConcatFor3 s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            StreamK.concatFor s $ \z ->+                StreamK.fromPure $ x + y + z++{-# INLINE drainConcatFor3M #-}+drainConcatFor3M :: Monad m => StreamK m Int -> m ()+drainConcatFor3M s = drain $ do+    StreamK.concatForM s $ \x ->+        pure $ StreamK.concatForM s $ \y ->+            pure $ StreamK.concatForM s $ \z ->+                pure $ StreamK.fromPure $ x + y + z++{-# INLINE drainConcatFor4 #-}+drainConcatFor4 :: Monad m => StreamK m Int -> m ()+drainConcatFor4 s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            StreamK.concatFor s $ \z ->+                StreamK.concatFor s $ \w ->+                    StreamK.fromPure $ x + y + z + w++{-# INLINE drainConcatFor5 #-}+drainConcatFor5 :: Monad m => StreamK m Int -> m ()+drainConcatFor5 s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            StreamK.concatFor s $ \z ->+                StreamK.concatFor s $ \w ->+                    StreamK.concatFor s $ \u ->+                        StreamK.fromPure $ x + y + z + w + u++{-# INLINE filterAllOutMonad #-}+filterAllOutMonad+    :: Monad m+    => StreamK m Int -> m ()+filterAllOutMonad str = drain $ do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else StreamK.nil++{-# INLINE filterAllOutConcatFor #-}+filterAllOutConcatFor+    :: Monad m+    => StreamK m Int -> m ()+filterAllOutConcatFor s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            let s1 = x + y+             in if s1 < 0+                then StreamK.fromPure s1+                else StreamK.nil++{-# INLINE filterAllInMonad #-}+filterAllInMonad+    :: Monad m+    => StreamK m Int -> m ()+filterAllInMonad str = drain $ do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else StreamK.nil++{-# INLINE filterAllInConcatFor #-}+filterAllInConcatFor+    :: Monad m+    => StreamK m Int -> m ()+filterAllInConcatFor s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            let s1 = x + y+             in if s1 > 0+                then StreamK.fromPure s1+                else StreamK.nil++-------------------------------------------------------------------------------+-- Nested Composition Pure lists+-------------------------------------------------------------------------------++-- There are several list benchmarks here for comparison with lists. It is easy+-- and convenient to see the comparisons when they are here, otherwise we'll+-- have to add a separate module for list benchmarks with the same names and+-- then add a comparison in bench.sh.++{-# INLINE unfoldrList #-}+unfoldrList :: Int -> Int -> [Int]+unfoldrList maxval n = List.unfoldr step n+    where+    step cnt =+        if cnt > n + maxval+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE toNullApNestedList #-}+toNullApNestedList :: [Int] -> [Int]+toNullApNestedList s = (+) <$> s <*> s++{-# INLINE toNullNestedList #-}+toNullNestedList :: [Int] -> [Int]+toNullNestedList s = do+    x <- s+    y <- s+    return $ x + y++{-# INLINE toNullNestedList3 #-}+toNullNestedList3 :: [Int] -> [Int]+toNullNestedList3 s = do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE filterAllOutNestedList #-}+filterAllOutNestedList :: [Int] -> [Int]+filterAllOutNestedList str = do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else []++{-# INLINE filterAllInNestedList #-}+filterAllInNestedList :: [Int] -> [Int]+filterAllInNestedList str = do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else []++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.StreamK"++o_1_space_generation :: Int -> Benchmark+o_1_space_generation streamLen =+    bgroup "generation"+        [ benchFold "unfoldr" drain (unfoldr streamLen)+        , benchFold "unfoldrM" drain (unfoldrM streamLen)+        , benchFold "repeat" drain (repeat streamLen)+        , benchFold "repeatM" drain (repeatM streamLen)+        , benchFold "replicate" drain (replicate streamLen)+        , benchFold "replicateM" drain (replicateM streamLen)+        , benchFold "iterate" drain (iterate streamLen)+        , benchFold "iterateM" drain (iterateM streamLen)++        , benchFold "fromFoldable"  drain (fromFoldable streamLen)+        , benchFold "fromFoldableM" drain (fromFoldableM streamLen)++        -- appends+        , benchFold "concatMapFoldableWith"  drain (concatMapFoldableSerial streamLen)+        , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)+        ]++o_1_space_elimination :: Int -> Benchmark+o_1_space_elimination streamLen =+    bgroup "elimination"+        [ benchFold "toNull"   drain   (unfoldrM streamLen)+        , benchFold "mapM_"    mapM_    (unfoldrM streamLen)+        , benchFold "uncons"   uncons   (unfoldrM streamLen)+        , benchFold "init"   init     (unfoldrM streamLen)+        , benchFold "foldl'" foldl'    (unfoldrM streamLen)+        , benchFold "foldlM'" foldlM' (unfoldrM streamLen)+        , benchFold "last"   last     (unfoldrM streamLen)+        ]++o_1_space_ap :: Int -> Benchmark+o_1_space_ap streamLen =+    bgroup "Applicative"+        [ benchFold "drain2" drainApplicative (unfoldrM streamLen2)+        , benchFold "pureDrain2" drainApplicative (unfoldr streamLen2)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop++o_1_space_monad :: Int -> Benchmark+o_1_space_monad streamLen =+    bgroup "Monad"+        [ benchFold "drain2"   drainMonad   (unfoldrM streamLen2)+        , benchFold "drain3"  drainMonad3  (unfoldrM streamLen3)+        , benchFold "filterAllIn2"  filterAllInMonad  (unfoldrM streamLen2)+        , benchFold "filterAllOut2" filterAllOutMonad (unfoldrM streamLen2)+        , benchFold "pureDrain2"   drainMonad   (unfoldr streamLen2)+        , benchFold "pureDrain3"  drainMonad3  (unfoldr streamLen3)+        , benchFold "pureFilterAllIn2"  filterAllInMonad  (unfoldr streamLen2)+        , benchFold "pureFilterAllOut2" filterAllOutMonad (unfoldr streamLen2)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop++o_1_space_bind :: Int -> Benchmark+o_1_space_bind streamLen =+    bgroup "concatFor"+        [ benchFold "drain1"   drainConcatFor1   (unfoldrM streamLen)+        , benchFold "drain2"   drainConcatFor   (unfoldrM streamLen2)+        , benchFold "drainM2"   drainConcatForM   (unfoldrM streamLen2)+        , benchFold "drain3"   drainConcatFor3   (unfoldrM streamLen3)+        , benchFold "drain4"   drainConcatFor4   (unfoldrM streamLen4)+        , benchFold "drain5"   drainConcatFor5   (unfoldrM streamLen5)+        , benchFold "drainM3"   drainConcatFor3M   (unfoldrM streamLen3)+        , benchFold "filterAllIn2"  filterAllInConcatFor  (unfoldrM streamLen2)+        , benchFold "filterAllOut2" filterAllOutConcatFor (unfoldrM streamLen2)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop+    streamLen4 = round (P.fromIntegral streamLen**(1/4::P.Double)) -- 4 times nested loop+    streamLen5 = round (P.fromIntegral streamLen**(1/5::P.Double)) -- 5 times nested loop++o_1_space_transformation :: Int -> Benchmark+o_1_space_transformation streamLen =+    bgroup "transformation"+        [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)+        , benchFold "scanl'"   (scanl' 1) (unfoldrM streamLen)+        , benchFold "map"    (map  1) (unfoldrM streamLen)+        , benchFold "fmap"   (fmapK 1) (unfoldrM streamLen)+        , benchFold "mapM"   (mapM 1) (unfoldrM streamLen)+        , benchFold "mapMSerial"  (mapMSerial 1) (unfoldrM streamLen)+        ]++o_1_space_transformationX4 :: Int -> Benchmark+o_1_space_transformationX4 streamLen =+    bgroup "transformationX4"+        [ benchFold "scanl'"   (scanl' 4) (unfoldrM streamLen)+        , benchFold "map"    (map  4) (unfoldrM streamLen)+        , benchFold "fmap"   (fmapK 4) (unfoldrM streamLen)+        , benchFold "mapM"   (mapM 4) (unfoldrM streamLen)+        , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)+        -- XXX this is horribly slow+        -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)+        ]++o_1_space_concat :: Int -> Benchmark+o_1_space_concat streamLen =+    bgroup "concat"+        [ benchIOSrc1 "concatMapPure outer=Max inner=1"+            (concatMapPure streamLen 1)+        , benchIOSrc1 "concatMapPure outer=inner=(sqrt Max)"+            (concatMapPure streamLen2 streamLen2)+        , benchIOSrc1 "concatMapPure outer=1 inner=Max"+            (concatMapPure 1 streamLen)++        , benchIOSrc1 "concatMap outer=Max inner=1"+            (concatMap streamLen 1)+        , benchIOSrc1 "concatMap outer=inner=(sqrt Max)"+            (concatMap streamLen2 streamLen2)+        , benchIOSrc1 "concatMap outer=1 inner=Max"+            (concatMap 1 streamLen)++        , benchIOSrc1 "concatMapRepl outer=inner=(sqrt Max)"+            (concatMapRepl streamLen2 streamLen2)++        -- This is for comparison with concatMapFoldableWith+        , benchIOSrc1 "concatMapWithId outer=Max inner=1 (fromFoldable)"+            (StreamK.drain+                . StreamK.concatMapWith StreamK.append id+                . sourceConcatMapId streamLen)++        , benchIOSrc1 "concatMapWith append outer=Max inner=1"+            (concatMapBySerial streamLen 1)+        , benchIOSrc1 "concatMapWith append outer=inner=(sqrt Max)"+            (concatMapBySerial streamLen2 streamLen2)+        , benchIOSrc1 "concatMapWith append outer=1 inner=Max"+            (concatMapBySerial 1 streamLen)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop++o_1_space_filtering :: Int -> Benchmark+o_1_space_filtering streamLen =+    bgroup "filtering"+        [ benchFold "filter-even"     (filterEven     1) (unfoldrM streamLen)+        , benchFold "filter-all-out"  (filterAllOut streamLen   1) (unfoldrM streamLen)+        , benchFold "filter-all-in"   (filterAllIn streamLen    1) (unfoldrM streamLen)+        , benchFold "take-all"        (takeAll streamLen        1) (unfoldrM streamLen)+        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  1) (unfoldrM streamLen)+        , benchFold "drop-one"        (dropOne        1) (unfoldrM streamLen)+        , benchFold "drop-all"        (dropAll streamLen        1) (unfoldrM streamLen)+        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  1) (unfoldrM streamLen)+        , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)+        ]++o_1_space_filteringX4 :: Int -> Benchmark+o_1_space_filteringX4 streamLen =+    bgroup "filteringX4"+        [ benchFold "filter-even"     (filterEven     4) (unfoldrM streamLen)+        , benchFold "filter-all-out"  (filterAllOut streamLen   4) (unfoldrM streamLen)+        , benchFold "filter-all-in"   (filterAllIn streamLen    4) (unfoldrM streamLen)+        , benchFold "take-all"        (takeAll streamLen        4) (unfoldrM streamLen)+        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  4) (unfoldrM streamLen)+        , benchFold "drop-one"        (dropOne        4) (unfoldrM streamLen)+        , benchFold "drop-all"        (dropAll streamLen        4) (unfoldrM streamLen)+        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  4) (unfoldrM streamLen)+        , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)+        ]++o_1_space_zipping :: Int -> Benchmark+o_1_space_zipping streamLen =+    bgroup "zipping"+        [ benchFold "zipWith" zipWith (unfoldrM streamLen)+        , benchFold "zipWithM" zipWithM (unfoldrM streamLen)+        ]++o_1_space_mixed :: Int -> Benchmark+o_1_space_mixed streamLen =+    bgroup "mixed"+        [ benchFold "scan-map"    (scanMap    1) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    1) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   1) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   1) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   1) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   1) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 1) (unfoldrM streamLen)+        ]++o_1_space_mixedX2 :: Int -> Benchmark+o_1_space_mixedX2 streamLen =+    bgroup "mixedX2"+        [ benchFold "scan-map"    (scanMap    2) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    2) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   2) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   2) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   2) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   2) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 2) (unfoldrM streamLen)+        ]++o_1_space_mixedX4 :: Int -> Benchmark+o_1_space_mixedX4 streamLen =+    bgroup "mixedX4"+        [ benchFold "scan-map"    (scanMap    4) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    4) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   4) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   4) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   4) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   4) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 4) (unfoldrM streamLen)+        ]++o_1_space_list :: Int -> Benchmark+o_1_space_list streamLen =+    bgroup "list"+      [ bgroup "elimination"+        [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)+        ]+      , bgroup "Applicative"+        [ benchList "drain2" toNullApNestedList (unfoldrList streamLen2)+        ]+      , bgroup "Monad"+        [ benchList "drain2"   toNullNestedList (unfoldrList streamLen2)+        , benchList "drain3"  toNullNestedList3 (unfoldrList streamLen3)+        , benchList "filterAllIn2"  filterAllInNestedList (unfoldrList streamLen2)+        , benchList "filterAllOut2"  filterAllOutNestedList (unfoldrList streamLen2)+        ]+      ]+    where++    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop++o_1_space :: Int -> Benchmark+o_1_space streamLen =+    bgroup (o_1_space_prefix moduleName)+      [ o_1_space_generation streamLen+      , o_1_space_elimination streamLen+      , o_1_space_ap streamLen+      , o_1_space_monad streamLen+      , o_1_space_bind streamLen+      , o_1_space_transformation streamLen+      , o_1_space_transformationX4 streamLen+      , o_1_space_concat streamLen+      , o_1_space_filtering streamLen+      , o_1_space_filteringX4 streamLen+      , o_1_space_zipping streamLen+      , o_1_space_mixed streamLen+      , o_1_space_mixedX2 streamLen+      , o_1_space_mixedX4 streamLen+      , o_1_space_list streamLen+      ]++o_n_heap :: Int -> Benchmark+o_n_heap streamLen =+    bgroup (o_n_heap_prefix moduleName)+      [ bgroup "transformation"+        [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)+        ]+      , bgroup "concat"+        [ benchFold "sortBy" sortBy (unfoldrM streamLen)+        ]+      ]++{-# INLINE benchK #-}+benchK :: P.String -> (Int -> StreamK P.IO Int) -> Benchmark+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f++o_n_stack :: Int -> Int -> Int -> Benchmark+o_n_stack streamLen iterStreamLen maxIters =+    bgroup (o_n_stack_prefix moduleName)+      [ bgroup "elimination"+        [ benchFold "tail"   tail     (unfoldrM streamLen)+        , benchFold "nullTail" nullTail (unfoldrM streamLen)+        , benchFold "headTail" headTail (unfoldrM streamLen)+        ]+      , bgroup "transformation"+        [+          -- XXX why do these need so much stack+          benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)+        , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)+        ]+      , bgroup "transformationX4"+        [+          benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)+        ]+      , bgroup "iterated"+        [ benchK "mapM"                 (iterateMapM iterStreamLen maxIters)+        , benchK "scan(1/10)"           (iterateScan iterStreamLen maxIters)+        , benchK "filterEven"           (iterateFilterEven iterStreamLen maxIters)+        , benchK "takeAll"              (iterateTakeAll streamLen iterStreamLen maxIters)+        , benchK "dropOne"              (iterateDropOne iterStreamLen maxIters)+        , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)+        , benchK "dropWhileTrue"        (iterateDropWhileTrue streamLen iterStreamLen maxIters)+        ]+      ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop++o_n_space :: Int -> Benchmark+o_n_space streamLen =+    bgroup (o_n_space_prefix moduleName)+      [ bgroup "elimination"+        [ benchFold "toList" toList   (unfoldrM streamLen)+        ]+      ]++{- HLINT ignore "Use <&>" -}+{-# INLINE benchList #-}+benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark+benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f++main :: IO ()+main = do+    runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks streamLen =+        let !iterStreamLen = 10+            !maxIters = streamLen `div` iterStreamLen+         in [ o_1_space streamLen+            , o_n_stack streamLen iterStreamLen maxIters+            , o_n_heap streamLen+            , o_n_space streamLen+            ]
+ benchmark/Streamly/Benchmark/Data/StreamK/FromStream.hs view
@@ -0,0 +1,1497 @@+-- |+-- Module      : Streamly.Benchmark.Data.StreamK.FromStream+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+--+-- There are two ways to benchmark mixed use of Stream and StreamK.+--+-- First, benchmark one StreamK operation using all other operations from+-- Stream. This is for comparison of all pure StreamK operations vs using+-- operations from Stream whenever possible. We should compare these benchmarks+-- with pure StreamK benchmarks.+--+-- Second, benchmark one Stream operation with all other operations from+-- StreamK.+--+-- XXX This module uses both of the above, we need to separate the two in+-- separate benchmark groups.++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Main (main) where++-- import Control.Applicative (liftA2)+-- import Control.Monad (when)+-- import Data.Maybe (isJust)+-- import System.Random (randomRIO)++import Control.DeepSeq (NFData(..))+import Control.Exception (try)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.State.Strict (StateT, get, put)+import Data.Functor.Identity (Identity, runIdentity)+import GHC.Exception (ErrorCall)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.StreamK (StreamK, CrossStreamK)+import System.IO.Unsafe (unsafeInterleaveIO)+import System.Random (randomRIO)+import Test.Tasty.Bench (bgroup, Benchmark, defaultMain, nf, nfIO, bench)++import qualified Prelude as P+-- import qualified Data.List as List+import qualified Control.Monad.State.Strict as State+import qualified Streamly.Internal.Data.Parser as Parser+import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Fold as Fold++import Prelude hiding+    ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate+    , repeat, replicate, reverse+    )+import Streamly.Benchmark.Common+#ifdef INSPECTION+import Test.Inspection+#endif++-------------------------------------------------------------------------------+-- Bench utilities+-------------------------------------------------------------------------------++{-# NOINLINE benchIO #-}+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f++-- | Takes a source, and uses it with a default drain/fold method.+{-# INLINE benchIOSrc #-}+benchIOSrc+    :: String+    -> (Int -> StreamK IO a)+    -> Benchmark+benchIOSrc name f =+    bench name $ nfIO $ randomRIO (1,1) >>= drain . f++{-# INLINE benchIOSink #-}+benchIOSink+    :: (NFData b)+    => Int -> String -> (StreamK IO Int -> IO b) -> Benchmark+benchIOSink value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f . unfoldrMD value++-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but+-- we can't use it as it requires MonadAsync constraint.+{-# INLINE benchIdentitySink #-}+benchIdentitySink+    :: (NFData b)+    => Int -> String -> (Stream Identity Int -> Identity b) -> Benchmark+benchIdentitySink value name f = bench name $ nf (f . unfoldr value) 1++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++{-# INLINE unfoldr #-}+unfoldr :: Monad m => Int -> Int -> Stream m Int+unfoldr streamLen n = Stream.unfoldr step n+    where+    step cnt =+        if cnt > n + streamLen+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE unfoldrD #-}+unfoldrD :: Monad m => Int -> Int -> StreamK m Int+unfoldrD streamLen n = Stream.toStreamK $ unfoldr streamLen n++{-# INLINE unfoldrMD #-}+unfoldrMD :: Monad m => Int -> Int -> StreamK m Int+unfoldrMD streamLen n = Stream.toStreamK (Stream.unfoldrM step n)+    where+    step cnt =+        if cnt > n + streamLen+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-+{-# INLINE unfoldrK #-}+unfoldrK :: Int -> Int -> StreamK m Int+unfoldrK streamLen n = StreamK.unfoldr step n+    where+    step cnt =+        if cnt > n + streamLen+        then Nothing+        else Just (cnt, cnt + 1)+-}++{-# INLINE unfoldrMK #-}+unfoldrMK :: Monad m => Int -> Int -> StreamK m Int+unfoldrMK streamLen n = StreamK.unfoldrMWith StreamK.consM step n+    where+    step cnt =+        if cnt > n + streamLen+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE repeat #-}+repeat :: Monad m => Int -> Int -> StreamK m Int+repeat streamLen = StreamK.take streamLen . Stream.toStreamK . Stream.repeat++{-# INLINE repeatM #-}+repeatM :: Monad m => Int -> Int -> StreamK m Int+repeatM streamLen = StreamK.take streamLen . Stream.toStreamK . Stream.repeatM . return++{-# INLINE replicate #-}+replicate :: Monad m => Int -> Int -> StreamK m Int+replicate x y = Stream.toStreamK $ Stream.replicate x y++{-# INLINE replicateM #-}+replicateM :: Monad m => Int -> Int -> StreamK m Int+replicateM streamLen = Stream.toStreamK . Stream.replicateM streamLen . return++{-# INLINE iterate #-}+iterate :: Monad m => Int -> Int -> StreamK m Int+iterate streamLen = StreamK.take streamLen . Stream.toStreamK . Stream.iterate (+1)++{-# INLINE iterateM #-}+iterateM :: Monad m => Int -> Int -> StreamK m Int+iterateM streamLen = StreamK.take streamLen . Stream.toStreamK . Stream.iterateM (return . (+1)) . return++{-# INLINE fromFoldable #-}+fromFoldable :: Int -> Int -> StreamK m Int+fromFoldable streamLen n = StreamK.fromFoldable [n..n+streamLen]++{-# INLINE fromFoldableM #-}+fromFoldableM :: Monad m => Int -> Int -> StreamK m Int+fromFoldableM streamLen n =+    Prelude.foldr (StreamK.consM . return) StreamK.nil [n .. n + streamLen]++{-+{-# INLINABLE concatMapFoldableWith #-}+concatMapFoldableWith :: Foldable f+    => (StreamK m b -> StreamK m b -> StreamK m b)+    -> (a -> StreamK m b)+    -> f a+    -> StreamK m b+concatMapFoldableWith f g = Prelude.foldr (f . g) StreamK.nil+-}++{-# INLINE concatMapFoldableSerial #-}+concatMapFoldableSerial :: Monad m => Int -> Int -> StreamK m Int+concatMapFoldableSerial streamLen n =+    Stream.toStreamK $ Stream.concatMap Stream.fromPure $ Stream.fromStreamK $ StreamK.fromList [n..n+streamLen]++{-# INLINE concatMapFoldableSerialM #-}+concatMapFoldableSerialM :: Monad m => Int -> Int -> StreamK m Int+concatMapFoldableSerialM streamLen n =+    -- concatMapFoldableWith StreamK.serial (StreamK.fromEffect . return) [n..n+streamLen]+    Stream.toStreamK $ Stream.concatMap (Stream.fromEffect . return) $ Stream.fromStreamK $ StreamK.fromList [n..n+streamLen]++{-# INLINE mfixUnfold #-}+mfixUnfold :: Int -> Int -> StreamK IO (Int, Int)+mfixUnfold count start = StreamK.mfix f+    where+    f action = StreamK.unCross $ do+        let incr n act = fmap ((+n) . snd)  $ unsafeInterleaveIO act+        x <- StreamK.mkCross (StreamK.fromStream $ Stream.fromListM [incr 1 action, incr 2 action])+        y <- StreamK.mkCross (unfoldrD count start)+        return (x, y)++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE drainD #-}+drainD :: Monad m => StreamK m a -> m ()+drainD = Stream.drain . Stream.fromStreamK++{-# INLINE drain #-}+drain :: Monad m => StreamK m a -> m ()+-- XXX Use "Stream" instead of "StreamK" when eliminating?+-- drain = drainD+drain = StreamK.drain++{-# INLINE mapM_ #-}+mapM_ :: Monad m => StreamK m a -> m ()+mapM_ s = Stream.mapM_ (\_ -> return ()) $ Stream.fromStreamK s++{-# INLINE uncons #-}+uncons :: Monad m => StreamK m Int -> m ()+uncons s = do+    r <- StreamK.uncons s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons t++-- Recursive call, does it work well?+{-# INLINE unconsD #-}+unconsD :: Monad m => StreamK m Int -> m ()+unconsD s = do+    r <- Stream.uncons $ Stream.fromStreamK s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons (Stream.toStreamK t)++{-+{-# INLINE init #-}+init :: Monad m => StreamK m a -> m ()+init s = do+    t <- StreamK.init s+    P.mapM_ StreamK.drain t++{-# INLINE tail #-}+tail :: Monad m => StreamK m a -> m ()+tail s = StreamK.tail s >>= P.mapM_ tail++{-# INLINE nullTail #-}+nullTail :: Monad m => StreamK m Int -> m ()+nullTail s = do+    r <- StreamK.null s+    when (not r) $ StreamK.tail s >>= P.mapM_ nullTail++{-# INLINE headTail #-}+headTail :: Monad m => StreamK m Int -> m ()+headTail s = do+    h <- StreamK.head s+    when (isJust h) $ StreamK.tail s >>= P.mapM_ headTail+-}++{-# INLINE toList #-}+toList :: Monad m => StreamK m Int -> m [Int]+toList = Stream.fold Fold.toList . Stream.fromStreamK++{-# INLINE foldl' #-}+foldl' :: Monad m => StreamK m Int -> m Int+foldl' = Stream.fold (Fold.foldl' (+) 0) . Stream.fromStreamK++{-# INLINE last #-}+last :: Monad m => StreamK m Int -> m (Maybe Int)+last = Stream.fold Fold.latest . Stream.fromStreamK++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE composeN #-}+composeN+    :: Monad m+    => Int -> (StreamK m Int -> StreamK m Int) -> StreamK m Int -> m ()+composeN n f =+    case n of+        1 -> drain . f+        2 -> drain . f . f+        3 -> drain . f . f . f+        4 -> drain . f . f . f . f+        _ -> undefined++{-# INLINE scanl' #-}+scanl' :: Monad m => Int -> StreamK m Int -> m ()+scanl' n =+    composeN n (Stream.toStreamK . Stream.scan (Fold.foldl' (+) 0) . Stream.fromStreamK)++{-# INLINE map #-}+map :: Monad m => Int -> StreamK m Int -> m ()+map n = composeN n (Stream.toStreamK . Stream.map (+ 1) . Stream.fromStreamK)++{-+{-# INLINE fmapK #-}+fmapK :: Monad m => Int -> StreamK m Int -> m ()+fmapK n = composeN n $ P.fmap (+ 1)+-}++{-# INLINE mapM #-}+mapM :: Monad m => Int -> StreamK m Int -> m ()+mapM n = composeN n (Stream.toStreamK . Stream.mapM return . Stream.fromStreamK)++{-+{-# INLINE mapMSerial #-}+mapMSerial :: StreamK.MonadAsync m => Int -> StreamK m Int -> m ()+mapMSerial n = composeN n $ StreamK.mapMSerial return+-}++{-# INLINE filterEven #-}+filterEven :: Monad m => Int -> StreamK m Int -> m ()+filterEven n = composeN n (Stream.toStreamK . Stream.filter even . Stream.fromStreamK)++{-+{-# INLINE filterAllOut #-}+filterAllOut :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterAllOut streamLen n = composeN n $ StreamK.filter (> streamLen)++{-# INLINE filterAllIn #-}+filterAllIn :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterAllIn streamLen n = composeN n $ StreamK.filter (<= streamLen)++{-# INLINE _takeOne #-}+_takeOne :: Monad m => Int -> StreamK m Int -> m ()+_takeOne n = composeN n $ StreamK.take 1++{-# INLINE takeAll #-}+takeAll :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeAll streamLen n = composeN n $ StreamK.take streamLen++{-# INLINE takeWhileTrue #-}+takeWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeWhileTrue streamLen n = composeN n $ StreamK.takeWhile (<= streamLen)++{-# INLINE dropOne #-}+dropOne :: Monad m => Int -> StreamK m Int -> m ()+dropOne n = composeN n $ StreamK.drop 1++{-# INLINE dropAll #-}+dropAll :: Monad m => Int -> Int -> StreamK m Int -> m ()+dropAll streamLen n = composeN n $ StreamK.drop streamLen++{-# INLINE dropWhileTrue #-}+dropWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m ()+dropWhileTrue streamLen n = composeN n $ StreamK.dropWhile (<= streamLen)++{-# INLINE dropWhileFalse #-}+dropWhileFalse :: Monad m => Int -> StreamK m Int -> m ()+dropWhileFalse n = composeN n $ StreamK.dropWhile (<= 1)+-}++{-+{-# INLINE foldlS #-}+foldlS :: Monad m => Int -> StreamK m Int -> m ()+foldlS n = composeN n $ StreamK.foldlS (flip StreamK.cons) StreamK.nil+-}++{-# INLINE foldrS #-}+foldrS :: MonadIO m => Int -> StreamK m Int -> m ()+foldrS n =+    composeN n (StreamK.foldrS StreamK.cons StreamK.nil)++{-# INLINE foldrSMap #-}+foldrSMap :: MonadIO m => Int -> StreamK m Int -> m ()+foldrSMap n =+    composeN n+        (+          StreamK.foldrS (\x xs -> x + 1 `StreamK.cons` xs) StreamK.nil+        )++{-# INLINE foldrToStream #-}+foldrToStream :: Monad m => Stream m Int -> m (StreamK Identity Int)+foldrToStream = Stream.foldr StreamK.cons StreamK.nil++{-+{-# INLINE intersperse #-}+intersperse :: StreamK.MonadAsync m => Int -> Int -> StreamK m Int -> m ()+intersperse streamLen n = composeN n $ StreamK.intersperse streamLen+-}++-------------------------------------------------------------------------------+-- Traversable Instance+-------------------------------------------------------------------------------++{-# INLINE traversableTraverse #-}+traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int)+traversableTraverse = traverse return++{- HLINT ignore "Use traverse" -}+{-# INLINE traversableSequenceA #-}+traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int)+traversableSequenceA = sequenceA . Prelude.fmap return++{-# INLINE traversableMapM #-}+traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int)+traversableMapM = P.mapM return++{- HLINT ignore "Use mapM" -}+{-# INLINE traversableSequence #-}+traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int)+traversableSequence = Prelude.sequence . Prelude.fmap return++{-# INLINE benchPureSinkIO #-}+benchPureSinkIO+    :: NFData b+    => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark+benchPureSinkIO value name f =+    bench name+        $ nfIO $ randomRIO (1, 1) >>= f . unfoldrD value++instance NFData a => NFData (StreamK Identity a) where+    {-# INLINE rnf #-}+    rnf xs =+        runIdentity+            $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) (StreamK.toStream xs)++o_n_space_traversable :: Int -> Benchmark+o_n_space_traversable value =+    -- Buffering operations using heap proportional to number of elements.+    bgroup "traversable"+        -- Traversable instance+        [ benchPureSinkIO value "traverse" traversableTraverse+        , benchPureSinkIO value "sequenceA" traversableSequenceA+        , benchPureSinkIO value "mapM" traversableMapM+        , benchPureSinkIO value "sequence" traversableSequence+        ]++o_1_space_mapping :: Int -> Benchmark+o_1_space_mapping value =+    bgroup+        "mapping"+        [+        -- Right folds+          benchIOSink value "foldrS" (foldrS 1)+        , benchIOSink value "foldrSMap" (foldrSMap 1)+        ]++-------------------------------------------------------------------------------+-- Iteration of transformations+-------------------------------------------------------------------------------++{-# INLINE iterateSource #-}+iterateSource ::+       Monad m+    => (StreamK m Int -> StreamK m Int)+    -> Int+    -> Int+    -> Int+    -> StreamK m Int+iterateSource g count len n = f count (unfoldrMD len n)++    where++    f (0 :: Int) stream = stream+    f i stream = f (i - 1) (g stream)++-- this is quadratic+{-# INLINE iterateScan #-}+iterateScan :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateScan = iterateSource (StreamK.scanl' (+) 0)++{-# INLINE iterateMapM #-}+iterateMapM :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateMapM = iterateSource (StreamK.mapM return)++{-# INLINE iterateFilterEven #-}+iterateFilterEven :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateFilterEven = iterateSource (StreamK.filter even)++{-# INLINE iterateTakeAll #-}+iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> StreamK m Int+iterateTakeAll value = iterateSource (StreamK.take (value + 1))++{-# INLINE iterateDropOne #-}+iterateDropOne :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateDropOne = iterateSource (StreamK.drop 1)++{-# INLINE iterateDropWhileTrue #-}+iterateDropWhileTrue :: Monad m+    => Int -> Int -> Int -> Int -> StreamK m Int+iterateDropWhileTrue value = iterateSource (StreamK.dropWhile (<= (value + 1)))++{-# INLINE iterateDropWhileFalse #-}+iterateDropWhileFalse :: Monad m+    => Int -> Int -> Int -> Int -> StreamK m Int+iterateDropWhileFalse value = iterateSource (StreamK.dropWhile (> (value + 1)))++-- Head recursive operations.+o_n_stack_iterated :: Int -> Benchmark+o_n_stack_iterated value = by10 `seq` by100 `seq`+    bgroup "iterated"+        [+          benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10+        , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $+            iterateScan by100 100+        , benchIOSrc "filterEven (n/10 x 10)" $+            iterateFilterEven by10 10+        , benchIOSrc "takeAll (n/10 x 10)" $+            iterateTakeAll value by10 10+        , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10+        , benchIOSrc "dropWhileTrue (n/10 x 10)" $+            iterateDropWhileTrue value by10 10+        , benchIOSrc "dropWhileFalse (n/10 x 10)" $+            iterateDropWhileFalse value by10 10+        {-+        , benchFold "tail"   tail     (unfoldrM streamLen)+        , benchFold "nullTail" nullTail (unfoldrM streamLen)+        , benchFold "headTail" headTail (unfoldrM streamLen)+        -}+        ]++    where++    by10 = value `div` 10+    by100 = value `div` 100++-------------------------------------------------------------------------------+-- Iteration Applicative+-------------------------------------------------------------------------------++{-# INLINE iterateN #-}+iterateN :: (Int -> a -> a) -> a -> Int -> a+iterateN g initial count = f count initial++    where++    f (0 :: Int) x = x+    f i x = f (i - 1) (g i x)++-- Iterate a transformation over a singleton stream+{-# INLINE iterateSingleton #-}+iterateSingleton ::+       (Int -> CrossStreamK m Int -> CrossStreamK m Int)+    -> Int+    -> Int+    -> StreamK m Int+iterateSingleton g count n =+      StreamK.unCross+    $ iterateN g (StreamK.mkCross (StreamK.fromPure n)) count++{-+-- XXX need to check why this is slower than the explicit recursion above, even+-- if the above code is written in a foldr like head recursive way. We also+-- need to try this with foldlM' once #150 is fixed.+-- However, it is perhaps best to keep the iteration benchmarks independent of+-- foldrM and any related fusion issues.+{-# INLINE _iterateSingleton #-}+_iterateSingleton ::+       Monad m+    => (Int -> Stream m Int -> Stream m Int)+    -> Int+    -> Int+    -> Stream m Int+_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n+-}++{- HLINT ignore "Redundant <*" -}+o_n_space_applicative :: Int -> Benchmark+o_n_space_applicative value =+    bgroup "iterated"+        [ benchIOSrc "(*>) (n times)" $+            iterateSingleton ((*>) . pure) value+        , benchIOSrc "(<*) (n times)" $+            iterateSingleton (\x xs -> xs <* pure x) value+        , benchIOSrc "(<*>) (n times)" $+            iterateSingleton (\x xs -> pure (+ x) <*> xs) value+        , benchIOSrc "liftA2 (n times)" $+            iterateSingleton (liftA2 (+) . pure) value+        ]++-------------------------------------------------------------------------------+-- Iteration Monadic+-------------------------------------------------------------------------------++-- This is a good benchmark but inefficient way to compute primes. As we see a+-- new prime we keep appending a division filter for all the future numbers.+{-# INLINE sieve #-}+sieve :: Monad m => StreamK m Int -> StreamK m Int+sieve s = StreamK.concatEffect $ do+    r <- StreamK.uncons s+    case r of+        Just (prime, rest) ->+            -- XXX Use K.filter or rewrite to K.filter+            let f = Stream.filter (\n -> n `mod` prime /= 0)+             in pure $ prime `StreamK.cons` sieve (StreamK.fromStream $ f $ StreamK.toStream rest)+        Nothing -> pure StreamK.nil++o_n_space_iterated :: Int -> Benchmark+o_n_space_iterated value =+    bgroup "iterated"+        [+          benchIO "concatEffect prime sieve (n/4)"+            (\n ->+                  Stream.fold Fold.sum+                $ StreamK.toStream+                $ sieve+                $ StreamK.fromStream+                $ Stream.enumerateFromTo 2 (value `div` 4 + n))+        , benchIOSrc "(>>) (n times)" $+            iterateSingleton ((>>) . pure) value+        , benchIOSrc "(>>=) (n times)" $+            iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value+        ]++-------------------------------------------------------------------------------+-- Zipping+-------------------------------------------------------------------------------++{-+{-# INLINE zipWith #-}+zipWith :: Monad m => StreamK m Int -> m ()+zipWith src = drain $ StreamK.zipWith (,) src src++{-# INLINE zipWithM #-}+zipWithM :: Monad m => StreamK m Int -> m ()+zipWithM src = drain $ StreamK.zipWithM (curry return) src src++{-# INLINE sortByK #-}+sortByK :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a+sortByK f = StreamK.concatPairsWith (StreamK.mergeBy f) StreamK.fromPure++{-# INLINE sortBy #-}+sortBy :: Monad m => StreamK m Int -> m ()+sortBy = drain . sortByK compare++-------------------------------------------------------------------------------+-- Mixed Composition+-------------------------------------------------------------------------------++{-# INLINE scanMap #-}+scanMap :: Monad m => Int -> StreamK m Int -> m ()+scanMap n = composeN n $ StreamK.map (subtract 1) . StreamK.scanl' (+) 0++{-# INLINE dropMap #-}+dropMap :: Monad m => Int -> StreamK m Int -> m ()+dropMap n = composeN n $ StreamK.map (subtract 1) . StreamK.drop 1++{-# INLINE dropScan #-}+dropScan :: Monad m => Int -> StreamK m Int -> m ()+dropScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.drop 1++{-# INLINE takeDrop #-}+takeDrop :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.take streamLen++{-# INLINE takeScan #-}+takeScan :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeScan streamLen n = composeN n $ StreamK.scanl' (+) 0 . StreamK.take streamLen++{-# INLINE takeMap #-}+takeMap :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.take streamLen++{-# INLINE filterDrop #-}+filterDrop :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.filter (<= streamLen)++{-# INLINE filterTake #-}+filterTake :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterTake streamLen n = composeN n $ StreamK.take streamLen . StreamK.filter (<= streamLen)++{-# INLINE filterScan #-}+filterScan :: Monad m => Int -> StreamK m Int -> m ()+filterScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.filter (<= maxBound)++{-# INLINE filterMap #-}+filterMap :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.filter (<= streamLen)+-}++-------------------------------------------------------------------------------+-- Applicative+-------------------------------------------------------------------------------++{-# INLINE apDiscardFst #-}+apDiscardFst :: Monad m =>+    Int -> Int -> m ()+apDiscardFst linearCount start = drain $ StreamK.unCross $+    StreamK.mkCross (unfoldrMD nestedCount2 start)+        *> StreamK.mkCross (unfoldrMD nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE apDiscardSnd #-}+apDiscardSnd :: Monad m => Int -> Int -> m ()+apDiscardSnd linearCount start = drain $ StreamK.unCross $+    StreamK.mkCross (unfoldrMD nestedCount2 start)+        <* StreamK.mkCross (unfoldrMD nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE apLiftA2 #-}+apLiftA2 :: Monad m => Int -> Int -> m ()+apLiftA2 linearCount start = drain $ StreamK.unCross $+    liftA2 (+) (StreamK.mkCross (unfoldrMD nestedCount2 start))+        (StreamK.mkCross (unfoldrMD nestedCount2 start))++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullAp #-}+toNullAp :: Monad m => Int -> Int -> m ()+toNullAp linearCount start = drain $ StreamK.unCross $+    (+) <$> StreamK.mkCross (unfoldrMD nestedCount2 start)+        <*> StreamK.mkCross (unfoldrMD nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++o_1_space_applicative :: Int -> Benchmark+o_1_space_applicative value =+    bgroup "Applicative"+        [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value+        , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value+        , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value+        , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value+        ]++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++{-# INLINE monadThen #-}+monadThen :: Monad m => Int -> Int -> m ()+monadThen linearCount start = drain $ StreamK.unCross $ do+    StreamK.mkCross (unfoldrMD nestedCount2 start) >>+        StreamK.mkCross (unfoldrMD nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullM #-}+toNullM :: Monad m => Int -> Int -> m ()+toNullM linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    return $ x + y++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullM3 #-}+toNullM3 :: Monad m => Int -> Int -> m ()+toNullM3 linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount3 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount3 start)+    z <- StreamK.mkCross (unfoldrMD nestedCount3 start)+    return $ x + y + z+  where+    nestedCount3 = round (fromIntegral linearCount**(1/3::Double))++{-# INLINE filterAllOutM #-}+filterAllOutM :: Monad m => Int -> Int -> m ()+filterAllOutM linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    let s = x + y+    if s < 0+    then return s+    else StreamK.mkCross StreamK.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterAllInM #-}+filterAllInM :: Monad m => Int -> Int -> m ()+filterAllInM linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    let s = x + y+    if s > 0+    then return s+    else StreamK.mkCross StreamK.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterSome #-}+filterSome :: Monad m => Int -> Int -> m ()+filterSome linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    let s = x + y+    if s > 1100000+    then return s+    else StreamK.mkCross StreamK.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE breakAfterSome #-}+breakAfterSome :: Int -> Int -> IO ()+breakAfterSome linearCount start = do+    (_ :: Either ErrorCall ()) <- try $ drain $ StreamK.unCross $ do+        x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+        y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+        let s = x + y+        if s > 1100000+        then error "break"+        else return s+    return ()+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toListM #-}+toListM :: Monad m => Int -> Int -> m [Int]+toListM linearCount start = toList $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    return $ x + y+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++-- Taking a specified number of elements is very expensive in logict so we have+-- a test to measure the same.+{-# INLINE toListSome #-}+toListSome :: Monad m => Int -> Int -> m [Int]+toListSome linearCount start =+    toList $ StreamK.take 10000 $ StreamK.unCross $ do+        x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+        y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+        return $ x + y+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++o_1_space_monad :: Int -> Benchmark+o_1_space_monad value =+    bgroup "Monad"+        [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value+        , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value+        , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $+            filterAllOutM value+        , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $+            filterAllInM value+        , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $+            filterSome value+        , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $+            breakAfterSome value+        , benchIO "(>>=) (cubert n x cubert n x cubert n)" $+            toNullM3 value+        ]++o_n_space_monad :: Int -> Benchmark+o_n_space_monad value =+    bgroup "Monad"+        [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $+            toListM value+        , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $+            toListSome value+        ]++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++{-# INLINE serial2 #-}+serial2 :: Int -> Int -> IO ()+serial2 count n =+    drain $+        StreamK.append+            (unfoldrMD count n)+            (unfoldrMD count (n + 1))++{-# INLINE serial4 #-}+serial4 :: Int -> Int -> IO ()+serial4 count n =+    drain $+    StreamK.append+        (StreamK.append+            (unfoldrMD count n)+            (unfoldrMD count (n + 1)))+        (StreamK.append+              (unfoldrMD count (n + 2))+              (unfoldrMD count (n + 3)))++o_1_space_joining :: Int -> Benchmark+o_1_space_joining value =+    bgroup "joining"+        [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))+        , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))+        ]++-------------------------------------------------------------------------------+-- ConcatMap+-------------------------------------------------------------------------------++-- concatMap unfoldrM/unfoldrM++{-# INLINE sourceConcatMapId #-}+sourceConcatMapId :: Monad m+    => Int -> Int -> StreamK m (StreamK m Int)+sourceConcatMapId val n =+    StreamK.fromFoldable $ fmap (StreamK.fromEffect . return) [n..n+val]++{-# INLINE concatMap #-}+concatMap :: Int -> Int -> Int -> IO ()+concatMap outer inner n =+    drain $ StreamK.concatMap+        (\_ -> unfoldrMD inner n)+        (unfoldrMD outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMap+#endif++{-# INLINE concatMapPure #-}+concatMapPure :: Int -> Int -> Int -> IO ()+concatMapPure outer inner n =+    drain $ StreamK.concatMap+        (\_ -> unfoldrMD inner n)+        (unfoldrMD outer n)++#ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]+#else+inspect $ hasNoTypeClasses 'concatMapPure+#endif+inspect $ 'concatMapPure `hasNoType` ''SPEC+#endif++{-# INLINE concatMapRepl #-}+concatMapRepl :: Int -> Int -> Int -> IO ()+concatMapRepl outer inner n =+    drain $ StreamK.concatMap+        (StreamK.replicate inner) (unfoldrMD outer n)++#ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]+#else+inspect $ hasNoTypeClasses 'concatMapRepl+#endif+inspect $ 'concatMapRepl `hasNoType` ''SPEC+#endif++-- concatMapWith++{-# INLINE concatStreamsWith #-}+concatStreamsWith+    :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)+    -> Int+    -> Int+    -> Int+    -> IO ()+concatStreamsWith op outer inner n =+    drain $ StreamK.concatMapWith op+        (unfoldrMD inner)+        (unfoldrMD outer n)++{-# INLINE mergeMapWith #-}+mergeMapWith+    :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)+    -> Int+    -> Int+    -> Int+    -> IO ()+mergeMapWith op outer inner n =+    drain $ StreamK.mergeMapWith op+        (unfoldrMD inner)+        (unfoldrMD outer n)++{-# INLINE concatMapWithSerial #-}+concatMapWithSerial :: Int -> Int -> Int -> IO ()+concatMapWithSerial = concatStreamsWith StreamK.append++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapWithSerial+inspect $ 'concatMapWithSerial `hasNoType` ''SPEC+#endif++{-+{-# INLINE concatMapWithAppend #-}+concatMapWithAppend :: Int -> Int -> Int -> IO ()+concatMapWithAppend = concatStreamsWith Stream.append++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapWithAppend+inspect $ 'concatMapWithAppend `hasNoType` ''SPEC+#endif+-}++-- mergeMapWith++{-# INLINE mergeMapWithSerial #-}+mergeMapWithSerial :: Int -> Int -> Int -> IO ()+mergeMapWithSerial = mergeMapWith StreamK.append++{-+{-# INLINE mergeMapWithAppend #-}+mergeMapWithAppend :: Int -> Int -> Int -> IO ()+mergeMapWithAppend = mergeMapWith Stream.append+-}++{-+-------------------------------------------------------------------------------+-- Nested Composition+-------------------------------------------------------------------------------++-- XXX Use CrossStreamK instead+instance Monad m => Applicative (StreamK.Stream m) where+    {-# INLINE pure #-}+    pure = StreamK.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = StreamK.crossApply++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>) = StreamK.crossApplySnd++    {-# INLINE (<*) #-}+    (<*) = StreamK.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.Stream m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip StreamK.concatMap++{-# INLINE drainApplicative #-}+drainApplicative :: Monad m => StreamK m Int -> m ()+drainApplicative s = drain $ do+    (+) <$> s <*> s++{-# INLINE drainMonad #-}+drainMonad :: Monad m => StreamK m Int -> m ()+drainMonad s = drain $ do+    x <- s+    y <- s+    return $ x + y++{-# INLINE drainMonad3 #-}+drainMonad3 :: Monad m => StreamK m Int -> m ()+drainMonad3 s = drain $ do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE filterAllOutMonad #-}+filterAllOutMonad+    :: Monad m+    => StreamK m Int -> m ()+filterAllOutMonad str = drain $ do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else StreamK.nil++{-# INLINE filterAllInMonad #-}+filterAllInMonad+    :: Monad m+    => StreamK m Int -> m ()+filterAllInMonad str = drain $ do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else StreamK.nil+-}++-------------------------------------------------------------------------------+-- Buffering+-------------------------------------------------------------------------------++{-# INLINE reverse #-}+reverse :: MonadIO m => Int -> StreamK m Int -> m ()+reverse n = composeN n StreamK.reverse++-------------------------------------------------------------------------------+-- Reduce+-------------------------------------------------------------------------------++{-# INLINE parseBreak #-}+parseBreak :: Monad m => StreamK m Int -> m ()+parseBreak s = do+    r <- StreamK.parseDBreak Parser.one s+    case r of+         (Left _, _) -> return ()+         (Right _, s1) -> parseBreak s1++-------------------------------------------------------------------------------+-- Lift+-------------------------------------------------------------------------------++{-# INLINE iterateStateIO #-}+iterateStateIO ::+       Monad m+    => Int+    -> StateT Int m Int+iterateStateIO n = do+    x <- get+    if x > n+    then do+        put (x - 1)+        iterateStateIO n+    else return x++-- XXX This is basically testing the perf of concatEffect, change it to just+-- use concatEffect and move it along with other concatMap benchmarks.+{-# INLINE iterateStateT #-}+iterateStateT :: Int -> StreamK (StateT Int IO) Int+iterateStateT n = StreamK.concatEffect $ do+    x <- get+    if x > n+    then do+        put (x - 1)+        return $ iterateStateT n+    else return $ StreamK.fromPure x++o_n_heap_transformer :: Int -> Benchmark+o_n_heap_transformer value =+    bgroup "transformer"+        [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->+            State.evalStateT (iterateStateIO n) value+        , benchIO "Stream (StateT Int IO) (n times)" $ \n ->+            State.evalStateT (drain (iterateStateT n)) value+        ]++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.StreamK.FromStream"++-- Generation of StreamK using StreamD generation functions and eleminating+-- using StreamK drain.+o_1_space_generation :: Int -> Benchmark+o_1_space_generation streamLen =+    bgroup "generation"+        [ benchFold "unfoldr" drain (unfoldrD streamLen)+        , benchFold "unfoldrM" drain (unfoldrMD streamLen)+        , benchFold "repeat" drain (repeat streamLen)+        , benchFold "repeatM" drain (repeatM streamLen)+        , benchFold "replicate" drain (replicate streamLen)+        , benchFold "replicateM" drain (replicateM streamLen)+        , benchFold "iterate" drain (iterate streamLen)+        , benchFold "iterateM" drain (iterateM streamLen)++        , benchFold "fromFoldable"  drain (fromFoldable streamLen)+        , benchFold "fromFoldableM" drain (fromFoldableM streamLen)++        , benchIOSrc "mfix_10" (mfixUnfold 10)+        , benchIOSrc "mfix_100" (mfixUnfold 100)+        , benchIOSrc "mfix_1000" (mfixUnfold 1000)++        -- appends+        , benchFold "concatMapFoldableWith"  drain (concatMapFoldableSerial streamLen)+        , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)+        ]++-- Generating using StreamK and eliminating using StreamD folds.+o_1_space_elimination :: Int -> Benchmark+o_1_space_elimination streamLen =+    bgroup "elimination"+        [ benchFold "toNull" drainD (unfoldrMK streamLen)+        , benchFold "mapM_" mapM_ (unfoldrMK streamLen)+        , benchIOSink streamLen "uncons" uncons+        , benchFold "unconsD" unconsD (unfoldrMK streamLen)+        -- , benchFold "init"   init     (unfoldrM streamLen)+        , benchFold "foldl'" foldl'    (unfoldrMK streamLen)+        , benchFold "last"   last     (unfoldrMK streamLen)+        , bgroup "build"+            [+              bgroup "Identity"+                  [+                    benchIdentitySink streamLen "foldrToStreamLength"+                        (Stream.fold Fold.length . StreamK.toStream . runIdentity . foldrToStream)+                  {-+                  , benchIdentitySink 16 "foldrToStreamLength (16)"+                        (S.fold Fold.length . toStream . runIdentity . foldrToStream)+                  -}+                  ]+            ]+        ]++{-+o_1_space_nested :: Int -> Benchmark+o_1_space_nested streamLen =+    bgroup "nested"+        [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)+        , benchFold "drainMonad"   drainMonad   (unfoldrM streamLen2)+        , benchFold "drainMonad3"  drainMonad3  (unfoldrM streamLen3)+        , benchFold "filterAllInMonad"  filterAllInMonad  (unfoldrM streamLen2)+        , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)+        , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)+        , benchFold "drainMonad (pure)"   drainMonad   (unfoldr streamLen2)+        , benchFold "drainMonad3 (pure)"  drainMonad3  (unfoldr streamLen3)+        , benchFold "filterAllInMonad (pure)"  filterAllInMonad  (unfoldr streamLen2)+        , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop+-}++-- Generate using StreamK and transform using StreamD transformation functions+-- and then drain using StreamK.+o_1_space_transformation :: Int -> Benchmark+o_1_space_transformation streamLen =+    bgroup "transformation"+        [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)+          benchFold "scanl'"   (scanl' 1) (unfoldrMK streamLen)+        , benchFold "map"    (map  1) (unfoldrMK streamLen)+        -- , benchFold "fmap"   (fmapK 1) (unfoldrM streamLen)+        , benchFold "mapM"   (mapM 1) (unfoldrMK streamLen)+        -- , benchFold "mapMSerial"  (mapMSerial 1) (unfoldrM streamLen)+        ]++o_1_space_transformationX4 :: Int -> Benchmark+o_1_space_transformationX4 streamLen =+    bgroup "transformationX4"+        [ benchFold "scanl'"   (scanl' 4) (unfoldrMK streamLen)+        , benchFold "map"    (map  4) (unfoldrMK streamLen)+        -- , benchFold "fmap"   (fmapK 4) (unfoldrMK streamLen)+        , benchFold "mapM"   (mapM 4) (unfoldrMK streamLen)+        -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)+        -- XXX this is horribly slow+        -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)+        ]++o_1_space_concat :: Int -> Benchmark+o_1_space_concat streamLen =+    bgroup "concat"+        [ benchIOSrc1 "concatMapPure (n of 1)"+            (concatMapPure streamLen 1)+        , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"+            (concatMapPure streamLen2 streamLen2)+        , benchIOSrc1 "concatMapPure (1 of n)"+            (concatMapPure 1 streamLen)++        , benchIOSrc1 "concatMap (n of 1)"+            (concatMap streamLen 1)+        , benchIOSrc1 "concatMap (sqrt n of sqrt n)"+            (concatMap streamLen2 streamLen2)+        , benchIOSrc1 "concatMap (1 of n)"+            (concatMap 1 streamLen)++        -- This is for comparison with foldMapWith+        , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"+            (StreamK.concatMapWith StreamK.append id . sourceConcatMapId streamLen)++        , benchIOSrc1 "concatMapWith (n of 1)"+            (concatMapWithSerial streamLen 1)+        , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"+            (concatMapWithSerial streamLen2 streamLen2)+        , benchIOSrc1 "concatMapWith (1 of n)"+            (concatMapWithSerial 1 streamLen)++        {-+        -- quadratic with number of outer streams+        , benchIOSrc1 "concatMapWithAppend (2 of n/2)"+            (concatMapWithAppend 2 (value `div` 2))+        -}++        , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"+            (concatMapRepl streamLen2 streamLen2)++        {-+        , benchFold "sortBy" sortBy (unfoldrM streamLen)+        -}+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop++o_n_space_merge :: Int -> Benchmark+o_n_space_merge value = sqrtVal `seq`+    bgroup "concat"+        [+        -------------------mergeMapWith-----------------++        -- Use large number of streams to check scalability++          benchIOSrc1 "mergeMapWithSerial (n of 1)"+            (mergeMapWithSerial value 1)+        , benchIOSrc1 "mergeMapWithSerial (sqrtVal of sqrtVal)"+            (mergeMapWithSerial sqrtVal sqrtVal)+        , benchIOSrc1 "mergeMapWithSerial (2 of n/2)"+            (mergeMapWithSerial 2 (value `div` 2))++        {-+        , benchIOSrc1 "mergeMapWithAppend (n of 1)"+            (mergeMapWithAppend value 1)+        , benchIOSrc1 "mergeMapWithAppend (sqrtVal of sqrtVal)"+            (mergeMapWithAppend sqrtVal sqrtVal)+        -}+        ]++    where++    sqrtVal = round $ sqrt (fromIntegral value :: Double)++o_1_space_filtering :: Int -> Benchmark+o_1_space_filtering streamLen =+    bgroup "filtering"+        [ benchFold "filter-even"     (filterEven     1) (unfoldrMK streamLen)+        {-+        , benchFold "filter-all-out"  (filterAllOut streamLen   1) (unfoldrM streamLen)+        , benchFold "filter-all-in"   (filterAllIn streamLen    1) (unfoldrM streamLen)+        , benchFold "take-all"        (takeAll streamLen        1) (unfoldrM streamLen)+        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  1) (unfoldrM streamLen)+        , benchFold "drop-one"        (dropOne        1) (unfoldrM streamLen)+        , benchFold "drop-all"        (dropAll streamLen        1) (unfoldrM streamLen)+        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  1) (unfoldrM streamLen)+        , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)+        -}+        ]++o_1_space_filteringX4 :: Int -> Benchmark+o_1_space_filteringX4 streamLen =+    bgroup "filteringX4"+        [ benchFold "filter-even"     (filterEven     4) (unfoldrMK streamLen)+        {-+        , benchFold "filter-all-out"  (filterAllOut streamLen   4) (unfoldrM streamLen)+        , benchFold "filter-all-in"   (filterAllIn streamLen    4) (unfoldrM streamLen)+        , benchFold "take-all"        (takeAll streamLen        4) (unfoldrM streamLen)+        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  4) (unfoldrM streamLen)+        , benchFold "drop-one"        (dropOne        4) (unfoldrM streamLen)+        , benchFold "drop-all"        (dropAll streamLen        4) (unfoldrM streamLen)+        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  4) (unfoldrM streamLen)+        , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)+        -}+        ]++{-+o_1_space_zipping :: Int -> Benchmark+o_1_space_zipping streamLen =+    bgroup "zipping"+        [ benchFold "zipWith" zipWith (unfoldrM streamLen)+        , benchFold "zipWithM" zipWithM (unfoldrM streamLen)+        ]++o_1_space_mixed :: Int -> Benchmark+o_1_space_mixed streamLen =+    bgroup "mixed"+        [ benchFold "scan-map"    (scanMap    1) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    1) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   1) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   1) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   1) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   1) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 1) (unfoldrM streamLen)+        ]++o_1_space_mixedX2 :: Int -> Benchmark+o_1_space_mixedX2 streamLen =+    bgroup "mixedX2"+        [ benchFold "scan-map"    (scanMap    2) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    2) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   2) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   2) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   2) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   2) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 2) (unfoldrM streamLen)+        ]++o_1_space_mixedX4 :: Int -> Benchmark+o_1_space_mixedX4 streamLen =+    bgroup "mixedX4"+        [ benchFold "scan-map"    (scanMap    4) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    4) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   4) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   4) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   4) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   4) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 4) (unfoldrM streamLen)+        ]+-}++o_1_space_grouping :: Int -> Benchmark+o_1_space_grouping value =+    bgroup "grouping"+        [+          benchIOSink value "parseBreak (recursive)" parseBreak+        ]++o_1_space :: Int -> Benchmark+o_1_space streamLen =+    bgroup (o_1_space_prefix moduleName)+      [ o_1_space_generation streamLen+      , o_1_space_elimination streamLen+      -- , o_1_space_nested streamLen+      , o_1_space_joining streamLen+      , o_1_space_mapping streamLen+      , o_1_space_transformation streamLen+      , o_1_space_transformationX4 streamLen+      , o_1_space_concat streamLen+      , o_1_space_applicative streamLen+      , o_1_space_monad streamLen+      , o_1_space_filtering streamLen+      , o_1_space_filteringX4 streamLen+      , o_1_space_grouping streamLen+      -- , o_1_space_zipping streamLen+      -- , o_1_space_mixed streamLen+      -- , o_1_space_mixedX2 streamLen+      -- , o_1_space_mixedX4 streamLen+      -- , o_1_space_list streamLen+      ]++o_n_heap :: Int -> Benchmark+o_n_heap streamLen =+    bgroup (o_n_heap_prefix moduleName)+      [ {- bgroup "transformation"+        [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)+        ] -}+        bgroup "buffered" [benchIOSink streamLen "reverse" (reverse 1)]+      , o_n_heap_transformer streamLen+      ]++o_n_stack :: Int -> Benchmark+o_n_stack streamLen =+    bgroup (o_n_stack_prefix moduleName)+      [+      {-+      , bgroup "transformation"+        [+          -- XXX why do these need so much stack+          benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)+        , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)+        ]+      , bgroup "transformationX4"+        [+          benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)+        ]+        -}+          o_n_stack_iterated streamLen+        ]+      {-+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop+    -}++o_n_space :: Int -> Benchmark+o_n_space streamLen =+    bgroup (o_n_space_prefix moduleName)+      [ bgroup "elimination"+        [ benchFold "toList" toList (unfoldrMK streamLen)+        ]+      , o_n_space_merge streamLen+      , o_n_space_monad streamLen+      , o_n_space_iterated streamLen+      , o_n_space_applicative streamLen+      , o_n_space_traversable streamLen+      ]++main :: IO ()+main =+    defaultMain+        [ o_1_space streamLen+        , o_n_stack streamLen+        , o_n_heap streamLen+        , o_n_space streamLen+        ]++    where++    streamLen = 100000
+ benchmark/Streamly/Benchmark/Data/StreamK/StreamKAlt.hs view
@@ -0,0 +1,454 @@++-- |+-- Module      : Streamly.Benchmark.Data.Stream.StreamDK+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++-- import Control.Monad (when)+-- import Data.Maybe (isJust)+import Prelude hiding ()+-- import qualified Prelude as P+-- import qualified Data.List as List++import qualified Streamly.Internal.Data.StreamK.Alt as S+-- import qualified Streamly.Internal.Data.Stream.Common as SP+-- import qualified Streamly.Internal.Data.SVar as S++import Streamly.Benchmark.Common+import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)++value :: Int+value = 100000+{-+value2, value3, value16, maxValue :: Int+value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop+value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop+value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop+maxValue = value+-}++-------------------------------------------------------------------------------+-- Benchmark ops+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Stream m a = S.Stream m a++{-# INLINE sourceUnfoldr #-}+sourceUnfoldr :: Monad m => Int -> Stream m Int+sourceUnfoldr n = S.unfoldr step n+    where+    step cnt =+        if cnt > n + value+        then Nothing+        else Just (cnt, cnt + 1)++{-+{-# INLINE sourceUnfoldrN #-}+sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrN m n = S.unfoldr step n+    where+    step cnt =+        if cnt > n + m+        then Nothing+        else Just (cnt, cnt + 1)+-}++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Stream m Int+sourceUnfoldrM n = S.unfoldrM step n+    where+    step cnt =+        if cnt > n + value+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-+{-# INLINE sourceUnfoldrMN #-}+sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrMN m n = S.unfoldrM step n+    where+    step cnt =+        if cnt > n + m+        then return Nothing+        else return (Just (cnt, cnt + 1))+-}++{-+{-# INLINE sourceFromEnum #-}+sourceFromEnum :: Monad m => Int -> Stream m Int+sourceFromEnum n = S.enumFromStepN n 1 value+-}++{-+{-# INLINE sourceFromFoldable #-}+sourceFromFoldable :: Int -> Stream m Int+sourceFromFoldable n = S.fromFoldable [n..n+value]+-}++{-+{-# INLINE sourceFromFoldableM #-}+sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int+sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])+-}++{-+{-# INLINE sourceFoldMapWith #-}+sourceFoldMapWith :: Int -> Stream m Int+sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]++{-# INLINE sourceFoldMapWithM #-}+sourceFoldMapWithM :: Monad m => Int -> Stream m Int+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]+-}++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE runStream #-}+runStream :: Monad m => Stream m a -> m ()+runStream = S.drain+-- runStream = S.mapM_ (\_ -> return ())++{-+{-# INLINE mapM_ #-}+mapM_ :: Monad m => Stream m a -> m ()+mapM_ = S.mapM_ (\_ -> return ())+-}++{-# INLINE toNull #-}+toNull :: Monad m => Stream m Int -> m ()+toNull = runStream++{-# INLINE uncons #-}+uncons :: Monad m => Stream m Int -> m ()+uncons s = do+    r <- S.uncons s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons t++{-+{-# INLINE init #-}+init :: (Monad m, S.IsStream t) => t m a -> m ()+init s = do+    t <- S.init s+    P.mapM_ S.drain t++{-# INLINE tail #-}+tail :: (Monad m, S.IsStream t) => t m a -> m ()+tail s = S.tail s >>= P.mapM_ tail++{-# INLINE nullTail #-}+{-# INLINE headTail #-}+{-# INLINE zip #-}+nullTail, headTail, zip+    :: Monad m+    => Stream m Int -> m ()++nullTail s = do+    r <- S.null s+    when (not r) $ S.tail s >>= P.mapM_ nullTail++headTail s = do+    h <- S.head s+    when (isJust h) $ S.tail s >>= P.mapM_ headTail++{-# INLINE toList #-}+toList :: Monad m => Stream m Int -> m [Int]+toList = S.toList++{-# INLINE foldl #-}+foldl :: Monad m => Stream m Int -> m Int+foldl  = S.foldl' (+) 0++{-# INLINE last #-}+last :: Monad m => Stream m Int -> m (Maybe Int)+last   = S.last+-}++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-+{-# INLINE transform #-}+transform :: Monad m => Stream m a -> m ()+transform = runStream++{-# INLINE composeN #-}+composeN+    :: Monad m+    => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()+composeN n f =+    case n of+        1 -> transform . f+        2 -> transform . f . f+        3 -> transform . f . f . f+        4 -> transform . f . f . f . f+        _ -> undefined+-}++{-+{-# INLINE scan #-}+{-# INLINE map #-}+{-# INLINE fmap #-}+{-# INLINE filterEven #-}+{-# INLINE filterAllOut #-}+{-# INLINE filterAllIn #-}+{-# INLINE takeOne #-}+{-# INLINE takeAll #-}+{-# INLINE takeWhileTrue #-}+{-# INLINE dropOne #-}+{-# INLINE dropAll #-}+{-# INLINE dropWhileTrue #-}+{-# INLINE dropWhileFalse #-}+{-# INLINE foldlS #-}+{-# INLINE concatMap #-}+scan, map, fmap, filterEven, filterAllOut,+    filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,+    dropWhileTrue, dropWhileFalse, foldlS, concatMap+    :: Monad m+    => Int -> Stream m Int -> m ()++{-# INLINE mapM #-}+{-# INLINE mapMSerial #-}+{-# INLINE intersperse #-}+mapM, mapMSerial, intersperse+    :: S.MonadAsync m => Int -> Stream m Int -> m ()++scan           n = composeN n $ S.scanl' (+) 0+map            n = composeN n $ P.fmap (+1)+fmap           n = composeN n $ P.fmap (+1)+mapM           n = composeN n $ S.mapM return+mapMSerial     n = composeN n $ S.mapMSerial return+filterEven     n = composeN n $ S.filter even+filterAllOut   n = composeN n $ S.filter (> maxValue)+filterAllIn    n = composeN n $ S.filter (<= maxValue)+takeOne        n = composeN n $ S.take 1+takeAll        n = composeN n $ S.take maxValue+takeWhileTrue  n = composeN n $ S.takeWhile (<= maxValue)+dropOne        n = composeN n $ S.drop 1+dropAll        n = composeN n $ S.drop maxValue+dropWhileTrue  n = composeN n $ S.dropWhile (<= maxValue)+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)+foldlS         n = composeN n $ S.foldlS (flip S.cons) S.nil+-- We use a (sqrt n) element stream as source and then concat the same stream+-- for each element to produce an n element stream.+concatMap      n = composeN n $ (\s -> S.concatMap (\_ -> s) s)+intersperse    n = composeN n $ S.intersperse maxValue++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 10000++{-# INLINE iterateSource #-}+iterateSource+    :: S.MonadAsync m+    => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)+    where+        f (0 :: Int) m = g m+        f x m = g (f (x P.- 1) m)++{-# INLINE iterateMapM #-}+{-# INLINE iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,+    iterateDropWhileFalse, iterateDropWhileTrue+    :: S.MonadAsync m+    => Int -> Stream m Int++-- this is quadratic+iterateScan            = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)+iterateDropWhileFalse  = iterateSource (S.dropWhile (> maxValue))+                                       (maxIters `div` 10)++iterateMapM            = iterateSource (S.mapM return) maxIters+iterateFilterEven      = iterateSource (S.filter even) maxIters+iterateTakeAll         = iterateSource (S.take maxValue) maxIters+iterateDropOne         = iterateSource (S.drop 1) maxIters+iterateDropWhileTrue   = iterateSource (S.dropWhile (<= maxValue)) maxIters++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++zip src       = transform $ S.zipWith (,) src src++{-# INLINE concatMapRepl4xN #-}+concatMapRepl4xN :: Monad m => Stream m Int -> m ()+concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)++-------------------------------------------------------------------------------+-- Mixed Composition+-------------------------------------------------------------------------------++{-# INLINE scanMap #-}+{-# INLINE dropMap #-}+{-# INLINE dropScan #-}+{-# INLINE takeDrop #-}+{-# INLINE takeScan #-}+{-# INLINE takeMap #-}+{-# INLINE filterDrop #-}+{-# INLINE filterTake #-}+{-# INLINE filterScan #-}+{-# INLINE filterMap #-}+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,+    filterTake, filterScan, filterMap+    :: Monad m => Int -> Stream m Int -> m ()++scanMap    n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0+dropMap    n = composeN n $ S.map (subtract 1) . S.drop 1+dropScan   n = composeN n $ S.scanl' (+) 0 . S.drop 1+takeDrop   n = composeN n $ S.drop 1 . S.take maxValue+takeScan   n = composeN n $ S.scanl' (+) 0 . S.take maxValue+takeMap    n = composeN n $ S.map (subtract 1) . S.take maxValue+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)+filterMap  n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)++-------------------------------------------------------------------------------+-- Nested Composition+-------------------------------------------------------------------------------++{-# INLINE toNullApNested #-}+toNullApNested :: Monad m => Stream m Int -> m ()+toNullApNested s = runStream $ do+    (+) <$> s <*> s++{-# INLINE toNullNested #-}+toNullNested :: Monad m => Stream m Int -> m ()+toNullNested s = runStream $ do+    x <- s+    y <- s+    return $ x + y++{-# INLINE toNullNested3 #-}+toNullNested3 :: Monad m => Stream m Int -> m ()+toNullNested3 s = runStream $ do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE filterAllOutNested #-}+filterAllOutNested+    :: Monad m+    => Stream m Int -> m ()+filterAllOutNested str = runStream $ do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else S.nil++{-# INLINE filterAllInNested #-}+filterAllInNested+    :: Monad m+    => Stream m Int -> m ()+filterAllInNested str = runStream $ do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else S.nil++-------------------------------------------------------------------------------+-- Nested Composition Pure lists+-------------------------------------------------------------------------------++{-# INLINE sourceUnfoldrList #-}+sourceUnfoldrList :: Int -> Int -> [Int]+sourceUnfoldrList maxval n = List.unfoldr step n+    where+    step cnt =+        if cnt > n + maxval+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE toNullApNestedList #-}+toNullApNestedList :: [Int] -> [Int]+toNullApNestedList s = (+) <$> s <*> s++{-# INLINE toNullNestedList #-}+toNullNestedList :: [Int] -> [Int]+toNullNestedList s = do+    x <- s+    y <- s+    return $ x + y++{-# INLINE toNullNestedList3 #-}+toNullNestedList3 :: [Int] -> [Int]+toNullNestedList3 s = do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE filterAllOutNestedList #-}+filterAllOutNestedList :: [Int] -> [Int]+filterAllOutNestedList str = do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else []++{-# INLINE filterAllInNestedList #-}+filterAllInNestedList :: [Int] -> [Int]+filterAllInNestedList str = do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else []+-}++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Stream.StreamDK"++o_1_space :: [Benchmark]+o_1_space =+    [ bgroup (o_1_space_prefix moduleName)+      [ bgroup "generation"+        [ benchFold "unfoldr"       toNull sourceUnfoldr+        , benchFold "unfoldrM"      toNull sourceUnfoldrM+        ]+      , bgroup "elimination"+        [ benchFold "toNull"   toNull   sourceUnfoldrM+        , benchFold "uncons"   uncons   sourceUnfoldrM+        ]+      ]+    ]++main :: IO ()+main = defaultMain [o_1_space]
benchmark/Streamly/Benchmark/Data/Unfold.hs view
@@ -21,6 +21,8 @@  import Control.DeepSeq (NFData(..)) import Control.Exception (SomeException, ErrorCall, try)+import Data.Char (ord)+import Data.Word (Word8) import Streamly.Internal.Data.Unfold (Unfold) import System.IO (Handle, hClose) import System.Random (randomRIO)@@ -29,17 +31,20 @@ import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Unfold as UF-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K-import qualified Streamly.Prelude as SP+#ifndef USE_STREAMLY_CORE+import qualified Streamly.Internal.Data.Unfold.Prelude as UF+#endif+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K -import Gauge hiding (env)-import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)+import Test.Tasty.Bench hiding (env)+import Prelude hiding (take, filter, zipWith, map, mapM, takeWhile) import Streamly.Benchmark.Common import Streamly.Benchmark.Common.Handle  #ifdef INSPECTION+import Control.Monad.Catch (MonadCatch) import Test.Inspection #endif @@ -54,7 +59,7 @@ -- generate numbers up to the argument value {-# INLINE source #-} source :: Monad m => Int -> Unfold m Int Int-source n = UF.supplySecond n UF.enumerateFromToIntegral+source n = UF.second n UF.enumerateFromToIntegral  ------------------------------------------------------------------------------- -- Benchmark helpers@@ -73,7 +78,7 @@ drainTransformationDefault ::        Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m () drainTransformationDefault to =-    drainTransformation (UF.supplySecond to UF.enumerateFromToIntegral)+    drainTransformation (UF.second to UF.enumerateFromToIntegral)  {-# INLINE drainProduct #-} drainProduct ::@@ -96,7 +101,7 @@      where -    src = UF.supplySecond to UF.enumerateFromToIntegral+    src = UF.second to UF.enumerateFromToIntegral  ------------------------------------------------------------------------------- -- Operations on input@@ -112,26 +117,26 @@ lmapM size start =     drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start -{-# INLINE supply #-}-supply :: Monad m => Int -> Int -> m ()-supply size start =-    drainTransformationDefault (size + start) (UF.supply start) undefined+{-# INLINE both #-}+both :: Monad m => Int -> Int -> m ()+both size start =+    drainTransformationDefault (size + start) (UF.supply start) ()  -{-# INLINE supplyFirst #-}-supplyFirst :: Monad m => Int -> Int -> m ()-supplyFirst size start =+{-# INLINE first #-}+first :: Monad m => Int -> Int -> m ()+first size start =     drainTransformation         (UF.take size UF.enumerateFromThenIntegral)-        (UF.supplyFirst start)+        (UF.first start)         1 -{-# INLINE supplySecond #-}-supplySecond :: Monad m => Int -> Int -> m ()-supplySecond size start =+{-# INLINE second #-}+second :: Monad m => Int -> Int -> m ()+second size start =     drainTransformation         (UF.take size UF.enumerateFromThenIntegral)-        (UF.supplySecond 1)+        (UF.second 1)         start  {-# INLINE discardFirst #-}@@ -159,7 +164,7 @@ {-# INLINE fromStream #-} fromStream :: Int -> Int -> IO () fromStream size start =-    drainGeneration UF.fromStream (S.replicate size start :: S.SerialT IO Int)+    drainGeneration UF.fromStream (S.replicate size start :: S.Stream IO Int)  -- XXX INVESTIGATE: Although the performance of this should be equivalant to -- fromStream, this is considerably worse. More than 4x worse.@@ -198,9 +203,9 @@ _const size start =     drainGeneration (UF.take size (UF.fromEffect (return start))) undefined -{-# INLINE unfoldrM #-}-unfoldrM :: Monad m => Int -> Int -> m ()-unfoldrM size start = drainGeneration (UF.unfoldrM step) start+{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Int -> Unfold m Int Int+sourceUnfoldrM size start = UF.unfoldrM step      where @@ -210,6 +215,10 @@               then Just (i, i + 1)               else Nothing +{-# INLINE unfoldrM #-}+unfoldrM :: Monad m => Int -> Int -> m ()+unfoldrM size start = drainGeneration (sourceUnfoldrM size start) start+ {-# INLINE fromList #-} fromList :: Monad m => Int -> Int -> m () fromList size start = drainGeneration UF.fromList [start .. start + size]@@ -229,7 +238,7 @@  {-# INLINE replicateM #-} replicateM :: Monad m => Int -> Int -> m ()-replicateM size start = drainGeneration (UF.replicateM size) (return start)+replicateM size start = drainGeneration UF.replicateM (size, return start)  {-# INLINE repeatM #-} repeatM :: Monad m => Int -> Int -> m ()@@ -254,7 +263,7 @@ enumerateFromToIntegral :: Monad m => Int -> Int -> m () enumerateFromToIntegral size start =     drainGeneration-    ( UF.supplySecond+    ( UF.second       (size + start)       UF.enumerateFromToIntegral     ) start@@ -278,7 +287,7 @@ enumerateFromToFractional size start =     let intToDouble x = (fromInteger (fromIntegral x)) :: Double      in drainGeneration-            ( UF.supplySecond+            ( UF.second               (intToDouble $ start + size)               UF.enumerateFromToFractional             )@@ -288,6 +297,11 @@ -- Stream transformation ------------------------------------------------------------------------------- +{-# INLINE postscan #-}+postscan :: Monad m => Int -> Int -> m ()+postscan size start =+    drainTransformationDefault (size + start) (UF.postscan FL.sum) start+ {-# INLINE map #-} map :: Monad m => Int -> Int -> m () map size start = drainTransformationDefault (size + start) (UF.map (+1)) start@@ -297,12 +311,12 @@ mapM size start =     drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start -{-# INLINE mapMWithInput #-}-mapMWithInput :: Monad m => Int -> Int -> m ()-mapMWithInput size start =+{-# INLINE mapM2 #-}+mapM2 :: Monad m => Int -> Int -> m ()+mapM2 size start =     drainTransformationDefault         size-        (UF.mapMWithInput (\a b -> return $ a + b))+        (UF.mapM (\(a, b) -> return $ a + b) . UF.carry)         start  -------------------------------------------------------------------------------@@ -410,13 +424,16 @@ -- Applicative ------------------------------------------------------------------------------- +nthRoot :: Double -> Int -> Int+nthRoot n value = round (fromIntegral value**(1/n))+ {-# INLINE toNullAp #-} toNullAp :: Monad m => Int -> Int -> m () toNullAp value start =     let end = start + nthRoot 2 value         s = source end     -- in UF.fold ((+) <$> s <*> s) FL.drain start-    in UF.fold FL.drain ((+) `fmap` s `UF.apply` s) start+    in UF.fold FL.drain (((+) `fmap` s) `UF.crossApply` s) start  {-# INLINE _apDiscardFst #-} _apDiscardFst :: Int -> Int -> m ()@@ -430,19 +447,17 @@ -- Monad ------------------------------------------------------------------------------- -nthRoot :: Double -> Int -> Int-nthRoot n value = round (fromIntegral value**(1/n))-+-- XXX to keep the benchmarks same as Stream we should use sourceUnfoldrM in+-- all of these, and other benchmarks too. {-# INLINE concatMapM #-}-concatMapM :: Monad m => Int -> Int -> m ()-concatMapM value start =-    val `seq` drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start+concatMapM :: Monad m => Int -> Int -> Int -> m ()+concatMapM inner outer start =+    drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start      where -    val = nthRoot 2 value-    unfoldInGen i = return (UF.supplySecond (i + val) UF.enumerateFromToIntegral)-    unfoldOut = UF.supplySecond (start + val) UF.enumerateFromToIntegral+    unfoldInGen i = return (UF.second (i + inner) UF.enumerateFromToIntegral)+    unfoldOut = UF.second (start + outer) UF.enumerateFromToIntegral  {-# INLINE toNull #-} toNull :: Monad m => Int -> Int -> m ()@@ -475,7 +490,8 @@         -}         u = src `UF.bind` \x ->             src `UF.bind` \y ->-                UF.fromPure (x + y)+            src `UF.bind` \z ->+                UF.fromPure (x + y + z)      in UF.fold FL.drain u start  {-# INLINE toList #-}@@ -588,16 +604,13 @@ -- Benchmark ops ------------------------------------------------------------------------------- --- n * (n + 1) / 2 == linearCount-concatCount :: Int -> Int-concatCount linearCount =-    round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)--{-# INLINE concat #-}-concat :: Monad m => Int -> Int -> m ()-concat linearCount start = do-    let end = start + concatCount linearCount-    UF.fold FL.drain (UF.many (source end) (source end)) start+{-# INLINE unfoldEach #-}+unfoldEach :: Monad m => Int -> Int -> Int -> m ()+unfoldEach inner outer start = do+    UF.fold+        FL.drain+        (UF.unfoldEach (sourceUnfoldrM inner start) (sourceUnfoldrM outer start))+        start  ------------------------------------------------------------------------------- -- Benchmarks@@ -612,9 +625,9 @@           "transformation/input"           [ benchIO "lmap" $ lmap size           , benchIO "lmapM" $ lmapM size-          , benchIO "supply" $ supply size-          , benchIO "supplyFirst" $ supplyFirst size-          , benchIO "supplySecond" $ supplySecond size+          , benchIO "both" $ both size+          , benchIO "first" $ first size+          , benchIO "second" $ second size           , benchIO "discardFirst" $ discardFirst size           , benchIO "discardSecond" $ discardSecond size           , benchIO "swap" $ swap size@@ -660,7 +673,8 @@           "transformation"           [ benchIO "map" $ map size           , benchIO "mapM" $ mapM size-          , benchIO "mapMWithInput" $ mapMWithInput size+          , benchIO "mapM2" $ mapM2 size+          , benchIO "postscan" $ postscan size           ]     ] @@ -693,33 +707,50 @@           ]     ] -o_1_space_nested :: Int -> [Benchmark]-o_1_space_nested size =+lf :: Word8+lf = fromIntegral (ord '\n')++-- | Split on line feed.+foldManySepBy :: Handle -> IO Int+foldManySepBy =+    let u = UF.foldMany (FL.takeEndBy_ (== lf) FL.drain) FH.reader+     in UF.fold FL.length u++o_1_space_nested :: BenchEnv -> Int -> [Benchmark]+o_1_space_nested env size =     [ bgroup           "nested"-          [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size+          [ benchIO "crossApply outer=inner=(sqrt Max)" $ toNullAp size           -- Unimplemented           -- , benchIO "apDiscardFst" $ apDiscardFst size           -- , benchIO "apDiscardSnd" $ apDiscardSnd size -          , benchIO "concatMapM (sqrt n x sqrt n)" $ concatMapM size-          , benchIO "(>>=) (sqrt n x sqrt n)" $ toNull size-          , benchIO "(>>=) (cubert n x cubert n x cubert n)" $ toNull3 size-          , benchIO "breakAfterSome" $ breakAfterSome size-          , benchIO "filterAllOut" $ filterAllOut size-          , benchIO "filterAllIn" $ filterAllIn size-          , benchIO "filterSome" $ filterSome size+          , benchIO "concatMapM outer=inner=(sqrt Max)" $ concatMapM sqrtVal sqrtVal+          , benchIO "bind2" $ toNull size+          , benchIO "bind3" $ toNull3 size+          , benchIO "breakAfterSome2" $ breakAfterSome size+          , benchIO "filterAllOut2" $ filterAllOut size+          , benchIO "filterAllIn2" $ filterAllIn size+          , benchIO "filterSome2" $ filterSome size -          , benchIO "concat" $ concat size+          , benchIO "unfoldEach inner=outer=(sqrt Max)" $ unfoldEach sqrtVal sqrtVal+          , benchIO "unfoldEach inner=1 outer=Max" $ unfoldEach 1 size+          , benchIO "unfoldEach inner=Max outer=1" $ unfoldEach size 1+          , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env+            $ \inh _ -> foldManySepBy inh           ]     ] +    where++    sqrtVal = round $ sqrt (fromIntegral size :: Double)+ o_n_space_nested :: Int -> [Benchmark] o_n_space_nested size =     [ bgroup           "nested"-          [ benchIO "toList" $ toList size-          , benchIO "toListSome" $ toListSome size+          [ benchIO "toList2" $ toList size+          , benchIO "toListSome2" $ toListSome size           ]     ] @@ -729,11 +760,11 @@ -- | Send the file contents to /dev/null with exception handling readWriteOnExceptionUnfold :: Handle -> Handle -> IO () readWriteOnExceptionUnfold inh devNull =-    let readEx = UF.onException (\_ -> hClose inh) FH.read-    in SP.fold (FH.write devNull) $ SP.unfold readEx inh+    let readEx = UF.onException (\_ -> hClose inh) FH.reader+    in S.fold (FH.write devNull) $ S.unfold readEx inh  #ifdef INSPECTION-inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold+-- inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold -- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step #endif @@ -741,45 +772,58 @@ readWriteHandleExceptionUnfold :: Handle -> Handle -> IO () readWriteHandleExceptionUnfold inh devNull =     let handler (_e :: SomeException) = hClose inh >> return 10-        readEx = UF.handle (UF.functionM handler) FH.read-    in SP.fold (FH.write devNull) $ SP.unfold readEx inh+        readEx = UF.handle (UF.functionM handler) FH.reader+    in S.fold (FH.write devNull) $ S.unfold readEx inh  #ifdef INSPECTION-inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold+-- hasNoTypeClasses started failing in GHC 9.4.4+-- inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold -- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step #endif  -- | Send the file contents to /dev/null with exception handling readWriteFinally_Unfold :: Handle -> Handle -> IO () readWriteFinally_Unfold inh devNull =-    let readEx = UF.finally_ (\_ -> hClose inh) FH.read-    in SP.fold (FH.write devNull) $ SP.unfold readEx inh+    let readEx = UF.finally_ (\_ -> hClose inh) FH.reader+    in S.fold (FH.write devNull) $ S.unfold readEx inh  #ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'readWriteFinally_Unfold [''MonadCatch]+#else inspect $ hasNoTypeClasses 'readWriteFinally_Unfold+#endif -- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step #endif +#ifndef USE_STREAMLY_CORE readWriteFinallyUnfold :: Handle -> Handle -> IO () readWriteFinallyUnfold inh devNull =-    let readEx = UF.finally (\_ -> hClose inh) FH.read-    in SP.fold (FH.write devNull) $ SP.unfold readEx inh+    let readEx = UF.finally (\_ -> hClose inh) FH.reader+    in S.fold (FH.write devNull) $ S.unfold readEx inh+#endif  -- | Send the file contents to /dev/null with exception handling readWriteBracket_Unfold :: Handle -> Handle -> IO () readWriteBracket_Unfold inh devNull =-    let readEx = UF.bracket_ return (\_ -> hClose inh) FH.read-    in SP.fold (FH.write devNull) $ SP.unfold readEx inh+    let readEx = UF.bracket_ return (\_ -> hClose inh) FH.reader+    in S.fold (FH.write devNull) $ S.unfold readEx inh  #ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'readWriteBracket_Unfold [''MonadCatch]+#else inspect $ hasNoTypeClasses 'readWriteBracket_Unfold+#endif -- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step #endif +#ifndef USE_STREAMLY_CORE readWriteBracketUnfold :: Handle -> Handle -> IO () readWriteBracketUnfold inh devNull =-    let readEx = UF.bracket return (\_ -> hClose inh) FH.read-    in SP.fold (FH.write devNull) $ S.unfold readEx inh+    let readEx = UF.bracket return (\_ -> hClose inh) FH.reader+    in S.fold (FH.write devNull) $ S.unfold readEx inh+#endif  o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark] o_1_space_copy_read_exceptions env =@@ -790,12 +834,14 @@            readWriteHandleExceptionUnfold inh (nullH env)        , mkBenchSmall "UF.finally_" env $ \inh _ ->            readWriteFinally_Unfold inh (nullH env)-       , mkBenchSmall "UF.finally" env $ \inh _ ->-           readWriteFinallyUnfold inh (nullH env)        , mkBenchSmall "UF.bracket_" env $ \inh _ ->            readWriteBracket_Unfold inh (nullH env)+#ifndef USE_STREAMLY_CORE+       , mkBenchSmall "UF.finally" env $ \inh _ ->+           readWriteFinallyUnfold inh (nullH env)        , mkBenchSmall "UF.bracket" env $ \inh _ ->            readWriteBracketUnfold inh (nullH env)+#endif         ]     ] @@ -819,7 +865,7 @@                   , o_1_space_transformation size                   , o_1_space_filtering size                   , o_1_space_zip size-                  , o_1_space_nested size+                  , o_1_space_nested env size                   , o_1_space_copy_read_exceptions env                   ]         , bgroup (o_n_space_prefix moduleName)
+ benchmark/Streamly/Benchmark/FileSystem/DirIO.hs view
@@ -0,0 +1,93 @@+-- |+-- Module      : Streamly.Benchmark.FileSystem.DirIO+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE CPP #-}++module Main (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Control.Monad (void)+import GHC.IO.Encoding (setLocaleEncoding, utf8)+import Streamly.Benchmark.Common (o_1_space_prefix)++import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Data.Fold as Fold++import Prelude hiding (last, length)+import Test.Tasty.Bench+import BenchTestLib.DirIO++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "FileSystem.DirIO"++-- | List the current directory recursively+main :: IO ()+main = do+    setLocaleEncoding utf8++    let smallTree = "benchmark-tmp/dir-structure-small"+        bigTree = "benchmark-tmp/dir-structure-big"+    void $ createDirStucture smallTree 2 3+    void $ createDirStucture bigTree 5 5++    defaultMain+        [ bgroup (o_1_space_prefix moduleName)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+           $ bench "listDirByteChunked (big)" (nfIO $+               Stream.fold Fold.drain $ listDirByteChunked bigTree) :+#endif+            -- NOTE: The BFS traversal fails with:+            -- openDirStream: resource exhausted (Too many open files)+            -- if a bigger directory tree is used+            [ bench "listDirUnfoldDfs (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirUnfoldDfs id bigTree+            , bench "listDirUnfoldBfs (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirUnfoldBfs id smallTree+            , bench "listDirUnfoldBfsRev (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirUnfoldBfsRev id smallTree+            , bench "listDirConcatDfs (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirConcatDfs id bigTree+            , bench "listDirConcatBfs (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirConcatBfs id smallTree+            , bench "listDirConcatBfsRev (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirConcatBfsRev id smallTree+            , bench "listDirAppend (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirAppend id bigTree+            , bench "listDirInterleave (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirInterleave id bigTree+            , bench "listDirPar (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirPar id bigTree+            , bench "listDirParInterleaved (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirParInterleaved id bigTree+            , bench "listDirParOrdered (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirParOrdered id bigTree+            , bench "listDirChunkDfs (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkDfs id bigTree+            , bench "listDirChunkBfs (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkBfs id smallTree+            , bench "listDirChunkBfsRev (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkBfsRev id smallTree+            , bench "listDirChunkAppend (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkAppend id bigTree+            , bench "listDirChunkInterleave (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkInterleave id bigTree+            , bench "listDirChunkPar (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkPar id bigTree+            , bench "listDirChunkParInterleaved (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkParInterleaved id bigTree+            , bench "listDirChunkParOrdered (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkParOrdered id bigTree+            ]+        ]
benchmark/Streamly/Benchmark/FileSystem/Handle.hs view
@@ -17,16 +17,12 @@ {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} #endif--#if __GLASGOW_HASKELL__ >= 800-#endif- import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)  import qualified Handle.ReadWrite as RW import qualified Handle.Read as RO -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Prelude hiding (last, length) import Streamly.Benchmark.Common
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs view
@@ -1,3 +1,4 @@+ -- | -- Module      : Streamly.Benchmark.FileSystem.Handle -- Copyright   : (c) 2019 Composewell Technologies@@ -24,32 +25,28 @@  import Data.Word (Word8) import GHC.Magic (inline)-#if __GLASGOW_HASKELL__ >= 802 import GHC.Magic (noinline)-#else-#define noinline-#endif import System.IO (Handle) +import qualified Streamly.Data.Fold as Fold import qualified Streamly.FileSystem.Handle as FH-import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Foreign.Type as AT+import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Stream.IsStream as IP+import qualified Streamly.Internal.Data.Stream as IP import qualified Streamly.Internal.FileSystem.Handle as IFH import qualified Streamly.Internal.Unicode.Stream as IUS-import qualified Streamly.Prelude as S+import qualified Streamly.Data.Stream.Prelude as S import qualified Streamly.Unicode.Stream as SS -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Prelude hiding (last, length) import Streamly.Benchmark.Common.Handle  #ifdef INSPECTION-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), FoldMany)+import Streamly.Internal.Data.Stream (Step(..), FoldMany) -import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Unfold as IUF  import Test.Inspection@@ -63,49 +60,49 @@  -- | Get the last byte from a file bytestream. readLast :: Handle -> IO (Maybe Word8)-readLast = S.last . S.unfold FH.read+readLast = S.fold Fold.latest . S.unfold FH.reader  #ifdef INSPECTION inspect $ hasNoTypeClasses 'readLast inspect $ 'readLast `hasNoType` ''Step -- S.unfold inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'readLast `hasNoType` ''MA.ReadUState  -- FH.read/A.read+inspect $ 'readLast `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read #endif  -- assert that flattenArrays constructors are not present -- | Count the number of bytes in a file. readCountBytes :: Handle -> IO Int-readCountBytes = S.length . S.unfold FH.read+readCountBytes = S.fold Fold.length . S.unfold FH.reader  #ifdef INSPECTION inspect $ hasNoTypeClasses 'readCountBytes inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'readCountBytes `hasNoType` ''MA.ReadUState  -- FH.read/A.read+inspect $ 'readCountBytes `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read #endif  -- | Count the number of lines in a file. readCountLines :: Handle -> IO Int readCountLines =-    S.length+    S.fold Fold.length         . IUS.lines FL.drain         . SS.decodeLatin1-        . S.unfold FH.read+        . S.unfold FH.reader  #ifdef INSPECTION inspect $ hasNoTypeClasses 'readCountLines inspect $ 'readCountLines `hasNoType` ''Step inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'readCountLines `hasNoType` ''MA.ReadUState  -- FH.read/A.read+inspect $ 'readCountLines `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read #endif  -- | Count the number of words in a file. readCountWords :: Handle -> IO Int readCountWords =-    S.length+    S.fold Fold.length         . IUS.words FL.drain         . SS.decodeLatin1-        . S.unfold FH.read+        . S.unfold FH.reader  #ifdef INSPECTION inspect $ hasNoTypeClasses 'readCountWords@@ -114,13 +111,13 @@  -- | Sum the bytes in a file. readSumBytes :: Handle -> IO Word8-readSumBytes = S.sum . S.unfold FH.read+readSumBytes = S.fold Fold.sum . S.unfold FH.reader  #ifdef INSPECTION inspect $ hasNoTypeClasses 'readSumBytes inspect $ 'readSumBytes `hasNoType` ''Step inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState  -- FH.read/A.read+inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read #endif  -- XXX When we mark this with INLINE and we have two benchmarks using S.drain@@ -134,21 +131,21 @@ -- fusion-plugin to propagate INLINE phase information such that this problem -- does not occur. readDrain :: Handle -> IO ()-readDrain inh = S.drain $ S.unfold FH.read inh+readDrain inh = S.fold Fold.drain $ S.unfold FH.reader inh  -- XXX investigate why we need an INLINE in this case (GHC) {-# INLINE readDecodeLatin1 #-} readDecodeLatin1 :: Handle -> IO () readDecodeLatin1 inh =-   S.drain+   S.fold Fold.drain      $ SS.decodeLatin1-     $ S.unfold FH.read inh+     $ S.unfold FH.reader inh  readDecodeUtf8 :: Handle -> IO () readDecodeUtf8 inh =-   S.drain+   S.fold Fold.drain      $ SS.decodeUtf8-     $ S.unfold FH.read inh+     $ S.unfold FH.reader inh  #ifdef INSPECTION inspect $ hasNoTypeClasses 'readDecodeUtf8@@ -187,25 +184,25 @@ -------------------------------------------------------------------------------  -- | Count the number of lines in a file.-toChunksConcatUnfoldCountLines :: Handle -> IO Int-toChunksConcatUnfoldCountLines inh =-    S.length+getChunksConcatUnfoldCountLines :: Handle -> IO Int+getChunksConcatUnfoldCountLines inh =+    S.fold Fold.length         $ IUS.lines FL.drain         $ SS.decodeLatin1         -- XXX replace with toBytes-        $ S.unfoldMany A.read (IFH.toChunks inh)+        $ S.unfoldEach A.reader (IFH.readChunks inh)  #ifdef INSPECTION-inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines-inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step-inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState+inspect $ hasNoTypeClasses 'getChunksConcatUnfoldCountLines+inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''Step+inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState #endif  o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark] o_1_space_reduce_toBytes env =     [ bgroup "reduce/toBytes"         [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->-            toChunksConcatUnfoldCountLines inh+            getChunksConcatUnfoldCountLines inh         ]     ] @@ -214,58 +211,63 @@ -------------------------------------------------------------------------------  chunksOfSum :: Int -> Handle -> IO Int-chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)+chunksOfSum n inh =+    S.fold Fold.length $ IP.groupsOf n FL.sum (S.unfold FH.reader inh) -foldManyPostChunksOfSum :: Int -> Handle -> IO Int-foldManyPostChunksOfSum n inh =-    S.length $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.read inh)+foldMany1ChunksOfSum :: Int -> Handle -> IO Int+foldMany1ChunksOfSum n inh =+    S.fold Fold.length+        $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.reader inh)  foldManyChunksOfSum :: Int -> Handle -> IO Int foldManyChunksOfSum n inh =-    S.length $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.read inh)+    S.fold Fold.length+        $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.reader inh)  -- XXX investigate why we need an INLINE in this case (GHC) -- Even though allocations remain the same in both cases inlining improves time -- by 4x. -- | Slice in chunks of size n and get the count of chunks.-{-# INLINE chunksOf #-}-chunksOf :: Int -> Handle -> IO Int-chunksOf n inh =+{-# INLINE groupsOf #-}+groupsOf :: Int -> Handle -> IO Int+groupsOf n inh =     -- writeNUnsafe gives 2.5x boost here over writeN.-    S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)+    S.fold Fold.length+        $ IP.groupsOf n (A.unsafeCreateOf n) (S.unfold FH.reader inh)  #ifdef INSPECTION-inspect $ hasNoTypeClasses 'chunksOf-inspect $ 'chunksOf `hasNoType` ''Step-inspect $ 'chunksOf `hasNoType` ''FoldMany-inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe-inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'chunksOf `hasNoType` ''MA.ReadUState  -- FH.read/A.read+inspect $ hasNoTypeClasses 'groupsOf+inspect $ 'groupsOf `hasNoType` ''Step+inspect $ 'groupsOf `hasNoType` ''FoldMany+inspect $ 'groupsOf `hasNoType` ''MutArray.ArrayUnsafe -- AT.writeNUnsafe+                                                 -- FH.read/A.read+inspect $ 'groupsOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many #endif -{-# INLINE arraysOf #-}-arraysOf :: Int -> Handle -> IO Int-arraysOf n inh = S.length $ IP.arraysOf n (S.unfold FH.read inh)+{-# INLINE chunksOf #-}+chunksOf :: Int -> Handle -> IO Int+chunksOf n inh =+    S.fold Fold.length $ A.chunksOf n (S.unfold FH.reader inh)  o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark] o_1_space_reduce_read_grouped env =     [ bgroup "reduce/read/chunks"-        [ mkBench ("S.chunksOf " ++ show (bigSize env) ++  " FL.sum") env $+        [ mkBench ("S.groupsOf " ++ show (bigSize env) ++  " FL.sum") env $             \inh _ ->                 chunksOfSum (bigSize env) inh-        , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->+        , mkBench "S.groupsOf 1 FL.sum" env $ \inh _ ->             chunksOfSum 1 inh          -- XXX investigate why we need inline/noinline in these cases (GHC)         -- Chunk using parsers         , mkBench-            ("S.foldManyPost (FL.take " ++ show (bigSize env) ++ " FL.sum)")+            ("S.foldMany1 (FL.take " ++ show (bigSize env) ++ " FL.sum)")             env-            $ \inh _ -> noinline foldManyPostChunksOfSum (bigSize env) inh+            $ \inh _ -> noinline foldMany1ChunksOfSum (bigSize env) inh         , mkBench-            "S.foldManyPost (FL.take 1 FL.sum)"+            "S.foldMany1 (FL.take 1 FL.sum)"             env-            $ \inh _ -> inline foldManyPostChunksOfSum 1 inh+            $ \inh _ -> inline foldMany1ChunksOfSum 1 inh         , mkBench             ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")             env@@ -276,20 +278,20 @@             $ \inh _ -> inline foldManyChunksOfSum 1 inh          -- folding chunks to arrays-        , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->+        , mkBenchSmall "S.groupsOf 1" env $ \inh _ ->+            groupsOf 1 inh+        , mkBench "S.groupsOf 10" env $ \inh _ ->+            groupsOf 10 inh+        , mkBench "S.groupsOf 1000" env $ \inh _ ->+            groupsOf 1000 inh++        -- chunksOf may use a different impl than groupsOf+        , mkBenchSmall "A.chunksOf 1" env $ \inh _ ->             chunksOf 1 inh-        , mkBench "S.chunksOf 10" env $ \inh _ ->+        , mkBench "A.chunksOf 10" env $ \inh _ ->             chunksOf 10 inh-        , mkBench "S.chunksOf 1000" env $ \inh _ ->+        , mkBench "A.chunksOf 1000" env $ \inh _ ->             chunksOf 1000 inh--        -- arraysOf may use a different impl than chunksOf-        , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->-            arraysOf 1 inh-        , mkBench "S.arraysOf 10" env $ \inh _ ->-            arraysOf 10 inh-        , mkBench "S.arraysOf 1000" env $ \inh _ ->-            arraysOf 1000 inh         ]     ]
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs view
@@ -1,3 +1,4 @@+ -- | -- Module      : Streamly.Benchmark.FileSystem.Handle -- Copyright   : (c) 2019 Composewell Technologies@@ -29,20 +30,18 @@ import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Unfold as IUF import qualified Streamly.Internal.FileSystem.Handle as IFH-import qualified Streamly.Data.Array.Foreign as A-import qualified Streamly.Prelude as S+import qualified Streamly.Data.Array as A+import qualified Streamly.Data.Stream.Prelude as S -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common.Handle  #ifdef INSPECTION-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))+import Streamly.Internal.Data.Stream (Step(..)) -import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Tuple.Strict as Strict-import qualified Streamly.Internal.Data.Array.Stream.Mut.Foreign as MAS-import qualified Streamly.Internal.Data.Array.Foreign.Type as AT-import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA+import qualified Streamly.Internal.Data.MutArray as MutArray  import Test.Inspection #endif@@ -53,7 +52,7 @@  -- | Copy file copyChunks :: Handle -> Handle -> IO ()-copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks inh+copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.readChunks inh  #ifdef INSPECTION inspect $ hasNoTypeClasses 'copyChunks@@ -62,7 +61,7 @@  o_1_space_copy_chunked :: BenchEnv -> [Benchmark] o_1_space_copy_chunked env =-    [ bgroup "copy/toChunks"+    [ bgroup "copy/getChunks"         [ mkBench "toNull" env $ \inH _ ->             copyChunks inH (nullH env)         , mkBench "raw" env $ \inH outH ->@@ -76,14 +75,14 @@  -- | Copy file copyStream :: Handle -> Handle -> IO ()-copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)+copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.reader inh)  #ifdef INSPECTION inspect $ hasNoTypeClasses 'copyStream inspect $ 'copyStream `hasNoType` ''Step -- S.unfold inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'copyStream `hasNoType` ''MA.ReadUState  -- FH.read/A.read-inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe+inspect $ 'copyStream `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe+                                                   -- FH.read/A.read inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf #endif @@ -103,28 +102,28 @@  -- | Send the file contents to /dev/null readFromBytesNull :: Handle -> Handle -> IO ()-readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.read inh+readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.reader inh  #ifdef INSPECTION inspect $ hasNoTypeClasses 'readFromBytesNull inspect $ 'readFromBytesNull `hasNoType` ''Step-inspect $ 'readFromBytesNull `hasNoType` ''MAS.SpliceState-inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf+inspect $ 'readFromBytesNull `hasNoType` ''MutArray.SpliceState+inspect $ 'readFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf inspect $ 'readFromBytesNull `hasNoType` ''D.FoldMany #endif  -- | Send the file contents ('defaultChunkSize') to /dev/null-readWithBufferOfFromBytesNull :: Handle -> Handle -> IO ()-readWithBufferOfFromBytesNull inh devNull =+readWithFromBytesNull :: Handle -> Handle -> IO ()+readWithFromBytesNull inh devNull =     IFH.putBytes devNull-        $ S.unfold FH.readWithBufferOf (defaultChunkSize, inh)+        $ S.unfold FH.readerWith (defaultChunkSize, inh)  #ifdef INSPECTION-inspect $ hasNoTypeClasses 'readWithBufferOfFromBytesNull-inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''Step-inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''MAS.SpliceState-inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf-inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''D.FoldMany+inspect $ hasNoTypeClasses 'readWithFromBytesNull+inspect $ 'readWithFromBytesNull `hasNoType` ''Step+inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.SpliceState+inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf+inspect $ 'readWithFromBytesNull `hasNoType` ''D.FoldMany #endif  -- | Send the chunk content ('defaultChunkSize') to /dev/null@@ -135,44 +134,43 @@     where      fld = FH.write devNull-    unf = IUF.many FH.readChunks A.read+    unf = IUF.unfoldEach A.reader FH.chunkReader  -- | Send the chunk content to /dev/null--- Implicitly benchmarked via 'readWithBufferOfFromBytesNull'-_readChunksWithBufferOf :: Handle -> Handle -> IO ()-_readChunksWithBufferOf inh devNull = IUF.fold fld unf (defaultChunkSize, inh)+-- Implicitly benchmarked via 'readWithFromBytesNull'+_readChunksWith :: Handle -> Handle -> IO ()+_readChunksWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)      where      fld = FH.write devNull-    unf = IUF.many FH.readChunksWithBufferOf A.read-+    unf = IUF.unfoldEach A.reader FH.chunkReaderWith  o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark] o_1_space_copy_fromBytes env =     [ bgroup "copy/putBytes"         [ mkBench "rawToNull" env $ \inh _ ->             readFromBytesNull inh (nullH env)-        , mkBench "FH.readWithBufferOf" env $ \inh _ ->-            readWithBufferOfFromBytesNull inh (nullH env)+        , mkBench "FH.readWith" env $ \inh _ ->+            readWithFromBytesNull inh (nullH env)         ]     ]  -- | Send the file contents ('defaultChunkSize') to /dev/null-writeReadWithBufferOf :: Handle -> Handle -> IO ()-writeReadWithBufferOf inh devNull = IUF.fold fld unf (defaultChunkSize, inh)+writeReadWith :: Handle -> Handle -> IO ()+writeReadWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)      where -    fld = FH.writeWithBufferOf defaultChunkSize devNull-    unf = FH.readWithBufferOf+    fld = FH.writeWith defaultChunkSize devNull+    unf = FH.readerWith  #ifdef INSPECTION-inspect $ hasNoTypeClasses 'writeReadWithBufferOf-inspect $ 'writeReadWithBufferOf `hasNoType` ''Step-inspect $ 'writeReadWithBufferOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'writeReadWithBufferOf `hasNoType` ''MA.ReadUState  -- FH.read/A.read-inspect $ 'writeReadWithBufferOf `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe+inspect $ hasNoTypeClasses 'writeReadWith+inspect $ 'writeReadWith `hasNoType` ''Step+inspect $ 'writeReadWith `hasNoType` ''IUF.ConcatState -- FH.read/UF.many+inspect $ 'writeReadWith `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe+                                                      -- FH.read/A.read #endif  -- | Send the file contents ('AT.defaultChunkSize') to /dev/null@@ -182,14 +180,14 @@     where      fld = FH.write devNull-    unf = FH.read+    unf = FH.reader  #ifdef INSPECTION inspect $ hasNoTypeClasses 'writeRead inspect $ 'writeRead `hasNoType` ''Step inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'writeRead `hasNoType` ''MA.ReadUState  -- FH.read/A.read-inspect $ 'writeRead `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe+inspect $ 'writeRead `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe+                                                  -- FH.read/A.read #endif  o_1_space_copy :: BenchEnv -> [Benchmark]@@ -197,8 +195,8 @@     [ bgroup "copy"         [ mkBench "FH.write . FH.read" env $ \inh _ ->             writeRead inh (nullH env)-        , mkBench "FH.writeWithBufferOf . FH.readWithBufferOf" env $ \inh _ ->-            writeReadWithBufferOf inh (nullH env)+        , mkBench "FH.writeWith . FH.readWith" env $ \inh _ ->+            writeReadWith inh (nullH env)         ]     ]
benchmark/Streamly/Benchmark/Prelude/Adaptive.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -8,7 +10,7 @@ import Control.Concurrent (threadDelay) import Control.Monad (when) import Control.Monad.IO.Class (liftIO)-import Gauge+import Test.Tasty.Bench import Streamly.Prelude as S import System.Random (randomRIO) @@ -34,11 +36,14 @@  {-# INLINE run #-} run :: IsStream t => (Int, Int) -> (Int, Int) -> (t IO Int -> SerialT IO Int) -> IO ()-run srange crange t = S.drain $ do-    n <- t $ source srange-    d <- liftIO (randomRIO crange)-    when (d /= 0) $ liftIO $ threadDelay d-    return n+run srange crange t = S.drain $ S.mapM action (t $ source srange)++    where++    action x = liftIO $ do+        d <- randomRIO crange+        when (d /= 0) $ threadDelay d+        return x  low, medium, high :: Int low = 10
benchmark/Streamly/Benchmark/Prelude/Ahead.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -13,7 +15,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench  moduleName :: String moduleName = "Prelude.Ahead"
benchmark/Streamly/Benchmark/Prelude/Async.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -14,7 +16,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench  moduleName :: String moduleName = "Prelude.Async"@@ -122,9 +124,9 @@             (sourceFoldMapWithStream value)         , benchIOSrc fromAsync "foldMapWithM (<>) (List)"             (sourceFoldMapWithM value)-        , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"+        , benchIOSrc fromAsync "S.concatFoldableWith (<>) (List)"             (concatFoldableWith value)-        , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"+        , benchIOSrc fromAsync "S.concatForFoldableWith (<>) (List)"             (concatForFoldableWith value)         , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)         ]
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} -- |@@ -14,7 +15,7 @@     , fromWAsync, parallel, fromParallel     ) -import Gauge+import Test.Tasty.Bench import qualified Streamly.Prelude as S  -------------------------------------------------------------------------------
benchmark/Streamly/Benchmark/Prelude/Merge.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -28,13 +30,13 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench  #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif  moduleName :: String
benchmark/Streamly/Benchmark/Prelude/Parallel.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -20,7 +22,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench  moduleName :: String moduleName = "Prelude.Parallel"
benchmark/Streamly/Benchmark/Prelude/Rate.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} {-# LANGUAGE FlexibleContexts #-}  -- |@@ -13,7 +14,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench  moduleName :: String moduleName = "Prelude.Rate"
− benchmark/Streamly/Benchmark/Prelude/Serial.hs 
@@ -1,53 +0,0 @@--- |--- Module      : Serial--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}--module Main (main) where--import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)--import qualified Serial.Elimination as Elimination-import qualified Serial.Exceptions as Exceptions-import qualified Serial.Generation as Generation-import qualified Serial.NestedStream as NestedStream-import qualified Serial.Split as Split-import qualified Serial.Transformation as Transformation-import qualified Serial.NestedFold as NestedFold-import qualified Serial.Lift as Lift--import Streamly.Benchmark.Common--moduleName :: String-moduleName = "Prelude.Serial"------------------------------------------------------------------------------------ Main------------------------------------------------------------------------------------ In addition to gauge options, the number of elements in the stream can be--- passed using the --stream-size option.----main :: IO ()-main = do-    env <- mkHandleBenchEnv-    runWithCLIOpts defaultStreamSize (allBenchmarks env)--    where--    allBenchmarks env size = Prelude.concat-        [ Generation.benchmarks moduleName size-        , Elimination.benchmarks moduleName size-        , Exceptions.benchmarks moduleName env size-        , Split.benchmarks moduleName env-        , Transformation.benchmarks moduleName size-        , NestedFold.benchmarks moduleName size-        , Lift.benchmarks moduleName size-        , NestedStream.benchmarks moduleName size-        ]
− benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hs 
@@ -1,686 +0,0 @@--- |--- Module      : Serial.Elimination--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Serial.Elimination (benchmarks) where--import Control.DeepSeq (NFData(..))-import Data.Functor.Identity (Identity, runIdentity)-import System.Random (randomRIO)--import qualified Data.Foldable as F-import qualified GHC.Exts as GHC--#ifdef INSPECTION-import GHC.Types (SPEC(..))-import Test.Inspection--import qualified Streamly.Internal.Data.Stream.StreamD as D-#endif--import qualified Streamly.Prelude  as S-import qualified Streamly.Internal.Data.Stream.IsStream as Internal--import Gauge-import Streamly.Prelude (SerialT, IsStream, fromSerial)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Prelude-import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),-    lookup, repeat, minimum, maximum, product, last, mapM_, init)-import qualified Prelude--{-# INLINE repeat #-}-repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-repeat count = S.take count . S.repeat------------------------------------------------------------------------------------ Elimination-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Foldable Instance----------------------------------------------------------------------------------{-# INLINE foldableFoldl' #-}-foldableFoldl' :: Int -> Int -> Int-foldableFoldl' value n =-    F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableFoldrElem #-}-foldableFoldrElem :: Int -> Int -> Bool-foldableFoldrElem value n =-    F.foldr (\x xs -> x == value || xs)-            False-            (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableSum #-}-foldableSum :: Int -> Int -> Int-foldableSum value n =-    Prelude.sum (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableProduct #-}-foldableProduct :: Int -> Int -> Int-foldableProduct value n =-    Prelude.product (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE _foldableNull #-}-_foldableNull :: Int -> Int -> Bool-_foldableNull value n =-    Prelude.null (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableElem #-}-foldableElem :: Int -> Int -> Bool-foldableElem value n =-    value `Prelude.elem` (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableNotElem #-}-foldableNotElem :: Int -> Int -> Bool-foldableNotElem value n =-    value `Prelude.notElem` (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableFind #-}-foldableFind :: Int -> Int -> Maybe Int-foldableFind value n =-    F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableAll #-}-foldableAll :: Int -> Int -> Bool-foldableAll value n =-    Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableAny #-}-foldableAny :: Int -> Int -> Bool-foldableAny value n =-    Prelude.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableAnd #-}-foldableAnd :: Int -> Int -> Bool-foldableAnd value n =-    Prelude.and $ S.map-        (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableOr #-}-foldableOr :: Int -> Int -> Bool-foldableOr value n =-    Prelude.or $ S.map-        (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableLength #-}-foldableLength :: Int -> Int -> Int-foldableLength value n =-    Prelude.length (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableMin #-}-foldableMin :: Int -> Int -> Int-foldableMin value n =-    Prelude.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE ordInstanceMin #-}-ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int-ordInstanceMin src = min src src--{-# INLINE foldableMax #-}-foldableMax :: Int -> Int -> Int-foldableMax value n =-    Prelude.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableMinBy #-}-foldableMinBy :: Int -> Int -> Int-foldableMinBy value n =-    F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableListMinBy #-}-foldableListMinBy :: Int -> Int -> Int-foldableListMinBy value n = F.minimumBy compare [1..value+n]--{-# INLINE foldableMaxBy #-}-foldableMaxBy :: Int -> Int -> Int-foldableMaxBy value n =-    F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableToList #-}-foldableToList :: Int -> Int -> [Int]-foldableToList value n =-    F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableMapM_ #-}-foldableMapM_ :: Monad m => Int -> Int -> m ()-foldableMapM_ value n =-    F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)--{-# INLINE foldableSequence_ #-}-foldableSequence_ :: Int -> Int -> IO ()-foldableSequence_ value n =-    F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))--{-# INLINE _foldableMsum #-}-_foldableMsum :: Int -> Int -> IO Int-_foldableMsum value n =-    F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))--{-# INLINE showInstance #-}-showInstance :: SerialT Identity Int -> String-showInstance = show--o_1_space_elimination_foldable :: Int -> [Benchmark]-o_1_space_elimination_foldable value =-    [ bgroup "foldable"-          -- Foldable instance-        [ bench "foldl'" $ nf (foldableFoldl' value) 1-        , bench "foldrElem" $ nf (foldableFoldrElem value) 1-     -- , bench "null" $ nf (_foldableNull value) 1-        , bench "elem" $ nf (foldableElem value) 1-        , bench "length" $ nf (foldableLength value) 1-        , bench "sum" $ nf (foldableSum value) 1-        , bench "product" $ nf (foldableProduct value) 1-        , bench "minimum" $ nf (foldableMin value) 1-        , benchPureSink value "min (ord)" ordInstanceMin-        , bench "maximum" $ nf (foldableMax value) 1-        , bench "length . toList"-            $ nf (Prelude.length . foldableToList value) 1-        , bench "notElem" $ nf (foldableNotElem value) 1-        , bench "find" $ nf (foldableFind value) 1-        , bench "all" $ nf (foldableAll value) 1-        , bench "any" $ nf (foldableAny value) 1-        , bench "and" $ nf (foldableAnd value) 1-        , bench "or" $ nf (foldableOr value) 1--        -- Applicative and Traversable operations-        -- TBD: traverse_-        , benchIOSink1 "mapM_" (foldableMapM_ value)-        -- TBD: for_-        -- TBD: forM_-        , benchIOSink1 "sequence_" (foldableSequence_ value)-        -- TBD: sequenceA_-        -- TBD: asum-        -- XXX needs to be fixed, results are in ns-        -- , benchIOSink1 "msum" (foldableMsum value)-        ]-    ]--o_n_space_elimination_foldable :: Int -> [Benchmark]-o_n_space_elimination_foldable value =-    -- Head recursive strict right folds.-    [ bgroup "foldl"-        -- XXX the definitions of minimumBy and maximumBy in Data.Foldable use-        -- foldl1 which does not work in constant memory for our-        -- implementation.  It works in constant memory for lists but even for-        -- lists it takes 15x more time compared to our foldl' based-        -- implementation.-        [ bench "minimumBy" $ nf (`foldableMinBy` 1) value-        , bench "maximumBy" $ nf (`foldableMaxBy` 1) value-        , bench "minimumByList" $ nf (`foldableListMinBy` 1) value-        ]-    ]------------------------------------------------------------------------------------ Stream folds----------------------------------------------------------------------------------{-# INLINE benchPureSink #-}-benchPureSink :: NFData b-    => Int -> String -> (SerialT Identity Int -> b) -> Benchmark-benchPureSink value name = benchPure name (sourceUnfoldr value)--{-# INLINE benchHoistSink #-}-benchHoistSink-    :: (IsStream t, NFData b)-    => Int -> String -> (t Identity Int -> IO b) -> Benchmark-benchHoistSink value name f =-    bench name $ nfIO $ randomRIO (1,1) >>= f .  sourceUnfoldr value---- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but--- we can't use it as it requires MonadAsync constraint.-{-# INLINE benchIdentitySink #-}-benchIdentitySink-    :: (IsStream t, NFData b)-    => Int -> String -> (t Identity Int -> Identity b) -> Benchmark-benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1------------------------------------------------------------------------------------ Reductions----------------------------------------------------------------------------------{-# INLINE uncons #-}-uncons :: Monad m => SerialT m Int -> m ()-uncons s = do-    r <- S.uncons s-    case r of-        Nothing -> return ()-        Just (_, t) -> uncons t--{-# INLINE init #-}-init :: Monad m => SerialT m a -> m ()-init s = S.init s >>= Prelude.mapM_ S.drain--{-# INLINE mapM_ #-}-mapM_ :: Monad m => SerialT m Int -> m ()-mapM_ = S.mapM_ (\_ -> return ())--{-# INLINE foldrMElem #-}-foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool-foldrMElem e =-    S.foldrM-        (\x xs ->-             if x == e-                 then return True-                 else xs)-        (return False)--{-# INLINE foldrToStream #-}-foldrToStream :: Monad m => SerialT m Int -> m (SerialT Identity Int)-foldrToStream = S.foldr S.cons S.nil--{-# INLINE foldrMBuild #-}-foldrMBuild :: Monad m => SerialT m Int -> m [Int]-foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])--{-# INLINE foldl'Reduce #-}-foldl'Reduce :: Monad m => SerialT m Int -> m Int-foldl'Reduce = S.foldl' (+) 0--{-# INLINE foldl1'Reduce #-}-foldl1'Reduce :: Monad m => SerialT m Int -> m (Maybe Int)-foldl1'Reduce = S.foldl1' (+)--{-# INLINE foldlM'Reduce #-}-foldlM'Reduce :: Monad m => SerialT m Int -> m Int-foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)--{-# INLINE last #-}-last :: Monad m => SerialT m Int -> m (Maybe Int)-last = S.last--{-# INLINE _head #-}-_head :: Monad m => SerialT m Int -> m (Maybe Int)-_head = S.head--{-# INLINE elem #-}-elem :: Monad m => Int -> SerialT m Int -> m Bool-elem value = S.elem (value + 1)--{-# INLINE notElem #-}-notElem :: Monad m => Int -> SerialT m Int -> m Bool-notElem value = S.notElem (value + 1)--{-# INLINE length #-}-length :: Monad m => SerialT m Int -> m Int-length = S.length--{-# INLINE all #-}-all :: Monad m => Int -> SerialT m Int -> m Bool-all value = S.all (<= (value + 1))--{-# INLINE any #-}-any :: Monad m => Int -> SerialT m Int -> m Bool-any value = S.any (> (value + 1))--{-# INLINE and #-}-and :: Monad m => Int -> SerialT m Int -> m Bool-and value = S.and . S.map (<= (value + 1))--{-# INLINE or #-}-or :: Monad m => Int -> SerialT m Int -> m Bool-or value = S.or . S.map (> (value + 1))--{-# INLINE find #-}-find :: Monad m => Int -> SerialT m Int -> m (Maybe Int)-find value = S.find (== (value + 1))--{-# INLINE findM #-}-findM :: Monad m => Int -> SerialT m Int -> m (Maybe Int)-findM value = S.findM (\z -> return $ z == (value + 1))--{-# INLINE findIndex #-}-findIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)-findIndex value = S.findIndex (== (value + 1))--{-# INLINE elemIndex #-}-elemIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)-elemIndex value = S.elemIndex (value + 1)--{-# INLINE maximum #-}-maximum :: Monad m => SerialT m Int -> m (Maybe Int)-maximum = S.maximum--{-# INLINE minimum #-}-minimum :: Monad m => SerialT m Int -> m (Maybe Int)-minimum = S.minimum--{-# INLINE sum #-}-sum :: Monad m => SerialT m Int -> m Int-sum = S.sum--{-# INLINE product #-}-product :: Monad m => SerialT m Int -> m Int-product = S.product--{-# INLINE minimumBy #-}-minimumBy :: Monad m => SerialT m Int -> m (Maybe Int)-minimumBy = S.minimumBy compare--{-# INLINE maximumBy #-}-maximumBy :: Monad m => SerialT m Int -> m (Maybe Int)-maximumBy = S.maximumBy compare--{-# INLINE the #-}-the :: Monad m => SerialT m Int -> m (Maybe Int)-the = S.the--{-# INLINE drainN #-}-drainN :: Monad m => Int -> SerialT m Int -> m ()-drainN = S.drainN--{-# INLINE drainWhile #-}-drainWhile :: Monad m => SerialT m Int -> m ()-drainWhile = S.drainWhile (const True)--{-# INLINE (!!) #-}-(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)-(!!) = flip (Internal.!!)--{-# INLINE lookup #-}-lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)-lookup val = S.lookup val . S.map (\x -> (x, x))--o_1_space_elimination_folds :: Int -> [Benchmark]-o_1_space_elimination_folds value =-    [ bgroup "elimination"-        -- Basic folds-        [ bgroup "reduce"-            [ bgroup-                  "IO"-                  [ benchIOSink value "foldl'" foldl'Reduce-                  , benchIOSink value "foldl1'" foldl1'Reduce-                  , benchIOSink value "foldlM'" foldlM'Reduce-                  ]-            , bgroup-                  "Identity"-                  [ benchIdentitySink value "foldl'" foldl'Reduce-                  , benchIdentitySink value "foldl1'" foldl1'Reduce-                  , benchIdentitySink value "foldlM'" foldlM'Reduce-                  ]-            ]-        , bgroup "build"-            [ bgroup "IO"-                  [ benchIOSink value "foldrMElem" (foldrMElem value)-                  ]-            , bgroup "Identity"-                  [ benchIdentitySink value "foldrMElem" (foldrMElem value)-                  , benchIdentitySink value "foldrToStreamLength"-                        (S.length . runIdentity . foldrToStream)-                  , benchPureSink value "foldrMToListLength"-                        (Prelude.length . runIdentity . foldrMBuild)-                  ]-            ]--        -- deconstruction-        , benchIOSink value "uncons" uncons-        , benchIOSink value "init" init--        -- draining-        , benchIOSink value "drain" $ toNull fromSerial-        , benchIOSink value "drainN" $ drainN value-        , benchIOSink value "drainWhile" drainWhile-        , benchPureSink value "drain (pure)" id-        , benchIOSink value "mapM_" mapM_--        -- this is too fast, causes all benchmarks reported in ns-    -- , benchIOSink value "head" head-        , benchIOSink value "last" last-        , benchIOSink value "length" length-        , benchHoistSink value "length . generally"-              (length . Internal.generally)-        , benchIOSink value "sum" sum-        , benchIOSink value "product" product-        , benchIOSink value "maximumBy" maximumBy-        , benchIOSink value "maximum" maximum-        , benchIOSink value "minimumBy" minimumBy-        , benchIOSink value "minimum" minimum--        , bench "the" $ nfIO $ randomRIO (1,1) >>= the . repeat value-        , benchIOSink value "find" (find value)-        , benchIOSink value "findM" (findM value)-        -- , benchIOSink value "lookupFirst" (lookup 1)-        , benchIOSink value "lookupNever" (lookup (value + 1))-        , benchIOSink value "(!!)" (value !!)-        , benchIOSink value "findIndex" (findIndex value)-        , benchIOSink value "elemIndex" (elemIndex value)-        -- this is too fast, causes all benchmarks reported in ns-    -- , benchIOSink value "null" S.null-        , benchIOSink value "elem" (elem value)-        , benchIOSink value "notElem" (notElem value)-        , benchIOSink value "all" (all value)-        , benchIOSink value "any" (any value)-        , benchIOSink value "and" (and value)-        , benchIOSink value "or" (or value)--        -- length is used to check for foldr/build fusion-        , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)-        ]-    ]------------------------------------------------------------------------------------ Buffered Transformations by fold----------------------------------------------------------------------------------{-# INLINE foldl'Build #-}-foldl'Build :: Monad m => SerialT m Int -> m [Int]-foldl'Build = S.foldl' (flip (:)) []--{-# INLINE foldlM'Build #-}-foldlM'Build :: Monad m => SerialT m Int -> m [Int]-foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])--o_n_heap_elimination_foldl :: Int -> [Benchmark]-o_n_heap_elimination_foldl value =-    [ bgroup "foldl"-        -- Left folds for building a structure are inherently non-streaming-        -- as the structure cannot be lazily consumed until fully built.-        [ benchIOSink value "foldl'/build/IO" foldl'Build-        , benchIdentitySink value "foldl'/build/Identity" foldl'Build-        , benchIOSink value "foldlM'/build/IO" foldlM'Build-        , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build-        ]-    ]---- For comparisons-{-# INLINE showInstanceList #-}-showInstanceList :: [Int] -> String-showInstanceList = show--o_n_heap_elimination_buffered :: Int -> [Benchmark]-o_n_heap_elimination_buffered value =-    [ bgroup "buffered"-        -- Buffers the output of show/read.-        -- XXX can the outputs be streaming? Can we have special read/show-        -- style type classes, readM/showM supporting streaming effects?-        [ bench "showPrec Haskell lists" $ nf showInstanceList (mkList value)-        -- XXX This is not o-1-space for GHC-8.10-        , benchPureSink value "showsPrec pure streams" showInstance-        ]-    ]--{-# INLINE foldrMReduce #-}-foldrMReduce :: Monad m => SerialT m Int -> m Int-foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)--o_n_space_elimination_foldr :: Int -> [Benchmark]-o_n_space_elimination_foldr value =-    -- Head recursive strict right folds.-    [ bgroup "foldr"-        -- accumulation due to strictness of IO monad-        [ benchIOSink value "foldrM/build/IO (toList)" foldrMBuild-        -- Right folds for reducing are inherently non-streaming as the-        -- expression needs to be fully built before it can be reduced.-        , benchIdentitySink value "foldrM/reduce/Identity (sum)" foldrMReduce-        , benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce-        ]-    ]--o_n_heap_elimination_toList :: Int -> [Benchmark]-o_n_heap_elimination_toList value =-    [ bgroup "toList"-        -- Converting the stream to a list or pure stream in a strict monad-        [ benchIOSink value "toListRev" Internal.toListRev-        , benchIOSink value "toStreamRev"-            (Internal.toStreamRev :: (SerialT IO Int -> IO (SerialT Identity Int)))-        ]-    ]--o_n_space_elimination_toList :: Int -> [Benchmark]-o_n_space_elimination_toList value =-    [ bgroup "toList"-        -- Converting the stream to a list or pure stream in a strict monad-        [ benchIOSink value "toList" S.toList-        , benchIOSink value "toStream"-            (Internal.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))-        ]-    ]------------------------------------------------------------------------------------ Multi-stream folds-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Multi-stream pure----------------------------------------------------------------------------------{-# INLINE eqBy' #-}-eqBy' :: (Monad m, Eq a) => SerialT m a -> m Bool-eqBy' src = S.eqBy (==) src src--{-# INLINE eqByPure #-}-eqByPure :: Int -> Int -> Identity Bool-eqByPure value n = eqBy' (sourceUnfoldr value n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'eqByPure-inspect $ 'eqByPure `hasNoType` ''SPEC-inspect $ 'eqByPure `hasNoType` ''D.Step-#endif--{-# INLINE eqInstance #-}-eqInstance :: SerialT Identity Int -> Bool-eqInstance src = src == src--{-# INLINE eqInstanceNotEq #-}-eqInstanceNotEq :: SerialT Identity Int -> Bool-eqInstanceNotEq src = src /= src--{-# INLINE cmpBy' #-}-cmpBy' :: (Monad m, Ord a) => SerialT m a -> m Ordering-cmpBy' src = S.cmpBy compare src src--{-# INLINE cmpByPure #-}-cmpByPure :: Int -> Int -> Identity Ordering-cmpByPure value n = cmpBy' (sourceUnfoldr value n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'cmpByPure-inspect $ 'cmpByPure `hasNoType` ''SPEC-inspect $ 'cmpByPure `hasNoType` ''D.Step-#endif--{-# INLINE ordInstance #-}-ordInstance :: SerialT Identity Int -> Bool-ordInstance src = src < src--o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]-o_1_space_elimination_multi_stream_pure value =-    [ bgroup "multi-stream-pure"-        [ benchPureSink1 "eqBy" (eqByPure value)-        , benchPureSink value "==" eqInstance-        , benchPureSink value "/=" eqInstanceNotEq-        , benchPureSink1 "cmpBy" (cmpByPure value)-        , benchPureSink value "<" ordInstance-        ]-    ]--{-# INLINE isPrefixOf #-}-isPrefixOf :: Monad m => SerialT m Int -> m Bool-isPrefixOf src = S.isPrefixOf src src--{-# INLINE isSubsequenceOf #-}-isSubsequenceOf :: Monad m => SerialT m Int -> m Bool-isSubsequenceOf src = S.isSubsequenceOf src src--{-# INLINE stripPrefix #-}-stripPrefix :: Monad m => SerialT m Int -> m ()-stripPrefix src = do-    _ <- S.stripPrefix src src-    return ()--{-# INLINE eqBy #-}-eqBy :: Int -> Int -> IO Bool-eqBy value n = eqBy' (sourceUnfoldrM value n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'eqBy-inspect $ 'eqBy `hasNoType` ''SPEC-inspect $ 'eqBy `hasNoType` ''D.Step-#endif--{-# INLINE cmpBy #-}-cmpBy :: Int -> Int -> IO Ordering-cmpBy value n = cmpBy' (sourceUnfoldrM value n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'cmpBy-inspect $ 'cmpBy `hasNoType` ''SPEC-inspect $ 'cmpBy `hasNoType` ''D.Step-#endif--o_1_space_elimination_multi_stream :: Int -> [Benchmark]-o_1_space_elimination_multi_stream value =-    [ bgroup "multi-stream"-        [ benchIOSink1 "eqBy" (eqBy value)-        , benchIOSink1 "cmpBy" (cmpBy value)-        , benchIOSink value "isPrefixOf" isPrefixOf-        , benchIOSink value "isSubsequenceOf" isSubsequenceOf-        , benchIOSink value "stripPrefix" stripPrefix-        ]-    ]------------------------------------------------------------------------------------ Main------------------------------------------------------------------------------------ In addition to gauge options, the number of elements in the stream can be--- passed using the --stream-size option.----benchmarks :: String -> Int -> [Benchmark]-benchmarks moduleName size =-        [ bgroup (o_1_space_prefix moduleName) $ concat-            [ o_1_space_elimination_foldable size-            , o_1_space_elimination_folds size-            , o_1_space_elimination_multi_stream_pure size-            , o_1_space_elimination_multi_stream size-            ]-        , bgroup (o_n_heap_prefix moduleName) $ concat-            [ o_n_heap_elimination_foldl size-            , o_n_heap_elimination_toList size-            , o_n_heap_elimination_buffered size-            ]-        , bgroup (o_n_space_prefix moduleName) $ concat-            [ o_n_space_elimination_foldable size-            , o_n_space_elimination_toList size-            , o_n_space_elimination_foldr size-            ]-        ]
− benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs 
@@ -1,317 +0,0 @@--- |--- Module      : Streamly.Benchmark.Prelude.Serial.Exceptions--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Serial.Exceptions (benchmarks) where--import Control.Exception (SomeException, Exception, throwIO)-import System.IO (Handle, hClose, hPutChar)--import qualified Data.IORef as Ref-import qualified Data.Map.Strict as Map--import qualified Streamly.FileSystem.Handle as FH-import qualified Streamly.Internal.Data.Unfold as IUF-import qualified Streamly.Internal.FileSystem.Handle as IFH-import qualified Streamly.Internal.Data.Stream.IsStream as IP-import qualified Streamly.Prelude as S--import Gauge hiding (env)-import Prelude hiding (last, length)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Common.Handle--#ifdef INSPECTION-import Test.Inspection--import qualified Streamly.Internal.Data.Stream.StreamD as D-#endif------------------------------------------------------------------------------------ stream exceptions----------------------------------------------------------------------------------data BenchException-    = BenchException1-    | BenchException2-    deriving (Show, Eq, Ord)--instance Exception BenchException--retryNoneSimple :: Int -> Int -> IO ()-retryNoneSimple length from =-    IP.drain-        $ IP.retry (Map.singleton BenchException1 length) (const S.nil) source--    where--    source = S.enumerateFromTo from (from + length)--retryNone :: Int -> Int -> IO ()-retryNone length from = do-    ref <- Ref.newIORef (0 :: Int)-    IP.drain-        $ IP.retry (Map.singleton BenchException1 length) (const S.nil)-        $ source ref--    where--    source ref =-        IP.replicateM (from + length)-            $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref--retryAll :: Int -> Int -> IO ()-retryAll length from = do-    ref <- Ref.newIORef 0-    IP.drain-        $ IP.retry (Map.singleton BenchException1 (length + from)) (const S.nil)-        $ source ref--    where--    source ref =-        IP.fromEffect-            $ do-                Ref.modifyIORef' ref (+ 1)-                val <- Ref.readIORef ref-                if val >= length-                then return length-                else throwIO BenchException1--retryUnknown :: Int -> Int -> IO ()-retryUnknown length from = do-    IP.drain-        $ IP.retry (Map.singleton BenchException1 length) (const source)-        $ throwIO BenchException2 `S.before` S.nil--    where--    source = S.enumerateFromTo from (from + length)---o_1_space_serial_exceptions :: Int -> [Benchmark]-o_1_space_serial_exceptions length =-    [ bgroup-          "exceptions/serial"-          [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length)-          , benchIOSrc1 "retryNone" (retryNone length)-          , benchIOSrc1 "retryAll" (retryAll length)-          , benchIOSrc1 "retryUnknown" (retryUnknown length)-          ]-    ]------------------------------------------------------------------------------------ copy stream exceptions------------------------------------------------------------------------------------ | Send the file contents to /dev/null with exception handling-readWriteOnExceptionStream :: Handle -> Handle -> IO ()-readWriteOnExceptionStream inh devNull =-    let readEx = S.onException (hClose inh) (S.unfold FH.read inh)-    in S.fold (FH.write devNull) $ readEx--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'readWriteOnExceptionStream-#endif---- | Send the file contents to /dev/null with exception handling-readWriteHandleExceptionStream :: Handle -> Handle -> IO ()-readWriteHandleExceptionStream inh devNull =-    let handler (_e :: SomeException) = S.fromEffect (hClose inh >> return 10)-        readEx = S.handle handler (S.unfold FH.read inh)-    in S.fold (FH.write devNull) $ readEx--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream-#endif---- | Send the file contents to /dev/null with exception handling-readWriteFinally_Stream :: Handle -> Handle -> IO ()-readWriteFinally_Stream inh devNull =-    let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)-    in S.fold (FH.write devNull) readEx--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'readWriteFinally_Stream-#endif--readWriteFinallyStream :: Handle -> Handle -> IO ()-readWriteFinallyStream inh devNull =-    let readEx = S.finally (hClose inh) (S.unfold FH.read inh)-    in S.fold (FH.write devNull) readEx---- | Send the file contents to /dev/null with exception handling-fromToBytesBracket_Stream :: Handle -> Handle -> IO ()-fromToBytesBracket_Stream inh devNull =-    let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)-                    (\_ -> IFH.toBytes inh)-    in IFH.putBytes devNull $ readEx--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream-#endif--fromToBytesBracketStream :: Handle -> Handle -> IO ()-fromToBytesBracketStream inh devNull =-    let readEx = S.bracket (return ()) (\_ -> hClose inh)-                    (\_ -> IFH.toBytes inh)-    in IFH.putBytes devNull $ readEx--readWriteBeforeAfterStream :: Handle -> Handle -> IO ()-readWriteBeforeAfterStream inh devNull =-    let readEx =-            IP.after (hClose inh)-                $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)-     in S.fold (FH.write devNull) readEx--#ifdef INSPECTION-inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step-#endif--readWriteAfterStream :: Handle -> Handle -> IO ()-readWriteAfterStream inh devNull =-    let readEx = IP.after (hClose inh) (S.unfold FH.read inh)-     in S.fold (FH.write devNull) readEx--#ifdef INSPECTION-inspect $ 'readWriteAfterStream `hasNoType` ''D.Step-#endif--readWriteAfter_Stream :: Handle -> Handle -> IO ()-readWriteAfter_Stream inh devNull =-    let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)-     in S.fold (FH.write devNull) readEx--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'readWriteAfter_Stream-inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step-#endif--o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]-o_1_space_copy_stream_exceptions env =-    [ bgroup "exceptions"-       [ mkBenchSmall "S.onException" env $ \inh _ ->-           readWriteOnExceptionStream inh (nullH env)-       , mkBenchSmall "S.handle" env $ \inh _ ->-           readWriteHandleExceptionStream inh (nullH env)-       , mkBenchSmall "S.finally_" env $ \inh _ ->-           readWriteFinally_Stream inh (nullH env)-       , mkBenchSmall "S.finally" env $ \inh _ ->-           readWriteFinallyStream inh (nullH env)-       , mkBenchSmall "S.after . S.before" env $ \inh _ ->-           readWriteBeforeAfterStream inh (nullH env)-       , mkBenchSmall "S.after" env $ \inh _ ->-           readWriteAfterStream inh (nullH env)-       , mkBenchSmall "S.after_" env $ \inh _ ->-           readWriteAfter_Stream inh (nullH env)-       ]-    , bgroup "exceptions/fromToBytes"-       [ mkBenchSmall "S.bracket_" env $ \inh _ ->-           fromToBytesBracket_Stream inh (nullH env)-       , mkBenchSmall "S.bracket" env $ \inh _ ->-           fromToBytesBracketStream inh (nullH env)-        ]-    ]-- ---------------------------------------------------------------------------------- Exceptions readChunks------------------------------------------------------------------------------------ | Send the file contents to /dev/null with exception handling-readChunksOnException :: Handle -> Handle -> IO ()-readChunksOnException inh devNull =-    let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks-    in IUF.fold (IFH.writeChunks devNull) readEx inh--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'readChunksOnException-#endif---- | Send the file contents to /dev/null with exception handling-readChunksBracket_ :: Handle -> Handle -> IO ()-readChunksBracket_ inh devNull =-    let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.readChunks-    in IUF.fold (IFH.writeChunks devNull) readEx inh--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'readChunksBracket_-#endif--readChunksBracket :: Handle -> Handle -> IO ()-readChunksBracket inh devNull =-    let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks-    in IUF.fold (IFH.writeChunks devNull) readEx inh--o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]-o_1_space_copy_exceptions_readChunks env =-    [ bgroup "exceptions/readChunks"-        [ mkBench "UF.onException" env $ \inH _ ->-            readChunksOnException inH (nullH env)-        , mkBench "UF.bracket_" env $ \inH _ ->-            readChunksBracket_ inH (nullH env)-        , mkBench "UF.bracket" env $ \inH _ ->-            readChunksBracket inH (nullH env)-        ]-    ]------------------------------------------------------------------------------------ Exceptions toChunks------------------------------------------------------------------------------------ | Send the file contents to /dev/null with exception handling-toChunksBracket_ :: Handle -> Handle -> IO ()-toChunksBracket_ inh devNull =-    let readEx = IP.bracket_-            (return ())-            (\_ -> hClose inh)-            (\_ -> IFH.toChunks inh)-    in S.fold (IFH.writeChunks devNull) $ readEx--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'toChunksBracket_-#endif--toChunksBracket :: Handle -> Handle -> IO ()-toChunksBracket inh devNull =-    let readEx = S.bracket-            (return ())-            (\_ -> hClose inh)-            (\_ -> IFH.toChunks inh)-    in S.fold (IFH.writeChunks devNull) $ readEx--o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]-o_1_space_copy_exceptions_toChunks env =-    [ bgroup "exceptions/toChunks"-        [ mkBench "S.bracket_" env $ \inH _ ->-            toChunksBracket_ inH (nullH env)-        , mkBench "S.bracket" env $ \inH _ ->-            toChunksBracket inH (nullH env)-        ]-    ]---benchmarks :: String -> BenchEnv -> Int -> [Benchmark]-benchmarks moduleName env size =-        [ bgroup (o_1_space_prefix moduleName) $ concat-            [ o_1_space_copy_exceptions_readChunks env-            , o_1_space_copy_exceptions_toChunks env-            , o_1_space_copy_stream_exceptions env-            , o_1_space_serial_exceptions size-            ]-        ]
− benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs 
@@ -1,179 +0,0 @@--- |--- Module      : Serial.Generation--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}--module Serial.Generation (benchmarks) where--import Data.Functor.Identity (Identity)--import qualified Prelude-import qualified GHC.Exts as GHC--import qualified Streamly.Prelude  as S--import Gauge-import Streamly.Prelude (SerialT, fromSerial, MonadAsync)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Prelude-import Prelude hiding (repeat, replicate, iterate)------------------------------------------------------------------------------------ Generation-------------------------------------------------------------------------------------------------------------------------------------------------------------------- fromList----------------------------------------------------------------------------------{-# INLINE sourceIsList #-}-sourceIsList :: Int -> Int -> SerialT Identity Int-sourceIsList value n = GHC.fromList [n..n+value]--{-# INLINE sourceIsString #-}-sourceIsString :: Int -> Int -> SerialT Identity Char-sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')--{-# INLINE readInstance #-}-readInstance :: String -> SerialT Identity Int-readInstance str =-    let r = reads str-    in case r of-        [(x,"")] -> x-        _ -> error "readInstance: no parse"---- For comparisons-{-# INLINE readInstanceList #-}-readInstanceList :: String -> [Int]-readInstanceList str =-    let r = reads str-    in case r of-        [(x,"")] -> x-        _ -> error "readInstance: no parse"--{-# INLINE repeat #-}-repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-repeat count = S.take count . S.repeat--{-# INLINE repeatM #-}-repeatM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int-repeatM count = S.take count . S.repeatM . return--{-# INLINE replicate #-}-replicate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-replicate = S.replicate--{-# INLINE replicateM #-}-replicateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int-replicateM count = S.replicateM count . return--{-# INLINE enumerateFrom #-}-enumerateFrom :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-enumerateFrom count = S.take count . S.enumerateFrom--{-# INLINE enumerateFromTo #-}-enumerateFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-enumerateFromTo = sourceIntFromTo--{-# INLINE enumerateFromThen #-}-enumerateFromThen :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-enumerateFromThen count inp = S.take count $ S.enumerateFromThen inp (inp + 1)--{-# INLINE enumerateFromThenTo #-}-enumerateFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-enumerateFromThenTo = sourceIntFromThenTo---- n ~ 1-{-# INLINE enumerate #-}-enumerate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-enumerate count n = S.take (count + n) S.enumerate---- n ~ 1-{-# INLINE enumerateTo #-}-enumerateTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-enumerateTo count n = S.enumerateTo (minBound + count + n)--{-# INLINE iterate #-}-iterate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-iterate count = S.take count . S.iterate (+1)--{-# INLINE iterateM #-}-iterateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int-iterateM count = S.take count . S.iterateM (return . (+1)) . return--{-# INLINE fromIndices #-}-fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-fromIndices value n = S.take value $ S.fromIndices (+ n)--{-# INLINE fromIndicesM #-}-fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int-fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))--o_1_space_generation :: Int -> [Benchmark]-o_1_space_generation value =-    [ bgroup "generation"-        [ benchIOSrc fromSerial "unfoldr" (sourceUnfoldr value)-        , benchIOSrc fromSerial "unfoldrM" (sourceUnfoldrM value)-        , benchIOSrc fromSerial "repeat" (repeat value)-        , benchIOSrc fromSerial "repeatM" (repeatM value)-        , benchIOSrc fromSerial "replicate" (replicate value)-        , benchIOSrc fromSerial "replicateM" (replicateM value)-        , benchIOSrc fromSerial "iterate" (iterate value)-        , benchIOSrc fromSerial "iterateM" (iterateM value)-        , benchIOSrc fromSerial "fromIndices" (fromIndices value)-        , benchIOSrc fromSerial "fromIndicesM" (fromIndicesM value)-        , benchIOSrc fromSerial "intFromTo" (sourceIntFromTo value)-        , benchIOSrc fromSerial "intFromThenTo" (sourceIntFromThenTo value)-        , benchIOSrc fromSerial "integerFromStep" (sourceIntegerFromStep value)-        , benchIOSrc fromSerial "fracFromThenTo" (sourceFracFromThenTo value)-        , benchIOSrc fromSerial "fracFromTo" (sourceFracFromTo value)-        , benchIOSrc fromSerial "fromList" (sourceFromList value)-        , benchPureSrc "IsList.fromList" (sourceIsList value)-        , benchPureSrc "IsString.fromString" (sourceIsString value)-        , benchIOSrc fromSerial "fromListM" (sourceFromListM value)-        , benchIOSrc fromSerial "enumerateFrom" (enumerateFrom value)-        , benchIOSrc fromSerial "enumerateFromTo" (enumerateFromTo value)-        , benchIOSrc fromSerial "enumerateFromThen" (enumerateFromThen value)-        , benchIOSrc fromSerial "enumerateFromThenTo" (enumerateFromThenTo value)-        , benchIOSrc fromSerial "enumerate" (enumerate value)-        , benchIOSrc fromSerial "enumerateTo" (enumerateTo value)--          -- These essentially test cons and consM-        , benchIOSrc fromSerial "fromFoldable" (sourceFromFoldable value)-        , benchIOSrc fromSerial "fromFoldableM" (sourceFromFoldableM value)--        , benchIOSrc fromSerial "absTimes" $ absTimes value-        ]-    ]--o_n_heap_generation :: Int -> [Benchmark]-o_n_heap_generation value =-    [ bgroup "buffered"-    -- Buffers the output of show/read.-    -- XXX can the outputs be streaming? Can we have special read/show-    -- style type classes, readM/showM supporting streaming effects?-        [ bench "readsPrec pure streams" $-          nf readInstance (mkString value)-        , bench "readsPrec Haskell lists" $-          nf readInstanceList (mkListString value)-        ]-    ]------------------------------------------------------------------------------------ Main------------------------------------------------------------------------------------ In addition to gauge options, the number of elements in the stream can be--- passed using the --stream-size option.----benchmarks :: String -> Int -> [Benchmark]-benchmarks moduleName size =-        [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)-        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)-        ]
− benchmark/Streamly/Benchmark/Prelude/Serial/Lift.hs 
@@ -1,123 +0,0 @@--- |--- Module      : Serial.Lift--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}--module Serial.Lift (benchmarks) where--import Control.Monad.State.Strict (StateT, get, put, MonadState)-import qualified Control.Monad.State.Strict as State-import Control.Monad.Trans.Class (lift)--import qualified Streamly.Prelude  as S-import qualified Streamly.Internal.Data.Stream.IsStream as Internal--import Gauge-import Streamly.Prelude (SerialT, fromSerial)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Prelude-import Prelude hiding (reverse, tail)------------------------------------------------------------------------------------ Monad transformation (hoisting etc.)----------------------------------------------------------------------------------{-# INLINE sourceUnfoldrState #-}-sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)-                   => Int -> Int -> t (StateT Int m) Int-sourceUnfoldrState value n = S.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else do-            s <- get-            put (s + 1)-            return (Just (s, cnt + 1))--{-# INLINE evalStateT #-}-evalStateT :: S.MonadAsync m => Int -> Int -> SerialT m Int-evalStateT value n =-    Internal.evalStateT (return 0) (sourceUnfoldrState value n)--{-# INLINE withState #-}-withState :: S.MonadAsync m => Int -> Int -> SerialT m Int-withState value n =-    Internal.evalStateT-        (return (0 :: Int)) (Internal.liftInner (sourceUnfoldrM value n))--o_1_space_hoisting :: Int -> [Benchmark]-o_1_space_hoisting value =-    [ bgroup "hoisting"-        [ benchIOSrc fromSerial "evalState" (evalStateT value)-        , benchIOSrc fromSerial "withState" (withState value)-        ]-    ]--{-# INLINE iterateStateIO #-}-iterateStateIO ::-       (S.MonadAsync m)-    => Int-    -> StateT Int m Int-iterateStateIO n = do-    x <- get-    if x > n-    then do-        put (x - 1)-        iterateStateIO n-    else return x--{-# INLINE iterateStateT #-}-iterateStateT :: Int -> SerialT (StateT Int IO) Int-iterateStateT n = do-    x <- lift get-    if x > n-    then do-        lift $ put (x - 1)-        iterateStateT n-    else return x--{-# INLINE iterateState #-}-{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}-iterateState ::-       (S.MonadAsync m, MonadState Int m)-    => Int-    -> SerialT m Int-iterateState n = do-    x <- get-    if x > n-    then do-        put (x - 1)-        iterateState n-    else return x--o_n_heap_transformer :: Int -> [Benchmark]-o_n_heap_transformer value =-    [ bgroup "transformer"-        [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->-            State.evalStateT (iterateStateIO n) value-        , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->-            State.evalStateT (S.drain (iterateStateT n)) value-        , benchIO "MonadState Int m => SerialT m Int" $ \n ->-            State.evalStateT (S.drain (iterateState n)) value-        ]-    ]------------------------------------------------------------------------------------ Main------------------------------------------------------------------------------------ In addition to gauge options, the number of elements in the stream can be--- passed using the --stream-size option.----benchmarks :: String -> Int -> [Benchmark]-benchmarks moduleName size =-        [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)-        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)-        ]
− benchmark/Streamly/Benchmark/Prelude/Serial/NestedFold.hs 
@@ -1,463 +0,0 @@--- |--- Module      : Serial.NestedFold--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TupleSections #-}--module Serial.NestedFold (benchmarks) where--import Control.DeepSeq (NFData(..))-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Monoid (Sum(..))-import GHC.Generics (Generic)--import qualified Streamly.Internal.Data.Refold.Type as Refold-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Stream.IsStream as Internal-import qualified Streamly.Prelude  as S--import Gauge-import Streamly.Prelude (SerialT, fromSerial)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Prelude-import Prelude hiding (reverse, tail)------------------------------------------------------------------------------------ Iteration/looping utilities----------------------------------------------------------------------------------{-# INLINE iterateN #-}-iterateN :: (Int -> a -> a) -> a -> Int -> a-iterateN g initial count = f count initial--    where--    f (0 :: Int) x = x-    f i x = f (i - 1) (g i x)---- Iterate a transformation over a singleton stream-{-# INLINE iterateSingleton #-}-iterateSingleton :: S.MonadAsync m-    => (Int -> SerialT m Int -> SerialT m Int)-    -> Int-    -> Int-    -> SerialT m Int-iterateSingleton g count n = iterateN g (return n) count---- XXX need to check why this is slower than the explicit recursion above, even--- if the above code is written in a foldr like head recursive way. We also--- need to try this with foldlM' once #150 is fixed.--- However, it is perhaps best to keep the iteration benchmarks independent of--- foldrM and any related fusion issues.-{-# INLINE _iterateSingleton #-}-_iterateSingleton ::-       S.MonadAsync m-    => (Int -> SerialT m Int -> SerialT m Int)-    -> Int-    -> Int-    -> SerialT m Int-_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n---- Apply transformation g count times on a stream of length len-{-# INLINE iterateSource #-}-iterateSource ::-       S.MonadAsync m-    => (SerialT m Int -> SerialT m Int)-    -> Int-    -> Int-    -> Int-    -> SerialT m Int-iterateSource g count len n = f count (sourceUnfoldrM len n)--    where--    f (0 :: Int) stream = stream-    f i stream = f (i - 1) (g stream)------------------------------------------------------------------------------------ Functor----------------------------------------------------------------------------------o_n_space_functor :: Int -> [Benchmark]-o_n_space_functor value =-    [ bgroup "Functor"-        [ benchIO "(+) (n times) (baseline)" $ \i0 ->-            iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value-        , benchIOSrc fromSerial "(<$) (n times)" $-            iterateSingleton (<$) value-        , benchIOSrc fromSerial "fmap (n times)" $-            iterateSingleton (fmap . (+)) value-        {--        , benchIOSrc fromSerial "_(<$) (n times)" $-            _iterateSingleton (<$) value-        , benchIOSrc fromSerial "_fmap (n times)" $-            _iterateSingleton (fmap . (+)) value-        -}-        ]-    ]------------------------------------------------------------------------------------ Grouping transformations----------------------------------------------------------------------------------{-# INLINE groups #-}-groups :: MonadIO m => SerialT m Int -> m ()-groups = S.drain . S.groups FL.drain---- XXX Change this test when the order of comparison is later changed-{-# INLINE groupsByGT #-}-groupsByGT :: MonadIO m => SerialT m Int -> m ()-groupsByGT = S.drain . S.groupsBy (>) FL.drain--{-# INLINE groupsByEq #-}-groupsByEq :: MonadIO m => SerialT m Int -> m ()-groupsByEq = S.drain . S.groupsBy (==) FL.drain---- XXX Change this test when the order of comparison is later changed-{-# INLINE groupsByRollingLT #-}-groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()-groupsByRollingLT =-    S.drain . S.groupsByRolling (<) FL.drain--{-# INLINE groupsByRollingEq #-}-groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()-groupsByRollingEq =-    S.drain . S.groupsByRolling (==) FL.drain--{-# INLINE foldMany #-}-foldMany :: Monad m => SerialT m Int -> m ()-foldMany =-      S.drain-    . S.map getSum-    . Internal.foldMany (FL.take 2 FL.mconcat)-    . S.map Sum--{-# INLINE refoldMany #-}-refoldMany :: Monad m => SerialT m Int -> m ()-refoldMany =-      S.drain-    . S.map getSum-    . Internal.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)-    . S.map Sum--{-# INLINE foldIterateM #-}-foldIterateM :: Monad m => SerialT m Int -> m ()-foldIterateM =-    S.drain-        . S.map getSum-        . Internal.foldIterateM-            (return . FL.take 2 . FL.sconcat) (return (Sum 0))-        . S.map Sum--{-# INLINE refoldIterateM #-}-refoldIterateM :: Monad m => SerialT m Int -> m ()-refoldIterateM =-    S.drain-        . S.map getSum-        . Internal.refoldIterateM-            (Refold.take 2 Refold.sconcat) (return (Sum 0))-        . S.map Sum--o_1_space_grouping :: Int -> [Benchmark]-o_1_space_grouping value =-    -- Buffering operations using heap proportional to group/window sizes.-    [ bgroup "grouping"-        [ benchIOSink value "groups" groups-        , benchIOSink value "groupsByGT" groupsByGT-        , benchIOSink value "groupsByEq" groupsByEq-        , benchIOSink value "groupsByRollingLT" groupsByRollingLT-        , benchIOSink value "groupsByRollingEq" groupsByRollingEq-        , benchIOSink value "foldMany" foldMany-        , benchIOSink value "refoldMany" refoldMany-        , benchIOSink value "foldIterateM" foldIterateM-        , benchIOSink value "refoldIterateM" refoldIterateM-        ]-    ]------------------------------------------------------------------------------------ Size conserving transformations (reordering, buffering, etc.)----------------------------------------------------------------------------------{-# INLINE reverse #-}-reverse :: MonadIO m => Int -> SerialT m Int -> m ()-reverse n = composeN n S.reverse--{-# INLINE reverse' #-}-reverse' :: MonadIO m => Int -> SerialT m Int -> m ()-reverse' n = composeN n Internal.reverse'--o_n_heap_buffering :: Int -> [Benchmark]-o_n_heap_buffering value =-    [ bgroup "buffered"-        [-        -- Reversing a stream-          benchIOSink value "reverse" (reverse 1)-        , benchIOSink value "reverse'" (reverse' 1)--        , benchIOSink value "mkAsync" (mkAsync fromSerial)-        ]-    ]------------------------------------------------------------------------------------ Grouping/Splitting----------------------------------------------------------------------------------{-# INLINE classifySessionsOf #-}-classifySessionsOf :: (S.MonadAsync m) => SerialT m Int -> m ()-classifySessionsOf =-      S.drain-    . Internal.classifySessionsOf (const (return False)) 3 FL.drain-    . Internal.timestamped-    . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))--o_n_space_grouping :: Int -> [Benchmark]-o_n_space_grouping value =-    -- Buffering operations using heap proportional to group/window sizes.-    [ bgroup "grouping"-        [ benchIOSink (value `div` 10) "classifySessionsOf" classifySessionsOf-        ]-    ]------------------------------------------------------------------------------------ Mixed Transformation----------------------------------------------------------------------------------{-# INLINE scanMap #-}-scanMap :: MonadIO m => Int -> SerialT m Int -> m ()-scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0--{-# INLINE dropMap #-}-dropMap :: MonadIO m => Int -> SerialT m Int -> m ()-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1--{-# INLINE dropScan #-}-dropScan :: MonadIO m => Int -> SerialT m Int -> m ()-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1--{-# INLINE takeDrop #-}-takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)--{-# INLINE takeScan #-}-takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)--{-# INLINE takeMap #-}-takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)--{-# INLINE filterDrop #-}-filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))--{-# INLINE filterTake #-}-filterTake :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))--{-# INLINE filterScan #-}-filterScan :: MonadIO m => Int -> SerialT m Int -> m ()-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)--{-# INLINE filterScanl1 #-}-filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()-filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)--{-# INLINE filterMap #-}-filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))------------------------------------------------------------------------------------ Scan and fold----------------------------------------------------------------------------------data Pair a b =-    Pair !a !b-    deriving (Generic, NFData)--{-# INLINE sumProductFold #-}-sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)-sumProductFold = S.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1)--{-# INLINE sumProductScan #-}-sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)-sumProductScan =-    S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .-    S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)--{-# INLINE foldl'ReduceMap #-}-foldl'ReduceMap :: Monad m => SerialT m Int -> m Int-foldl'ReduceMap = fmap (+ 1) . S.foldl' (+) 0--o_1_space_transformations_mixed :: Int -> [Benchmark]-o_1_space_transformations_mixed value =-    -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl-    -- library. If scan/fold followed by a map is efficient enough we may not-    -- need monolithic implementations of these.-    [ bgroup "mixed"-        [ benchIOSink value "scanl-map" (scanMap 1)-        , benchIOSink value "foldl-map" foldl'ReduceMap-        , benchIOSink value "sum-product-fold" sumProductFold-        , benchIOSink value "sum-product-scan" sumProductScan-        ]-    ]--o_1_space_transformations_mixedX4 :: Int -> [Benchmark]-o_1_space_transformations_mixedX4 value =-    [ bgroup "mixedX4"-        [ benchIOSink value "scan-map" (scanMap 4)-        , benchIOSink value "drop-map" (dropMap 4)-        , benchIOSink value "drop-scan" (dropScan 4)-        , benchIOSink value "take-drop" (takeDrop value 4)-        , benchIOSink value "take-scan" (takeScan value 4)-        , benchIOSink value "take-map" (takeMap value 4)-        , benchIOSink value "filter-drop" (filterDrop value 4)-        , benchIOSink value "filter-take" (filterTake value 4)-        , benchIOSink value "filter-scan" (filterScan 4)-        , benchIOSink value "filter-scanl1" (filterScanl1 4)-        , benchIOSink value "filter-map" (filterMap value 4)-        ]-    ]------------------------------------------------------------------------------------ Iterating a transformation over and over again------------------------------------------------------------------------------------ this is quadratic-{-# INLINE iterateScan #-}-iterateScan :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int-iterateScan = iterateSource (S.scanl' (+) 0)---- this is quadratic-{-# INLINE iterateScanl1 #-}-iterateScanl1 :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int-iterateScanl1 = iterateSource (S.scanl1' (+))--{-# INLINE iterateMapM #-}-iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int-iterateMapM = iterateSource (S.mapM return)--{-# INLINE iterateFilterEven #-}-iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int-iterateFilterEven = iterateSource (S.filter even)--{-# INLINE iterateTakeAll #-}-iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int-iterateTakeAll value = iterateSource (S.take (value + 1))--{-# INLINE iterateDropOne #-}-iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int-iterateDropOne = iterateSource (S.drop 1)--{-# INLINE iterateDropWhileFalse #-}-iterateDropWhileFalse :: S.MonadAsync m-    => Int -> Int -> Int -> Int -> SerialT m Int-iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))--{-# INLINE iterateDropWhileTrue #-}-iterateDropWhileTrue :: S.MonadAsync m-    => Int -> Int -> Int -> Int -> SerialT m Int-iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))--{-# INLINE tail #-}-tail :: Monad m => SerialT m a -> m ()-tail s = S.tail s >>= mapM_ tail--{-# INLINE nullHeadTail #-}-nullHeadTail :: Monad m => SerialT m Int -> m ()-nullHeadTail s = do-    r <- S.null s-    when (not r) $ do-        _ <- S.head s-        S.tail s >>= mapM_ nullHeadTail---- Head recursive operations.-o_n_stack_iterated :: Int -> [Benchmark]-o_n_stack_iterated value = by10 `seq` by100 `seq`-    [ bgroup "iterated"-        [ benchIOSrc fromSerial "mapM (n/10 x 10)" $ iterateMapM by10 10-        , benchIOSrc fromSerial "scanl' (quadratic) (n/100 x 100)" $-            iterateScan by100 100-        , benchIOSrc fromSerial "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10-        , benchIOSrc fromSerial "filterEven (n/10 x 10)" $-            iterateFilterEven by10 10-        , benchIOSrc fromSerial "takeAll (n/10 x 10)" $-            iterateTakeAll value by10 10-        , benchIOSrc fromSerial "dropOne (n/10 x 10)" $ iterateDropOne by10 10-        , benchIOSrc fromSerial "dropWhileFalse (n/10 x 10)" $-            iterateDropWhileFalse value by10 10-        , benchIOSrc fromSerial "dropWhileTrue (n/10 x 10)" $-            iterateDropWhileTrue value by10 10-        , benchIOSink value "tail" tail-        , benchIOSink value "nullHeadTail" nullHeadTail-        ]-    ]--    where--    by10 = value `div` 10-    by100 = value `div` 100------------------------------------------------------------------------------------ Pipes----------------------------------------------------------------------------------o_1_space_pipes :: Int -> [Benchmark]-o_1_space_pipes value =-    [ bgroup "pipes"-        [ benchIOSink value "mapM" (transformMapM fromSerial 1)-        , benchIOSink value "compose" (transformComposeMapM fromSerial 1)-        , benchIOSink value "tee" (transformTeeMapM fromSerial 1)-#ifdef DEVBUILD-        -- XXX this take 1 GB memory to compile-        , benchIOSink value "zip" (transformZipMapM fromSerial 1)-#endif-        ]-    ]--o_1_space_pipesX4 :: Int -> [Benchmark]-o_1_space_pipesX4 value =-    [ bgroup "pipesX4"-        [ benchIOSink value "mapM" (transformMapM fromSerial 4)-        , benchIOSink value "compose" (transformComposeMapM fromSerial 4)-        , benchIOSink value "tee" (transformTeeMapM fromSerial 4)-#ifdef DEVBUILD-        -- XXX this take 1 GB memory to compile-        , benchIOSink value "zip" (transformZipMapM fromSerial 4)-#endif-        ]-    ]------------------------------------------------------------------------------------ Main------------------------------------------------------------------------------------ In addition to gauge options, the number of elements in the stream can be--- passed using the --stream-size option.----benchmarks :: String -> Int -> [Benchmark]-benchmarks moduleName size =-        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat-            [ o_1_space_grouping size-            , o_1_space_transformations_mixed size-            , o_1_space_transformations_mixedX4 size--            -- pipes-            , o_1_space_pipes size-            , o_1_space_pipesX4 size-            ]-        , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)-        , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat-            [ o_n_space_grouping size-            , o_n_space_functor size-            , o_n_heap_buffering size-            ]-        ]
− benchmark/Streamly/Benchmark/Prelude/Serial/NestedStream.hs 
@@ -1,502 +0,0 @@--- |--- Module      : Serial.NestedStream--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Serial.NestedStream (benchmarks) where--import Control.Monad.Trans.Class (lift)--import qualified Control.Applicative as AP--#ifdef INSPECTION-import GHC.Types (SPEC(..))-import Test.Inspection--import qualified Streamly.Internal.Data.Stream.StreamD as D-#endif--import qualified Streamly.Prelude  as S-import qualified Streamly.Internal.Data.Stream.IsStream as Internal-import qualified Streamly.Internal.Data.Unfold as UF--import Gauge-import Streamly.Prelude (SerialT, fromSerial, serial)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Prelude-import Prelude hiding (concatMap)------------------------------------------------------------------------------------ Iteration/looping utilities----------------------------------------------------------------------------------{-# INLINE iterateN #-}-iterateN :: (Int -> a -> a) -> a -> Int -> a-iterateN g initial count = f count initial--    where--    f (0 :: Int) x = x-    f i x = f (i - 1) (g i x)---- Iterate a transformation over a singleton stream-{-# INLINE iterateSingleton #-}-iterateSingleton :: S.MonadAsync m-    => (Int -> SerialT m Int -> SerialT m Int)-    -> Int-    -> Int-    -> SerialT m Int-iterateSingleton g count n = iterateN g (return n) count---- XXX need to check why this is slower than the explicit recursion above, even--- if the above code is written in a foldr like head recursive way. We also--- need to try this with foldlM' once #150 is fixed.--- However, it is perhaps best to keep the iteration benchmarks independent of--- foldrM and any related fusion issues.-{-# INLINE _iterateSingleton #-}-_iterateSingleton ::-       S.MonadAsync m-    => (Int -> SerialT m Int -> SerialT m Int)-    -> Int-    -> Int-    -> SerialT m Int-_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n------------------------------------------------------------------------------------ Multi-Stream-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Appending----------------------------------------------------------------------------------{-# INLINE serial2 #-}-serial2 :: Int -> Int -> IO ()-serial2 count n =-    S.drain $-        S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))--{-# INLINE serial4 #-}-serial4 :: Int -> Int -> IO ()-serial4 count n =-    S.drain $-    S.serial-        (S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))-        (S.serial-              (sourceUnfoldrM count (n + 2))-              (sourceUnfoldrM count (n + 3)))--{-# INLINE append2 #-}-append2 :: Int -> Int -> IO ()-append2 count n =-    S.drain $-    Internal.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))--{-# INLINE append4 #-}-append4 :: Int -> Int -> IO ()-append4 count n =-    S.drain $-    Internal.append-        (Internal.append-              (sourceUnfoldrM count n)-              (sourceUnfoldrM count (n + 1)))-        (Internal.append-              (sourceUnfoldrM count (n + 2))-              (sourceUnfoldrM count (n + 3)))--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'append2-inspect $ 'append2 `hasNoType` ''SPEC-inspect $ 'append2 `hasNoType` ''D.AppendState-#endif--o_1_space_joining :: Int -> [Benchmark]-o_1_space_joining value =-    [ bgroup "joining"-        [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))-        , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))-        , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))-        , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))-        ]-    ]------------------------------------------------------------------------------------ Concat Foldable containers----------------------------------------------------------------------------------o_1_space_concatFoldable :: Int -> [Benchmark]-o_1_space_concatFoldable value =-    [ bgroup "concat-foldable"-        [ benchIOSrc fromSerial "foldMapWith (<>) (List)"-            (sourceFoldMapWith value)-        , benchIOSrc fromSerial "foldMapWith (<>) (Stream)"-            (sourceFoldMapWithStream value)-        , benchIOSrc fromSerial "foldMapWithM (<>) (List)"-            (sourceFoldMapWithM value)-        , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"-            (concatFoldableWith value)-        , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"-            (concatForFoldableWith value)-        , benchIOSrc fromSerial "foldMapM (List)" (sourceFoldMapM value)-        ]-    ]------------------------------------------------------------------------------------ Concat------------------------------------------------------------------------------------ concatMap unfoldrM/unfoldrM--{-# INLINE concatMap #-}-concatMap :: Int -> Int -> Int -> IO ()-concatMap outer inner n =-    S.drain $ S.concatMap-        (\_ -> sourceUnfoldrM inner n)-        (sourceUnfoldrM outer n)--{-# INLINE concatMapM #-}-concatMapM :: Int -> Int -> Int -> IO ()-concatMapM outer inner n =-    S.drain $ S.concatMapM-        (\_ -> return $ sourceUnfoldrM inner n)-        (sourceUnfoldrM outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMap-inspect $ 'concatMap `hasNoType` ''SPEC-#endif---- concatMap unfoldr/unfoldr--{-# INLINE concatMapPure #-}-concatMapPure :: Int -> Int -> Int -> IO ()-concatMapPure outer inner n =-    S.drain $ S.concatMap-        (\_ -> sourceUnfoldr inner n)-        (sourceUnfoldr outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapPure-inspect $ 'concatMapPure `hasNoType` ''SPEC-#endif---- concatMap replicate/unfoldrM--{-# INLINE concatMapRepl #-}-concatMapRepl :: Int -> Int -> Int -> IO ()-concatMapRepl outer inner n =-    S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapRepl-inspect $ 'concatMapRepl `hasNoType` ''SPEC-#endif---- concatMapWith--{-# INLINE concatMapWithSerial #-}-concatMapWithSerial :: Int -> Int -> Int -> IO ()-concatMapWithSerial = concatStreamsWith S.serial--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapWithSerial-inspect $ 'concatMapWithSerial `hasNoType` ''SPEC-#endif--{-# INLINE concatMapWithAppend #-}-concatMapWithAppend :: Int -> Int -> Int -> IO ()-concatMapWithAppend = concatStreamsWith Internal.append--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapWithAppend-inspect $ 'concatMapWithAppend `hasNoType` ''SPEC-#endif---- concatPairWith--{-# INLINE concatPairWithSerial #-}-concatPairWithSerial :: Int -> Int -> Int -> IO ()-concatPairWithSerial = concatPairsWith Internal.serial--{-# INLINE concatPairWithAppend #-}-concatPairWithAppend :: Int -> Int -> Int -> IO ()-concatPairWithAppend = concatPairsWith Internal.append---- unfoldMany---- unfoldMany replicate/unfoldrM--{-# INLINE unfoldManyRepl #-}-unfoldManyRepl :: Int -> Int -> Int -> IO ()-unfoldManyRepl outer inner n =-    S.drain-         $ S.unfoldMany-               (UF.lmap return (UF.replicateM inner))-               (sourceUnfoldrM outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'unfoldManyRepl-inspect $ 'unfoldManyRepl `hasNoType` ''D.ConcatMapUState-inspect $ 'unfoldManyRepl `hasNoType` ''SPEC-#endif--o_1_space_concat :: Int -> [Benchmark]-o_1_space_concat value = sqrtVal `seq`-    [ bgroup "concat"-        [ benchIOSrc1 "concatMapPure (n of 1)"-            (concatMapPure value 1)-        , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"-            (concatMapPure sqrtVal sqrtVal)-        , benchIOSrc1 "concatMapPure (1 of n)"-            (concatMapPure 1 value)--        -- This is for comparison with foldMapWith-        , benchIOSrc fromSerial "concatMapId (n of 1) (fromFoldable)"-            (S.concatMap id . sourceConcatMapId value)--        , benchIOSrc1 "concatMap (n of 1)"-            (concatMap value 1)-        , benchIOSrc1 "concatMap (sqrt n of sqrt n)"-            (concatMap sqrtVal sqrtVal)-        , benchIOSrc1 "concatMap (1 of n)"-            (concatMap 1 value)--        , benchIOSrc1 "concatMapM (n of 1)"-            (concatMapM value 1)-        , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"-            (concatMapM sqrtVal sqrtVal)-        , benchIOSrc1 "concatMapM (1 of n)"-            (concatMapM 1 value)--        -- This is for comparison with foldMapWith-        , benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"-            (S.concatMapWith serial id . sourceConcatMapId value)--        , benchIOSrc1 "concatMapWith (n of 1)"-            (concatMapWithSerial value 1)-        , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"-            (concatMapWithSerial sqrtVal sqrtVal)-        , benchIOSrc1 "concatMapWith (1 of n)"-            (concatMapWithSerial 1 value)--        -- quadratic with number of outer streams-        , benchIOSrc1 "concatMapWithAppend (2 of n/2)"-            (concatMapWithAppend 2 (value `div` 2))--        -- concatMap vs unfoldMany-        , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"-            (concatMapRepl sqrtVal sqrtVal)-        , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"-            (unfoldManyRepl sqrtVal sqrtVal)-        ]-    ]--    where--    sqrtVal = round $ sqrt (fromIntegral value :: Double)--o_n_space_concat :: Int -> [Benchmark]-o_n_space_concat value = sqrtVal `seq`-    [ bgroup "concat"-        [-        -------------------concatPairsWith-------------------        -- Use large number of streams to check scalability--          benchIOSrc1 "concatPairWithSerial (n of 1)"-            (concatPairWithSerial value 1)-        , benchIOSrc1 "concatPairWithSerial (sqrtVal of sqrtVal)"-            (concatPairWithSerial sqrtVal sqrtVal)-        , benchIOSrc1 "concatPairWithSerial (2 of n/2)"-            (concatPairWithSerial 2 (value `div` 2))--        , benchIOSrc1 "concatPairWithAppend (n of 1)"-            (concatPairWithAppend value 1)-        , benchIOSrc1 "concatPairWithAppend (sqrtVal of sqrtVal)"-            (concatPairWithAppend sqrtVal sqrtVal)-        ]-    ]--    where--    sqrtVal = round $ sqrt (fromIntegral value :: Double)------------------------------------------------------------------------------------ Applicative----------------------------------------------------------------------------------o_1_space_applicative :: Int -> [Benchmark]-o_1_space_applicative value =-    [ bgroup "Applicative"-        [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value fromSerial-        , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value fromSerial-        , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value fromSerial-        , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value fromSerial-        ]-    ]--o_n_space_applicative :: Int -> [Benchmark]-o_n_space_applicative value =-    [ bgroup "Applicative"-        [ benchIOSrc fromSerial "(*>) (n times)" $-            iterateSingleton ((*>) . pure) value-        , benchIOSrc fromSerial "(<*) (n times)" $-            iterateSingleton (\x xs -> xs <* pure x) value-        , benchIOSrc fromSerial "(<*>) (n times)" $-            iterateSingleton (\x xs -> pure (+ x) <*> xs) value-        , benchIOSrc fromSerial "liftA2 (n times)" $-            iterateSingleton (AP.liftA2 (+) . pure) value-        ]-    ]------------------------------------------------------------------------------------ Monad----------------------------------------------------------------------------------o_1_space_monad :: Int -> [Benchmark]-o_1_space_monad value =-    [ bgroup "Monad"-        [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value fromSerial-        , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value fromSerial-        , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $-            filterAllOutM value fromSerial-        , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $-            filterAllInM value fromSerial-        , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $-            filterSome value fromSerial-        , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $-            breakAfterSome value fromSerial-        , benchIO "(>>=) (cubert n x cubert n x cubert n)" $-            toNullM3 value fromSerial-        ]-    ]---- This is a good benchmark but inefficient way to compute primes. As we see a--- new prime we keep appending a division filter for all the future numbers.-{-# INLINE sieve #-}-sieve :: Monad m => SerialT m Int -> SerialT m Int-sieve s = do-    r <- lift $ S.uncons s-    case r of-        Just (prime, rest) ->-            prime `S.cons` sieve (S.filter (\n -> n `mod` prime /= 0) rest)-        Nothing -> S.nil--o_n_space_monad :: Int -> [Benchmark]-o_n_space_monad value =-    [ bgroup "Monad"-        [ benchIOSrc fromSerial "(>>) (n times)" $-            iterateSingleton ((>>) . pure) value-        , benchIOSrc fromSerial "(>>=) (n times)" $-            iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value-        , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $-            toListM value fromSerial-        , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $-            toListSome value fromSerial-        , benchIO "naive prime sieve (n/4)"-            (\n -> S.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n))-        ]-    ]------------------------------------------------------------------------------------ Joining----------------------------------------------------------------------------------toKv :: Int -> (Int, Int)-toKv p = (p, p)--{-# INLINE joinWith #-}-joinWith :: (S.MonadAsync m) =>-       ((Int -> Int -> Bool) -> SerialT m Int -> SerialT m Int -> SerialT m b)-    -> Int-    -> Int-    -> m ()-joinWith j val i =-    S.drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))--{-# INLINE joinMapWith #-}-joinMapWith :: (S.MonadAsync m) =>-       (SerialT m (Int, Int) -> SerialT m (Int, Int) -> SerialT m b)-    -> Int-    -> Int-    -> m ()-joinMapWith j val i =-    S.drain-        $ j-            (fmap toKv (sourceUnfoldrM val i))-            (fmap toKv (sourceUnfoldrM val (val `div` 2)))--o_n_heap_buffering :: Int -> [Benchmark]-o_n_heap_buffering value =-    [ bgroup "buffered"-        [-          benchIOSrc1 "joinInner (sqrtVal)"-            $ joinWith Internal.joinInner sqrtVal-        , benchIOSrc1 "joinInnerMap"-            $ joinMapWith Internal.joinInnerMap halfVal-        , benchIOSrc1 "joinLeft (sqrtVal)"-            $ joinWith Internal.joinLeft sqrtVal-        , benchIOSrc1 "joinLeftMap "-            $ joinMapWith Internal.joinLeftMap halfVal-        , benchIOSrc1 "joinOuter (sqrtVal)"-            $ joinWith Internal.joinOuter sqrtVal-        , benchIOSrc1 "joinOuterMap"-            $ joinMapWith Internal.joinOuterMap halfVal-        , benchIOSrc1 "intersectBy (sqrtVal)"-            $ joinWith Internal.intersectBy sqrtVal-        , benchIOSrc1 "intersectBySorted"-            $ joinMapWith (Internal.intersectBySorted compare) halfVal-        ]-    ]--    where--    halfVal = value `div` 2-    sqrtVal = round $ sqrt (fromIntegral value :: Double)------------------------------------------------------------------------------------ Main------------------------------------------------------------------------------------ In addition to gauge options, the number of elements in the stream can be--- passed using the --stream-size option.----benchmarks :: String -> Int -> [Benchmark]-benchmarks moduleName size =-        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat-            [-            -- multi-stream-              o_1_space_joining size-            , o_1_space_concatFoldable size-            , o_1_space_concat size--            , o_1_space_applicative size-            , o_1_space_monad size--            ]-        , bgroup (o_n_space_prefix moduleName) $ Prelude.concat-            [-            -- multi-stream-              o_n_space_applicative size-            , o_n_space_monad size-            , o_n_space_concat size-            ]-       , bgroup (o_n_heap_prefix moduleName) $-            -- multi-stream-            o_n_heap_buffering size-        ]
− benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs 
@@ -1,231 +0,0 @@--- |--- Module      : Streamly.Benchmark.Prelude.Serial.Split--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Serial.Split (benchmarks) where--import Data.Char (ord)-import Data.Word (Word8)-import System.IO (Handle)--import qualified Streamly.FileSystem.Handle as FH-import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Stream.IsStream as IP-import qualified Streamly.Internal.FileSystem.Handle as IFH-import qualified Streamly.Internal.Unicode.Stream as IUS-import qualified Streamly.Prelude as S--import Gauge hiding (env)-import Prelude hiding (last, length)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Common.Handle--#ifdef INSPECTION-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))--import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA-import qualified Streamly.Internal.Data.Unfold as IUF--import Test.Inspection-#endif-- ---------------------------------------------------------------------------------- reduce with splitting transformations----------------------------------------------------------------------------------lf :: Word8-lf = fromIntegral (ord '\n')--toarr :: String -> A.Array Word8-toarr = A.fromList . map (fromIntegral . ord)---- | Split on line feed.-splitOn :: Handle -> IO Int-splitOn inh =-    (S.length $ S.splitOn (== lf) FL.drain-        $ S.unfold FH.read inh) -- >>= print--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'splitOn-inspect $ 'splitOn `hasNoType` ''Step-inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'splitOn `hasNoType` ''MA.ReadUState  -- FH.read/A.read-#endif---- | Split suffix on line feed.-splitOnSuffix :: Handle -> IO Int-splitOnSuffix inh =-    (S.length $ S.splitOnSuffix (== lf) FL.drain-        $ S.unfold FH.read inh) -- >>= print--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'splitOnSuffix-inspect $ 'splitOnSuffix `hasNoType` ''Step-inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'splitOnSuffix `hasNoType` ''MA.ReadUState  -- FH.read/A.read-#endif---- | Split suffix with line feed.-splitWithSuffix :: Handle -> IO Int-splitWithSuffix inh =-    (S.length $ S.splitWithSuffix (== lf) FL.drain-        $ S.unfold FH.read inh) -- >>= print--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'splitWithSuffix-inspect $ 'splitWithSuffix `hasNoType` ''Step-inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'splitWithSuffix `hasNoType` ''MA.ReadUState  -- FH.read/A.read-#endif---- | Split on line feed.-foldManySepBy :: Handle -> IO Int-foldManySepBy inh =-    (S.length-        $ IP.foldMany-            (FL.takeEndBy_ (== lf) FL.drain)-            (S.unfold FH.read inh)-    ) -- >>= print---- | Split on line feed.-parseManySepBy :: Handle -> IO Int-parseManySepBy inh =-    (S.length-        $ IP.parseMany-            (PR.fromFold $ FL.takeEndBy_ (== lf) FL.drain)-            (S.unfold FH.read inh)-    ) -- >>= print---- | Words by space-wordsBy :: Handle -> IO Int-wordsBy inh =-    (S.length $ S.wordsBy isSp FL.drain-        $ S.unfold FH.read inh) -- >>= print--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'wordsBy-inspect $ 'wordsBy `hasNoType` ''Step-inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'wordsBy `hasNoType` ''MA.ReadUState  -- FH.read/A.read-#endif---- | Split on a word8 sequence.-splitOnSeq :: String -> Handle -> IO Int-splitOnSeq str inh =-    (S.length $ IP.splitOnSeq (toarr str) FL.drain-        $ S.unfold FH.read inh) -- >>= print--#ifdef INSPECTION--- inspect $ hasNoTypeClasses 'splitOnSeq--- inspect $ 'splitOnSeq `hasNoType` ''Step-#endif---- | Split on a word8 sequence.-splitOnSeq100k :: Handle -> IO Int-splitOnSeq100k inh = do-    arr <- A.fromStream $ S.replicate 100000 123-    (S.length $ IP.splitOnSeq arr FL.drain-        $ S.unfold FH.read inh) -- >>= print---- | Split on suffix sequence.-splitOnSuffixSeq :: String -> Handle -> IO Int-splitOnSuffixSeq str inh =-    (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain-        $ S.unfold FH.read inh) -- >>= print--#ifdef INSPECTION--- inspect $ hasNoTypeClasses 'splitOnSuffixSeq--- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step-#endif--o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]-o_1_space_reduce_read_split env =-    [ bgroup "split"-        [ mkBench "S.foldMany (FL.takeEndBy_ (== lf) FL.drain)" env-            $ \inh _ -> foldManySepBy inh-        , mkBench "S.parseMany (FL.takeEndBy_ (== lf) FL.drain)" env-            $ \inh _ -> parseManySepBy inh-        , mkBench "S.wordsBy isSpace FL.drain" env $ \inh _ ->-            wordsBy inh-        , mkBench "S.splitOn (== lf) FL.drain" env $ \inh _ ->-            splitOn inh-        , mkBench "S.splitOnSuffix (== lf) FL.drain" env $ \inh _ ->-            splitOnSuffix inh-        , mkBench "S.splitWithSuffix (== lf) FL.drain" env $ \inh _ ->-            splitWithSuffix inh-        , mkBench "S.splitOnSeq \"\" FL.drain" env $ \inh _ ->-            splitOnSeq "" inh-        , mkBench "S.splitOnSuffixSeq \"\" FL.drain" env $ \inh _ ->-            splitOnSuffixSeq "" inh-        , mkBench "S.splitOnSeq \"\\n\" FL.drain" env $ \inh _ ->-            splitOnSeq "\n" inh-        , mkBench "S.splitOnSuffixSeq \"\\n\" FL.drain" env $ \inh _ ->-            splitOnSuffixSeq "\n" inh-        , mkBench "S.splitOnSeq \"a\" FL.drain" env $ \inh _ ->-            splitOnSeq "a" inh-        , mkBench "S.splitOnSeq \"\\r\\n\" FL.drain" env $ \inh _ ->-            splitOnSeq "\r\n" inh-        , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->-            splitOnSuffixSeq "\r\n" inh-        , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->-            splitOnSeq "aa" inh-        , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->-            splitOnSeq "aaaa" inh-        , mkBench "S.splitOnSeq \"abcdefgh\" FL.drain" env $ \inh _ ->-            splitOnSeq "abcdefgh" inh-        , mkBench "S.splitOnSeq \"abcdefghi\" FL.drain" env $ \inh _ ->-            splitOnSeq "abcdefghi" inh-        , mkBench "S.splitOnSeq \"catcatcatcatcat\" FL.drain" env $ \inh _ ->-            splitOnSeq "catcatcatcatcat" inh-        , mkBench "S.splitOnSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"-            env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh-        , mkBench "S.splitOnSeq 100k long pattern"-            env $ \inh _ -> splitOnSeq100k inh-        , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"-            env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh-        ]-    ]---- | Split on a character sequence.-splitOnSeqUtf8 :: String -> Handle -> IO Int-splitOnSeqUtf8 str inh =-    (S.length $ IP.splitOnSeq (A.fromList str) FL.drain-        $ IUS.decodeUtf8Arrays-        $ IFH.toChunks inh) -- >>= print--o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]-o_1_space_reduce_toChunks_split env =-    [ bgroup "split/toChunks"-        [ mkBenchSmall ("S.splitOnSeqUtf8 \"abcdefgh\" FL.drain "-            ++ ". US.decodeUtf8Arrays") env $ \inh _ ->-                splitOnSeqUtf8 "abcdefgh" inh-        , mkBenchSmall "S.splitOnSeqUtf8 \"abcdefghijklmnopqrstuvwxyz\" FL.drain"-            env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh-        ]-    ]--benchmarks :: String -> BenchEnv -> [Benchmark]-benchmarks moduleName env =-        [ bgroup (o_1_space_prefix moduleName) $ concat-            [ o_1_space_reduce_read_split env-            , o_1_space_reduce_toChunks_split env-            ]-        ]
− benchmark/Streamly/Benchmark/Prelude/Serial/Transformation.hs 
@@ -1,567 +0,0 @@--- |--- Module      : Serial.Transformation--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RankNTypes #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Serial.Transformation (benchmarks) where--import Control.DeepSeq (NFData(..))-import Control.Monad.IO.Class (MonadIO(..))-import Data.Functor.Identity (Identity)-import Data.IORef (newIORef, modifyIORef')-import System.Random (randomRIO)--#ifdef INSPECTION-import Test.Inspection-#endif--import qualified Streamly.Prelude  as S-import qualified Streamly.Internal.Data.Stream.IsStream as Internal-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Prelude--import Gauge-import Streamly.Prelude (SerialT, fromSerial, MonadAsync)-import Streamly.Benchmark.Common-import Streamly.Benchmark.Prelude-import Streamly.Internal.Data.Time.Units-import Prelude hiding (sequence, mapM, fmap)------------------------------------------------------------------------------------ Pipelines (stream-to-stream transformations)-------------------------------------------------------------------------------------------------------------------------------------------------------------------- one-to-one transformations-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Traversable Instance----------------------------------------------------------------------------------{-# INLINE traversableTraverse #-}-traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)-traversableTraverse = traverse return--{-# INLINE traversableSequenceA #-}-traversableSequenceA :: SerialT Identity Int -> IO (SerialT Identity Int)-traversableSequenceA = sequenceA . Prelude.fmap return--{-# INLINE traversableMapM #-}-traversableMapM :: SerialT Identity Int -> IO (SerialT Identity Int)-traversableMapM = Prelude.mapM return--{-# INLINE traversableSequence #-}-traversableSequence :: SerialT Identity Int -> IO (SerialT Identity Int)-traversableSequence = Prelude.sequence . Prelude.fmap return--{-# INLINE benchPureSinkIO #-}-benchPureSinkIO-    :: NFData b-    => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark-benchPureSinkIO value name f =-    bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value--o_n_space_traversable :: Int -> [Benchmark]-o_n_space_traversable value =-    -- Buffering operations using heap proportional to number of elements.-    [ bgroup "traversable"-        -- Traversable instance-        [ benchPureSinkIO value "traverse" traversableTraverse-        , benchPureSinkIO value "sequenceA" traversableSequenceA-        , benchPureSinkIO value "mapM" traversableMapM-        , benchPureSinkIO value "sequence" traversableSequence-        ]-    ]------------------------------------------------------------------------------------ maps and scans----------------------------------------------------------------------------------{-# INLINE scanl' #-}-scanl' :: MonadIO m => Int -> SerialT m Int -> m ()-scanl' n = composeN n $ S.scanl' (+) 0--{-# INLINE scanlM' #-}-scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()-scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)--{-# INLINE scanl1' #-}-scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()-scanl1' n = composeN n $ S.scanl1' (+)--{-# INLINE scanl1M' #-}-scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()-scanl1M' n = composeN n $ S.scanl1M' (\b a -> return $ b + a)--{-# INLINE scan #-}-scan :: MonadIO m => Int -> SerialT m Int -> m ()-scan n = composeN n $ S.scan FL.sum--{-# INLINE postscanl' #-}-postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()-postscanl' n = composeN n $ S.postscanl' (+) 0--{-# INLINE postscanlM' #-}-postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()-postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)--{-# INLINE postscan #-}-postscan :: MonadIO m => Int -> SerialT m Int -> m ()-postscan n = composeN n $ S.postscan FL.sum--{-# INLINE sequence #-}-sequence ::-       (S.IsStream t, S.MonadAsync m)-    => (t m Int -> S.SerialT m Int)-    -> t m (m Int)-    -> m ()-sequence t = S.drain . t . S.sequence--{-# INLINE tap #-}-tap :: MonadIO m => Int -> SerialT m Int -> m ()-tap n = composeN n $ S.tap FL.sum--{-# INLINE tapRate #-}-tapRate :: Int -> SerialT IO Int -> IO ()-tapRate n str = do-    cref <- newIORef 0-    composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str--{-# INLINE pollCounts #-}-pollCounts :: Int -> SerialT IO Int -> IO ()-pollCounts n =-    composeN n (Internal.pollCounts (const True) f FL.drain)--    where--    f = Internal.rollingMap (-) . Internal.delayPost 1--{-# INLINE timestamped #-}-timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()-timestamped = S.drain . Internal.timestamped--{-# INLINE foldrS #-}-foldrS :: MonadIO m => Int -> SerialT m Int -> m ()-foldrS n = composeN n $ Internal.foldrS S.cons S.nil--{-# INLINE foldrSMap #-}-foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()-foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil--{-# INLINE foldrT #-}-foldrT :: MonadIO m => Int -> SerialT m Int -> m ()-foldrT n = composeN n $ Internal.foldrT S.cons S.nil--{-# INLINE foldrTMap #-}-foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()-foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil---{-# INLINE trace #-}-trace :: MonadAsync m => Int -> SerialT m Int -> m ()-trace n = composeN n $ Internal.trace return--o_1_space_mapping :: Int -> [Benchmark]-o_1_space_mapping value =-    [ bgroup-        "mapping"-        [-        -- Right folds-          benchIOSink value "foldrS" (foldrS 1)-        , benchIOSink value "foldrSMap" (foldrSMap 1)-        , benchIOSink value "foldrT" (foldrT 1)-        , benchIOSink value "foldrTMap" (foldrTMap 1)--        -- Mapping-        , benchIOSink value "map" (mapN fromSerial 1)-        , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->-              sequence fromSerial (sourceUnfoldrAction value n)-        , benchIOSink value "mapM" (mapM fromSerial 1)-        , benchIOSink value "tap" (tap 1)-        , benchIOSink value "tapRate 1 second" (tapRate 1)-        , benchIOSink value "pollCounts 1 second" (pollCounts 1)-        , benchIOSink value "timestamped" timestamped--        -- Scanning-        , benchIOSink value "scanl'" (scanl' 1)-        , benchIOSink value "scanl1'" (scanl1' 1)-        , benchIOSink value "scanlM'" (scanlM' 1)-        , benchIOSink value "scanl1M'" (scanl1M' 1)-        , benchIOSink value "postscanl'" (postscanl' 1)-        , benchIOSink value "postscanlM'" (postscanlM' 1)--        , benchIOSink value "scan" (scan 1)-        , benchIOSink value "postscan" (postscan 1)-        ]-    ]--o_1_space_mappingX4 :: Int -> [Benchmark]-o_1_space_mappingX4 value =-    [ bgroup "mappingX4"-        [ benchIOSink value "map" (mapN fromSerial 4)-        , benchIOSink value "mapM" (mapM fromSerial 4)-        , benchIOSink value "trace" (trace 4)--        , benchIOSink value "scanl'" (scanl' 4)-        , benchIOSink value "scanl1'" (scanl1' 4)-        , benchIOSink value "scanlM'" (scanlM' 4)-        , benchIOSink value "scanl1M'" (scanl1M' 4)-        , benchIOSink value "postscanl'" (postscanl' 4)-        , benchIOSink value "postscanlM'" (postscanlM' 4)--        ]-    ]--{-# INLINE sieveScan #-}-sieveScan :: Monad m => SerialT m Int -> SerialT m Int-sieveScan =-      S.mapMaybe snd-    . S.scanlM' (\(primes, _) n -> do-            return $-                let ps = takeWhile (\p -> p * p <= n) primes-                 in if all (\p -> n `mod` p /= 0) ps-                    then (primes ++ [n], Just n)-                    else (primes, Nothing)) (return ([2], Just 2))--o_n_space_mapping :: Int -> [Benchmark]-o_n_space_mapping value =-    [ bgroup "mapping"-        [ benchIO "naive prime sieve"-            (\n -> S.sum $ sieveScan $ S.enumerateFromTo 2 (value + n))-        ]-    ]------------------------------------------------------------------------------------ Functor----------------------------------------------------------------------------------o_1_space_functor :: Int -> [Benchmark]-o_1_space_functor value =-    [ bgroup "Functor"-        [ benchIOSink value "fmap" (fmapN fromSerial 1)-        , benchIOSink value "fmap x 4" (fmapN fromSerial 4)-        ]-    ]------------------------------------------------------------------------------------ Size reducing transformations (filtering)----------------------------------------------------------------------------------{-# INLINE filterEven #-}-filterEven :: MonadIO m => Int -> SerialT m Int -> m ()-filterEven n = composeN n $ S.filter even--{-# INLINE filterAllOut #-}-filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-filterAllOut value n = composeN n $ S.filter (> (value + 1))--{-# INLINE filterAllIn #-}-filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-filterAllIn value n = composeN n $ S.filter (<= (value + 1))--{-# INLINE filterMEven #-}-filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()-filterMEven n = composeN n $ S.filterM (return . even)--{-# INLINE filterMAllOut #-}-filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))--{-# INLINE filterMAllIn #-}-filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))--{-# INLINE _takeOne #-}-_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()-_takeOne n = composeN n $ S.take 1--{-# INLINE takeAll #-}-takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-takeAll value n = composeN n $ S.take (value + 1)--{-# INLINE takeWhileTrue #-}-takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))--{-# INLINE takeWhileMTrue #-}-takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))--{-# INLINE takeInterval #-}-takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()-takeInterval i n = composeN n (Internal.takeInterval i)--#ifdef INSPECTION--- inspect $ hasNoType 'takeInterval ''SPEC-inspect $ hasNoTypeClasses 'takeInterval--- inspect $ 'takeInterval `hasNoType` ''D.Step-#endif--{-# INLINE dropOne #-}-dropOne :: MonadIO m => Int -> SerialT m Int -> m ()-dropOne n = composeN n $ S.drop 1--{-# INLINE dropAll #-}-dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-dropAll value n = composeN n $ S.drop (value + 1)--{-# INLINE dropWhileTrue #-}-dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))--{-# INLINE dropWhileMTrue #-}-dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))--{-# INLINE dropWhileFalse #-}-dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))---- XXX Decide on the time interval-{-# INLINE _intervalsOfSum #-}-_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()-_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)--{-# INLINE dropInterval #-}-dropInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()-dropInterval i n = composeN n (Internal.dropInterval i)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'dropInterval--- inspect $ 'dropInterval `hasNoType` ''D.Step-#endif--{-# INLINE findIndices #-}-findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-findIndices value n = composeN n $ S.findIndices (== (value + 1))--{-# INLINE elemIndices #-}-elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-elemIndices value n = composeN n $ S.elemIndices (value + 1)--{-# INLINE deleteBy #-}-deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)---- uniq . uniq == uniq, composeN 2 ~ composeN 1-{-# INLINE uniq #-}-uniq :: MonadIO m => Int -> SerialT m Int -> m ()-uniq n = composeN n S.uniq--{-# INLINE mapMaybe #-}-mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()-mapMaybe n =-    composeN n $-    S.mapMaybe-        (\x ->-             if odd x-             then Nothing-             else Just x)--{-# INLINE mapMaybeM #-}-mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()-mapMaybeM n =-    composeN n $-    S.mapMaybeM-        (\x ->-             if odd x-             then return Nothing-             else return $ Just x)--o_1_space_filtering :: Int -> [Benchmark]-o_1_space_filtering value =-    [ bgroup "filtering"-        [ benchIOSink value "filter-even" (filterEven 1)-        , benchIOSink value "filter-all-out" (filterAllOut value 1)-        , benchIOSink value "filter-all-in" (filterAllIn value 1)--        , benchIOSink value "filterM-even" (filterMEven 1)-        , benchIOSink value "filterM-all-out" (filterMAllOut value 1)-        , benchIOSink value "filterM-all-in" (filterMAllIn value 1)--        -- Trimming-        , benchIOSink value "take-all" (takeAll value 1)-        , benchIOSink-              value-              "takeInterval-all"-              (takeInterval (NanoSecond64 maxBound) 1)-        , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)-     -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)-        , benchIOSink value "drop-one" (dropOne 1)-        , benchIOSink value "drop-all" (dropAll value 1)-        , benchIOSink-              value-              "dropInterval-all"-              (dropInterval (NanoSecond64 maxBound) 1)-        , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)-     -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)-        , benchIOSink-              value-              "dropWhile-false"-              (dropWhileFalse value 1)-        , benchIOSink value "deleteBy" (deleteBy value 1)--        , benchIOSink value "uniq" (uniq 1)--        -- Map and filter-        , benchIOSink value "mapMaybe" (mapMaybe 1)-        , benchIOSink value "mapMaybeM" (mapMaybeM 1)--        -- Searching (stateful map and filter)-        , benchIOSink value "findIndices" (findIndices value 1)-        , benchIOSink value "elemIndices" (elemIndices value 1)-        ]-    ]--o_1_space_filteringX4 :: Int -> [Benchmark]-o_1_space_filteringX4 value =-    [ bgroup "filteringX4"-        [ benchIOSink value "filter-even" (filterEven 4)-        , benchIOSink value "filter-all-out" (filterAllOut value 4)-        , benchIOSink value "filter-all-in" (filterAllIn value 4)--        , benchIOSink value "filterM-even" (filterMEven 4)-        , benchIOSink value "filterM-all-out" (filterMAllOut value 4)-        , benchIOSink value "filterM-all-in" (filterMAllIn value 4)--        -- trimming-        , benchIOSink value "take-all" (takeAll value 4)-        , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)-        , benchIOSink value "takeWhileM-true" (takeWhileMTrue value 4)-        , benchIOSink value "drop-one" (dropOne 4)-        , benchIOSink value "drop-all" (dropAll value 4)-        , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)-        , benchIOSink value "dropWhileM-true" (dropWhileMTrue value 4)-        , benchIOSink-              value-              "dropWhile-false"-              (dropWhileFalse value 4)-        , benchIOSink value "deleteBy" (deleteBy value 4)--        , benchIOSink value "uniq" (uniq 4)--        -- map and filter-        , benchIOSink value "mapMaybe" (mapMaybe 4)-        , benchIOSink value "mapMaybeM" (mapMaybeM 4)--        -- searching-        , benchIOSink value "findIndices" (findIndices value 4)-        , benchIOSink value "elemIndices" (elemIndices value 4)-        ]-    ]------------------------------------------------------------------------------------ Size increasing transformations (insertions)----------------------------------------------------------------------------------{-# INLINE intersperse #-}-intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()-intersperse value n = composeN n $ S.intersperse (value + 1)--{-# INLINE intersperseM #-}-intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()-intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)--{-# INLINE insertBy #-}-insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-insertBy value n = composeN n $ S.insertBy compare (value + 1)--{-# INLINE interposeSuffix #-}-interposeSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()-interposeSuffix value n =-    composeN n $ Internal.interposeSuffix (value + 1) Unfold.identity--{-# INLINE intercalateSuffix #-}-intercalateSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()-intercalateSuffix value n =-    composeN n $ Internal.intercalateSuffix Unfold.identity (value + 1)--o_1_space_inserting :: Int -> [Benchmark]-o_1_space_inserting value =-    [ bgroup "inserting"-        [ benchIOSink value "intersperse" (intersperse value 1)-        , benchIOSink value "intersperseM" (intersperseM value 1)-        , benchIOSink value "insertBy" (insertBy value 1)-        , benchIOSink value "interposeSuffix" (interposeSuffix value 1)-        , benchIOSink value "intercalateSuffix" (intercalateSuffix value 1)-        ]-    ]--o_1_space_insertingX4 :: Int -> [Benchmark]-o_1_space_insertingX4 value =-    [ bgroup "insertingX4"-        [ benchIOSink value "intersperse" (intersperse value 4)-        , benchIOSink value "insertBy" (insertBy value 4)-        ]-    ]------------------------------------------------------------------------------------ Indexing----------------------------------------------------------------------------------{-# INLINE indexed #-}-indexed :: MonadIO m => Int -> SerialT m Int -> m ()-indexed n = composeN n (S.map snd . S.indexed)--{-# INLINE indexedR #-}-indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()-indexedR value n = composeN n (S.map snd . S.indexedR value)--o_1_space_indexing :: Int -> [Benchmark]-o_1_space_indexing value =-    [ bgroup "indexing"-        [ benchIOSink value "indexed" (indexed 1)-        , benchIOSink value "indexedR" (indexedR value 1)-        ]-    ]--o_1_space_indexingX4 :: Int -> [Benchmark]-o_1_space_indexingX4 value =-    [ bgroup "indexingx4"-        [ benchIOSink value "indexed" (indexed 4)-        , benchIOSink value "indexedR" (indexedR value 4)-        ]-    ]------------------------------------------------------------------------------------ Main------------------------------------------------------------------------------------ In addition to gauge options, the number of elements in the stream can be--- passed using the --stream-size option.----benchmarks :: String -> Int -> [Benchmark]-benchmarks moduleName size =-        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat-            [ o_1_space_functor size-            , o_1_space_mapping size-            , o_1_space_mappingX4 size-            , o_1_space_filtering size-            , o_1_space_filteringX4 size-            , o_1_space_inserting size-            , o_1_space_insertingX4 size-            , o_1_space_indexing size-            , o_1_space_indexingX4 size-            ]-        , bgroup (o_n_space_prefix moduleName) $ Prelude.concat-            [ o_n_space_traversable size-            , o_n_space_mapping size-            ]-        ]
benchmark/Streamly/Benchmark/Prelude/WAsync.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -13,7 +15,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench  moduleName :: String moduleName = "Prelude.WAsync"
benchmark/Streamly/Benchmark/Prelude/WSerial.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -27,13 +29,13 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench  #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif  moduleName :: String
benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -13,7 +15,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench  moduleName :: String moduleName = "Prelude.ZipAsync"@@ -56,10 +58,16 @@                                                        (value `div` 2))         , benchIOSrc fromSerial "zipAsyncAp (2,x/2)" (zipAsyncAp (value `div` 2))         , benchIOSink value "fmap zipAsyncly" $ fmapN S.fromZipAsync 1-        , fromZipAsyncTraverse "ZipAsync Applicative (x/100)" (value `div` 100)         ]     ] +o_n_heap_joining :: Int -> [Benchmark]+o_n_heap_joining value =+    [ bgroup "joining"+        [ fromZipAsyncTraverse "ZipAsync Applicative (x/100)" (value `div` 100)+        ]+    ]+ ------------------------------------------------------------------------------- -- Monad outer product -------------------------------------------------------------------------------@@ -85,4 +93,5 @@             [ o_1_space_joining size             , o_1_space_outerProduct size             ]+        , bgroup (o_n_heap_prefix moduleName) $ o_n_heap_joining size         ]
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Main -- Copyright   : (c) 2018 Composewell Technologies@@ -27,13 +29,13 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM) -import Gauge+import Test.Tasty.Bench  #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif  moduleName :: String
benchmark/Streamly/Benchmark/Unicode/Char.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-}+ -- -- Module      : Streamly.Unicode.Char -- Copyright   : (c) 2021 Composewell Technologies@@ -10,19 +12,19 @@ -- Imports -------------------------------------------------------------------------------- -import Control.DeepSeq (NFData)-import Streamly.Internal.Data.Array.Foreign (Array)+import Control.DeepSeq (NFData(..))+import Streamly.Internal.Data.Array (Array) import System.FilePath (dropExtensions, takeFileName) import System.FilePath.Posix ((</>))-import Gauge.Main (Benchmark, bench, bgroup, defaultMain, env, nfIO)+import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, env, nfIO) import Streamly.Internal.Unicode.Char     ( NormalizationMode(NFC, NFD, NFKC, NFKD)     , normalize     ) import Streamly.Benchmark.Common (o_1_space_prefix) -import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Stream.IsStream as IsStream+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Stream as IsStream import qualified System.Directory as Dir  --------------------------------------------------------------------------------@@ -41,7 +43,13 @@ dataSetSize :: Int dataSetSize = 1000000 -makeBench :: (NFData a) => (String, a -> IO ()) -> (String, IO a) -> Benchmark+-- Unboxed arrays are fully evaluated.+instance NFData (Array a) where+    {-# INLINE rnf #-}+    rnf _ = ()++makeBench ::+    (String, Array Char -> IO ()) -> (String, IO (Array Char)) -> Benchmark makeBench (implName, func) (dataName, setup) =     env setup (bench (implName ++ "/" ++ dataName) . nfIO . func) @@ -65,10 +73,10 @@  benchFunctions :: [(String, Array Char -> IO ())] benchFunctions =-    [ ("NFD", IsStream.drain . normalize NFD . Array.toStream)-    , ("NFKD", IsStream.drain . normalize NFKD . Array.toStream)-    , ("NFC", IsStream.drain . normalize NFC . Array.toStream)-    , ("NFKC", IsStream.drain . normalize NFKC . Array.toStream)+    [ ("NFD", IsStream.drain . normalize NFD . Array.read)+    , ("NFKD", IsStream.drain . normalize NFKD . Array.read)+    , ("NFC", IsStream.drain . normalize NFC . Array.read)+    , ("NFKC", IsStream.drain . normalize NFKC . Array.read)     ]  main :: IO ()
+ benchmark/Streamly/Benchmark/Unicode/Parser.hs view
@@ -0,0 +1,107 @@+-- |+-- Module      : Streamly.Benchmark.Data.Parser+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif++module Main+  (+    main+  ) where++import Control.DeepSeq (NFData(..))+import Control.Monad (replicateM_)+import Streamly.Internal.Data.Parser (ParseError(..))+import Streamly.Internal.Data.Stream (Stream)+import Prelude hiding+    (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile)++import qualified Streamly.Data.Array as Array+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Unicode.Parser as PRU++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common++runParser :: Int -> (Stream IO Char -> IO a) -> IO ()+runParser count p = do+    let v = "+123456789.123456789e-123"+    let !(arr :: Array.Array Char) = Array.fromListN (length v) v+    let s = Stream.unfold Array.reader arr+    replicateM_ count (p s)++-- | Takes a fold method, and uses it with a default source.+{-# INLINE benchIOSink #-}+benchIOSink :: Int -> String -> (Stream IO Char -> IO b) -> Benchmark+benchIOSink value name f = bench name $ nfIO $ runParser value f++{-# INLINE doubleParser #-}+doubleParser :: Monad m => Stream m Char -> m (Either ParseError (Int, Int))+doubleParser = Stream.parse PRU.doubleParser++{-# INLINE number #-}+number :: Monad m => Stream m Char -> m (Either ParseError (Integer, Int))+number = Stream.parse PRU.number++{-# INLINE double #-}+double :: Monad m => Stream m Char -> m (Either ParseError Double)+double = Stream.parse PRU.double++{-# INLINE numberDouble #-}+numberDouble :: Monad m => Stream m Char -> m (Either ParseError Double)+numberDouble = Stream.parse p+    where p = uncurry PRU.mkDouble <$> PRU.number++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Unicode.Parser"++instance NFData ParseError where+    {-# INLINE rnf #-}+    rnf (ParseError x) = rnf x++o_n_heap_serial :: Int -> [Benchmark]+o_n_heap_serial value =+    [+      benchIOSink value "doubleParser" doubleParser+    , benchIOSink value "number" number+    , benchIOSink value "double (doubleParser)" double+    , benchIOSink value "double (number)" numberDouble+    ]++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++main :: IO ()+main = do+#ifndef FUSION_CHECK+    runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)+        ]+#else+    -- Enable FUSION_CHECK macro at the beginning of the file+    -- Enable one benchmark below, and run the benchmark+    -- Check the .dump-simpl output+    let value = 100000+    runParser value double+    return ()+#endif
benchmark/Streamly/Benchmark/Unicode/Stream.hs view
@@ -1,3 +1,4 @@+ -- -- Module      : Streamly.Unicode.Stream -- Copyright   : (c) 2019 Composewell Technologies@@ -9,6 +10,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} +#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif+ #ifdef __HADDOCK_VERSION__ #undef INSPECTION #endif@@ -18,29 +24,31 @@ {-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} #endif +import Streamly.Data.Stream (Stream)+import Streamly.Data.Fold (Fold) import Prelude hiding (last, length) import System.IO (Handle)+import Streamly.Internal.System.IO (arrayPayloadSize) -import qualified Streamly.Data.Array.Foreign as Array+import qualified Streamly.Data.Array as Array import qualified Streamly.Data.Fold as Fold-import qualified Streamly.FileSystem.Handle as Handle-import qualified Streamly.Internal.Data.Stream.IsStream as Stream+import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.FileSystem.Handle as Handle-import qualified Streamly.Internal.Unicode.Array.Char as UnicodeArr+import qualified Streamly.Internal.Unicode.Array as UnicodeArr import qualified Streamly.Internal.Unicode.Stream as Unicode+import qualified Streamly.Internal.Data.Array as Array -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common import Streamly.Benchmark.Common.Handle  #ifdef INSPECTION-import Foreign.Storable (Storable)-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))-import qualified Streamly.Internal.Data.Fold.Type as Fold+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Internal.Data.Stream (Step(..))+import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Tuple.Strict as Strict-import qualified Streamly.Internal.Data.Array.Foreign.Type as Array-import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MArray  import Test.Inspection #endif@@ -54,8 +62,8 @@ copyCodecUtf8ArraysLenient inh outh =    Stream.fold (Handle.write outh)      $ Unicode.encodeUtf8'-     $ Unicode.decodeUtf8Arrays-     $ Handle.toChunks inh+     $ Unicode.decodeUtf8Chunks+     $ Handle.readChunks inh  #ifdef INSPECTION inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient@@ -75,23 +83,29 @@ -- copy with group/ungroup transformations ------------------------------------------------------------------------------- +{-# INLINE splitOnSuffix #-}+splitOnSuffix+    :: (Monad m)+    => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+splitOnSuffix predicate f = Stream.foldMany (Fold.takeEndBy_ predicate f)+ {-# NOINLINE linesUnlinesCopy #-} linesUnlinesCopy :: Handle -> Handle -> IO () linesUnlinesCopy inh outh =     Stream.fold (Handle.write outh)       $ Unicode.encodeLatin1'       $ Unicode.unlines Unfold.fromList-      $ Stream.splitOnSuffix (== '\n') Fold.toList+      $ splitOnSuffix (== '\n') Fold.toList       $ Unicode.decodeLatin1-      $ Stream.unfold Handle.read inh+      $ Stream.unfold Handle.reader inh  {-# NOINLINE linesUnlinesArrayWord8Copy #-} linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO () linesUnlinesArrayWord8Copy inh outh =     Stream.fold (Handle.write outh)-      $ Stream.interposeSuffix 10 Array.read-      $ Stream.splitOnSuffix (== 10) Array.write-      $ Stream.unfold Handle.read inh+      $ Stream.unfoldEachEndBy 10 Array.reader+      $ splitOnSuffix (== 10) Array.create+      $ Stream.unfold Handle.reader inh  -- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion -- | Lines and unlines@@ -103,10 +117,10 @@       $ UnicodeArr.unlines       $ UnicodeArr.lines       $ Unicode.decodeLatin1-      $ Stream.unfold Handle.read inh+      $ Stream.unfold Handle.reader inh  #ifdef INSPECTION-inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]+inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Unbox] -- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step #endif @@ -129,9 +143,9 @@ wordsUnwordsCopyWord8 :: Handle -> Handle -> IO () wordsUnwordsCopyWord8 inh outh =     Stream.fold (Handle.write outh)-        $ Stream.interposeSuffix 32 Unfold.fromList+        $ Stream.unfoldEachEndBy 32 Unfold.fromList         $ Stream.wordsBy isSp Fold.toList-        $ Stream.unfold Handle.read inh+        $ Stream.unfold Handle.reader inh  #ifdef INSPECTION inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8@@ -155,7 +169,7 @@       $ Stream.wordsBy isSpace Fold.toList       -- -- $ Stream.splitOn isSpace Fold.toList       $ Unicode.decodeLatin1-      $ Stream.unfold Handle.read inh+      $ Stream.unfold Handle.reader inh  #ifdef INSPECTION -- inspect $ hasNoTypeClasses 'wordsUnwordsCopy@@ -170,7 +184,7 @@       $ UnicodeArr.unwords       $ UnicodeArr.words       $ Unicode.decodeLatin1-      $ Stream.unfold Handle.read inh+      $ Stream.unfold Handle.reader inh  o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark] o_1_space_copy_read_group_ungroup env =@@ -202,16 +216,16 @@    Stream.fold (Handle.write outh)      $ Unicode.encodeLatin1'      $ Unicode.decodeLatin1-     $ Stream.unfold Handle.read inh+     $ Stream.unfold Handle.reader inh  #ifdef INSPECTION inspect $ hasNoTypeClasses 'copyStreamLatin1' inspect $ 'copyStreamLatin1' `hasNoType` ''Step inspect $ 'copyStreamLatin1' `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many-inspect $ 'copyStreamLatin1' `hasNoType` ''MArray.ReadUState  -- Handle.read/Array.read  inspect $ 'copyStreamLatin1' `hasNoType` ''Fold.Step-inspect $ 'copyStreamLatin1' `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe+inspect $ 'copyStreamLatin1' `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe+                                                             -- Handle.read/Array.read inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf #endif @@ -222,17 +236,17 @@    Stream.fold (Handle.write outh)      $ Unicode.encodeLatin1      $ Unicode.decodeLatin1-     $ Stream.unfold Handle.read inh+     $ Stream.unfold Handle.reader inh  #ifdef INSPECTION inspect $ hasNoTypeClasses 'copyStreamLatin1 inspect $ 'copyStreamLatin1 `hasNoType` ''Step inspect $ 'copyStreamLatin1 `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many-inspect $ 'copyStreamLatin1 `hasNoType` ''MArray.ReadUState  -- Handle.read/Array.read  inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.ManyState inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.Step-inspect $ 'copyStreamLatin1 `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe+inspect $ 'copyStreamLatin1 `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe+                                                            -- Handle.read/Array.read inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf #endif @@ -242,8 +256,19 @@    Stream.fold (Handle.write outh)      $ Unicode.encodeUtf8'      $ Unicode.decodeUtf8'-     $ Stream.unfold Handle.read inh+     $ Stream.unfold Handle.reader inh +-- | Copy file+{-# NOINLINE copyStreamUtf16 #-}+copyStreamUtf16 :: Handle -> Handle -> IO ()+copyStreamUtf16 inh outh =+   Stream.fold (Handle.writeChunks outh)+     $ fmap Array.unsafeCast $ Array.chunksOf (arrayPayloadSize (16 * 1024))+     $ Unicode.encodeUtf16le'+     $ Unicode.decodeUtf16le+     $ Array.concat $ fmap Array.unsafeCast $ Unicode.mkEvenW8Chunks+     $ Handle.readChunks inh+ #ifdef INSPECTION inspect $ hasNoTypeClasses '_copyStreamUtf8' -- inspect $ '_copyStreamUtf8 `hasNoType` ''Step@@ -258,7 +283,7 @@    Stream.fold (Handle.write outh)      $ Unicode.encodeUtf8      $ Unicode.decodeUtf8-     $ Stream.unfold Handle.read inh+     $ Stream.unfold Handle.reader inh  #ifdef INSPECTION inspect $ hasNoTypeClasses 'copyStreamUtf8@@ -272,17 +297,18 @@ _copyStreamUtf8'Fold inh outh =    Stream.fold (Handle.write outh)      $ Unicode.encodeUtf8-     $ Stream.foldMany Unicode.writeCharUtf8'-     $ Stream.unfold Handle.read inh+     $ Stream.catRights+     $ Stream.parseMany Unicode.writeCharUtf8'+     $ Stream.unfold Handle.reader inh  {-# NOINLINE _copyStreamUtf8Parser #-} _copyStreamUtf8Parser :: Handle -> Handle -> IO () _copyStreamUtf8Parser inh outh =    Stream.fold (Handle.write outh)      $ Unicode.encodeUtf8-     $ Stream.parseMany+     $ Stream.catRights $ Stream.parseMany            (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure)-     $ Stream.unfold Handle.read inh+     $ Stream.unfold Handle.reader inh  o_1_space_decode_encode_read :: BenchEnv -> [Benchmark] o_1_space_decode_encode_read env =@@ -304,11 +330,14 @@               $ \inh outh -> _copyStreamUtf8Parser inh outh         , mkBenchSmall "encodeUtf8 . decodeUtf8" env $ \inh outh ->             copyStreamUtf8 inh outh+        , mkBenchSmall "encodeUtf16 . decodeUtf16" env $ \inh outh ->+            copyStreamUtf16 inh outh         ]     ]  main :: IO () main = do+#ifndef FUSION_CHECK     env <- mkHandleBenchEnv     defaultMain (allBenchmarks env) @@ -321,3 +350,13 @@             , o_1_space_decode_encode_read env             ]         ]+#else+    -- Enable FUSION_CHECK macro at the beginning of the file+    -- Enable one benchmark below, and run the benchmark+    -- Check the .dump-simpl output+    env <- mkHandleBenchEnv+    let mkHandles (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh+    (Handles inh outh) <- getHandles env mkHandles+    copyStreamLatin1' inh outh+    return ()+#endif
benchmark/Streamly/Benchmark/Unicode/Utf8.hs view
@@ -13,7 +13,7 @@ import Data.Char (chr) import Streamly.Internal.Unicode.Utf8 (Utf8) -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common  import qualified Streamly.Internal.Unicode.Utf8 as Utf8@@ -49,7 +49,7 @@     allBenchmarks value =         [ bgroup               moduleName-              [ bench "pack" $ nf pack value-              , bench "pack + unpack" $ nf packUnpack value+              [ bench "pack" $ whnf pack value+              , bench "pack + unpack" $ whnf packUnpack value               ]         ]
− benchmark/bench-report/BenchReport.hs 
@@ -1,272 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main where--import Control.Exception (catch, ErrorCall(..))-import Control.Monad (mzero)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.State-import Data.Char (toLower)-import Data.List-import System.Environment (getArgs)-import Text.Read (readMaybe)--import BenchShow----------------------------------------------------------------------------------- Command line parsing---------------------------------------------------------------------------------data BenchType-    = Compare String-    | Standard String-    deriving Show--data Options = Options-    { genGraphs :: Bool-    , sortByName :: Bool-    , useGauge :: Bool-    , benchType :: Maybe BenchType-    , fields :: [String]-    , diffStyle :: GroupStyle-    , cutOffPercent :: Double-    } deriving Show--defaultOptions :: Options-defaultOptions = Options False False False Nothing ["time"] PercentDiff 0--setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()-setGenGraphs val = do-    (args, opts) <- get-    put (args, opts { genGraphs = val })--setSortByName :: Monad m => Bool -> StateT (a, Options) m ()-setSortByName val = do-    (args, opts) <- get-    put (args, opts { sortByName = val })--setUseGauge :: Monad m => Bool -> StateT (a, Options) m ()-setUseGauge val = do-    (args, opts) <- get-    put (args, opts { useGauge = val })--setBenchType :: Monad m => BenchType -> StateT (a, Options) m ()-setBenchType val = do-    (args, opts) <- get-    put (args, opts { benchType = Just val })--setFields :: Monad m => [String] -> StateT (a, Options) m ()-setFields val = do-    (args, opts) <- get-    put (args, opts { fields = val })--setDiff :: Monad m => String -> StateT (a, Options) m ()-setDiff val = do-    (args, opts) <- get-    let cmpStyle =-            case val of-                "absolute" -> Absolute-                "multiples" -> Multiples-                "percent" -> PercentDiff-                x -> error $ "Unknown diff option: " ++ show x-     in put (args, opts { diffStyle = cmpStyle })--setCutOff :: Monad m => String -> StateT (a, Options) m ()-setCutOff val = do-    (args, opts) <- get-    case readMaybe val of-        Just x -> put (args, opts { cutOffPercent = x })-        Nothing -> error $ "Invalid cutoff value: " ++ show val---- Like the shell "shift" to shift the command line arguments-shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)-shift = do-    s <- get-    case s of-        ([], _) -> return Nothing-        (x : xs, opts) -> put (xs, opts) >> return (Just x)--parseBench :: StateT ([String], Options) (MaybeT IO) ()-parseBench = do-    x <- shift-    case x of-        Just str | "_cmp" `isSuffixOf` str -> setBenchType (Compare str)-        Just str -> setBenchType (Standard str)-        Nothing -> do-                liftIO $ putStrLn "please provide a benchmark type "-                mzero--parseFields :: StateT ([String], Options) (MaybeT IO) ()-parseFields = do-    x <- shift-    case x of-        Just str -> setFields (words str)-        Nothing -> do-                liftIO $ putStrLn-                    "please provide a list of fields after --fields"-                mzero--parseDiff :: StateT ([String], Options) (MaybeT IO) ()-parseDiff = do-    x <- shift-    case x of-        Just str -> setDiff str-        Nothing -> do-                liftIO $ putStrLn "please provide a diff type"-                mzero--parseCutOff :: StateT ([String], Options) (MaybeT IO) ()-parseCutOff = do-    x <- shift-    case x of-        Just str -> setCutOff str-        Nothing -> do-                liftIO $ putStrLn "please provide a cutoff percent"-                mzero---- totally imperative style option parsing-parseOptions :: IO (Maybe Options)-parseOptions = do-    args <- getArgs-    runMaybeT $ flip evalStateT (args, defaultOptions) $ do-        parseLoop-        fmap snd get--    where--    parseOpt opt =-        case opt of-            "--graphs" -> setGenGraphs True-            "--sort-by-name" -> setSortByName True-            "--use-gauge" -> setUseGauge True-            "--benchmark" -> parseBench-            "--fields" -> parseFields-            "--diff-style" -> parseDiff-            "--diff-cutoff-percent" -> parseCutOff-            str -> do-                liftIO $ putStrLn $ "Unrecognized option " <> str-                mzero--    parseLoop = do-        next <- shift-        case next of-            Just opt -> parseOpt opt >> parseLoop-            Nothing -> return ()--ignoringErr :: IO () -> IO ()-ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->-    putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")----------------------------------------------------------------------------------- Generic---------------------------------------------------------------------------------makeGraphs :: String -> Config -> String -> IO ()-makeGraphs name cfg inputFile =-    ignoringErr $ graph inputFile name cfg----------------------------------------------------------------------------------- Arrays---------------------------------------------------------------------------------showComparisons :: Options -> Config -> FilePath -> FilePath -> IO ()-showComparisons Options{..} cfg inp out =-    let cfg1 = cfg { classifyBenchmark = classifyComparison }-     in if genGraphs-        then ignoringErr $ graph inp "comparison"-                cfg1 { outputDir = Just out-                     , presentation = Groups Absolute-                     }-        else ignoringErr $ report inp Nothing cfg1--    where--    separator = if useGauge then '/' else '.'-    dropComponent sep = dropWhile (== sep) . dropWhile (/= sep)--    -- In case of tasty-bench the names could be like-    -- All.Data.Array.Prim.Pinned/o-1-space.generation.show-    -- All.Data.Array.Foreign/o-1-space.generation.show-    classifyComparison b =-        let b1 =-                if useGauge-                then b-                else dropComponent separator b --- drop "All." at the beginning-         in Just-            ( takeWhile (/= '/') b1-            , dropComponent '/' b1 -- for tasty-bench drop up to "/"-            )----------------------------------------------------------------------------------- text reports---------------------------------------------------------------------------------selectBench-    :: Options-    -> (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])-    -> [String]-selectBench Options{..} f =-    -- Apply filterPred only if at least 2 columns exist-    let colVals =-            case f (ColumnIndex 1) (Just PercentDiff) of-                Left _ -> either error id $ f (ColumnIndex 0) (Just PercentDiff)-                Right xs -> filter (filterPred . snd) xs-    in reverse-           $ fmap fst-           $ sortFunc colVals--    where--    sortFunc = if sortByName then sortOn fst else sortOn snd--    filterPred x-        | isInfinite x = False-        | isNaN x = False-        | cutOffPercent > 0 = x >= cutOffPercent-        | cutOffPercent < 0 = x <= cutOffPercent-        | otherwise = True--benchShow ::-       Options-    -> Config-    -> (Config -> String -> IO ())-    -> String-    -> FilePath-    -> IO ()-benchShow Options{..} cfg func inp out =-    if genGraphs-    then func cfg {outputDir = Just out} inp-    else ignoringErr $ report inp Nothing cfg--main :: IO ()-main = do-    res <- parseOptions-    case res of-        Nothing -> do-            putStrLn "cannot parse options"-            return ()-        Just opts@Options{fields = fs, benchType = btype} ->-            let cfg = defaultConfig-                    { presentation = Groups (diffStyle opts)-                    , selectBenchmarks = selectBench opts-                    , selectFields = filter-                        ( flip elem (fmap (fmap toLower) fs)-                        . fmap toLower-                        )-                    }-            in case btype of-                Just (Compare str) ->-                    showComparisons opts cfg-                        { title = Just str }-                        ("charts/" ++ str ++ "/results.csv")-                        ("charts/" ++ str)-                Just (Standard str) ->-                    benchShow opts cfg-                        { title = Just str }-                        (makeGraphs str)-                        ("charts/" ++ str ++ "/results.csv")-                        ("charts/" ++ str)-                Nothing ->-                    error "Please specify a benchmark using --benchmark."
− benchmark/bench-report/bench-report.cabal 
@@ -1,23 +0,0 @@-cabal-version:      2.2-name:               bench-report-version:            0.0.0-synopsis:           Benchmark report generation-description: Benchmark reporting application is not included in the overall-  cabal project so that the dependencies of both can remain independent.-  Benchmark reporting has a lot of dependencies that usually lag behind-  when new GHC releases arrive.------------------------------------------------------------------------------------ benchmark comparison and presentation----------------------------------------------------------------------------------executable bench-report-  default-language: Haskell2010-  ghc-options: -Wall-  hs-source-dirs: .-  main-is: BenchReport.hs-  buildable: True-  build-Depends:-      base >= 4.9 && < 4.17-    , bench-show >= 0.3.2 && < 0.4-    , transformers >= 0.4  && < 0.6
− benchmark/bench-report/bin/bench-runner.sh 
@@ -1,685 +0,0 @@-#!/usr/bin/env bash--# Note that this script is used in the "streamly" package as well as-# in "streaming-benchmarks" package. Any changes to the script should be-# generic enough so that it works in both the cases.--#--------------------------------------------------------------------------------set -o pipefail--SCRIPT_DIR=$(cd `dirname $0`; pwd)--RUNNING_BENCHMARKS=y-source $SCRIPT_DIR/build-lib.sh--print_help () {-  echo "Usage: $0 "-  echo "       [--benchmarks <"bench1 bench2 ..." | help>]"-  echo "       [--prefix <benchmark name prefix to match>"-  echo "       [--fields <"field1 field2 ..." | help>]"-  echo "       [--sort-by-name]"-  echo "       [--compare]"-  echo "       [--diff-style <absolute|percent|multiples>]"-  echo "       [--diff-cutoff-percent <percent-value>]"-  echo "       [--graphs]"-  echo "       [--silent]"-  echo "       [--no-measure]"-  echo "       [--append]"-  echo "       [--long]"-  echo "       [--slow]"-  echo "       [--quick]"-  echo "       [--raw]"-  echo "       [--dev-build]"-  echo "       [--use-nix]"-  echo "       [--with-compiler <compiler exe name>]"-  echo "       [--cabal-build-options <options>]"-  echo "       [--rtsopts <opts>]"-  #echo "       [--commit-compare] [--base <commit>] [--candidate <commit>]"-  #echo "       -- <gauge options or benchmarks>"-  echo-  echo "--benchmarks: benchmarks to run, use 'help' for list of benchmarks"-  echo "--compare: compare the specified benchmarks with each other"--  echo "--diff-cutoff-percent: Diff percentage used for benchmark selection."-  echo "This applies only to the second column of the report and makes sense"-  echo "only while comparing benchmarks."-  echo "A positive cutoff value selects only regressions, whereas, a negative"-  echo "cutoff value selects only improvements."--  echo "--fields: measurement fields to report, use 'help' for a list"-  echo "--graphs: Generate graphical reports"-  echo "--no-measure: Don't run benchmarks, run reports from previous results"-  echo "--append: Don't overwrite previous results, append for comparison"-  echo "--long: Use much longer stream size for infinite stream benchmarks"-  echo "--slow: Slightly more accurate results at the expense of speed"-  echo "--quick: Faster results, useful for longer benchmarks"-  echo "--raw: Run the benchmarks but don't report them. This is useful when"-  echo "       you only want to work with the csv files generated."-  echo "--cabal-build-options: Pass any cabal build options to be used for build"-  echo "       e.g. --cabal-build-options \"--flag dev\""-  echo-  echo "When specific space complexity group is chosen then (and only then) "-  echo "RTS memory restrictions are used accordingly. For example, "-  echo "bench.sh --benchmarks Data.Parser -- Data.Parser/o-1-space "-  echo "restricts Heap/Stack space for O(1) characterstics"-  echo-  #echo "When using --commit-compare, by default comparative chart of HEAD^ vs HEAD"-  #echo "commit is generated, in the 'charts' directory."-  #echo "Use --base and --candidate to select the commits to compare."-  #echo-  #echo "Any arguments after a '--' are passed directly to gauge"-  exit-}--#------------------------------------------------------------------------------# Reporting utility functions-#-------------------------------------------------------------------------------list_comparisons ()  {-  echo "Comparison groups:"-  for i in $COMPARISONS-  do-    echo -n "$i ["-    eval "echo -n \$$i"-    echo "]"-  done-  echo-}--build_report_prog() {-    local prog_path=$BENCH_REPORT_DIR/bin/bench-report--    hash -r-    if test ! -x "$prog_path" -a "$BUILD_ONCE" = "0"-    then-      echo "Building bench-report executables"-      BUILD_ONCE=1-      pushd $BENCH_REPORT_DIR-      local cmd-      cmd="$CABAL_EXECUTABLE install --installdir bin bench-report"-      if test "$USE_NIX" -eq 0-      then-        $cmd || die "bench-report build failed"-      else-        nix-shell --run "$cmd" || die "bench-report build failed"-      fi-      popd-    elif test ! -x "$prog_path"-    then-      return 1-    fi-    return 0-}--build_report_progs() {-  if test "$RAW" = "0"-  then-      build_report_prog || exit 1-      local prog-      prog=$BENCH_REPORT_DIR/bin/bench-report-      test -x $prog || die "Cannot find bench-report executable"-      echo "Using bench-report executable [$prog]"-  fi-}--# We run the benchmarks in isolation in a separate process so that different-# benchmarks do not interfere with other. To enable that we need to pass the-# benchmark exe path to gauge as an argument. Unfortunately it cannot find its-# own path currently.--# The path is dependent on the architecture and cabal version.--bench_output_file() {-    local bench_name=$1-    echo "charts/$bench_name/results.csv"-}--#-------------------------------------------------------------------------------# Speed options-#--------------------------------------------------------------------------------# tasty-bench does not like an option set twice-set_super_quick_mode () {-    echo -n super_quick-}--# For certain long benchmarks if the user has not requested super quick-# mode we anyway use a slightly quicker mode.-use_quicker_mode () {-  if test "$QUICK_MODE" -eq 0-  then-    echo quicker-  fi-}--#-------------------------------------------------------------------------------# Determine options from benchmark name-#--------------------------------------------------------------------------------# Global environment passed:-# BENCH_EXEC_PATH: the benchmark executable-# RTS_OPTIONS: additional RTS options-# QUICK_MODE: whether we are in quick mode-# USE_GAUGE: whether to use gauge or tasty-bench-# LONG: whether to use a large stream size--# $1: bench name-bench_exec_one() {-  local BENCH_NAME_ORIG-  BENCH_NAME_ORIG="$1"-  shift--  local SUPER_QUICK_OPTIONS-  local QUICKER_OPTIONS-  if test "$USE_GAUGE" -eq 0-  then-    SUPER_QUICK_OPTIONS="--stdev 1000000"-    QUICKER_OPTIONS="--stdev 100"-  else-    # Do not keep time limit as 0 otherwise GC stats may remain 0 in some cases.-    SUPER_QUICK_OPTIONS="--quick --min-duration 0 --time-limit 0.01 --include-first-iter"-    QUICKER_OPTIONS="--min-samples 3 --time-limit 1"-  fi--  local BENCH_NAME0-  local BENCH_NAME1-  local BENCH_NAME2-  local BENCH_NAME-  # XXX this is a hack to make the "/" separated names used in the functions-  # determining options based on benchmark name. For tasty-bench the benchmark-  # names are separated by "." instead of "/" and are prefixed by "All".-  #-  # For example, All.Prelude.Serial/x.y.z => Prelude.Serial/x/y/z-  if test "$USE_GAUGE" -eq 0-  then-    # Remove the prefix "All."-    BENCH_NAME0=$(echo $BENCH_NAME_ORIG | sed -e s/^All\.//)--    # Module names could contain dots e.g. "Prelude.Serial". So we insert-    # an explicit "/" to separate the module name part and the rest of-    # the benchmark name. For example, Prelude.Serial/elimination.drain-    BENCH_NAME1=$(echo $BENCH_NAME0 | cut -f1 -d '/')--    if test "$BENCH_NAME1" = "$BENCH_NAME0"-    then-      # There is no "/" separator-      BENCH_NAME1=$(echo $BENCH_NAME0 | sed -e 's/\./\//g')-      BENCH_NAME2=""-    else-      BENCH_NAME2=/$(echo $BENCH_NAME0 | cut -f2- -d '/' | sed -e 's/\./\//g')-    fi-    BENCH_NAME="${BENCH_NAME1}${BENCH_NAME2}"-  else-    BENCH_NAME=$BENCH_NAME_ORIG-  fi--  local RTS_OPTIONS1-  RTS_OPTIONS1="\-+RTS -T \-$(bench_rts_options $(basename $BENCH_EXEC_PATH) $BENCH_NAME) \-$RTS_OPTIONS \--RTS"--  local QUICK_MODE_TYPE-  QUICK_MODE_TYPE="\-  $(if test "$QUICK_MODE" -ne 0; then set_super_quick_mode; fi) \-  $(bench_speed_options $(basename $BENCH_EXEC_PATH) $BENCH_NAME)"--  local QUICK_BENCH_OPTIONS-  for i in $QUICK_MODE_TYPE-  do-    case "$i" in-      super_quick) QUICK_BENCH_OPTIONS="$SUPER_QUICK_OPTIONS"; break ;;-      quicker) QUICK_BENCH_OPTIONS="$QUICKER_OPTIONS"; break ;;-    esac-  done--  local STREAM_SIZE-  local STREAM_LEN-  local STREAM_SIZE_OPT-  if test "$LONG" -ne 0-  then-    STREAM_SIZE=10000000-    STREAM_LEN=$(env LC_ALL=en_US.UTF-8 printf "--stream-size %'.f\n" $STREAM_SIZE)-    STREAM_SIZE_OPT="--stream-size $STREAM_SIZE"-  fi--  echo "$BENCH_NAME_ORIG: \-  $RTS_OPTIONS1 \-  $STREAM_LEN \-  $QUICK_BENCH_OPTIONS" \-  "$@"--  #-------------------------------------------------------------------------------  # Run benchmark with options and collect results-  #--------------------------------------------------------------------------------  local output_file-  output_file=$(bench_output_file $(basename $BENCH_EXEC_PATH))-  mkdir -p `dirname $output_file`-  rm -f ${output_file}.tmp--  local BENCH_NAME_ESC-  if test $USE_GAUGE -eq 0-  then-    # Escape "\" and double quotes in benchmark names-    BENCH_NAME_ESC=$(echo "$BENCH_NAME_ORIG" | sed -e 's/\\/\\\\/g' | sed -e 's/"/\\"/g')-    $BENCH_EXEC_PATH \-      -j 1 \-      $RTS_OPTIONS1 \-      $STREAM_SIZE_OPT \-      $QUICK_BENCH_OPTIONS \-      "$@" \-      --csv=${output_file}.tmp \-      -p '$0 == "'"$BENCH_NAME_ESC"'"' || die "Benchmark execution failed."--    # Convert cpuTime field from picoseconds to seconds-    awk --version 2>&1 | grep -q "GNU Awk" \-      || die "Need GNU awk. [$(which awk)] is not GNU awk."-    tail -n +2 ${output_file}.tmp | \-      awk 'BEGIN {FPAT = "([^,]+)|(\"[^\"]+\")";OFS=","} {$2=$2/1000000000000;print}' \-      >> $output_file-  else-    $BENCH_EXEC_PATH \-      $RTS_OPTIONS1 \-      $STREAM_SIZE_OPT \-      $QUICK_BENCH_OPTIONS \-      "$@" \-      --csvraw=${output_file}.tmp \-      -m exact "$BENCH_NAME" || die "Benchmark execution failed."-    tail -n +2 ${output_file}.tmp \-      >> $output_file-  fi-}--invoke_gauge () {-    local target_prog="$1"-    local target_name="$2"-    local output_file="$3"--    local MATCH=""-    if test "$LONG" -ne 0-    then-      MATCH="$target_name/o-1-space"-    else-      MATCH="$BENCH_PREFIX"-    fi-    echo "name,iters,time,cycles,cpuTime,utime,stime,maxrss,minflt,majflt,nvcsw,nivcsw,allocated,numGcs,bytesCopied,mutatorWallSeconds,mutatorCpuSeconds,gcWallSeconds,gcCpuSeconds" >> $output_file-    # keep only benchmark names with shortest prefix e.g. "a/b/c" and "a/b", we-    # should only keep "a/b" otherwise benchmarks will run multiple times. why?-    $target_prog -l \-      | grep "^$MATCH" \-      | while read -r name; \-  do bench_exec_one "$name" "${GAUGE_ARGS[@]}" || exit 1; done \-      || die "Benchmark execution failed."-}--invoke_tasty_bench () {-    local target_prog="$1"-    local target_name="$2"-    local output_file="$3"--    local MATCH=""-    if test "$LONG" -ne 0-    then-      MATCH="-p /$target_name\/o-1-space/"-    else-        if test -n "$BENCH_PREFIX"-        then-          # escape "/"-          local escaped_name=$(echo "$BENCH_PREFIX" | sed -e 's/\//\\\//g')-          MATCH="-p /$escaped_name/"-        fi-    fi-    echo "Name,cpuTime,2*Stdev (ps),Allocated,bytesCopied,maxrss" >> $output_file-    $target_prog -l $MATCH \-      | grep "^All" \-      | while read -r name; \-          do bench_exec_one "$name" "${GAUGE_ARGS[@]}" || exit 1; done \-      || die "Benchmark execution failed."-}--run_bench_target () {-  local package_name=$1-  local component=$2-  local target_name=$3--  local target_prog-  if test -z "$BENCHMARK_PACKAGE_VERSION"-  then-    echo "Please set BENCHMARK_PACKAGE_VERSION in bench_config"-    exit 1-  fi-  target_prog=$(cabal_target_prog $package_name-$BENCHMARK_PACKAGE_VERSION $component $target_name) || \-    die "Cannot find executable for target $target_name"--  echo "Running executable $target_name ..."--  # Needed by bench_exec_one-  BENCH_EXEC_PATH=$target_prog--  local output_file=$(bench_output_file $target_name)-  mkdir -p `dirname $output_file`-  if test "$USE_GAUGE" -eq 0-  then invoke_tasty_bench "$target_prog" "$target_name" "$output_file"-  else invoke_gauge "$target_prog" "$target_name" "$output_file"-  fi-}--# $1: package name-# $2: component-# $3: targets-run_bench_targets() {-    for i in $3-    do-      run_bench_target $1 $2 $i-    done-}--run_benches_comparing() {-    local bench_list=$1--    if test -z "$CANDIDATE"-    then-      CANDIDATE=$(git rev-parse HEAD)-    fi-    if test -z "$BASE"-    then-      # XXX Should be where the current branch is forked from master-      BASE="$CANDIDATE^"-    fi-    echo "Comparing baseline commit [$BASE] with candidate [$CANDIDATE]"-    echo "Checking out base commit [$BASE] for benchmarking"-    # XXX git checkout will overwrite this script itself and the scripts-    # imported/used by this script.-    git checkout "$BASE" || die "Checkout of base commit [$BASE] failed"--    # $BUILD_BENCH || die "build failed"-    run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"-    run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args--    echo "Checking out candidate commit [$CANDIDATE] for benchmarking"-    git checkout "$CANDIDATE" || \-        die "Checkout of candidate [$CANDIDATE] commit failed"--    # $BUILD_BENCH || die "build failed"-    run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"-    run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args-    # XXX reset back to the original commit-}--backup_output_file() {-  local bench_name=$1-  local output_file=$(bench_output_file $bench_name)--  if test -e $output_file -a "$APPEND" != 1-  then-      mv -f -v $output_file ${output_file}.prev-  fi-}--run_measurements() {-  local bench_list=$1--  for i in $bench_list-  do-      backup_output_file $i-  done--  if test "$COMMIT_COMPARE" = "0"-  then-    run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"-    run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args-  else-    run_benches_comparing "$bench_list"-  fi-}--run_reports() {-    local prog-    prog=$BENCH_REPORT_DIR/bin/bench-report-    test -x $prog || die "Cannot find bench-report executable"-    test -z "$SILENT" && echo--    for i in $1-    do-        test -z "$SILENT" && echo "Generating reports for ${i}..."-        $prog \-            --benchmark $i \-            $(test "$USE_GAUGE" = 1 && echo "--use-gauge") \-            $(test "$GRAPH" = 1 && echo "--graphs") \-            $(test "$SORT_BY_NAME" = 1 && echo "--sort-by-name") \-            $(test -n "$BENCH_DIFF_STYLE" && echo "--diff-style $BENCH_DIFF_STYLE") \-            $(test -n "$BENCH_CUTOFF_PERCENT" && echo "--diff-cutoff-percent $BENCH_CUTOFF_PERCENT") \-            --fields "$FIELDS"-    done-}--#------------------------------------------------------------------------------# Execution starts here-#-------------------------------------------------------------------------------USE_GIT_CABAL=1 # This is used by set_common_vars-set_common_vars--USE_NIX=0-COMPARE=0-COMMIT_COMPARE=0-BASE=-CANDIDATE=--APPEND=0-LONG=0-RAW=0-SORT_BY_NAME=0-GRAPH=0-MEASURE=1--GAUGE_ARGS=-BUILD_ONCE=0--CABAL_BUILD_OPTIONS="--flag fusion-plugin --flag limit-build-mem"--#------------------------------------------------------------------------------# Read command line-#-------------------------------------------------------------------------------while test -n "$1"-do-  case $1 in-    -h|--help|help) print_help ;;-    # options with arguments-    --benchmarks) shift; TARGETS=$1; shift ;;-    --targets) shift; TARGETS=$1; shift ;;-    --prefix) shift; BENCH_PREFIX="$1"; shift ;;-    --fields) shift; FIELDS=$1; shift ;;-    --base) shift; BASE=$1; shift ;;-    --candidate) shift; CANDIDATE=$1; shift ;;-    --with-compiler) shift; CABAL_WITH_COMPILER=$1; shift ;;-    --cabal-build-flags) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;-    --cabal-build-options) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;-    --rtsopts) shift; RTS_OPTIONS=$1; shift ;;-    --config) shift; BENCH_CONFIG_FILE=$1; shift ;;-    --diff-style) shift; BENCH_DIFF_STYLE=$1; shift ;;-    --diff-cutoff-percent) shift; BENCH_CUTOFF_PERCENT=$1; shift ;;-    # flags-    --slow) SLOW=1; shift ;;-    --silent) SILENT=1; shift ;;-    --quick) QUICK_MODE=1; shift ;;-    --compare) COMPARE=1; shift ;;-    --commit-compare) COMMIT_COMPARE=1; shift ;;-    --raw) RAW=1; shift ;;-    --append) APPEND=1; shift ;;-    --long) LONG=1; shift ;;-    --sort-by-name) SORT_BY_NAME=1; shift ;;-    --graphs) GRAPH=1; shift ;;-    --no-measure) MEASURE=0; shift ;;-    # This is used in build-lib.sh to enable dev_build function which is used-    # in targets.sh to enable or disable some targets.-    --dev-build) RUNNING_DEVBUILD=1; shift ;;-    --use-nix) USE_NIX=1; shift ;;-    --use-gauge) USE_GAUGE=1; shift ;;-    --) shift; break ;;-    *) echo "Unknown flags: $*"; echo; print_help ;;-  esac-done-GAUGE_ARGS=("$@")--if test -z "$BENCH_CONFIG_FILE"-then-  die "Please use --config to specify config file"-fi--source "$BENCH_CONFIG_FILE" || \-  die "Failed to source config file $BENCH_CONFIG_FILE"--# Defined in $BENCH_CONFIG_FILE-bench_config--if test -z "$FIELDS"-then-  FIELDS=$DEFAULT_FIELDS-fi--set_derived_vars--#------------------------------------------------------------------------------# Determine targets-#-------------------------------------------------------------------------------only_real_benchmarks () {-  for i in $TARGETS-  do-    local SKIP=0-    for j in $COMPARISONS-    do-      if test $i == $j-      then-        SKIP=1-      fi-    done-    if test "$SKIP" -eq 0-    then-      echo -n "$i "-    fi-  done-}--# defined in $BENCH_CONFIG_FILE-bench_targets--if test "$(has_item "$TARGETS" help)" = "help"-then-  list_target_groups-  list_comparisons-  list_targets-  exit-fi--COMMON_FIELDS="allocated bytescopied cputime maxrss"-if test "$USE_GAUGE" -eq 1-then-  ALL_FIELDS="$COMMON_FIELDS time cycles utime stime minflt majflt nvcsw nivcsw"-else-  ALL_FIELDS="$COMMON_FIELDS"-fi-if test "$(has_item "$FIELDS" help)" = "help"-then-  echo "Supported fields: $ALL_FIELDS"-  echo "Default fields: $DEFAULT_FIELDS"-  exit-fi--if test "$LONG" -ne 0-then-  if test -n "$TARGETS"-  then-    echo "Cannot specify benchmarks [$TARGETS] with --long"-    exit-  fi-  TARGETS=$infinite_grp-fi--DEFAULT_TARGETS="$(all_grp)"-TARGETS=$(set_targets)--TARGETS_ORIG=$TARGETS-TARGETS=$(only_real_benchmarks)--test -z "$SILENT" && echo "Using benchmark suites [$TARGETS]"--#------------------------------------------------------------------------------# Build reporting utility-#-------------------------------------------------------------------------------# We need to build the report progs first at the current (latest) commit before-# checking out any other commit for benchmarking.-if test -z "$SILENT"-then build_report_progs-else silently build_report_progs-fi--#------------------------------------------------------------------------------# Build and run targets-#-------------------------------------------------------------------------------if test "$USE_GAUGE" -eq 1-then-  BUILD_FLAGS="--flag use-gauge"-fi--BUILD_BENCH="$CABAL_EXECUTABLE v2-build $BUILD_FLAGS $CABAL_BUILD_OPTIONS --enable-benchmarks"-if test "$MEASURE" = "1"-then-  run_measurements "$TARGETS"-fi--#------------------------------------------------------------------------------# Run reports-#-------------------------------------------------------------------------------# $1: var name-build_comparison_results () {-    local name-    local constituents--    name=$1-    constituents=$(eval "echo -n \$${name}")-    mkdir -p "charts/$name"-    dest_file="charts/$name/results.csv"-    : > $dest_file-    for j in $constituents-    do-      cat "charts/$j/results.csv" >> $dest_file-    done-}--if test "$COMPARE" -eq 1-then-  DYN_CMP_GRP="$(echo "$TARGETS" | sed -e 's/ /_/g')_cmp"-  eval "$DYN_CMP_GRP=\"$TARGETS\""-  COMPARISON_REPORTS=$DYN_CMP_GRP-  build_comparison_results $DYN_CMP_GRP-else-  COMPARISON_REPORTS=""-fi--for i in $COMPARISONS-do-  if test "$(has_item "$TARGETS_ORIG" $i)" = $i-  then-    COMPARISON_REPORTS="$COMPARISON_REPORTS $i"-    build_comparison_results $i-  fi-done--if test "$RAW" = "0"-then-  run_reports "$TARGETS"-  run_reports "$COMPARISON_REPORTS"-  if test -n "$DYN_CMP_GRP"-  then-    rm -rf "charts/$DYN_CMP_GRP"-  fi-fi
− benchmark/bench-report/bin/build-lib.sh 
@@ -1,218 +0,0 @@-# $1: message-die () {-  >&2 echo -e "Error: $1"-  exit 1-}--warn () {-  >&2 echo -e "Warning: $1"-}--# $1: command-function run_verbose() {-  echo "$*"-  bash -c "$*"-}--has_item () {-  for i in $1-  do-    if test "$i" = "$2"-    then-      echo "$i"-      break-    fi-  done-}--# $1: command-silently () {-  eval "$1 &> /dev/null"-}--#-------------------------------------------------------------------------------# target groups-#--------------------------------------------------------------------------------test_only () {-  if test -n "$RUNNING_TESTS"-  then-    echo $1-  fi-}--bench_only () {-  if test -n "$RUNNING_BENCHMARKS"-  then-    echo $1-  fi-}--dev_build () {-  if test -n "$RUNNING_DEVBUILD"-  then-    echo $1-  fi-}--# A group consisting of all known individual targets-all_grp () {-  { for i in $GROUP_TARGETS-    do-      for j in $(eval "echo \$$i")-      do-        echo $j-      done-    done-    for i in $INDIVIDUAL_TARGETS-    do-      echo $i-    done-  } | sort | uniq-}--# All groups-all_target_groups () {-  echo $GROUP_TARGETS-}--# XXX pass as arg-list_targets ()  {-  echo "Individual targets:"-  for i in $(all_grp)-  do-    echo "$i"-  done-  echo-}--# XXX pass as arg-list_target_groups ()  {-  echo "All Targets: all_grp"-  echo "Target groups:"-  for i in $(all_target_groups)-  do-    echo -n "$i ["-    eval "echo -n \$$i"-    echo "]"-  done-  echo-}--# XXX pass as arg-set_targets() {-  if test -z "$TARGETS"-  then-    echo $DEFAULT_TARGETS-  else-    for i in $(echo $TARGETS)-    do-        case $i in-          *_grp) eval "echo -n \$${i}" ;;-          *_cmp) eval "echo -n \$${i} $i" ;;-          *) echo -n $i ;;-        esac-        echo -n " "-    done-  fi-}--# XXX cabal issue "cabal v2-exec which" cannot find benchmark/test executables--# $1: builddir-# $2: package name with version-# $3: component ("" (lib), t (test), b (benchmark), x (executable))-# $4: command to find-cabal_which_builddir() {-  local noopt=""-  if test "$TEST_QUICK_MODE" = "1"-  then-    noopt="/noopt"-  fi--  local path=$(echo $1/build/*/ghc-${GHC_VERSION}/${2}/$3/$4$noopt/build/$4/$4)-  echo "[cabal_which $path]" 1>&2-  test -f "$path" && echo $path-}--# $1: package name with version-# $2: component-# $3: command to find-cabal_which() {-  cabal_which_builddir $BUILD_DIR $1 $2 $3-}--# We run the benchmarks in isolation in a separate process so that different-# benchmarks do not interfere with other. To enable that we need to pass the-# benchmark exe path to gauge as an argument. Unfortunately it cannot find its-# own path currently.--# The path is dependent on the architecture and cabal version.--# $1: package name with version-# $2: component-# $3: target-cabal_target_prog () {-  local target_prog=`cabal_which $1 $2 $3`-  if test -x "$target_prog"-  then-    echo $target_prog-  else-    return 1-  fi-}--set_common_vars () {-  SLOW=0-  QUICK_MODE=0--  RUNNING_DEVBUILD=--  TARGET_EXE_ARGS=-  RTS_OPTIONS=--  CABAL_BUILD_OPTIONS=""-  CABAL_EXECUTABLE=cabal--  # Use branch specific builds if git-cabal is present in PATH-  BUILD_DIR=dist-newstyle-  if test "$USE_GIT_CABAL" -eq 1-  then-    if which git-cabal 2>/dev/null-    then-        echo "Using git-cabal for branch specific builds"-        CABAL_EXECUTABLE=git-cabal-        BUILD_DIR=$(git-cabal show-builddir)-      fi-  fi-}--# To be called after parsing CLI arguments-set_derived_vars () {-  if test -n "$CABAL_WITH_COMPILER"-  then-    CABAL_BUILD_OPTIONS+=" --with-compiler $CABAL_WITH_COMPILER"-  else-    CABAL_WITH_COMPILER=ghc-  fi--  GHC_VERSION=$($CABAL_WITH_COMPILER --numeric-version)-}--# $1: build program-# $2: package name-# $3: component prefix-# $4: targets-run_build () {-  local build_prog=$1-  local package=$2-  local component_prefix=$3-  local COMPONENTS-  local c--  for c in $4-  do-    COMPONENTS+="$package:$component_prefix:$c "-  done-  run_verbose $build_prog $COMPONENTS || die "build failed"-}
− benchmark/bench-report/cabal.project 
@@ -1,1 +0,0 @@-packages: .
+ benchmark/bench-runner/Main.hs view
@@ -0,0 +1,180 @@+module Main (main) where++import BenchRunner (mainWith)+import BuildLib (Quickness(..))+import Control.Applicative ((<|>))+import Data.List (isInfixOf, isPrefixOf, isSuffixOf)++import Targets (targets)++rtsOpts :: String -> String -> String+rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific]++    where++    -- Drop All.+    benchName = drop 4 benchName0++    general+        -- GHC-9.6 requires 32M heap vs 16M for GHC-9.4+        | "o-1-sp" `isInfixOf` benchName = "-K36K -M32M"+        | "o-n-h" `isInfixOf` benchName = "-K36K -M32M"+        -- GHC-9.6 requires 32M heap vs 16M for GHC-9.4+        | "o-n-st" `isInfixOf` benchName = "-K1M -M32M"+        | "o-n-sp" `isInfixOf` benchName = "-K1M -M32M"+        | otherwise = ""++    exeSpecific+        | "Prelude.Concurrent" `isSuffixOf` exeName = "-K512K -M384M"+        | otherwise = ""++    benchSpecific+        -- GHC-9.6 requires 64M, earlier it was 16M+        | "Data.Fold/o-n-heap.key-value.toHashMapIO (max buckets) sum" == benchName =+            "-M64M"++        -- This is required only for the --long case because we allocate all+        -- the arrays upfront. depends on the size of the stream.+        | "Data.Parser/o-1-space" `isPrefixOf` benchName =+            "-M128M"++        -----------------------------------------------------------------------++        | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName = "-M256M"+        | "Prelude.Parallel/o-n-heap.monad-outer-product."+             `isPrefixOf` benchName = "-M256M"+        | "Prelude.Parallel/o-n-space.monad-outer-product."+             `isPrefixOf` benchName = "-K2M -M256M"+        | "Prelude.Rate/o-1-space." `isPrefixOf` benchName = "-K128K"+        | "Prelude.Rate/o-1-space.asyncly." `isPrefixOf` benchName = "-K128K"+        | "Prelude.WSerial/o-n-space." `isPrefixOf` benchName = "-K4M"+        | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =+            "-K4M"+        | "Prelude.Ahead/o-1-space.monad-outer-product." `isPrefixOf` benchName =+            "-K128K -M32M"+        | "Prelude.Ahead/o-1-space." `isPrefixOf` benchName = "-K128K"+        | "Prelude.Ahead/o-n-space.monad-outer-product." `isPrefixOf` benchName =+            "-K4M"+        | "Prelude.WAsync/o-n-heap.monad-outer-product.toNull3" == benchName =+            "-M64M"+        | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =+            "-K4M"++        -----------------------------------------------------------------------++        | "Data.StreamD/o-n-space.elimination.toList" == benchName =+            "-K2M"+        | "Data.StreamK/o-n-space.elimination.toList" == benchName =+            "-K2M"+        -- XXX Memory required for these has increased in streamly-core 0.3+        | "Data.StreamK/o-1-space.list.nested" `isPrefixOf` benchName =+            "-M640M"++        -----------------------------------------------------------------------++        | "Data.Stream/o-1-space.grouping.classifySessionsOf"+            `isPrefixOf` benchName = "-K512K"+        | "Data.Stream/o-n-space.foldr.foldrM/"+            `isPrefixOf` benchName = "-K4M"+        | "Data.Stream/o-n-space.iterated."+            `isPrefixOf` benchName = "-K4M"++        -- GHC-9.6 requires 64M, earlier it was 32M+        | "Data.Stream/o-n-heap.buffered.showPrec Haskell lists" == benchName =+            "-M64M"+        -- GHC-9.6 requires 64M, earlier it was 32M+        | "Data.Stream/o-n-heap.buffered.readsPrec pure streams" == benchName =+            "-M64M"++        | "Data.Stream.ConcurrentEager/o-n-heap.monad-outer-product.toNullAp"+            `isPrefixOf` benchName = "-M1500M"+        | "Data.Stream.ConcurrentEager/o-1-space."+            `isPrefixOf` benchName = "-M128M"++        | "Data.Stream.ConcurrentOrdered/o-1-space.concat-foldable.foldMapWith"+            `isPrefixOf` benchName = "-K128K"++        ----------------------------------------------------------------------++        | "Data.Array" `isPrefixOf` benchName+             && "/o-1-space.generation.read" `isSuffixOf` benchName = "-M32M"+        -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M+        | "Data.Array" `isPrefixOf` benchName+             && "/o-1-space.generation.show" `isSuffixOf` benchName = "-M64M"+        -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M+        | "Data.Array.Generic/o-1-space.transformationX4.map"+            `isPrefixOf` benchName = "-M64M"++        -- XXX For --long option, need to check why so much heap is required.+        -- Note, if we remove the chunked stream module we need to keep the+        -- chunked stream benchmarks in the stream module.+        | "Data.Array.Stream/o-1-space"+            `isPrefixOf` benchName = "-K4M -M512M"+        -- XXX Takes up to 160MB heap for --long, we use chunked stream for+        -- this, so the reason may be related to chunked streams.+        | "Data.ParserK/o-1-space"+            `isPrefixOf` benchName = "-K4M -M256M"+        | "Data.ParserK.Chunked/o-1-space"+            `isPrefixOf` benchName = "-K4M -M256M"+        | "Data.ParserK.Chunked.Generic/o-1-space"+            `isPrefixOf` benchName = "-K4M -M256M"++{-+        -- XXX This options does not seem to take effect. "ParserK.Chunked"+        -- needs more memory to work with --long option+        | "Data.ParserK.Chunked.Generic/o-1-space"+            `isPrefixOf` benchName = "-K4M -M256M"+-}++        -----------------------------------------------------------------------++        | "Unicode.Char/o-1-space." `isPrefixOf` benchName = "-M32M"++        | otherwise = ""++speedOpts :: String -> String -> Maybe Quickness+speedOpts exeName benchName0 = exeSpecific <|> benchSpecific++    where++    -- slowestOf Quicker _ = Quicker+    -- slowestOf _ Quicker = Quicker+    -- slowestOf _ _ = SuperQuick++    -- Drop All.+    benchName = drop 4 benchName0+    exeSpecific+        | "Prelude.Concurrent" == exeName = Just SuperQuick+        | "Prelude.Rate" == exeName = Just SuperQuick+        | "Prelude.Adaptive" == exeName = Just SuperQuick+        | otherwise = Nothing+    benchSpecific+        | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName =+            Just SuperQuick+        | "Prelude.Parallel/o-n-heap.monad-outer-product."+             `isPrefixOf` benchName = Just SuperQuick+        | "Prelude.Parallel.o-n-space.monad-outer-product."+             `isPrefixOf` benchName = Just SuperQuick+        | "Prelude.Parallel/o-n-heap.generation." `isPrefixOf` benchName =+            Just Quicker+        | "Prelude.Parallel/o-n-heap.mapping." `isPrefixOf` benchName =+            Just Quicker+        | "Prelude.Parallel/o-n-heap.concat-foldable." `isPrefixOf` benchName =+            Just Quicker+        | "Prelude.Async/o-1-space.monad-outer-product." `isPrefixOf` benchName =+            Just Quicker+        | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =+            Just Quicker+        | "Prelude.Ahead/o-1-space.monad-outer-product." `isPrefixOf` benchName =+            Just Quicker+        | "Prelude.Ahead/o-n-space.monad-outer-product." `isPrefixOf` benchName =+            Just Quicker+        | "Prelude.WAsync/o-n-heap.monad-outer-product." `isPrefixOf` benchName =+            Just Quicker+        | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =+            Just Quicker+        | "FileSystem.Handle." `isPrefixOf` benchName = Just Quicker+        | otherwise = Nothing++main :: IO ()+main = mainWith targets speedOpts rtsOpts
+ benchmark/bench-runner/bench-runner.cabal view
@@ -0,0 +1,42 @@+cabal-version:      2.4+name:               bench-runner+version:            0.1.0.0++-- A short (one-line) description of the package.+-- synopsis:++-- A longer description of the package.+-- description:++-- A URL where users can report bugs.+-- bug-reports:++-- The license under which the package is released.+-- license:++-- The package author(s).+-- author:++-- An email address to which users can send suggestions, bug reports, and patches.+-- maintainer:++-- A copyright notice.+-- copyright:+-- category:+-- extra-source-files: CHANGELOG.md++executable bench-runner+    ghc-options: -Wall+    main-is:          Main.hs++    -- Modules included in this executable, other than Main.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:+    build-depends:    base+                    , bench-report+                    , containers+                    , streamly-targets+    hs-source-dirs:   .+    default-language: Haskell2010
benchmark/lib/Streamly/Benchmark/Common.hs view
@@ -1,7 +1,5 @@ {-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -Wno-orphans #-}-#endif  -- | -- Module      : Streamly.Benchmark.Common@@ -55,10 +53,10 @@ import Data.Functor.Identity (Identity, runIdentity) import System.Random (randomRIO) -import qualified Streamly.Prelude as S+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as S -import Streamly.Prelude (SerialT)-import Gauge+import Test.Tasty.Bench  ------------------------------------------------------------------------------- -- Benchmark Prefixes@@ -80,10 +78,6 @@ -- Benchmarking utilities ------------------------------------------------------------------------------- -#if !MIN_VERSION_deepseq(1,4,3)-instance NFData Ordering where rnf = (`seq` ())-#endif- -- XXX once we convert all the functions to use this we can rename this to -- benchIOSink {-# INLINE benchIOSink1 #-}@@ -113,9 +107,13 @@     bench name $ nfIO $ randomRIO (1,1) >>= return . runIdentity . f  {-# INLINE benchPureSrc #-}-benchPureSrc :: String -> (Int -> SerialT Identity a) -> Benchmark-benchPureSrc name src = benchPure name src (runIdentity . S.drain)+benchPureSrc :: String -> (Int -> S.Stream Identity a) -> Benchmark+benchPureSrc name src = benchPure name src (runIdentity . drain) +    where++    drain = S.fold Fold.drain+ ------------------------------------------------------------------------------- -- String/List generation for read instances -------------------------------------------------------------------------------@@ -244,8 +242,9 @@     r <- alloc value     value `seq` runMode (mode cfg) cfg benches (mkBench r value) #else+    r0 <- alloc 0     (value, ingredients) <--        parseCLIOpts defStreamSize $ bgroup "All" (mkBench undefined 0)+        parseCLIOpts defStreamSize $ bgroup "All" (mkBench r0 0)     r <- alloc value     value `seq` defaultMainWithIngredients ingredients         $ bgroup "All" (mkBench r value)
benchmark/lib/Streamly/Benchmark/Common/Handle.hs view
@@ -30,11 +30,16 @@     , isSpace     , isSp     , mkHandleBenchEnv+    , Handles(..)+    , getHandles     ) where  import Control.DeepSeq (NFData(rnf)) import Data.Char (ord, chr)+#if MIN_VERSION_base(4,17,0)+import Data.Char (generalCategory, GeneralCategory(Space))+#endif import Data.Word (Word8) import System.Directory (getFileSize) import System.Environment (lookupEnv)@@ -43,7 +48,7 @@  import Data.IORef import Prelude hiding (last, length)-import Gauge hiding (env)+import Test.Tasty.Bench hiding (env)   scratchDir :: String@@ -140,8 +145,10 @@      useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh +#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 #-}@@ -154,7 +161,11 @@ -- so we'll do it like this until there's a way around that. 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
benchmark/lib/Streamly/Benchmark/Prelude.hs view
@@ -1,3 +1,4 @@+ -- | -- Module      : Streamly.Benchmark.Prelude -- Copyright   : (c) 2018 Composewell Technologies@@ -60,7 +61,7 @@     , transformComposeMapM     , transformMapM     , transformTeeMapM-    , transformZipMapM+    -- , transformZipMapM     ) where @@ -68,9 +69,6 @@ import Control.DeepSeq (NFData(..)) import Control.Exception (try) import Data.Functor.Identity (Identity)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup((<>)))-#endif import GHC.Exception (ErrorCall) import Prelude hiding (mapM) import System.Random (randomRIO)@@ -79,11 +77,11 @@ import qualified Data.List as List import qualified Streamly.Prelude  as S import qualified Streamly.Internal.Data.Stream.IsStream as Internal-import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream+import qualified Streamly.Internal.Data.Stream.IsStream as IsStream import qualified Streamly.Internal.Data.Pipe as Pipe import qualified Streamly.Internal.Data.Stream.Serial as Serial -import Gauge+import Test.Tasty.Bench import Streamly.Internal.Data.Time.Units  -- Common polymorphic stream APIs used across multiple stream modules@@ -319,9 +317,10 @@     composeN n $     t .     Internal.transform-        (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`+        (Pipe.mapM (\x -> return (x + 1)) `Pipe.teeMerge`          Pipe.mapM (\x -> return (x + 2))) +{- {-# INLINE transformZipMapM #-} transformZipMapM ::        (S.IsStream t, S.MonadAsync m)@@ -337,6 +336,7 @@              (+)              (Pipe.mapM (\x -> return (x + 1)))              (Pipe.mapM (\x -> return (x + 2))))+-}  ------------------------------------------------------------------------------- -- Streams of streams
benchmark/streamly-benchmarks.cabal view
@@ -54,18 +54,67 @@   manual: True   default: True -flag use-gauge-  description: Use gauge instead of tasty-bench for benchmarking+flag use-streamly-core+  description: Benchmark only core package   manual: True   default: False +flag use-prelude+  description: Use Prelude instead of Data.Stream for serial benchmarks+  manual: True+  default: False+ ------------------------------------------------------------------------------- -- Common stanzas ------------------------------------------------------------------------------- -common compile-options+common default-extensions     default-language: Haskell2010 +    -- GHC2024 may include more extensions than we are actually using, see the+    -- full list below. We enable this to ensure that we are able to compile+    -- with this i.e. there is no interference by other extensions.+    if impl(ghc >= 9.10)+      default-language: GHC2024++    if impl(ghc >= 9.2) && impl(ghc < 9.10)+      default-language: GHC2021++    if impl(ghc >= 8.10)+      default-extensions: StandaloneKindSignatures++    -- In GHC 2024+    default-extensions:+        BangPatterns+        ConstraintKinds+        DeriveDataTypeable+        DeriveGeneric+        DeriveTraversable+        ExistentialQuantification+        FlexibleContexts+        FlexibleInstances+        GeneralizedNewtypeDeriving+        InstanceSigs+        KindSignatures+        LambdaCase+        MultiParamTypeClasses+        RankNTypes+        ScopedTypeVariables+        TupleSections+        TypeApplications+        TypeOperators++        -- Not in GHC2024+        CPP+        MagicHash+        RecordWildCards++common compile-options+    import: default-extensions++    if flag(use-streamly-core)+      cpp-options:    -DUSE_STREAMLY_CORE+     if flag(dev)       cpp-options:    -DDEVBUILD @@ -75,17 +124,30 @@     if flag(inspection)       cpp-options:    -DINSPECTION -    ghc-options:      -Wall-                      -Wcompat-                      -Wunrecognised-warning-flags-                      -Widentities-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wredundant-constraints-                      -Wnoncanonical-monad-instances-                      -Rghc-timing-                      -Wmissing-export-lists+    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+                    -Wno-unused-packages+                    -Rghc-timing +    if impl(ghc >= 9.2)+      ghc-options:+        -Wno-missing-kind-signatures+        -Wno-operator-whitespace++    if impl(ghc >= 9.8)+      ghc-options:+        -Wno-missing-role-annotations+     if flag(has-llvm)       ghc-options: -fllvm @@ -93,15 +155,17 @@       ghc-options:    -Wmissed-specialisations                       -Wall-missed-specialisations -    if flag(dev) || flag(debug)-      ghc-options:    -fno-ignore-asserts- 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)+      ghc-options: -fno-ignore-asserts+     if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)       ghc-options: -fplugin Fusion.Plugin   else@@ -115,37 +179,36 @@     -- Core libraries shipped with ghc, the min and max     -- constraints of these libraries should match with     -- the GHC versions we support-      base                >= 4.9   && < 4.17-    , deepseq             >= 1.4.1 && < 1.5-    , mtl                 >= 2.2   && < 2.3+      base                >= 4.9   && < 4.23+    , deepseq             >= 1.4.1 && < 1.6+    , mtl                 >= 2.2   && < 2.4      -- other libraries-    , streamly+    , exceptions >= 0.8   && < 0.11     , random              >= 1.0   && < 2.0     , transformers        >= 0.4   && < 0.7-    , containers          >= 0.5   && < 0.7+    , containers          >= 0.5   && < 0.9+    , hashable            >= 1.3   && < 1.6+    , unordered-containers >= 0.2 && < 0.3     , process             >= 1.4 && < 1.7     , directory         >= 1.2.2 && < 1.4-    , filepath          >= 1.4.1 && < 1.5-    , ghc-prim          >= 0.4   && < 0.9+    , filepath          >= 1.4.1 && < 1.6+    , ghc-prim          >= 0.4   && < 0.14+    , tasty-bench       >= 0.3   && < 0.6+    , tasty             >= 1.4.1 && < 1.6+    , streamly-core -  if flag(use-gauge)-    build-depends:  gauge >= 0.2.4 && < 0.3-  else-    build-depends:    tasty-bench >= 0.3 && < 0.4-                    , tasty     >= 1.4.1 && < 1.5-    mixins: tasty-bench-      (Test.Tasty.Bench as Gauge-      , Test.Tasty.Bench as Gauge.Main-      )+  if !flag(use-streamly-core)+    build-depends:+          streamly+        , bench-test-lib    if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)     build-depends:         fusion-plugin     >= 0.2   && < 0.3   if flag(inspection)-    build-depends:     template-haskell   >= 2.14  && < 2.17-                     , inspection-testing >= 0.4   && < 0.5-                     , ghc-prim           >= 0.2   && < 0.9+    build-depends:     template-haskell   >= 2.14  && < 2.25+                     , inspection-testing >= 0.4   && < 0.7   -- Array uses a Storable constraint in dev build making several inspection   -- tests fail   if flag(dev) && flag(inspection)@@ -159,9 +222,11 @@     import: lib-options, bench-depends     hs-source-dirs: lib     exposed-modules: Streamly.Benchmark.Common-                   , Streamly.Benchmark.Common.Handle-                   , Streamly.Benchmark.Prelude+                    , Streamly.Benchmark.Common.Handle+    if flag(use-prelude)+      exposed-modules: Streamly.Benchmark.Prelude + ------------------------------------------------------------------------------- -- Benchmarks -------------------------------------------------------------------------------@@ -169,7 +234,7 @@ common bench-options   import: compile-options, optimization-options, bench-depends   include-dirs: .-  ghc-options: -rtsopts+  ghc-options: -rtsopts -with-rtsopts "-t"   if flag(limit-build-mem)     ghc-options: +RTS -M512M -RTS   build-depends: streamly-benchmarks == 0.0.0@@ -179,337 +244,359 @@   import: compile-options, optimization-options, bench-depends   -- -threaded and -N2 is important because some GC and space leak issues   -- trigger only with these options.-  ghc-options: -threaded -rtsopts -with-rtsopts "-N2"+  ghc-options: -threaded -rtsopts -with-rtsopts "-t -N2"   if flag(limit-build-mem)     ghc-options: +RTS -M512M -RTS   build-depends: streamly-benchmarks == 0.0.0  ---------------------------------------------------------------------------------- Serial Streams+-- Listed in alphabetical order ------------------------------------------------------------------------------- -benchmark Prelude.Serial+benchmark Data.Array   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: Serial.hs+  hs-source-dirs: ., Streamly/Benchmark/Data+  main-is: Streamly/Benchmark/Data/Array.hs   other-modules:-        Serial.Generation-      , Serial.Elimination-      , Serial.Transformation-      , Serial.NestedStream-      , Serial.NestedFold-      , Serial.Split-      , Serial.Exceptions-      , Serial.Lift-  if impl(ghcjs)+      Stream.Common+  if flag(use-streamly-core)     buildable: False   else     buildable: True   if flag(limit-build-mem)-    if flag(dev)-      ghc-options: +RTS -M3500M -RTS-    else-      ghc-options: +RTS -M2000M -RTS-+    ghc-options: +RTS -M1500M -RTS -benchmark Prelude.WSerial+benchmark Data.Array.Generic   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: WSerial.hs-  if impl(ghcjs)+  hs-source-dirs: ., Streamly/Benchmark/Data+  main-is: Streamly/Benchmark/Data/Array/Generic.hs+  other-modules:+      Stream.Common+  if flag(use-streamly-core)     buildable: False   else     buildable: True   if flag(limit-build-mem)-    ghc-options: +RTS -M750M -RTS+    ghc-options: +RTS -M1000M -RTS -benchmark Prelude.Merge+benchmark Data.Array.Stream   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: Merge.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Data/Array+  main-is: Stream.hs+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True+    build-depends: exceptions >= 0.8   && < 0.11 -benchmark Prelude.ZipSerial+benchmark Data.Fold   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: ZipSerial.hs+  hs-source-dirs: Streamly/Benchmark/Data+  main-is: Fold.hs   if impl(ghcjs)     buildable: False   else     buildable: True -benchmark Prelude.ZipAsync+benchmark Data.Fold.Prelude   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: ZipAsync.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Data/Fold+  -- XXX Using the name Prelude.hs causes compilation error+  main-is: Prelood.hs+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True++benchmark Data.Fold.Window+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Fold+  main-is: Window.hs+  -- MonoLocalBinds increases the memory requirement from 400MB to 1000MB,+  -- observed on macOS.   if flag(limit-build-mem)     ghc-options: +RTS -M1000M -RTS --benchmark Prelude.Ahead-  import: bench-options-threaded+benchmark Data.MutArray+  import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: Ahead.hs-  if impl(ghcjs)+  main-is: Streamly/Benchmark/Data/MutArray.hs+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS+  if flag(use-streamly-core)     buildable: False   else     buildable: True -benchmark Prelude.Async-  import: bench-options-threaded+benchmark Data.Parser+  import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: Async.hs+  hs-source-dirs: Streamly/Benchmark/Data+  main-is: Parser.hs   if impl(ghcjs)     buildable: False   else     buildable: True+    build-depends: exceptions >= 0.8   && < 0.11+  if flag(limit-build-mem)+    if flag(dev)+      ghc-options: +RTS -M3000M -RTS+    else+      ghc-options: +RTS -M2500M -RTS -benchmark Prelude.WAsync-  import: bench-options-threaded+benchmark Data.ParserK+  import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: WAsync.hs+  hs-source-dirs: Streamly/Benchmark/Data+  cpp-options: -DBENCH_SINGULAR+  main-is: ParserK.hs   if impl(ghcjs)     buildable: False   else     buildable: True+    build-depends: exceptions >= 0.8   && < 0.11 -benchmark Prelude.Parallel-  import: bench-options-threaded+benchmark Data.ParserK.Chunked+  import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: Parallel.hs+  hs-source-dirs: Streamly/Benchmark/Data+  cpp-options: -DBENCH_CHUNKED+  main-is: ParserK.hs   if impl(ghcjs)     buildable: False   else     buildable: True-  if flag(limit-build-mem)-    ghc-options: +RTS -M2000M -RTS-+    build-depends: exceptions >= 0.8   && < 0.11 -benchmark Data.Unfold+benchmark Data.ParserK.Chunked.Generic   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: .-  main-is: Streamly/Benchmark/Data/Unfold.hs+  hs-source-dirs: Streamly/Benchmark/Data+  cpp-options: -DBENCH_CHUNKED_GENERIC+  main-is: ParserK.hs   if impl(ghcjs)     buildable: False   else     buildable: True+    build-depends: exceptions >= 0.8   && < 0.11 -benchmark Data.Fold+benchmark Data.RingArray   import: bench-options   type: exitcode-stdio-1.0+  main-is: Streamly/Benchmark/Data/RingArray.hs+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS++benchmark Data.Scanl+  import: bench-options+  type: exitcode-stdio-1.0   hs-source-dirs: Streamly/Benchmark/Data-  main-is: Fold.hs-  if impl(ghcjs)-    buildable: False-  else-    buildable: True+  main-is: Scanl.hs -benchmark Data.Parser.ParserD+benchmark Data.Scanl.Window   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Parser-  main-is: ParserD.hs-  if impl(ghcjs)-    buildable: False-  else-    buildable: True-    build-depends: exceptions >= 0.8   && < 0.11-  if flag(limit-build-mem)-    if flag(dev)-      ghc-options: +RTS -M3000M -RTS-    else-      ghc-options: +RTS -M750M -RTS+  hs-source-dirs: Streamly/Benchmark/Data/Scanl+  main-is: Window.hs -benchmark Data.Parser.ParserK+benchmark Data.Scanl.Concurrent   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Parser-  main-is: ParserK.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Data/Scanl+  main-is: Concurrent.hs+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True-    build-depends: exceptions >= 0.8   && < 0.11 --- Note: to use this we have to set DISABLE_FUSION in ParserD.hs so that--- the rewrite rules are disabled. We can also use the "no-fusion" build--- flag but we need to keep in mind that it disables fusion for streams--- as well.-benchmark Data.Parser.FromParserK+-- XXX Should be renamed to MutByteArray+benchmark Data.Serialize   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Parser-  cpp-options: -DFROM_PARSERK-  main-is: ParserK.hs-  if impl(ghcjs)-    buildable: False-  else+  hs-source-dirs: .+  cpp-options: -DUSE_TH+  main-is: Streamly/Benchmark/Data/Serialize.hs+  build-depends: QuickCheck, template-haskell+  other-modules:+      Streamly.Benchmark.Data.Serialize.TH+      Streamly.Benchmark.Data.Serialize.RecCompatible+      Streamly.Benchmark.Data.Serialize.RecNonCompatible+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS++benchmark Data.SmallArray+  import: bench-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Benchmark/Data/Array/SmallArray.hs+  if flag(dev) && !flag(use-streamly-core)     buildable: True-    build-depends: exceptions >= 0.8   && < 0.11+  else+    buildable: False -benchmark Data.Parser+benchmark Data.Stream   import: bench-options   type: exitcode-stdio-1.0   hs-source-dirs: Streamly/Benchmark/Data-  main-is: Parser.hs-  if impl(ghcjs)-    buildable: False-  else-    buildable: True-    build-depends: exceptions >= 0.8   && < 0.11+  main-is: Stream.hs+  other-modules:+      Stream.Generate+      Stream.Eliminate+      Stream.Transform+      Stream.Reduce+      Stream.Expand+      Stream.Lift+      Stream.Split+      Stream.Common+  if !flag(use-streamly-core)+    other-modules:+      Stream.Exceptions   if flag(limit-build-mem)     if flag(dev)-      ghc-options: +RTS -M3000M -RTS+      ghc-options: +RTS -M3500M -RTS     else-      ghc-options: +RTS -M1000M -RTS------------------------------------------------------------------------------------ Raw Streams--------------------------------------------------------------------------------+      ghc-options: +RTS -M2500M -RTS -benchmark Data.Stream.StreamD-  import: bench-options+benchmark Data.Stream.Adaptive+  import: bench-options-threaded   type: exitcode-stdio-1.0   hs-source-dirs: Streamly/Benchmark/Data/Stream-  main-is: StreamD.hs-  if impl(ghcjs)+  main-is: Adaptive.hs+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True -benchmark Data.Stream.StreamK-  import: bench-options+benchmark Data.Stream.Concurrent+  import: bench-options-threaded   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Stream-  main-is: StreamK.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/+  main-is: Concurrent.hs+  other-modules:+      Stream.ConcurrentCommon+      Stream.Common+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True -benchmark Data.Stream.StreamDK-  import: bench-options+benchmark Data.Stream.ConcurrentEager+  import: bench-options-threaded   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Stream-  main-is: StreamDK.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/+  main-is: ConcurrentEager.hs+  other-modules:+      Stream.ConcurrentCommon+      Stream.Common+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True -executable nano-bench-  import: bench-options-  hs-source-dirs: .-  main-is: NanoBenchmarks.hs-  if flag(dev)-    buildable: True-  else+benchmark Data.Stream.ConcurrentInterleaved+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/+  main-is: ConcurrentInterleaved.hs+  other-modules:+      Stream.ConcurrentCommon+      Stream.Common+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False------------------------------------------------------------------------------------ Concurrent Streams--------------------------------------------------------------------------------+  else+    buildable: True -benchmark Prelude.Concurrent+benchmark Data.Stream.ConcurrentOrdered   import: bench-options-threaded   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: Concurrent.hs+  hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/+  main-is: ConcurrentOrdered.hs+  other-modules:+      Stream.ConcurrentCommon+      Stream.Common+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True -benchmark Prelude.Adaptive+benchmark Data.Stream.ConcurrentThreadHeavy   import: bench-options-threaded   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude-  main-is: Adaptive.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Data/Stream+  main-is: ConcurrentThreadHeavy.hs+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True -benchmark Prelude.Rate+benchmark Data.Stream.Rate   import: bench-options-threaded   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Prelude+  hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/   main-is: Rate.hs-  if impl(ghcjs)+  other-modules:+      Stream.ConcurrentCommon+      Stream.Common+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True ----------------------------------------------------------------------------------- Array Benchmarks----------------------------------------------------------------------------------benchmark Data.Array-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: .-  main-is: Streamly/Benchmark/Data/Array.hs--benchmark Data.Array.Prim+benchmark Data.StreamK   import: bench-options   type: exitcode-stdio-1.0-  main-is: Streamly/Benchmark/Data/Array/Prim.hs-  build-depends: primitive+  hs-source-dirs: Streamly/Benchmark/Data+  main-is: StreamK.hs+  if impl(ghcjs)+    buildable: False -benchmark Data.SmallArray+-- XXX This needs to be cleaned up+benchmark Data.StreamK.FromStream   import: bench-options   type: exitcode-stdio-1.0-  main-is: Streamly/Benchmark/Data/Array/SmallArray.hs+  hs-source-dirs: Streamly/Benchmark/Data/StreamK+  main-is: FromStream.hs+  if !flag(dev) || impl(ghcjs)+    buildable: False -benchmark Data.Array.Prim.Pinned+benchmark Data.StreamK.StreamKAlt   import: bench-options   type: exitcode-stdio-1.0-  main-is: Streamly/Benchmark/Data/Array/Prim/Pinned.hs+  hs-source-dirs: Streamly/Benchmark/Data/StreamK+  main-is: StreamKAlt.hs+  if !flag(dev) || impl(ghcjs)+    buildable: False -benchmark Data.Array.Foreign+benchmark Data.Unbox   import: bench-options   type: exitcode-stdio-1.0-  main-is: Streamly/Benchmark/Data/Array/Foreign.hs-  if flag(limit-build-mem)-    ghc-options: +RTS -M1000M -RTS+  hs-source-dirs: .+  cpp-options: -DUSE_UNBOX+  main-is: Streamly/Benchmark/Data/Serialize.hs -benchmark Data.Array.Foreign.Mut+benchmark Data.Unbox.Derive.TH   import: bench-options   type: exitcode-stdio-1.0-  main-is: Streamly/Benchmark/Data/Array/Foreign/Mut.hs------------------------------------------------------------------------------------ Array Stream Benchmarks--------------------------------------------------------------------------------+  hs-source-dirs: .+  cpp-options: -DUSE_UNBOX+  cpp-options: -DUSE_TH+  main-is: Streamly/Benchmark/Data/Serialize.hs -benchmark Data.Array.Stream.Foreign+benchmark Data.Unfold   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Array/Stream-  main-is: Foreign.hs+  hs-source-dirs: .+  main-is: Streamly/Benchmark/Data/Unfold.hs   if impl(ghcjs)     buildable: False   else     buildable: True-    build-depends: exceptions >= 0.8   && < 0.11 ----------------------------------------------------------------------------------- FileIO Benchmarks--------------------------------------------------------------------------------- benchmark FileSystem.Handle   import: bench-options   type: exitcode-stdio-1.0@@ -518,16 +605,25 @@   other-modules:       Handle.Read     , Handle.ReadWrite------------------------------------------------------------------------------------ Unicode Benchmarks--------------------------------------------------------------------------------+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True -benchmark Unicode.Stream+benchmark FileSystem.DirIO   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Unicode-  main-is: Stream.hs+  hs-source-dirs: Streamly/Benchmark/FileSystem+  main-is: DirIO.hs+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True+  -- Fix this benchmark for Windows+  if os(windows)+    buildable: False  benchmark Unicode.Char   import: bench-options@@ -535,11 +631,172 @@   hs-source-dirs: Streamly/Benchmark/Unicode   main-is: Char.hs   -- Takes too much memory for ghcjs-  if impl(ghcjs)+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False +benchmark Unicode.Parser+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Unicode+  main-is: Parser.hs++executable nano-bench+  import: bench-options+  hs-source-dirs: .+  main-is: NanoBenchmarks.hs+  if !flag(dev)+    buildable: False++benchmark Unicode.Stream+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Unicode+  main-is: Stream.hs+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True+ benchmark Unicode.Utf8   import: bench-options   type: exitcode-stdio-1.0   hs-source-dirs: Streamly/Benchmark/Unicode   main-is: Utf8.hs+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True++-------------------------------------------------------------------------------+-- Deprecated+-------------------------------------------------------------------------------++benchmark Prelude+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data+  main-is: Stream.hs+  other-modules:+      Stream.Generate+      Stream.Eliminate+      Stream.Transform+      Stream.Reduce+      Stream.Expand+      Stream.Lift+      Stream.Common+      Stream.Exceptions+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False+  if flag(limit-build-mem)+    if flag(dev)+      ghc-options: +RTS -M3500M -RTS+    else+      ghc-options: +RTS -M2500M -RTS++benchmark Prelude.WSerial+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: WSerial.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False+  if flag(limit-build-mem)+    ghc-options: +RTS -M750M -RTS++benchmark Prelude.Merge+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: Merge.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False++benchmark Prelude.ZipSerial+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: ZipSerial.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False++benchmark Prelude.ZipAsync+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: ZipAsync.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS++benchmark Prelude.Ahead+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: Ahead.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False++benchmark Prelude.Async+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: Async.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False++benchmark Prelude.WAsync+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: WAsync.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False++benchmark Prelude.Parallel+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: Parallel.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False+  if flag(limit-build-mem)+    ghc-options: +RTS -M2000M -RTS++benchmark Prelude.Concurrent+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: Concurrent.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False++benchmark Prelude.Adaptive+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: Adaptive.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False++benchmark Prelude.Rate+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Prelude+  main-is: Rate.hs+  cpp-options: -DUSE_PRELUDE+  if !flag(use-prelude)+    buildable: False
− bin/bench-config.sh 
@@ -1,160 +0,0 @@-#!/usr/bin/env bash--BENCH_CONFIG_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" &> /dev/null && pwd)"-source $BENCH_CONFIG_DIR/targets.sh \-  || { echo "Cannot source $BENCH_CONFIG_DIR/targets.sh"; exit 1; }--# Customization options-bench_config () {-  BENCH_REPORT_DIR=benchmark/bench-report-  BENCHMARK_PACKAGE_NAME=streamly-benchmarks-  BENCHMARK_PACKAGE_VERSION=0.0.0--  USE_GAUGE=0-  DEFAULT_FIELDS="allocated cputime bytescopied"-}--#-------------------------------------------------------------------------------# benchmark groups-#--------------------------------------------------------------------------------bench_targets () {-  targets-}--#-------------------------------------------------------------------------------# RTS options based on the benchmark executable name and benchmark name-#--------------------------------------------------------------------------------bench_rts_options () {-  local exe_name-  local bench_name--  exe_name="$1"-  bench_name="$2"--  # Based on benchmark class-  case "$bench_name" in-    */o-1-sp*) echo -n "-K36K -M16M" ;;-    */o-n-h*) echo -n "-K36K -M32M" ;;-    */o-n-st*) echo -n "-K1M -M16M" ;;-    */o-n-sp*) echo -n "-K1M -M32M" ;;-    *) echo -n "" ;;-  esac--  echo -n " "-  case "$exe_name" in-    Prelude.Concurrent*) echo -n "-K256K -M384M" ;;-    *) echo -n "" ;;-  esac--  echo -n " "-  # Based on specific benchmark-  # XXX Note: for tasty-bench we replace the "." separator in the benchmark names-  # with "/" for matching with this. It may not work reliably if the benchmark-  # name already contains ".".-  case "$bench_name" in-    Data.Stream.StreamD/o-n-space/elimination/toList) echo -n "-K2M" ;;-    Data.Stream.StreamK/o-n-space/elimination/toList) echo -n "-K2M" ;;--    Prelude.Parallel/o-n-heap/mapping/mapM) echo -n "-M256M" ;;-    Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;-    Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;--    Prelude.Rate/o-1-space/*) echo -n "-K128K" ;;-    Prelude.Rate/o-1-space/asyncly/*) echo -n "-K128K" ;;--    # XXX For GHC-9.0-    Prelude.Serial/o-1-space/mixed/sum-product-fold) echo -n "-K64M" ;;--    # XXX These should be moved to o-n-space?-    Prelude.Serial/o-n-heap/grouping/classifySessionsOf) echo -n "-K1M -M32M" ;;-    Prelude.Serial/o-n-heap/Functor/*) echo -n "-K4M -M32M" ;;-    Prelude.Serial/o-n-heap/transformer/*) echo -n "-K8M -M64M" ;;--    Prelude.Serial/o-n-space/Functor/*) echo -n "-K4M -M64M" ;;-    Prelude.Serial/o-n-space/Applicative/*) echo -n "-K8M -M128M" ;;-    Prelude.Serial/o-n-space/Monad/*) echo -n "-K8M -M64M" ;;--    # Use -K4M for o-n-space except for grouping-    Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;-    Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;--    Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;--    Prelude.Async/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;-    Prelude.Ahead/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;-    Prelude.Ahead/o-1-space/*) echo -n "-K128K" ;;--    Prelude.WAsync/o-n-heap/monad-outer-product/toNull3) echo -n "-M64M" ;;-    Prelude.WAsync/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;--    # XXX need to investigate these, taking too much stack-    Data.Parser.ParserD/o-1-space/some) echo -n "-K8M" ;;-    Data.Parser/o-1-space/some) echo -n "-K8M" ;;-    Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;-    Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;-    Data.Parser/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;-    Data.Parser/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;-    Data.Parser/o-n-heap/choice) echo -n "-K16M -M32M" ;;-    Data.Parser.ParserK/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;-    Data.Parser.ParserK/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;-    Data.Parser.ParserK/o-n-heap/sequence) echo -n "-M64M";;-    Data.Parser.ParserK/o-n-heap/sequenceA) echo -n "-M64M";;--    Data.SmallArray/o-1-sp*) echo -n "-K128K" ;;-    # For tasty-bench-    Data.Array*/o-1-space/generation/show) echo -n "-M32M" ;;-    # XXX For GHC-8.10-    Data.Array/o-1-space/transformationX4/map) echo -n "-M32M" ;;-    # DEVBUILD only benchmarks - array foldable instance-    Data.Array.Foreign/o-1-space/elimination/foldable/foldl*) echo -n "-K8M" ;;-    Data.Array.Foreign/o-1-space/elimination/foldable/sum) echo -n "-K8M" ;;-    *) echo -n "" ;;-  esac-}--#-------------------------------------------------------------------------------# Speed options-#--------------------------------------------------------------------------------bench_speed_options () {-  local exe_name-  local bench_name--  exe_name="$1"-  bench_name="$2"--  case "$exe_name" in-    Prelude.Concurrent) set_super_quick_mode ;;-    Prelude.Rate) set_super_quick_mode ;;-    Prelude.Adaptive) set_super_quick_mode;;-    *) echo -n "" ;;-  esac--  # XXX Note: for tasty-bench we replace the "." separator in the benchmark names-  # with "/" for matching with this. It may not work reliably if the benchmark-  # name already contains ".".--  # Use quick options for benchmarks that take too long-  case "$bench_name" in-    Prelude.Parallel/o-n-heap/mapping/mapM) set_super_quick_mode ;;-    Prelude.Parallel/o-n-heap/monad-outer-product/*) set_super_quick_mode ;;-    Prelude.Parallel/o-n-space/monad-outer-product/*) set_super_quick_mode ;;-    Prelude.Parallel/o-n-heap/generation/*) use_quicker_mode ;;-    Prelude.Parallel/o-n-heap/mapping/*) use_quicker_mode ;;-    Prelude.Parallel/o-n-heap/concat-foldable/*) use_quicker_mode ;;--    Prelude.Async/o-1-space/monad-outer-product/*) use_quicker_mode ;;-    Prelude.Async/o-n-space/monad-outer-product/*) use_quicker_mode ;;--    Prelude.Ahead/o-1-space/monad-outer-product/*) use_quicker_mode ;;-    Prelude.Ahead/o-n-space/monad-outer-product/*) use_quicker_mode ;;--    Prelude.WAsync/o-n-heap/monad-outer-product/*) use_quicker_mode ;;-    Prelude.WAsync/o-n-space/monad-outer-product/*) use_quicker_mode ;;--    FileSystem.Handle/*) use_quicker_mode ;;-    *) echo -n "" ;;-  esac-}
− bin/bench.sh 
@@ -1,15 +0,0 @@-#!/usr/bin/env bash--SCRIPT_DIR=$(cd `dirname $0`; pwd)-source $SCRIPT_DIR/bench-config.sh \-  || { echo "Cannot source $SCRIPT_DIR/bench-config.sh"; exit 1; }--bench_config-if test -z "$BENCH_REPORT_DIR"-then-  echo "BENCH_REPORT_DIR variable not defined by bench-config() in $SCRIPT_DIR/bench-config.sh"-  exit 1-fi--cd $SCRIPT_DIR/..-$BENCH_REPORT_DIR/bin/bench-runner.sh --config $SCRIPT_DIR/bench-config.sh "$@"
bin/mk-hscope.sh view
@@ -1,7 +1,7 @@ #!/usr/bin/env bash  GHC_VERSION=8.10.4-STREAMLY_VERSION=0.8.2+STREAMLY_VERSION=0.9.0  case `uname` in   Darwin) SYSTEM=x86_64-osx;;
− bin/targets.sh 
@@ -1,120 +0,0 @@-#-------------------------------------------------------------------------------# test and benchmark groups-#--------------------------------------------------------------------------------# Depends on RUNNING_TESTS, RUNNING_BENCHMARKS, RUNNING_DEVBUILD variables-# being set for dev_build, test_only, bench_only functions to work. So the-# "targets" fucntion should be called only after these are set.--# IMPORTANT NOTE: the names "_grp" and "_cmp" suffixes are special, do-# not rename them to something else.--targets () {-  base_stream_grp="\-    `bench_only Data.Stream.StreamD` \-    `bench_only Data.Stream.StreamK` \-    `bench_only Data.Stream.StreamDK`"--  prelude_serial_grp="\-    Prelude.Serial \-    Prelude.WSerial \-    Prelude.ZipSerial"--  prelude_concurrent_grp="\-    Prelude.Async \-    Prelude.WAsync \-    Prelude.Ahead \-    Prelude.Parallel \-    Prelude.ZipAsync"--  prelude_other_grp="\-    `test_only Prelude` \-    $(test_only $(dev_build Prelude.Rate)) \-    `bench_only Prelude.Rate` \-    `test_only Prelude.Fold` \-    `test_only Prelude.Concurrent` \-    $(bench_only $(dev_build Prelude.Concurrent)) \-    `bench_only Prelude.Adaptive`"--  array_grp="\-    Data.Array \-    Data.Array.Foreign \-    Data.Array.Prim \-    Data.SmallArray \-    Data.Array.Prim.Pinned"--  base_parser_grp="\-    Data.Parser.ParserD \-    `bench_only Data.Parser.ParserK`"--  parser_grp="\-    Data.Fold \-    Data.Parser"--  list_grp="\-    `test_only Data.List.Base` \-    `test_only Data.List`"--  #-------------------------------------------------------------------------------  # Streaming vs non-streaming-  #-------------------------------------------------------------------------------  # The "o-1-space" groups of these benchmarks are run with long stream-  # sizes when --long option is used.--  infinite_grp="\-    $prelude_serial_grp \-    $prelude_concurrent_grp \-    `bench_only Prelude.Rate`"--  #-------------------------------------------------------------------------------  # Benchmark comparison groups-  #--------------------------------------------------------------------------------  # *_cmp denotes a comparison benchmark, the benchmarks provided in *_cmp-  # variables are compared with each other-  base_stream_cmp="Data.Stream.StreamD Data.Stream.StreamK"-  serial_wserial_cmp="Prelude.Serial Prelude.WSerial"-  serial_async_cmp="Prelude.Serial Prelude.Async"-  concurrent_cmp="Prelude.Async Prelude.WAsync Prelude.Ahead Prelude.Parallel"-  array_cmp="Data.Array.Foreign Data.Array.Prim Data.Array Data.Array.Prim.Pinned"-  pinned_array_cmp="Data.Array.Foreign Data.Array.Prim.Pinned"-  base_parser_cmp=$base_parser_grp--  COMPARISONS="\-    base_stream_cmp \-    serial_wserial_cmp \-    serial_async_cmp \-    concurrent_cmp \-    array_cmp \-    pinned_array_cmp \-    base_parser_cmp"--  #-------------------------------------------------------------------------------  # All test/benchmark modules must be in at least one of these-  #--------------------------------------------------------------------------------  # All groups-  GROUP_TARGETS="\-      base_stream_grp \-      prelude_serial_grp \-      prelude_concurrent_grp \-      prelude_other_grp \-      array_grp \-      base_parser_grp \-      parser_grp \-      list_grp  \-      infinite_grp"--  # Not in any groups-  INDIVIDUAL_TARGETS="\-      Data.Unfold \-      Unicode.Stream \-      $(test_only $(dev_build Unicode.Char)) \-      `bench_only Unicode.Char` \-      `bench_only Unicode.Utf8` \-      FileSystem.Handle \-      `test_only FileSystem.Event` \-      `test_only Network.Socket` \-      `test_only Network.Inet.TCP` \-      `test_only version-bounds`"-}
− bin/test.sh 
@@ -1,247 +0,0 @@-#!/usr/bin/env bash--SCRIPT_DIR=$(dirname $0)--STREAMLY_VERSION=0.8.2-BENCH_REPORT_DIR=benchmark/bench-report-source $SCRIPT_DIR/targets.sh--#-------------------------------------------------------------------------------# Script-#--------------------------------------------------------------------------------print_help () {-  echo "Usage: $0 "-  echo "       [--targets <"target1 target2 ..." | help>]"-  echo-  echo "       [--quick]"-  echo "       [--with-compiler <compiler exe name>]"-  echo "       [--cabal-build-options <option>]"-  echo "       [--dev-build]"-  echo-  echo "       [--coverage]"-  echo "       [--hpc-report-options <option>]"-  echo "       [--no-measure]"-  echo "       [--raw]"-  echo-  echo "       [--rtsopts <option>]"-  echo "       -- <hspec options or test names>"-  echo-  echo "--targets: targets to run, use 'help' for list of targets"-  echo-  echo "--quick: disable optimizations to build quickly"-  echo "--cabal-build-options: Pass any cabal build options to be used for build"-  echo "--dev-build: runs some additional tests"-  echo-  echo "--coverage: enable coverage and report coverage info"-  echo "--hpc-report-options: option for 'hpc report'"-  echo "--no-measure: with --coverage, do not run tests, only show coverage info"-  echo "--raw: with --coverage, do not run hpc"-  echo-  echo "--rtsopts: pass GHC RTS options to the test executable"-  echo "Any arguments after a '--' are passed directly to hspec"-  exit-}--#------------------------------------------------------------------------------# Read command line-#-------------------------------------------------------------------------------RUNNING_TESTS=y-source $BENCH_REPORT_DIR/bin/build-lib.sh--USE_GIT_CABAL=1-set_common_vars-COVERAGE=0-MEASURE=1-HPC_REPORT_OPTIONS=-RAW=0-CABAL_BUILD_OPTIONS="--flag limit-build-mem"-TEST_QUICK_MODE=0--# XXX add a bisect option-while test -n "$1"-do-  case $1 in-    -h|--help|help) print_help ;;-    # options with arguments-    --targets) shift; TARGETS=$1; shift ;;-    --with-compiler) shift; CABAL_WITH_COMPILER=$1; shift ;;-    --cabal-build-options) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;-    --hpc-report-options) shift; HPC_REPORT_OPTIONS="$1"; shift ;;-    --rtsopts) shift; RTS_OPTIONS="$1"; shift ;;-    # flags-    --raw) RAW=1; shift ;;-    #--slow) SLOW=1; shift ;; # not implemented-    --quick) TEST_QUICK_MODE=1; shift ;;-    --dev-build) RUNNING_DEVBUILD=1 CABAL_BUILD_OPTIONS+=" --flag dev"; shift ;;-    --coverage) COVERAGE=1; shift ;;-    --no-measure) MEASURE=0; shift ;;-    --) shift; break ;;-    -*|--*) echo "Unknown flags: $*"; echo; print_help ;;-    *) break ;;-  esac-done-TARGET_EXE_ARGS=$*--set_derived_vars--if test $TEST_QUICK_MODE -eq 1-then-  CABAL_BUILD_OPTIONS+=" --disable-optimization --flags -opt"-fi--#------------------------------------------------------------------------------# Determine targets-#-------------------------------------------------------------------------------# Defined in targets.sh-targets--if test "$(has_item "$TARGETS" help)" = "help"-then-  list_target_groups-  list_targets-  exit-fi--DEFAULT_TARGETS="$(all_grp)"-TARGETS=$(set_targets)--echo "Using targets [$TARGETS]"--#------------------------------------------------------------------------------# Build targets-#-------------------------------------------------------------------------------test_exe_rts_opts () {-  case "$1" in-    # XXX Data.Array.* heap requirement increased for GHC-8.10-    Data.Array.Foreign) echo -n "-M128M" ;;-    Data.Array.Prim) echo -n "-M128M" ;;-    Data.Array.Prim.Pinned) echo -n "-M128M" ;;-    Prelude.Rate) echo -n "-M512M" ;;-    # For -O0 case writeChunks test fails, maybe we should have a separate flag-    # for O0 case?-    FileSystem.Handle) echo -n "-K16M" ;;-    *) if test "$COVERAGE" -eq "1"-       then-          echo -n "-K8M -M1024M"-        else-          echo -n "-K8M -M64M"-       fi ;;-  esac-}--# $1: bench name-# $2: bench executable-target_exe_extra_args () {-  local bench_name=$1-  local bench_prog=$2--  echo "+RTS \-    $(test_exe_rts_opts $(basename $bench_prog)) \-    $RTS_OPTIONS \-    -RTS"-}--if test "$COVERAGE" -eq "1"-then-  # Used to determine the hpc tix dir-  PACKAGE_FULL_NAME=streamly-$STREAMLY_VERSION-  case `uname` in-    Linux) SYSTEM=x86_64-linux ;;-    *) echo "Unsupported system"; exit 1 ;;-  esac--  # With the --enable-coverage option the tests as well as the library get-  # compiled with -fhpc, and we get coverage for tests as well. But we want to-  # exclude that, so a project file is needed.-  CABAL_BUILD_OPTIONS+=" --project-file cabal.project.coverage"-  mkdir -p $BUILD_DIR/hpc-fi-BUILD_TEST="$CABAL_EXECUTABLE v2-build $CABAL_BUILD_OPTIONS --enable-tests"--if test "$MEASURE" -eq "1"-then-run_build "$BUILD_TEST" streamly-tests test "$TARGETS"-fi--#------------------------------------------------------------------------------# Run targets-#-------------------------------------------------------------------------------# $1: target name-get_tix_file () {-  echo $BUILD_DIR/build/$SYSTEM/ghc-${GHC_VERSION}/$PACKAGE_FULL_NAME/hpc/vanilla/tix/$1/$1.tix-}--# $1: package name-# $2: component-# $3: target-# $4: args generator func-run_target () {-  local package_name=$1-  local component=$2-  local target_name=$3-  local extra_args=$4--  local target_prog--  target_prog=$(cabal_target_prog $package_name $component $target_name) || \-    die "Cannot find executable for target $target_name"--  echo "Running executable $target_name ..."--  mkdir -p $(dirname $(get_tix_file $target_name))-  export HPCTIXFILE=$(get_tix_file $target_name)--  run_verbose $target_prog $($extra_args $target_name $target_prog) \-    || die "Target exe failed"--  # hpc-coveralls fails if there is an empty dir and no .tix file generated-  rmdir $(dirname $(get_tix_file $target_name)) 2>/dev/null || true-}--# $1: package name with version-# $2: component-# $3: targets-# $4: args generator func-run_targets() {-    for i in $3-    do-      run_target $1 $2 $i $4-    done-}--if test "$MEASURE" -eq "1"-then-run_targets "streamly-tests-0.0.0" t "$TARGETS" target_exe_extra_args-fi--#------------------------------------------------------------------------------# Run coverage reports-#-------------------------------------------------------------------------------PACKAGE_NAME=streamly-$STREAMLY_VERSION-MIX_DIR=$BUILD_DIR/build/$SYSTEM/ghc-${GHC_VERSION}/$PACKAGE_NAME/hpc/vanilla/mix/$PACKAGE_NAME/-ALLTIX=$BUILD_DIR/hpc/all.tix--if test "$COVERAGE" -eq "1" -a "$RAW" -eq 0-then-  TIXFILES=-  for i in $TARGETS-  do-    tixfile="$(get_tix_file ${i})"-    if test -f "$tixfile"-    then-      TIXFILES+="$tixfile "-    fi-  done--  #echo "Combining tix files:"-  #echo $TIXFILES | tr ' ' '\n'-  hpc sum --union --output=$ALLTIX $TIXFILES-  run_verbose hpc markup $ALLTIX --hpcdir $MIX_DIR-  run_verbose hpc report $ALLTIX $HPC_REPORT_OPTIONS --hpcdir $MIX_DIR-fi
configure view
@@ -1,11 +1,11 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.71 for streamly 0.8.2.+# Generated by GNU Autoconf 2.72 for streamly 0.11.1. # # Report bugs to <streamly@composewell.com>. # #-# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation,+# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, # Inc. # #@@ -17,7 +17,6 @@  # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh-as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then :   emulate sh@@ -26,12 +25,13 @@   # is contrary to our usage.  Disable this feature.   alias -g '${1+"$@"}'='"$@"'   setopt NO_GLOB_SUBST-else $as_nop-  case `(set -o) 2>/dev/null` in #(+else case e in #(+  e) case `(set -o) 2>/dev/null` in #(   *posix*) :     set -o posix ;; #(   *) :      ;;+esac ;; esac fi @@ -103,7 +103,7 @@       ;; esac-# We did not find ourselves, most probably we were run as `sh COMMAND'+# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then   as_myself=$0@@ -133,15 +133,14 @@ esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail-# out after a failed `exec'.+# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255   fi   # We don't want this to propagate to other subprocesses.           { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then-  as_bourne_compatible="as_nop=:-if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1+  as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then :   emulate sh   NULLCMD=:@@ -149,12 +148,13 @@   # is contrary to our usage.  Disable this feature.   alias -g '\${1+\"\$@\"}'='\"\$@\"'   setopt NO_GLOB_SUBST-else \$as_nop-  case \`(set -o) 2>/dev/null\` in #(+else case e in #(+  e) case \`(set -o) 2>/dev/null\` in #(   *posix*) :     set -o posix ;; #(   *) :      ;;+esac ;; esac fi "@@ -172,8 +172,9 @@ if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : -else \$as_nop-  exitcode=1; echo positional parameters were not saved.+else case e in #(+  e) exitcode=1; echo positional parameters were not saved. ;;+esac fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah))@@ -186,14 +187,15 @@   if (eval "$as_required") 2>/dev/null then :   as_have_required=yes-else $as_nop-  as_have_required=no+else case e in #(+  e) as_have_required=no ;;+esac fi   if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : -else $as_nop-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+else case e in #(+  e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do@@ -226,12 +228,13 @@ if $as_found then : -else $as_nop-  if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&+else case e in #(+  e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } && 	      as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then :   CONFIG_SHELL=$SHELL as_have_required=yes-fi+fi ;;+esac fi  @@ -253,7 +256,7 @@ esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail-# out after a failed `exec'.+# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi@@ -273,7 +276,8 @@ $0: under such a shell if you do have one."   fi   exit 1-fi+fi ;;+esac fi fi SHELL=${CONFIG_SHELL-/bin/sh}@@ -312,14 +316,6 @@   as_fn_set_status $1   exit $1 } # as_fn_exit-# as_fn_nop-# ----------# Do nothing but, unlike ":", preserve the value of $?.-as_fn_nop ()-{-  return $?-}-as_nop=as_fn_nop  # as_fn_mkdir_p # -------------@@ -388,11 +384,12 @@   {     eval $1+=\$2   }'-else $as_nop-  as_fn_append ()+else case e in #(+  e) as_fn_append ()   {     eval $1=\$$1\$2-  }+  } ;;+esac fi # as_fn_append  # as_fn_arith ARG...@@ -406,21 +403,14 @@   {     as_val=$(( $* ))   }'-else $as_nop-  as_fn_arith ()+else case e in #(+  e) as_fn_arith ()   {     as_val=`expr "$@" || test $? -eq 1`-  }+  } ;;+esac fi # as_fn_arith -# as_fn_nop-# ----------# Do nothing but, unlike ":", preserve the value of $?.-as_fn_nop ()-{-  return $?-}-as_nop=as_fn_nop  # as_fn_error STATUS ERROR [LINENO LOG_FD] # ----------------------------------------@@ -494,6 +484,8 @@     /[$]LINENO/=   ' <$as_myself |     sed '+      t clear+      :clear       s/[$]LINENO.*/&-/       t lineno       b@@ -542,7 +534,6 @@ as_echo='printf %s\n' as_echo_n='printf %s' - rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then   rm -f conf$$.dir/conf$$.file@@ -554,9 +545,9 @@   if ln -s conf$$.file conf$$ 2>/dev/null; then     as_ln_s='ln -s'     # ... but there are two gotchas:-    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.-    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.-    # In both cases, we have to default to `cp -pR'.+    # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable.+    # In both cases, we have to default to 'cp -pR'.     ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||       as_ln_s='cp -pR'   elif ln conf$$.file conf$$ 2>/dev/null; then@@ -581,10 +572,12 @@ as_executable_p=as_fn_executable_p  # Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"+as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g"+as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated  # Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g"+as_tr_sh="eval sed '$as_sed_sh'" # deprecated   test -n "$DJDIR" || exec 7<&0 </dev/null@@ -610,43 +603,11 @@ # Identity of this package. PACKAGE_NAME='streamly' PACKAGE_TARNAME='streamly'-PACKAGE_VERSION='0.8.2'-PACKAGE_STRING='streamly 0.8.2'+PACKAGE_VERSION='0.11.1'+PACKAGE_STRING='streamly 0.11.1' 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@@ -816,7 +777,7 @@     ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`     # Reject names that are not valid shell variable names.     expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid feature name: \`$ac_useropt'"+      as_fn_error $? "invalid feature name: '$ac_useropt'"     ac_useropt_orig=$ac_useropt     ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`     case $ac_user_opts in@@ -842,7 +803,7 @@     ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`     # Reject names that are not valid shell variable names.     expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid feature name: \`$ac_useropt'"+      as_fn_error $? "invalid feature name: '$ac_useropt'"     ac_useropt_orig=$ac_useropt     ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`     case $ac_user_opts in@@ -1055,7 +1016,7 @@     ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`     # Reject names that are not valid shell variable names.     expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid package name: \`$ac_useropt'"+      as_fn_error $? "invalid package name: '$ac_useropt'"     ac_useropt_orig=$ac_useropt     ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`     case $ac_user_opts in@@ -1071,7 +1032,7 @@     ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`     # Reject names that are not valid shell variable names.     expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid package name: \`$ac_useropt'"+      as_fn_error $? "invalid package name: '$ac_useropt'"     ac_useropt_orig=$ac_useropt     ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`     case $ac_user_opts in@@ -1101,8 +1062,8 @@   | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)     x_libraries=$ac_optarg ;; -  -*) as_fn_error $? "unrecognized option: \`$ac_option'-Try \`$0 --help' for more information"+  -*) as_fn_error $? "unrecognized option: '$ac_option'+Try '$0 --help' for more information"     ;;    *=*)@@ -1110,7 +1071,7 @@     # Reject names that are not valid shell variable names.     case $ac_envvar in #(       '' | [0-9]* | *[!_$as_cr_alnum]* )-      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;+      as_fn_error $? "invalid variable name: '$ac_envvar'" ;;     esac     eval $ac_envvar=\$ac_optarg     export $ac_envvar ;;@@ -1160,7 +1121,7 @@   as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done -# There might be people who depend on the old broken behavior: `$host'+# There might be people who depend on the old broken behavior: '$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias@@ -1228,7 +1189,7 @@   test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."   as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi-ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"+ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work" ac_abs_confdir=`( 	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" 	pwd)`@@ -1256,7 +1217,7 @@   # Omit some internal or obsolete options to make the list less imposing.   # This message is too long to be a string in the A/UX 3.1 sh.   cat <<_ACEOF-\`configure' configures streamly 0.8.2 to adapt to many kinds of systems.+'configure' configures streamly 0.11.1 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1270,11 +1231,11 @@       --help=short        display options specific to this package       --help=recursive    display the short help of all the included packages   -V, --version           display version information and exit-  -q, --quiet, --silent   do not print \`checking ...' messages+  -q, --quiet, --silent   do not print 'checking ...' messages       --cache-file=FILE   cache test results in FILE [disabled]-  -C, --config-cache      alias for \`--cache-file=config.cache'+  -C, --config-cache      alias for '--cache-file=config.cache'   -n, --no-create         do not create output files-      --srcdir=DIR        find the sources in DIR [configure dir or \`..']+      --srcdir=DIR        find the sources in DIR [configure dir or '..']  Installation directories:   --prefix=PREFIX         install architecture-independent files in PREFIX@@ -1282,10 +1243,10 @@   --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX                           [PREFIX] -By default, \`make install' will install all the files in-\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify-an installation prefix other than \`$ac_default_prefix' using \`--prefix',-for instance \`--prefix=\$HOME'.+By default, 'make install' will install all the files in+'$ac_default_prefix/bin', '$ac_default_prefix/lib' etc.  You can specify+an installation prefix other than '$ac_default_prefix' using '--prefix',+for instance '--prefix=\$HOME'.  For better control, use the options below. @@ -1318,7 +1279,7 @@  if test -n "$ac_init_help"; then   case $ac_init_help in-     short | recursive ) echo "Configuration of streamly 0.8.2:";;+     short | recursive ) echo "Configuration of streamly 0.11.1:";;    esac   cat <<\_ACEOF @@ -1336,7 +1297,7 @@   CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if               you have headers in a nonstandard directory <include dir> -Use these variables to override the choices made by `configure' or to help+Use these variables to override the choices made by 'configure' or to help it to find libraries and programs with nonstandard names/locations.  Report bugs to <streamly@composewell.com>.@@ -1404,10 +1365,10 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then   cat <<\_ACEOF-streamly configure 0.8.2-generated by GNU Autoconf 2.71+streamly configure 0.11.1+generated by GNU Autoconf 2.72 -Copyright (C) 2021 Free Software Foundation, Inc.+Copyright (C) 2023 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF@@ -1446,11 +1407,12 @@        } && test -s conftest.$ac_objext then :   ac_retval=0-else $as_nop-  printf "%s\n" "$as_me: failed program was:" >&5+else case e in #(+  e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -	ac_retval=1+	ac_retval=1 ;;+esac fi   eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno   as_fn_set_status $ac_retval@@ -1470,8 +1432,8 @@ if eval test \${$3+y} then :   printf %s "(cached) " >&6-else $as_nop-  as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`+else case e in #(+  e) as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`   eval ac_save_FLAGS=\$$6   as_fn_append $6 " $5"   cat confdefs.h - <<_ACEOF >conftest.$ac_ext@@ -1495,161 +1457,21 @@ if ac_fn_c_try_compile "$LINENO" then :   eval "$3=yes"-else $as_nop-  eval "$3=no"+else case e in #(+  e) eval "$3=no" ;;+esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext   eval $6=\$ac_save_FLAGS--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_check_decl--# 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_fn_check_decl ac_configure_args_raw= for ac_arg do@@ -1674,8 +1496,8 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by streamly $as_me 0.8.2, which was-generated by GNU Autoconf 2.71.  Invocation command line was+It was created by streamly $as_me 0.11.1, which was+generated by GNU Autoconf 2.72.  Invocation command line was    $ $0$ac_configure_args_raw @@ -1921,10 +1743,10 @@ printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;}     sed 's/^/| /' "$ac_site_file" >&5     . "$ac_site_file" \-      || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+      || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file-See \`config.log' for more details" "$LINENO" 5; }+See 'config.log' for more details" "$LINENO" 5; }   fi done @@ -1960,9 +1782,7 @@ /* Most of the following tests are stolen from RCS 5.7 src/conf.sh.  */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int);-static char *e (p, i)-     char **p;-     int i;+static char *e (char **p, int i) {   return p[i]; }@@ -1976,6 +1796,21 @@   return s; } +/* C89 style stringification. */+#define noexpand_stringify(a) #a+const char *stringified = noexpand_stringify(arbitrary+token=sequence);++/* C89 style token pasting.  Exercises some of the corner cases that+   e.g. old MSVC gets wrong, but not very hard. */+#define noexpand_concat(a,b) a##b+#define expand_concat(a,b) noexpand_concat(a,b)+extern int vA;+extern int vbee;+#define aye A+#define bee B+int *pvA = &expand_concat(v,aye);+int *pvbee = &noexpand_concat(v,bee);+ /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has    function prototypes and stuff, but not \xHH hex character constants.    These do not provoke an error unfortunately, instead are silently treated@@ -2003,16 +1838,19 @@  # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals='-// Does the compiler advertise C99 conformance?+/* Does the compiler advertise C99 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif +// See if C++-style comments work.+ #include <stdbool.h> extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t);+extern void free (void *);  // Check varargs macros.  These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare@@ -2062,7 +1900,6 @@ static inline int test_restrict (ccp restrict text) {-  // See if C++-style comments work.   // Iterate through items via the restricted pointer.   // Also check for declarations in for loops.   for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i)@@ -2128,6 +1965,8 @@   ia->datasize = 10;   for (int i = 0; i < ia->datasize; ++i)     ia->data[i] = i * 1.234;+  // Work around memory leak warnings.+  free (ia);    // Check named initializers.   struct named_init ni = {@@ -2149,7 +1988,7 @@  # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals='-// Does the compiler advertise C11 conformance?+/* Does the compiler advertise C11 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif@@ -2253,15 +2092,6 @@ } " -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@@ -2272,12 +2102,12 @@   eval ac_new_val=\$ac_env_${ac_var}_value   case $ac_old_set,$ac_new_set in     set,)-      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5-printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5+printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;}       ac_cache_corrupted=: ;;     ,set)-      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5-printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5+printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;}       ac_cache_corrupted=: ;;     ,);;     *)@@ -2286,18 +2116,18 @@ 	ac_old_val_w=`echo x $ac_old_val` 	ac_new_val_w=`echo x $ac_new_val` 	if test "$ac_old_val_w" != "$ac_new_val_w"; then-	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5-printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}+	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5+printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;} 	  ac_cache_corrupted=: 	else-	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5-printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}+	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5+printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;} 	  eval $ac_var=\$ac_old_val 	fi-	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5-printf "%s\n" "$as_me:   former value:  \`$ac_old_val'" >&2;}-	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5-printf "%s\n" "$as_me:   current value: \`$ac_new_val'" >&2;}+	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   former value:  '$ac_old_val'" >&5+printf "%s\n" "$as_me:   former value:  '$ac_old_val'" >&2;}+	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   current value: '$ac_new_val'" >&5+printf "%s\n" "$as_me:   current value: '$ac_new_val'" >&2;}       fi;;   esac   # Pass precious variables to config.status.@@ -2313,11 +2143,11 @@   fi done if $ac_cache_corrupted; then-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;}-  as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file'+  as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file' 	    and start over" "$LINENO" 5 fi ## -------------------- ##@@ -2364,8 +2194,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2387,7 +2217,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2409,8 +2240,8 @@ if test ${ac_cv_prog_ac_ct_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$ac_ct_CC"; then+else case e in #(+  e) if test -n "$ac_ct_CC"; then   ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2432,7 +2263,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then@@ -2467,8 +2299,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2490,7 +2322,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2512,8 +2345,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else   ac_prog_rejected=no@@ -2552,7 +2385,8 @@     ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@"   fi fi-fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2576,8 +2410,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2599,7 +2433,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2625,8 +2460,8 @@ if test ${ac_cv_prog_ac_ct_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$ac_ct_CC"; then+else case e in #(+  e) if test -n "$ac_ct_CC"; then   ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2648,7 +2483,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then@@ -2686,8 +2522,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2709,7 +2545,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2731,8 +2568,8 @@ if test ${ac_cv_prog_ac_ct_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$ac_ct_CC"; then+else case e in #(+  e) if test -n "$ac_ct_CC"; then   ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2754,7 +2591,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then@@ -2783,10 +2621,10 @@ fi  -test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH-See \`config.log' for more details" "$LINENO" 5; }+See 'config.log' for more details" "$LINENO" 5; }  # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5@@ -2858,8 +2696,8 @@   printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5   test $ac_status = 0; } then :-  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.-# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'+  # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'.+# So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no' # in a Makefile.  We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf.@@ -2879,7 +2717,7 @@ 	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` 	fi 	# We set ac_cv_exeext here because the later test for it is not-	# safe: cross compilers may not add the suffix if given an `-o'+	# safe: cross compilers may not add the suffix if given an '-o' 	# argument, so we may need to know it at that point already. 	# Even if this section looks crufty: it has the advantage of 	# actually working.@@ -2890,8 +2728,9 @@ done test "$ac_cv_exeext" = no && ac_cv_exeext= -else $as_nop-  ac_file=''+else case e in #(+  e) ac_file='' ;;+esac fi if test -z "$ac_file" then :@@ -2900,13 +2739,14 @@ printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables-See \`config.log' for more details" "$LINENO" 5; }-else $as_nop-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5-printf "%s\n" "yes" >&6; }+See 'config.log' for more details" "$LINENO" 5; }+else case e in #(+  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5+printf "%s\n" "yes" >&6; } ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; }@@ -2930,10 +2770,10 @@   printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5   test $ac_status = 0; } then :-  # If both `conftest.exe' and `conftest' are `present' (well, observable)-# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will-# work properly (i.e., refer to `conftest.exe'), while it won't with-# `rm'.+  # If both 'conftest.exe' and 'conftest' are 'present' (well, observable)+# catch 'conftest.exe'.  For instance with Cygwin, 'ls conftest' will+# work properly (i.e., refer to 'conftest.exe'), while it won't with+# 'rm'. for ac_file in conftest.exe conftest conftest.*; do   test -f "$ac_file" || continue   case $ac_file in@@ -2943,11 +2783,12 @@     * ) break;;   esac done-else $as_nop-  { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+else case e in #(+  e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link-See \`config.log' for more details" "$LINENO" 5; }+See 'config.log' for more details" "$LINENO" 5; } ;;+esac fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5@@ -2963,6 +2804,8 @@ main (void) { FILE *f = fopen ("conftest.out", "w");+ if (!f)+  return 1;  return ferror (f) || fclose (f) != 0;    ;@@ -3002,26 +2845,27 @@     if test "$cross_compiling" = maybe; then 	cross_compiling=yes     else-	{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+	{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs.-If you meant to cross compile, use \`--host'.-See \`config.log' for more details" "$LINENO" 5; }+If you meant to cross compile, use '--host'.+See 'config.log' for more details" "$LINENO" 5; }     fi   fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out+rm -f conftest.$ac_ext conftest$ac_cv_exeext \+  conftest.o conftest.obj conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then :   printf %s "(cached) " >&6-else $as_nop-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+else case e in #(+  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */  int@@ -3053,16 +2897,18 @@        break;;   esac done-else $as_nop-  printf "%s\n" "$as_me: failed program was:" >&5+else case e in #(+  e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile-See \`config.log' for more details" "$LINENO" 5; }+See 'config.log' for more details" "$LINENO" 5; } ;;+esac fi-rm -f conftest.$ac_cv_objext conftest.$ac_ext+rm -f conftest.$ac_cv_objext conftest.$ac_ext ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; }@@ -3073,8 +2919,8 @@ if test ${ac_cv_c_compiler_gnu+y} then :   printf %s "(cached) " >&6-else $as_nop-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+else case e in #(+  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */  int@@ -3091,12 +2937,14 @@ if ac_fn_c_try_compile "$LINENO" then :   ac_compiler_gnu=yes-else $as_nop-  ac_compiler_gnu=no+else case e in #(+  e) ac_compiler_gnu=no ;;+esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu-+ ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; }@@ -3114,8 +2962,8 @@ if test ${ac_cv_prog_cc_g+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_save_c_werror_flag=$ac_c_werror_flag+else case e in #(+  e) ac_save_c_werror_flag=$ac_c_werror_flag    ac_c_werror_flag=yes    ac_cv_prog_cc_g=no    CFLAGS="-g"@@ -3133,8 +2981,8 @@ if ac_fn_c_try_compile "$LINENO" then :   ac_cv_prog_cc_g=yes-else $as_nop-  CFLAGS=""+else case e in #(+  e) CFLAGS=""       cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */ @@ -3149,8 +2997,8 @@ if ac_fn_c_try_compile "$LINENO" then : -else $as_nop-  ac_c_werror_flag=$ac_save_c_werror_flag+else case e in #(+  e) ac_c_werror_flag=$ac_save_c_werror_flag 	 CFLAGS="-g" 	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */@@ -3167,12 +3015,15 @@ then :   ac_cv_prog_cc_g=yes fi-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;+esac fi-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;+esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext-   ac_c_werror_flag=$ac_save_c_werror_flag+   ac_c_werror_flag=$ac_save_c_werror_flag ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; }@@ -3199,8 +3050,8 @@ if test ${ac_cv_prog_cc_c11+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_cv_prog_cc_c11=no+else case e in #(+  e) ac_cv_prog_cc_c11=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */@@ -3217,25 +3068,28 @@   test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext-CC=$ac_save_CC+CC=$ac_save_CC ;;+esac fi  if test "x$ac_cv_prog_cc_c11" = xno then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; }-else $as_nop-  if test "x$ac_cv_prog_cc_c11" = x+else case e in #(+  e) if test "x$ac_cv_prog_cc_c11" = x then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; }-else $as_nop-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5+else case e in #(+  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; }-     CC="$CC $ac_cv_prog_cc_c11"+     CC="$CC $ac_cv_prog_cc_c11" ;;+esac fi   ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11-  ac_prog_cc_stdc=c11+  ac_prog_cc_stdc=c11 ;;+esac fi fi if test x$ac_prog_cc_stdc = xno@@ -3245,8 +3099,8 @@ if test ${ac_cv_prog_cc_c99+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_cv_prog_cc_c99=no+else case e in #(+  e) ac_cv_prog_cc_c99=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */@@ -3263,25 +3117,28 @@   test "x$ac_cv_prog_cc_c99" != "xno" && break done rm -f conftest.$ac_ext-CC=$ac_save_CC+CC=$ac_save_CC ;;+esac fi  if test "x$ac_cv_prog_cc_c99" = xno then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; }-else $as_nop-  if test "x$ac_cv_prog_cc_c99" = x+else case e in #(+  e) if test "x$ac_cv_prog_cc_c99" = x then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; }-else $as_nop-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5+else case e in #(+  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; }-     CC="$CC $ac_cv_prog_cc_c99"+     CC="$CC $ac_cv_prog_cc_c99" ;;+esac fi   ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99-  ac_prog_cc_stdc=c99+  ac_prog_cc_stdc=c99 ;;+esac fi fi if test x$ac_prog_cc_stdc = xno@@ -3291,8 +3148,8 @@ if test ${ac_cv_prog_cc_c89+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_cv_prog_cc_c89=no+else case e in #(+  e) ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */@@ -3309,25 +3166,28 @@   test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext-CC=$ac_save_CC+CC=$ac_save_CC ;;+esac fi  if test "x$ac_cv_prog_cc_c89" = xno then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; }-else $as_nop-  if test "x$ac_cv_prog_cc_c89" = x+else case e in #(+  e) if test "x$ac_cv_prog_cc_c89" = x then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; }-else $as_nop-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5+else case e in #(+  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; }-     CC="$CC $ac_cv_prog_cc_c89"+     CC="$CC $ac_cv_prog_cc_c89" ;;+esac fi   ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89-  ac_prog_cc_stdc=c89+  ac_prog_cc_stdc=c89 ;;+esac fi fi @@ -3343,8 +3203,8 @@ if test ${ac_cv_c_undeclared_builtin_options+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_save_CFLAGS=$CFLAGS+else case e in #(+  e) ac_save_CFLAGS=$CFLAGS    ac_cv_c_undeclared_builtin_options='cannot detect'    for ac_arg in '' -fno-builtin; do      CFLAGS="$ac_save_CFLAGS $ac_arg"@@ -3363,8 +3223,8 @@ if ac_fn_c_try_compile "$LINENO" then : -else $as_nop-  # This test program should compile successfully.+else case e in #(+  e) # This test program should compile successfully.         # No library function is consistently available on         # freestanding implementations, so test against a dummy         # declaration.  Include always-available headers on the@@ -3392,26 +3252,29 @@   if test x"$ac_arg" = x then :   ac_cv_c_undeclared_builtin_options='none needed'-else $as_nop-  ac_cv_c_undeclared_builtin_options=$ac_arg+else case e in #(+  e) ac_cv_c_undeclared_builtin_options=$ac_arg ;;+esac fi           break fi-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;+esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext     done     CFLAGS=$ac_save_CFLAGS-+   ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_undeclared_builtin_options" >&5 printf "%s\n" "$ac_cv_c_undeclared_builtin_options" >&6; }   case $ac_cv_c_undeclared_builtin_options in #(   'cannot detect') :-    { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+    { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot make $CC report undeclared builtins-See \`config.log' for more details" "$LINENO" 5; } ;; #(+See 'config.log' for more details" "$LINENO" 5; } ;; #(   'none needed') :     ac_c_undeclared_builtin_options='' ;; #(   *) :@@ -3423,8 +3286,9 @@ if test "x$ac_cv_have_decl_IN_MASK_CREATE" = xyes then :   ac_have_decl=1-else $as_nop-  ac_have_decl=0+else case e in #(+  e) ac_have_decl=0 ;;+esac fi printf "%s\n" "#define HAVE_DECL_IN_MASK_CREATE $ac_have_decl" >>confdefs.h @@ -3433,8 +3297,9 @@ if test "x$ac_cv_have_decl_IN_EXCL_UNLINK" = xyes then :   ac_have_decl=1-else $as_nop-  ac_have_decl=0+else case e in #(+  e) ac_have_decl=0 ;;+esac fi printf "%s\n" "#define HAVE_DECL_IN_EXCL_UNLINK $ac_have_decl" >>confdefs.h @@ -3445,8 +3310,9 @@ if test "x$ac_cv_have_decl_kFSEventStreamCreateFlagFileEvents" = xyes then :   ac_have_decl=1-else $as_nop-  ac_have_decl=0+else case e in #(+  e) ac_have_decl=0 ;;+esac fi printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS $ac_have_decl" >>confdefs.h @@ -3455,8 +3321,9 @@ if test "x$ac_cv_have_decl_kFSEventStreamCreateFlagFullHistory" = xyes then :   ac_have_decl=1-else $as_nop-  ac_have_decl=0+else case e in #(+  e) ac_have_decl=0 ;;+esac fi printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY $ac_have_decl" >>confdefs.h @@ -3465,8 +3332,9 @@ if test "x$ac_cv_have_decl_kFSEventStreamEventFlagItemCloned" = xyes then :   ac_have_decl=1-else $as_nop-  ac_have_decl=0+else case e in #(+  e) ac_have_decl=0 ;;+esac fi printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMCLONED $ac_have_decl" >>confdefs.h @@ -3475,57 +3343,13 @@ if test "x$ac_cv_have_decl_kFSEventStreamEventFlagItemIsHardlink" = xyes then :   ac_have_decl=1-else $as_nop-  ac_have_decl=0+else case e in #(+  e) ac_have_decl=0 ;;+esac fi printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK $ac_have_decl" >>confdefs.h  -# Check headers and functions required-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" @@ -3539,8 +3363,8 @@ # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. #-# `ac_cv_env_foo' variables (set or unset) will be overridden when-# loading this file, other *unset* `ac_cv_foo' will be assigned the+# 'ac_cv_env_foo' variables (set or unset) will be overridden when+# loading this file, other *unset* 'ac_cv_foo' will be assigned the # following values.  _ACEOF@@ -3570,14 +3394,14 @@   (set) 2>&1 |     case $as_nl`(ac_space=' '; set) 2>&1` in #(     *${as_nl}ac_space=\ *)-      # `set' does not quote correctly, so add quotes: double-quote+      # 'set' does not quote correctly, so add quotes: double-quote       # substitution turns \\\\ into \\, and sed turns \\ into \.       sed -n \ 	"s/'/'\\\\''/g; 	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"       ;; #(     *)-      # `set' quotes correctly as required by POSIX, so do not add quotes.+      # 'set' quotes correctly as required by POSIX, so do not add quotes.       sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"       ;;     esac |@@ -3667,7 +3491,6 @@  # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh-as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then :   emulate sh@@ -3676,12 +3499,13 @@   # is contrary to our usage.  Disable this feature.   alias -g '${1+"$@"}'='"$@"'   setopt NO_GLOB_SUBST-else $as_nop-  case `(set -o) 2>/dev/null` in #(+else case e in #(+  e) case `(set -o) 2>/dev/null` in #(   *posix*) :     set -o posix ;; #(   *) :      ;;+esac ;; esac fi @@ -3753,7 +3577,7 @@       ;; esac-# We did not find ourselves, most probably we were run as `sh COMMAND'+# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then   as_myself=$0@@ -3782,7 +3606,6 @@ } # as_fn_error  - # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking.@@ -3822,11 +3645,12 @@   {     eval $1+=\$2   }'-else $as_nop-  as_fn_append ()+else case e in #(+  e) as_fn_append ()   {     eval $1=\$$1\$2-  }+  } ;;+esac fi # as_fn_append  # as_fn_arith ARG...@@ -3840,11 +3664,12 @@   {     as_val=$(( $* ))   }'-else $as_nop-  as_fn_arith ()+else case e in #(+  e) as_fn_arith ()   {     as_val=`expr "$@" || test $? -eq 1`-  }+  } ;;+esac fi # as_fn_arith  @@ -3927,9 +3752,9 @@   if ln -s conf$$.file conf$$ 2>/dev/null; then     as_ln_s='ln -s'     # ... but there are two gotchas:-    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.-    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.-    # In both cases, we have to default to `cp -pR'.+    # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable.+    # In both cases, we have to default to 'cp -pR'.     ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||       as_ln_s='cp -pR'   elif ln conf$$.file conf$$ 2>/dev/null; then@@ -4010,10 +3835,12 @@ as_executable_p=as_fn_executable_p  # Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"+as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g"+as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated  # Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g"+as_tr_sh="eval sed '$as_sed_sh'" # deprecated   exec 6>&1@@ -4028,8 +3855,8 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by streamly $as_me 0.8.2, which was-generated by GNU Autoconf 2.71.  Invocation command line was+This file was extended by streamly $as_me 0.11.1, which was+generated by GNU Autoconf 2.72.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES   CONFIG_HEADERS  = $CONFIG_HEADERS@@ -4056,7 +3883,7 @@  cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\-\`$as_me' instantiates files and other configuration actions+'$as_me' instantiates files and other configuration actions from templates according to the current configuration.  Unless the files and actions are specified as TAGs, all are instantiated by default. @@ -4084,11 +3911,11 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-streamly config.status 0.8.2-configured by $0, generated by GNU Autoconf 2.71,+streamly config.status 0.11.1+configured by $0, generated by GNU Autoconf 2.72,   with options \\"\$ac_cs_config\\" -Copyright (C) 2021 Free Software Foundation, Inc.+Copyright (C) 2023 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -4139,8 +3966,8 @@     ac_need_defaults=false;;   --he | --h)     # Conflict between --help and --header-    as_fn_error $? "ambiguous option: \`$1'-Try \`$0 --help' for more information.";;+    as_fn_error $? "ambiguous option: '$1'+Try '$0 --help' for more information.";;   --help | --hel | -h )     printf "%s\n" "$ac_cs_usage"; exit ;;   -q | -quiet | --quiet | --quie | --qui | --qu | --q \@@ -4148,8 +3975,8 @@     ac_cs_silent=: ;;    # This is an error.-  -*) as_fn_error $? "unrecognized option: \`$1'-Try \`$0 --help' for more information." ;;+  -*) as_fn_error $? "unrecognized option: '$1'+Try '$0 --help' for more information." ;;    *) as_fn_append ac_config_targets " $1"      ac_need_defaults=false ;;@@ -4199,7 +4026,7 @@   case $ac_config_target in     "src/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/config.h" ;; -  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;+  *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;;   esac done @@ -4217,7 +4044,7 @@ # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned:-# after its creation but before its name has been assigned to `$tmp'.+# after its creation but before its name has been assigned to '$tmp'. $debug || {   tmp= ac_tmp=@@ -4241,13 +4068,13 @@  # Set up the scripts for CONFIG_HEADERS section. # No need to generate them if there are no CONFIG_HEADERS.-# This happens for instance with `./config.status Makefile'.+# This happens for instance with './config.status Makefile'. if test -n "$CONFIG_HEADERS"; then cat >"$ac_tmp/defines.awk" <<\_ACAWK || BEGIN { _ACEOF -# Transform confdefs.h into an awk script `defines.awk', embedded as+# Transform confdefs.h into an awk script 'defines.awk', embedded as # here-document in config.status, that substitutes the proper values into # config.h.in to produce config.h. @@ -4357,7 +4184,7 @@   esac   case $ac_mode$ac_tag in   :[FHL]*:*);;-  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;+  :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;;   :[FH]-) ac_tag=-:-;;   :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;   esac@@ -4379,19 +4206,19 @@       -) ac_f="$ac_tmp/stdin";;       *) # Look for the file first in the build tree, then in the source tree 	 # (if the path is not absolute).  The absolute path cannot be DOS-style,-	 # because $ac_f cannot contain `:'.+	 # because $ac_f cannot contain ':'. 	 test -f "$ac_f" || 	   case $ac_f in 	   [\\/$]*) false;; 	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; 	   esac ||-	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;+	   as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;;       esac       case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac       as_fn_append ac_file_inputs " '$ac_f'"     done -    # Let's still pretend it is `configure' which instantiates (i.e., don't+    # Let's still pretend it is 'configure' which instantiates (i.e., don't     # use $as_me), people would be surprised to read:     #    /* config.h.  Generated by config.status.  */     configure_input='Generated from '`
configure.ac view
@@ -3,7 +3,7 @@ # See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on # the macros used in this file. -AC_INIT([streamly], [0.8.2], [streamly@composewell.com], [streamly], [https://streamly.composewell.com])+AC_INIT([streamly], [0.11.1], [streamly@composewell.com], [streamly], [https://streamly.composewell.com])  # To suppress "WARNING: unrecognized options: --with-compiler" AC_ARG_WITH([compiler], [GHC])@@ -17,10 +17,6 @@ AC_CHECK_DECLS([kFSEventStreamCreateFlagFullHistory],[],[],[#include <CoreServices/CoreServices.h>]) AC_CHECK_DECLS([kFSEventStreamEventFlagItemCloned],[],[],[#include <CoreServices/CoreServices.h>]) AC_CHECK_DECLS([kFSEventStreamEventFlagItemIsHardlink],[],[],[#include <CoreServices/CoreServices.h>])--# Check headers and functions required-AC_CHECK_HEADERS([time.h])-AC_CHECK_FUNCS([clock_gettime])  # Output AC_CONFIG_HEADERS([src/config.h])
− dev/MAINTAINING.md 
@@ -1,396 +0,0 @@-# Maintainers' Guide--## PR Merge Checklist--* All the CI tests pass-* New tests are added where applicable-* Benchmarks are added where applicable-* Run benchmarks locally if you suspect any regressions-* Documentation is added for any new combinators-  * New combinators have time and space complexity annotations-  * New combinators have `since` annotation-* Changelog entry is added for exposed combinators.-* Identify breaking changes, or changes that may require depndency-  version bound changes. See https://pvp.haskell.org/. Also see the-  "Breaking changes section below".-* Optionally, look at hlint output if anything in that is worth fixing.-* Merge the PR by rebasing. Note that github always creates new commits when-  merged with rebase, it records the committer as well as the author in the-  commit. This makes the local branch diverge from master. You can rebase and-  merge the commit manually in your local git tree and push the resulting-  master branch to avoid new commits and divergence from the original tree.--## Release Checklist--* Check if any critical pending bugs or issues are to be included-* If this is a major release check if any previously deprecated features are to-  be removed in this release.-* Check pre-release APIs to be exposed, especially from streamly-examples-* PVP is adhered to, additionally do not change pre-release APIs in a-  minor release--* _Documentation_:--    * Documentation is updated.-    * Check if all the links in the docs are stable.-      * External links might point to the `master` branch of a few-        repositories. Pin them to a specific version that works with the current-        release.-      * You can run `rg '/blob/'` and `rg '/tree/'` to search for github links.-      * For example, links that point to `streamly-examples` point to its-        `master` branch. Instead, while making the release we need to pin the-        links to a specific revision that works with the latest commit of the-        current release.-      * Ideally, the distribution process should automatically replace these-        with current stable references.-    * The markdown documentation files have no broken links. See the section-      about [checking for broken-      links](#checking-for-broken-links-in-the-markdown-files) for more info.-    * Haddock docs are consistent with the changes in the release-    * Tutorial has been updated for new changes-    * Documents in the `docs` directory are consistent with new changes-    * All combinators have time and space complexity annotations-    * All combinators have `since` annotation-    * Modules that were renamed or APIs that moved to other modules should be-      marked as "since" the current release.-    * Check all released modules to ensure that they do not have any leftover-      `Internal` or `Pre-release` annotations.-    * Unreleased combinators should be marked with `Pre-release` or-      `Internal` annotations-    * Streamly homepage is updated with the release docs-      * FileSystem.Event.Windows/Darwin modules require special handling--* _Build and Test_:--    * All CIs are green-    * Run tests using bin/test.sh to test with memory restrictions-    * Manually build and test for all flags (esp. `dev` flag) not covered by CIs-    * Test prime GHC version with -O0 and -O1--* _Benchmarks_:--    * Check regressions from previous release-    * Run benchmarks with large stream size (`bench.sh --long`) to-      check for space leaks and to ensure constant memory usage for streaming-      operations.-    * Run benchmarks with `dev` flag on. Some `fileio` benchmarks are disabled-      in regular runs.-    * Check comparative benchmarks using streaming-benchmarks--* _Dependencies_:--    * Make sure all dependency bounds can use latest versions-    * Update `stack.yaml` to latest stable resolver, cleanup extra-deps-    * Make sure fusion-plugin is up to date and uploaded-    * Check the dependency footprint of the library. See-      [Generating Dependency Graph](#generating-dependency-graph) section.--* _Dependent Packages_:--    * Update-      [streamly-examples](https://github.com/composewell/streamly-examples)-      to make sure it runs with the latest release.-    * Check the performance of examples where applicable-    * Update:-      * streamly-bytestring-      * streamly-process-      * streamly-lz4--* _Update Package Metadata:_--    * Make sure the description in cabal file is in sync with the docs-    * Make sure CI configs include last three major releases of GHC in CI testing.-    * Update GHC `tested-with` field-    * Update `docs/Compiling.md` with the distributions tested with-    * Any docs linked inside haddock/cabal/changelog or any other such file-      should go in the extra-doc-files section instead of-      extra-source-files. Otherwise hackage shows the links as broken.-    * Make sure any additional files are added to `extra-source-files` in cabal-      file. Artifacts required for build, test, benchmarks, docs, licenses-      should be packaged. Build environment customization may or may not be-      packaged.--* _Copyrights and Contibutors_--    * Make sure contributors to the release are listed in-      `docs/CONTRIBUTORS.md`.-    * Bump the release version in `docs/CONTRIBUTORS.md`.-    * Make sure any third party code included in the release has been listed in-      `docs/Credits.md` and the license is added to the repo.--* _Update changelog & Version_:--    * Find API changes using `cabal-diff streamly 0.8.2 .` and record-      them in docs/API-changelog.txt.-    * Make sure all the bug fixes being included in this release are marked-      with a target release on github. So that users can search by release if-      they want.-    * Bump the package version in configure.ac and run autoreconf-    * Change the `Unreleased` section at the top of changelog file to the new-      release version number and the month/year of publishing.-    * Bump the package version in cabal file or package.yaml-    * Bump the package version in any docs/links, use something like-      `rg '0\.8\.'|grep -v -i since` to find any remaining occurrences of the-      old release.  Check `rg -i unreleased` for any remaining todos.--* _Upload_:--    * Wait for final CI tests to pass:--        * Mask out the build status lines from the-          [docs/Introduction.md](/docs/Introduction.md)-        * Upload to hackage-          * Use a clean workspace to create source distribution-          by freshly cloning the git repository. The reason for-          doing this is that we use wild-cards in cabal file for-          `extra-source-files`, these wild-cards may match additional-          files lying around in the workspace and unintentionally ship-          them as well.-          * Upload and verify the candidate-            * `cabal v2-sdist; cabal upload <tarpath>`-            * `cabal v2-haddock --haddock-for-hackage --enable-doc; cabal upload -d <tarpath>`-          * Publish the package-            * `cabal v2-sdist`; `cabal upload --publish <tarpath>`-            * Run packcheck on the uploaded package. To get the latest uploaded-              version from hackage, run `cabal unpack <package-name>`. You might-              have to run `cabal update`.-        * Create a git tag corresponding to the release where X.Y.Z is the new-          package version (`git tag vX.Y.Z && git push -f origin vX.Y.Z`).-        * Add to stackage (`build-constraints.yaml` in Stackage repo) if needed-        * Optionally upload `package-X.Y.Z-sdist.tar.gz` to github release page-            * Update release contributors on github release page-              (`git shortlog -s prev_tag..new_tag | sed $'s/^[0-9 \t]*/* /' | sort -f`)-        * Update and if needed release streaming-benchmarks package-        * Check https://matrix.hackage.haskell.org/package/streamly-        * Check haddocks on Hackage, upload if not built-        * Announce to haskell-cafe@haskell.org--## Breaking Changes--This section lists what constitutes breaking changes.  See-https://pvp.haskell.org/ breaking changes that can be determined by the-API alone. We specify some additional recommendations here:--Behavior changes, this kind of changes are nasty and should be avoided. If such-changes are made they should be emphasized adequately in the changelog:--* Silent changes in the behavior of an API without any changes to the-  signature.-* Even fixing a bug could break things as users may have employed workarounds-  for the bug.-* Changes in the behavior of a dependency may also cause a change in behavior.--Be cautious about the following:--* Change in version bounds of dependencies may cause compilation failure for-  some programs because they may not be able to find a build plan.-* Ideally, new warnings should not be considered breaking, dependencies-  should never be compiled with -Werror. But packages may not be following-  it perfectly.-* Deprecating an API may issue new warnings, however the code can still be-  compiled if warnings are not treated as errors.--Internal APIs:--* Internal APIs can change without having to change the major version. However,-  we should try to align the Internal API changes with a major release as long-  as possible.--## Managing Issues--We label the issues in different dimensions based on the lifecyle and different-management aspects of the issue. The folowing sections discuss the labels used-to manage the issues. If a new label is required, it should be discussed before-creating it.--### Disposition--The level-1 triaging of the issue determines the current disposition-of the issue. If no change is required the issue must have one of the-following labels:--* disposition:invalid-* disposition:question-* disposition:discussion-* disposition:duplicate-* disposition:wontfix--If a change is required we need to do level-2 triage of the issue, see the-sections below.--### Change type--When a change is required we need to put one of the __change type__-labels as part of level-2 triaging:--* type:performance: User visible impact on performance.-* type:testing: Improves testing or related to testing.-* type:usability: It is not convenient to use the library.-* type:documentation: documentation is not correct or sufficient.-* type:bug: A functionality issue, not working as expected.-* type:enhancement: includes a new feature or enhancement-* type:maintenance: A refactor or any other change with no user visible impact.--### Aspect--In addition we can put a __product aspect__ label describing a feature name or-any other product specific classification bucket.--* aspect:<aspect name>--### Severity--Optionally we can add a severity label to indicate how severe is the-impact of the bug/issue, which may determine how important it is to fix it. By-default the severity is normal, if it is high we put a label:--* severity:high--### API impact--For a user visible issue whether it has a release/changelog impact:--* api:new: includes a new feature or enhancement-* api:breaking: has a breaking impact on existing deployments-* api:deprecating: deprecates an existing functionality--__RULE__: Any commit that may affect the end user in some way MUST have-either a changelog entry OR MUST have an issue marked with one of the-above labels OR both.--### Priority--By default the issues are normal priority. We use a label for high priority-issues:--* priority:high--### Scheduling--If the issue is assigned to someone then it is considered scheduled. Otherwise-it is unscheduled.  Unassigned issues may have the following labels:--* sched:deferred: deliberately deferred for some reason.-* sched:blocked: blocked on any other fix or a decision to be mad--### For Contributors--* help-wanted: anyone can take the issue and contribute-* good-first-issue: good for new contributors--## Correlating Changes, Issues and Releases--For planning purposes, open issues may be marked with milestones or target-releases.  However, it may not always be known which release a fix will finally-land in.  For example, we may decide to make a minor release instead of a major-one if there are no breaking changes yet, so we may not always know what would-be the next release version.--Trackability means that we should be able to find which issues got fixed in-which release. Or what all issues got fixed in a particular release. We track-significant changes using the changelog. However, there may be more changes-that can only be tracked via issues, PRs or commits.  When we make a release we-can mark all the issues fixed in that release with a correct release target for-future trackability.--For better trackability of which issue got fixed in which release we need the-following:--* Before you close an issue make sure a commit or a PR fixing the issue is-  attached with it. In the commit message you can reference an issue like-  "fixes #50", you can do the same in a PR as well.-* Before we make a new release EVERY issue with a commit included in that-  release that affects the end user, especially bugs and breaking changes MUST-  have the target release correctly set.--## Changelog Management--Keep the unreleased changes in the `Unreleased` section at the top of changelog-file.  Using `Unreleased` instead of the next release number for unreleased-changes is important. First, we do not know the next release number in advance,-it could be a major or minor release.  Second, if we use the next release-number instead, then when adding a new change to the changelog, at one look we-cannot know whether the release number on top is unreleased or released.--## TODO--* GPG signed releases and tags--## Generating Dependency Graph--Ways to get the dependencies. In the streamly package top dir:--```-# Keep only streamly in the packages section of stack.yaml-$ stack --system-ghc dot . --external|dot -Tpdf > streamly.pdf-```--Using nix, remove the test and benchmark components from-`shellFor/packages` in `default.nix` to get library only-dependencies. May show additional ghc boot libraries.--```-$ nix-shell --run "ghc-pkg dot | dot -Tpdf > streamly.pdf"-```--## Checking for broken links in the markdown files--You can use [markdown-link-check](https://github.com/tcort/markdown-link-check)-for finding broken links.--You can run it using `npx` like so:-```-npx markdown-link-check <markdown-file>-```--The following command - when run from the repository root - finds all the-markdown files that we need to consider:--```-find . -type f -name "*.md" \-    -not -path "./dist*" \-    -not -path "./.stack*" \-    -not -path "./benchmark/bench-report/dist*"-```--The following executes the markdown link checking with proper configuration on-the results. This also checks all the links are absolute to the root of the-repo.--```-find . -type f -name "*.md" \-    -not -path "./dist*" \-    -not -path "./.stack*" \-    -not -path "./benchmark/bench-report/dist*" \-    -exec npx markdown-link-check -c /dev/stdin --quiet {} \; <<EOF-{-  "ignorePatterns": [-    {-      "pattern": "^http"-    },-    {-      "pattern": "^ftp"-    },-    {-      "pattern": "^mailto"-    }-  ],-  "replacementPatterns": [-    {-      "pattern": "^", "replacement": "{{BASEURL}}"-    }-  ]-}-EOF-```--Once you run that, you can check all the links again without the config,-filtering in only `http`, `ftp`, and `mailto` links.--```-find . -type f -name "*.md" \-    -not -path "./dist*" \-    -not -path "./.stack*" \-    -not -path "./benchmark/bench-report/dist*" \-    -exec npx markdown-link-check --quiet {} \; 2>&1 | grep -e "http" -e "ftp" -e "mailto"-```
− dev/ci-tests.md 
@@ -1,54 +0,0 @@-# Continuous integration tests--This file documents the required CI test matrix so that we do not accidentally-remove or miss any tests when making changes to CI configs:--## For prime GHC version:--Distribution:-  * build from source distribution WITHOUT a cabal.project file--Performance:-  * `--flag inspection` + `--flag fusion-plugin`-  * Run `bin/bench.sh --quick --raw`-  * Run `bin/test.sh`-  * -Werror (for lib, test, bench)--Lint:-  * -Werror (for lib, test, bench) (Need a Werror with default flags)-  * hlint--Doctests:-  * Run cabal-docspec--Coverage:-  * `coverage` build--Debug:-  * --flag debug--StreamK:-  * --flag streamk--Windows:-  * Windows + stack--MacOS:-  * MacOS + stack--## Other GHC versions--GHC head:-  * `--flag inspection` + `--flag fusion-plugin` tests to catch any-    issues early.-  * Ideally we should also be running perf tests and compare-    against the prime version.--Other GHC versions:-* build lib, test, bench, docs, run tests, on Linux platform, using-  cabal build--## GHCJS--GHCJS:-* Latest version ghcjs build (lib, test, bench), run tests
− dev/container-api.md 
@@ -1,124 +0,0 @@-# Data Containers--Containers are persistent containers of data e.g. files, arrays, maps. For-consistency we use similar API for all such containers where possible. Usually-the API names are relative to the current module e.g. toBytes in an array-module means converting the array to bytes, it sounds intuitive if read-qualified with the module name e.g. Array.toBytes. This doc lists some-conventions and guidelines to be followed.--## Bytes and Chunks--APIs that deal with streams of Word8 may have "bytes" in their names-while the ones dealing with "Array Word8" have "chunks" in their-names. Usually the default is bytes when there is no explicit mention in-the name.--## Unfolds and Folds--* Unfolds are named as "read" or with a "read" prefix (e.g. readChunks).-* Folds are named as "write" or with a "write" prefix (e.g. writeChunks).--## To and from Stream--### From and Put--* Immutable construction from some external source is named with a "from"-  prefix (e.g.  fromList).-* Mutation of an existing container uses a "put" prefix instead of "from". When-  an API uses an existing container to write to and does not return a newly-  constructed container then use "put".-* "from" vs "put": "from" assumes creation of a new object, it may fail if the-  object being created already exists (e.g. the file exists), it may not take a-  lock as it assumes immutability. "put" may create a new object or overwrite-  an existing one, it may take a lock for writing as it assumes mutability.--### To and Get--* Converting the complete object to an external representation is prefixed with-  "to" (e.g. toBytes).-* For mutable objects "get" APIs may be used instead of "to" APIs.-* "to" vs "get": "to" assumes immutable object so does not have to take a lock.-  "get" assumes mutable object so may take a lock.--### Append--* Use "append" prefix for appending data at the end of a mutable container--## With additional config--Sometimes we need to modify the behavior of a combinator using some additional-config. For example, combinators to read/write using a specified size of-buffer. For such cases we apply the "With" suffix to standard combinator names:--* readWith-* readChunksWith-* toBytesWith-* getBytesWith--## Random Access (Arrays)--### Single elements--* getIndex (for arrays)-* putIndex (for mutable arrays)--### Ranges--* ...FromTo (e.g. readFromTo, readChunksFromTo, toBytesFromTo, getBytesFromTo)-* ...FromThenTo-* ...Indices--FromThenTo vs FromStepN:--We could use `fromThenTo` or `fromStepN` style APIs for stepwise-enumeration. The first one uses absolute numbers whereas the second one-uses relative positioning. We prefer FromThenTo style where possible for-the following reasons:--* It is the style used in base lists, and we are already using it in Enumerable-  type class.-* Both have their pros and cons. In `fromThenTo`, (1) it may be-  non-intuitive whether `To` is inclusive, (2) specifying an empty range-  is a bit awkward (e.g. fromThenTo 1 1 0). In `fromStepN`, if we know-  the first and the last element then we will have to compute the offset-  correctly. Ideally, when we know the elements then former is more-  suitable while if we know the count then the latter is more suitable.--Note that in case of floating point numbers `FromStep` style may have an-advantage over `FromThen` style. Here is a quote from the documentation of-`enumerateFromThenNum`:--```-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.-```--### Appending--* append (for mutable arrays)--## Key-Value Store Access (Maps)--* getKey-* findKey (test existence)-* createKey (insert new key for mutable maps)-* putKey (insert or update for mutable maps)-* updateKey (update existing or fail)-* deleteKey  (delete existing or fail)-* destroyKey (delete existing or not)--## Points to Consider--The fold and unfold APIs can be used to express the to/from stream APIs. So we-may not need both, it may just add to more APIs being proliferated.--We may need an "append" style fold as well? What would "stream" append-operations be called then?--We may need locked version of "write" folds for mutable containers for-concurrent access.
− dev/cps-vs-direct.rst 
@@ -1,328 +0,0 @@-Structured Loops (Direct Style)-===============================--::--  -- | Result of taking a single step in a stream-  data Step s a where-    Yield :: a -> s -> Step s a-    Stop  :: Step s a--  -- | Representation of a loop, step and state. Step returns the next value and-  -- the next state. We iterate on the state to keep producing more values.-  data Stream m a = forall s. Stream (s -> m (Step s a)) s--Generating-------------::--  nil :: Monad m => Stream m a-  nil = Stream (const (return Stop)) ()--  -- | A single value-  fromPure :: Applicative m => a -> Stream m a-  fromPure x = Stream step True--      where--      step True  = return $ Yield x False-      step False = return $ Stop--  fromList :: Applicative m => [a] -> Stream m a-  fromList = Stream step--      where--      step _ (x:xs) = pure $ Yield x xs-      step _ []     = pure Stop--Eliminating--------------::--  foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b-  foldrM f z (Stream step state) = go state--      where--      go st = do-            r <- step st-            case r of-              Yield x s -> f x (go s)-              Stop      -> z--In the above code the state is explicit and being threaded around in a-recursive loop. The state from the previous iteration is to be consumed-by the next iteration to generate the next value.  This mandates a-closed recursive loop. This is straightforward translation of imperative-loops to functional paradigm.--Transforming Loops---------------------::--  mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b-  mapM f (Stream step state) = Stream step' state--      where--      step' st = do-          r <- step st-          case r of-              Yield x s -> f x >>= \a -> return $ Yield a s-              Stop      -> return Stop--State wrapping-----------------Some operations like "drop" (uniq, intersperse, deleteBy, insertBy) may-have to introduce a branch in the code by wrapping the state in another-layer::--  drop :: Monad m => Int -> Stream m a -> Stream m a-  drop n (Stream step state) = Stream step' (state, Just n)--      where--      step' (st, Just i)-        | i > 0 = do-            r <- step st-            return $-              case r of-                Yield _ s -> step' (s, Just (i - 1))-                Stop      -> Stop-        | otherwise = step' (st, Nothing)--      step' (st, Nothing) = do-        r <- step st-        return $-          case r of-            Yield x s -> Yield x (s, Nothing)-            Stop      -> Stop--Note that the branch is always checked for every element in the stream.-It is still quite efficient because the code fuses.--We should use rewrite rules to fuse such consecutive operations together as-they introduce branching which could be costly.--Composing Loops------------------Composing two independent loops together is not scalable, we need-to create a wrapper state, wrapping the state of the old stream:--::--  cons :: Monad m => m a -> Stream m a -> Stream m a-  cons m (Stream step state) = Stream step1 Nothing--      where--      step1 Nothing   = m >>= \x -> return $ Yield x (Just state)-      step1 (Just st) = do-          r <- step st-          return $-            case r of-              Yield a s -> Yield a (Just s)-              Stop      -> Stop--As we keep consing we keep creating more layers wrapping the state in-``Maybe``. These layers need to be traversed every time we run the step-function of the composed stream. In the above example ``step1`` needs-to always branch on ``Nothing/Just`` to reach to the wrapped stream. More-layers we add the more branching needs to occur to generate an element-of the stream. If we have ``n`` "cons" operations we need to go through:--* 1 branch at the top level to generate the first element-* 2 branches to generate the next element-* 3 branches to generate the third element-* n branches to generate the nth element--The total number of branches that we need to take is: ``1 + 2 + 3 ... n`` i.e.-``n * (n + 1)/2 = O(n^2)`` where ``n`` is the number of cons operations.--Conceptually, to avoid the introduction of a branch we could use a-mutable step function and state to modify step1/state after yielding-the first element. The next time we call it, it would be a different-function that i.e. "step" and its state "st". However, that would introduce-an indirection and mutability. There is a better way to do it with-immutability i.e. CPS.--CPS representation-==================--In the direct representation we represented a stream using a step and a-state. This model requires us to iterate the step on the state creating-an explicit loop. The state machine implemented by the step function is-incrementally modified by adding new layers in the state which introduce-branches to be traversed every time we go through the loop.--::--  newtype Stream m a = Stream-      { runStream :: forall r. (a -> Stream m a -> m r) -> m r -> m r }--Here we represent the stream as a single function.  Instead, the-function is provided with functions to be called next.--Notice, the function does not have to be called again and again to-iterate on a state for generating new values.  Therefore, there is no-closed recursion. There is no explicit loop.--We (the current ``runStream`` function) can choose which one of the supplied-functions (continuations) to call next.  If we decide to terminate-the stream execution we call the "stop" continuation. If we decide to-generate a value we call the "yield" continuation.--A stream execution is composed of a progression of such continuations-until one of those decides to call the stop continuation.  It is a-composition of functions, a tree of functions composed together.--Yield continuation---------------------The yield continuation is provided with the generated value "a" and the-"Stream m a", the function representing the rest of the stream. Notice-that the stream function is done with one shot execution, there is no-closed loop or recursion, the future execution of the stream is the-responsibility of the continuation.--The continuation consumes the element "a" and then proceeds to call-"Stream m a" using a "yield" and "stop" continuation. By modifying the-"yield" and "stop" continuations that it passes to call "Stream m a", it-can control the execution of the stream.--Generating-------------::--  nil :: Stream m a-  nil = Stream $ \_ stp -> stp--  fromPure :: a -> Stream m a-  fromPure a = Stream $ \yield _ -> yield a nil--  cons :: a -> Stream m a -> Stream m a-  cons a r = Stream $ \yld _ -> yld a r--  fromList :: [a] -> Stream m a-  fromList = Prelude.foldr cons nil--Eliminating--------------::--  foldrM :: (a -> m b -> m b) -> m b -> Stream m a -> m b-  foldrM step acc m = go m-      where-      go m1 =-          let stop = acc-              yieldk a r = step a (go r)-          in runStream yieldk stop m1--Note that unlike in direct style fold, there is no generator state being-threaded around here instead the function yielded by the continuation is-being executed.--Transforming---------------::--  map :: (a -> b) -> Stream m a -> Stream m b-  map f = go--      where--      go m1 =-          Stream $ \yld stp ->-            let yieldk a r = yld (f a) (go r)-            in runStream yieldk stp m1--In direct style we had to examine the constructors to determine the-current state and execute code based on that. Here, we have to make-the next function call at each step. The former is much more efficient-because the compiler can optimize well to remove the constructors and-generate code with direct branches not involving the constructors. On-the other hand placing a function call is costlier. Though in some cases-it can be avoided by using foldr/build fusion but not always.--goto-------::--  drop :: Int -> Stream m a -> Stream m a-  drop n = Stream $ go n--      where--      go n1 m1 =-        Stream $ \yld stp ->-          let yieldk _ r = runStream yld stp $ go (n1 - 1) r-          in if n1 <= 0-             then runStream yld stp m1-             else runStream yieldk stp m1--This shows a crucial difference between direct style and CPS. In direct-style we have to always check for the branch to determine if we are-dropping the elements or consuming. In this case we can see that once-we have taken the "then" path we never have to check the condition "n1-<= 0", it is out of the way.--Basically CPS provides us the ability to take an exit path and forget-about the past code forever. So if we have a million "drop" composed-together CPS would have no problem, after the final drop there won't be-any branches in the way whereas direct style would introduce a million-branches to be traversed forever.--Combining Streams--------------------::--  cons :: a -> Stream m a -> Stream m a-  cons a r = Stream $ \yld _ -> yld a r--Unlike in direct style representation, the performance of stream-generation is independent of the number of "cons" operations. There is-no quadratic complexity, we simply call the next continuation at each-step.--Similarly appending streams is independent of number of appends.--::--  serial :: Stream m a -> Stream m a -> Stream m a-  serial m1 m2 = go m1--      where--      go m =-        Stream $ \yld stp ->-           let stop       = runStream yld stp m2-               yieldk a r = yld a (go r)-           in runStream yieldk stop m--Interleaved production and consumption-----------------------------------------In the direct style we have an explicit stream generator. A consumer-generates values using the generator and consumes them. In CPS the-consumer and generator are interleaved. The ``runStream`` function is a-generator and the "yield" continuation is a consumer. The consumer then-calls the generator again and so on.--Loop vs goto---------------The direct style representation is like a structured loop with well-defined exit points. Whereas the CPS representation can exit from-anywhere. Therefore, exception handling and resource management in-direct style is much simpler to implement.
− dev/dfa-bytes.png

binary file changed (18288 → absent bytes)

− dev/dfa-classes.png

binary file changed (15413 → absent bytes)

− dev/dfa-rearr.png

binary file changed (16619 → absent bytes)

− dev/linked-lists.md 
@@ -1,32 +0,0 @@-# Linked Lists--The immutable Haskell lists or streams are great for stream processing.-However, they may not be suitable for purposes where we need to store data for-a longer while. In such cases we need mutable linked lists in pinned memory for-high performance applications i.e. we need the C like linked lists. Here are-some cases where linked-lists may be warranted instead of immutable lists:--* Let's say we want to buffer incoming data in a list. The buffered data may be-  millions of elements. When we are buffering we may allocate cells from-  different areas of the GC heap. When there are other activities going on we-  may have to keep copying this buffered data during GCs. When we consume this-  buffer, again it creates a fragmented heap and we may have to copy some other-  long-lived data to defragment the heap. The point is that we should not have-  long-lived data in the GC heap.--* When we delete a node in the list, Haskell lists have to be recreated-  generating a lot of garbage. We cannot take a reference to the unmodified-  segments and reuse them in the new list. On the other hand with mutable-  linked-lists we can delete a node cheaply. This could be a common case in a-  hash table collision chain which requires deletion of elements.--* Similar to deletion, if we need to insert an element in the middle of the-  list, an immutable list has to be re-created.--* To implement a queue, two lists in the immutable model can be used-  efficiently if we are strictly adding at the end and deleting from the front-  and if there is sufficient batching so that swapping of the lists is not a-  common operation. If we have to insert elements in the middle or if we have-  to swap too many times again we will have the same GC issues as stated above.-  For example, in implementations of priority search queues or timer wheels we-  have to mutate the lists.
− dev/module-organization.md 
@@ -1,250 +0,0 @@-# Internal vs External Modules--## Exposing Internal Modules--We keep all modules exposed to facilitate convenient exposure of experimental-APIs and constructors to users. It allows users of the library to experiment-much more easily and carry a caveat that these APIs can change in future-without notice.  Since everything is exposed, maintainers do not have to think-about what to expose as experimental and what remains completely hidden every-time something is added to the library.--## Internal module Namespace--We expose the internal modules via `Streamly.Internal.*` namespace to keep all-the internal modules together under one module tree and to have their-documentation also separated under one head in haddock docs.--## Exposed Modules as Wrappers--Another decision point is about two choices:--* Keep the implementation of all the APIs in an internal module and just-reexport selected APIs through the external module. The disadvantages of this-are:--  1) users may not be able to easily figure out what unexposed APIs are available-  other than the ones exposed through the external module. To avoid this problem-  we can mark the unexposed APIs in the docs with a special comment.--  2) In tests and benchmarks we will be using internal modules to test internal-  and unexposed APIs. Since exposed APIs are exported via both internal and-  external modules we will have to be careful in not using the internal module-  for testing accidentally, instead we should always be using the exposed module-  so that we are always testing exactly the way users will be using the APIs.--* Keep the implementations of unexposed modules in the internal module file-and exposed module in the external module file. In this approach, users can-easily figure out the unexposed vs exposed APIs. But maintaining this would-require us to move the APIs from internal to external module file whenever we-expose an API.--We choose the first approach.--# Module Types and Naming--## Abstract modules--An abstract module represents an abstract interface using a type-class.  Multiple concrete modules can make use of this interface and possibly-extend it.--For example we have an `IsStream` type class that all stream types-implement.  The concrete stream types are `SerialT`, `AsyncT`-etc. Assuming `Streamly.Data.Stream` is the containing name space for-all stream modules, there are multiple ways to organize abstract and-concrete modules. The `IsStream` type class can be placed in:--* `Streamly.Data.Stream.Class` or `Streamly.Data.Stream.Interface`-* `Streamly.Data.Stream.IsStream`-* `Streamly.Data.Stream`--Using `Streamly.Data.Stream.IsStream` is preferred over `.Class` because it-conveys more information by the class name. We can place it in-`Streamly.Data.Stream` as well.--Concrete modules depend on the abstract module `IsStream` to implement-that interface.--Polymorphic operations utilizing the abstract interface can go in the-parent module `Streamly.Data.Stream`.--## Constrained Modules--Some modules represent operations on a type which constrain a type using a type-class or a specific instance of a general type. For example, we may have Arrays-that operate on a `Storable` or a `Prim` type.--One possible way to organize such module is to have a `Storable` or `Prim`-hierarchy and all data structures using that type constraint are bundled under-it. However, in general, a data structure may have multiple such-constraints or may have to be organized based on some other dimension-like an abstract interface it is implementing.--General purpose constraints like `Prim` can be defined in their own module-hierarchy and can be used everywhere. For example, we can have the following-Array types, here we have organized the types under the `Array` hierarchy-rather than putting the `PrimArray` under a `Prim` hierarchy.--```-Streamly.Internal.Data.Array.Boxed-Streamly.Internal.Data.Array.Prim-Streamly.Internal.Data.Array.Prim.Pinned-```--## Common Modules--Some modules represent common types or utility functions that are shared across-multiple higher level modules. Possible naming for such modules are:--* `Module.Types`-* `Module.Common`-* `Module.Core`-* `Module.Shared`--## Aggregate modules--In some cases we may want to aggregate the functionality of several small-modules in a combined aggregate module. In many cases, the aggregate module is-made a parent module of the constituent modules.  The parent module depends on-the child modules and exposes the functionality from the constituent modules.--## Placeholder Modules--In some cases a parent module is just a placeholder in the namespace and does-not export any functionality.--# Polymorphic vs Monomorphic Modules--In general we can just provide a polymorphic stream API and let the user use it-at the type he/she wants to use it. However, it has some disadvantages:--* Some constraints e.g. "MonadAsync" are unnecessarily imposed on all APIs even-  though they are needed by only concurrent types.-* type errors could be harder to resolve when using polymorphic types-* combinators like `fromAsync` can make all the combinators concurrent in one go-  which is usually problematic. If we use monorphic combinators it encourages-  to pick the required concurrent combinators one at a time which is-  usually better for performance.--Keeping this in mind our plan is to provide monomoprhic modules for each stream-type, keep the combinators that are specific to that stream type in the-monomorphic module and combinators that are exactly the same for all stream-types can be kept in the polymorphic module or in both the modules. Having-complete set of operations available in the monomorphic module has the-advantage that if we want we can just import a `Serial` module and get-everything if we just want to use the Serial stream.--# Streamly Modules--We use the "Streamly" prefix to all the module names so that they do not-conflict with any other module on Hackage.--We have the following module hierarchy under Streamly:--* Data: This is a generic bucket for basic data structures a la the `base`-  package's `Data` hierarchy.-    * Streamly.Data.Array--  Streams can be classified under `Data` or `Control`.  Though they are-  mostly used for processing, they can also be used to store data in-  memory.-    * Streamly.Data.Stream--  The following modules could in fact be classified under `Control`-  too as they are about processing of data rather than data itself:-    * Streamly.Data.Unfold-    * Streamly.Data.Fold-    * Streamly.Data.Parser--* Unicode: Unicode text processing:-    * Streamly.Unicode.Char       -- operations on individual chars-    * Streamly.Unicode.Stream     -- operations on streams of Char-    * Streamly.Unicode.Array.Char -- compact strings of UTF-32 chars-    * Streamly.Unicode.Array.Utf8 -- compact strings of UTF-8 encoded chars--* FileSystem: This name space is for data structures that reside in files-  provided by a file system interface on top of storage devices.--* Network: This name space is for APIs that access data from remote computers-  over the network.--## Stream modules--By default the streaming modules are effectful. The basic effectful-stream types are:--* `Streamly.Data.Stream`-* `Streamly.Data.Stream.Async`-* `Streamly.Data.Stream.Ahead`-* `Streamly.Data.Stream.Parallel`-* `Streamly.Data.Stream.IsStream` -- polymorphic operations-* `Streamly.Data.Stream.Using`    -- e.g. mapMUsing consMAsync--The above streams have an append-like multi-stream combining behavior-i.e. `concatMap` and `bind` would by default evaluate the streams one-after another. Alternative implementations of `concatMap` and `bind` are-possible. We can either use rebindable syntax to use a different bind or-define newtypes with a different bind behavior, all other operations for-these remain the same as the base type:--* `Streamly.Data.Stream.Zip`-* `Streamly.Data.Stream.Interleaved`-* `Streamly.Data.Stream.RoundRobin`-* `Streamly.Data.Stream.Async.Zip`-* `Streamly.Data.Stream.Async.Interleaved`-* `Streamly.Data.Stream.Async.RoundRobin`-* ...--Pure streams are a special case of effectful streams and have the same-interface as lists, so we put them under `Streamly.Data.List`:--* `Streamly.Data.List`-* `Streamly.Data.List.Zip`-* `Streamly.Data.List.Interleaved`-* `Streamly.Data.List.RoundRobin`-* ...--We could possibly use the same type named `Stream` for all stream-types, as the names of all stream operation are also the same and we-distinguish only by the module name.--## Array modules--Similarly, the immutable Array modules would go in:--* `Streamly.Data.Array`                  -- unpinned, native memory arrays-* `Streamly.Data.Array.Storable`         -- unpinned, unboxed, native memory arrays-* `Streamly.Data.Array.Storable.Pinned`  -- pinned, unboxed, native memory arrays-* `Streamly.Data.Array.Foreign` -- pinned, unboxed, foreign capable arrays--Unboxed arrays, based on `Prim` type class:--* `Streamly.Data.Array.Prim`-* `Streamly.Data.Array.Prim.Pinned`--Mutable arrays are a generalization of immutable arrays:--* `Streamly.Data.Array.Mut`-* `Streamly.Data.Array.Storable.Mut`-* `Streamly.Data.Array.Storable.Pinned.Mut`-* ...--## Stream and Fold Channels (SVar)--* `Streamly.Data.Stream.Channel`-* `Streamly.Data.Stream.Channel.Storable`-* `Streamly.Data.Fold.Channel`-* `Streamly.Data.Fold.Channel.Storable`--## Mutable variables--Unboxed IORef:--* `Streamly.Data.IORef.Prim`--## Strict Data--* `Streamly.Data.Tuple.Strict`-* `Streamly.Data.Maybe.Strict`-* `Streamly.Data.Either.Strict`
− dev/optimization-guidelines.md 
@@ -1,358 +0,0 @@-# Guidelines for writing well optimized code--Stream operations are always part of a loop. Usually the loop consists of a-stream generation or an unfold operation followed by stream transformation-functions (e.g. map) and then a stream elimination operation or a fold-operation.--The default or most common stream representation used in streamly is-`StreamD` which is a direct style (compare with CPS representation-`StreamK`) stream representation.  All the direct style operations in-a loop "fuse" together to form a tight machine loop eliminating any-intermediate constructors, therefore, reducing allocations and cpu cost.-This elimination of intermediate constructors in a stream loop is known-as stream fusion.--## Writing high performance code using streamly--This section outlines guidelines for writing code using the available-combinators. The guidelines for writing new combinators are provided in-the following section.--Note that there is no absolute benchmark for performance, most of-the time even without following the guidelines you may get excellent-performance for the task at hand. Two important points to keep in mind-before you optimize:--* See if you actually need more performance-* See if the code you are optimizing is in fast path--### Stream Fusion--When your performance requirements are stringent you may want to care-about not breaking stream fusion unnecessarily.  Certain operations do-not fuse and act as a barrier to stream fusion. If these operations are-part of a loop, the loop won't fuse completely. In some cases these may-be necessary but in others it may be possible to replace these with-better fusing operations. These operations include:--* Avoid unnecessary use of stream append operations in code that should-  fuse.  Append operations in general force CPS style breaking stream-  fusion.  Some direct style append operations can fuse but they won't-  scale for more than a few appends.-* Avoid unnecessary use of the stream monad if fusion is important. You-  may use functor or applicative though.-* Concurrent stream operations cannot fuse-* Operations involving exception primitives like catch/throw/mask-  on elements of the stream cannot fuse.-* Stream loops involving FFI calls on the elements of the stream--The haddock documentation includes a note when an operation cannot fuse.--### Unfolds--* Use unfolds especially when higher order operations are involved. For-  example, `unfoldMany` can fuse completely whereas `concatMap` would-  not fuse.-* Use `outerProduct` in `Unfold` module instead of using the monad instance of-  streams to fuse nested loops where performance matters. See the unfold-  benchmarks for an example. `outerProduct` can give you C like nested loop-  performance.--### Inlining--To make sure fusion can occur INLINE any operations that are part of a-stream loop but factored out as separate functions.--### Strictness--Keep the fold and scan accumulators strict. You could also consider-using mutable state in a fold accumulator if the state is large. A-large immutable structure as an accumulator may cause optimization-issues. See the `WordCount` example for an example of this case.--## Writing streamly combinators--To enable stream fusion in a direct style stream all the operations that-are part of a loop must be inlined:--* Use an explicit INLINE pragma on any combinator that could be part of a loop-  to ensure they will be inlined.-* When a higher order function consumes another function then ensure that the-  higher order function is inlined in the same phase or before the function it-  is consuming. Use appropriate inline phases to ensure proper inline ordering-  when required.--### Streams and Unfolds--Stream and Unfold State.  Direct style stream and unfold combinators use a-state data type to represent the internal state of the stream/unfold generator.--* In some cases we may have to add a `FUSE` annotation on the state type to-  ensure that all the internal join points created by GHC are inlined with the-  help of the `fusion-plugin`.-* In rare cases we may need to use a strictness annotation on the state-  to allow fusion. `parseMany` and `splitOnSeq` are such examples.--Step function of a stream or unfold:--* Do not introduce unnecessary states. If there is only one entry point of a-  state then perhaps you want to collapse the state into the state from which-  it is called. More states means more jumps and may affect code locality, and-  efficiency of low level code (e.g. register allocation) because of-  independent placement of the code blocks in different states.--  In some cases we may have to go against the above guideline and introduce a-  separate state even though it is not necessary. See the GroupConsume state in-  foldMany for an example.-* Keep minimum possible data in state. More variables in state may lead-  to poor performance because the state may not fit into registers and the-  spill may cause allocations on each iteration of the loop. Mutable state-  may help in such cases.-* The step function must be annotated such that it gets inlined after the main-  combinator (`INLINE_LATE`).--Multiple yield points or single?:--* A single yield point is usually desirable, however, not always necessary.-  In some cases multiple yield points may in fact be needed for fusion,-  see `splitOnSeq` for an example. Or maybe its fusing because of a-  direct yield instead of going through an indirect common yielding-  state.--Recursion in step function:--* In general, we avoid making the step function recursive. Use the-  `Skip` constructor to remove recursion. Recursive step function can-  introduce optimization barriers that are harder to remove by the GHC-  simplifier.--  However, in some cases it may be better to have a local recursive-  loop. A recursive loop can help us avoid threading around some large-  state values every time. Values that do not change across a loop can-  be factored in the scope outside the loop (static argument transform),-  this way we can create a local loop which is more efficient than-  threading around the state in a larger loop.  See the `splitOnSeq`-  combinator as an example where we use a local recursive loop, it fuses-  and is significantly efficient compared to using `Skip`.--  In a local recursive loop use SPEC and annotate even the rest of the-  loop arguments as strict where needed. We have observed that when the-  arguments were not strict the loop does not fuse (splitOnSeq).--### Fold and Parser drivers--Recursive loop closing operations:--* When writing recursive looping combinators using StreamD (e.g. foldlM' in-  StreamD) use a strict SPEC argument in the recursive loops to ensure that-  "Spec Constructor" optimization removes boxed arguments and reduces-  allocations.--### Fold and Parser combinators--State of a Fold or Parser:--* The accumulator of a fold must be a strict data structure. Use the strict-  data structures provided in `Streamly.Internal.Data` for this purpose or use-  explicit bang annotation to make the data strict.-* In some cases you may need a `FUSE` annotation on the state type to ensure-  that any internal join points created by GHC are always inlined with the help-  of the fusion-plugin.--The step function of a Fold or Parser:--* Never make the fold step recursive, recursion creates an optimization barrier-  for the GHC simplifier. Use `Partial` or `Continue` constructors to avoid-  recursion.--* Sometimes you may need an explicit INLINE on the step function.--### NOINLINE, isolating the closed loop--We want the loop iterations to be optimized and the loop stages to be fused to-generate a tighter loop. However, it is not necessarily optimal to inline the-whole loop itself into a parent function. For example, consider the following-function in the `FileSystem.Handle` benchmarks:--```-{-# NOINLINE readWriteAfter_Stream #-}-readWriteAfter_Stream :: Handle -> Handle -> IO ()-readWriteAfter_Stream inh devNull =-    let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)-     in S.fold (FH.write devNull) readEx-```--If this is inlined into a parent benchmark group list, this leads to-many times performance degradation. That's because inlining the loop-into a bigger structure interferes with the optimization of the loop-body itself and it may not fuse. Whereas it is desirable to INLINE all-the stages of a loop, it is often not useful to inline the whole loop-itself, in fact we may have to occasionally use a `NOINLINE` so that the-compiler does not inline it.--### NoSpecConstr--It is not always useful to specialize function calls for all constructors, some-constructors may just add to code bloat or add overhead of passing unboxed-values in a loop. In such cases the `NoSpecConstr` annotation can be useful.-See the `parselMx'` function in `StreamD` module.--### StreamK operations--StreamK uses foldr/build fusion to a very limited degree. StreamK is not the-primary representation in streamly but is used for several operations that-cannot scale in StreamD representation. StreamK is relatively immune to compiler-optimizations. In some cases you may need an INLINE pragma to improve the-performance.--### How to debug non-fusing code?--Strip down the code to a minimal version until it starts fusing and then-start building it up from there adding more things incrementally. At-each stage keep checking if the code is fusing. At some point it-won't fuse. See what we added that made the code not fuse. Go through-the guidelines above to check if we did something that that is not-recommended. Or raise an issue for GHC to be fixed if possible.--# GHC Optimizations In Streamly--There are three important levels of optimizations used in streamly:--* CPS style stream representation (StreamK) to direct style (StreamD)-  conversion and vice-versa using rewrite rules-* Stream fusion using case-of-case optimization in StreamD-* foldr/build fusion using rewrite rules in StreamK--## INLINE Phases--Inlining of functions at the right time is crucial for all these optimization-to work.  A missing inline or inline in an incorrect GHC simplifier phase can-adversely impact performance.  We use three builtin phases of GHC simplifier-for inlining i.e. phase 0, 1 and 2. We have defined them as follows in-  `src/inline.hs`:--```-#define INLINE_EARLY  INLINE [2]-#define INLINE_NORMAL INLINE [1]-#define INLINE_LATE   INLINE [0]-```--We also use INLINE [3] in some cases.--## `fromStreamD/toStreamD` Fusion--The combinators in `Streamly.Prelude` are defined in terms of combinators in-`Streamly.Internal.Data.Stream.StreamD` (Direct style streams) or-`Streamly.Internal.Data.Stream.StreamK` (CPS style streams). We convert the-stream from `StreamD` to `StreamK` representation or vice versa in some cases.--Most operations use the StreamD representation, however, stream append-operations and monad instances use StreamK representation because StreamD would-not perform well in these cases. We use rewrite rules to convert from one-representation to another when required. For this reason the combinators in-Streamly.Prelude are written using fromStreamD/fromStreamK etc.--In the first inlining phase (INLINE_EARLY or INLINE) we expand the combinators-in `Streamly.Prelude` into fromStreamD/fromStreamK/toStreamD/toStreamK and-combinators defined in StreamD or StreamK modules. Once we do that-fromStreamD/toStreamD get exposed and we can apply rewrite rules to rewrite-transformations like `fromStreamK .  toStreamK` to `id`. A plain `INLINE`-pragma is usually enough on combinators in `Streamly.Prelude`.--```-{-# RULES "fromStreamK/toStreamK fusion"-  forall s. toStreamK (fromStreamK s) = s #-}-```--Also, we have to prevent fromStreamK and toStreamK themselves from inlining in-this phase so that rewrite rules can be applied on them, therefore, we annotate-these functions with `INLINE_LATE`.--## Fallback Rules--In some cases, if the operation could not fuse we want to use a fallback-rewrite rule in the next phase. For such cases we use the INLINE_EARLY phase-for the first rewrite and the INLINE_NORMAL phase for the fallback rules.--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.--```-{-# INLINE_EARLY unfoldr #-}-unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a-unfoldr step seed = fromStreamS (S.unfoldr step seed)-{-# RULES "unfoldr fallback to StreamK" [1]-     forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}-```--## High Level Operation Fusion--Since each high level combinator in `Streamly.Prelude` is wrapped in-`fromStreamD/toStreamD` etc. the combinator fusion cannot work unless we have-removed those and exposed consecutive operations e.g. a `map` followed by-another `map`.  Assuming that redundant `fromStreamK/toStreamK` have been-removed in the `INLINE_EARLY` phase, we can then apply the combinator fusion-rules in the `INLINE_NORMAL` phase.  For example, we can fuse two `map`-operations into a single `map` operation.  Note that now we have exposed the-`StreamD/StreamK` implementations of combinators and the rules would apply on-those.--## Inlining Higher Order Functions--Note that partially applied functions cannot be inlined. So if we have a code-like this:--```-concatMap1 src = runStream $ S.concatMap (S.replicate 3) src-```--We want to ensure that `concatMap` gets inlined before `replicate` so that-`replicate` becomes fully applied before it gets inlined. Currently ensuring-that both of them are inlined in the same phase (`INLINE_NORMAL`) seems to be-enough to achieve that. In general, we should try to ensure that higher order-functions are inlined before or in the same phase as the functions they can-consume as arguments. This means `StreamD` combinators should not be marked-as `INLINE` or `INLINE_EARLY`, instead they should all be marked as-`INLINE_NORMAL` because higher order functions like `concatMap`/`map`/`mapM`-etc are marked as `INLINE_NORMAL`. `StreamD` functions in other modules like-`Streamly.Data.Array.Foreign` should also follow the same rules.--## Stream Fusion--In StreamD combinators, inlining the inner step or loop functions too early-i.e. in the same phase or before the outer function is inlined may block stream-fusion opportunities. Therefore, the inner step functions and folding loops are-marked as INLINE_LATE.--## Specialization--In some cases, the `step` function in `StreamD` does not get specialized when-inlined unless it is provided with an explicit signature or made a lambda, for-example, in the `replicate/replicateM` combinator we need the type annotation-on `i` to get it specialized:--```-    {-# INLINE_LATE step #-}-    step _ (i :: Int) =-        if i <= 0-        then return Stop-        else do-                x <- action-                return $ Yield x (i - 1)-```--`-flate-specialise` also helps in this case.--## Stream and Fold State Data Structures--Since state is an internal data structure threaded around in the loop, it is a-good practice to use strict unboxed fields for state data structures where-possible. In most cases it is not necessary, but in some cases it may affect-fusion and make a difference of 10x performance or more.  For example, using-non-strict fields can increase the code size for internal join points and-functions created during transformations, which can affect the inlining of-these code blocks which in turn can affect stream fusion.--See https://gitlab.haskell.org/ghc/ghc/issues/17075 .
− dev/overview.md 
@@ -1,24 +0,0 @@-# Streamly--This document is yet to be written. It is supposed to provide an overall-design overview for developers.--## Tricky Parts--The state-passing through each API is currently fragile. Every time we run a-stream we need to be careful about the state we are passing to it. In case of-folds where there is no incoming state, we start with the initial state-`defState`. When we have an incoming state passed to us there are two cases:--1. When we are building a concurrent stream that needs to share the same `SVar`-   we pass the incoming state as is.-2. In all other cases we must not share the SVar and every time we pass on the-   state to run a stream we must use `adaptState` to reset the `SVar` in the-   state.--When in doubt just use `adaptState` on the state before passing it on, we will at-most lose concurrency but the behavior will be correct.--There is no type level enforcement about this as of now, and therefore we need-to be careful when coding. There are specific tests to detect and report any-problems due to this, all transform operations must be added to those tests.
− dev/paths.rst 
@@ -1,230 +0,0 @@-Introduction---------------Paths are used by file systems as well as protocols to represent paths to files-and other resources. We need a generic type safe way to represent paths in-general and file system paths in particular.--Path limits--------------OS include files generally define PATH_MAX to 4K and NAME_MAX to 255,-however, it is possible to create paths bigger than these depending on-the file system.--Scalability--------------In general directory trees could be quite deep and a directory can contain-millions of entries. A good benchmark to measure the efficiency of path-representation would be to traverse a directory tree recursively and list all-the nodes under the tree. We could do this many times so that we do not need a-really big directory tree.--Compatibility----------------A file system starts with just the root directory and then files are-created in the file system by the user or by programs storing their data-on the file system. When a directory or file is created, or when a directory is-listed, the following operations are performed:--1. for lookups an existing directory name must be resolved based on the name-   supplied by the user.-2. for creation the file name to be created is supplied by the user--When the user asks the file system to lookup or create a file or-directory in the file system:--1) The operating system passes the name, as it is without any changes-   whatsoever, to the file system. or does it? Windows?-2) The file system may translate the name to its own conventions before a-   lookup or create, e.g. it may--   * change the name to upper case-   * translate the name to 8.3 chars-   * change the character encoding?-   * change the unicode normalization form of the name (Apple)--When resolving an existing directory name in the file system we need-to supply a path which consists of component names separated by a separator-byte. Separators are of no consequence to the file system, they are-resolved by the OS and the path components are used to lookup the paths-one components at a time. The path for lookup is acquired either by a-user input, device input or by the program which previously got the path-entries by traversing the file system itself.--1) When the path is acquired by a user input,  the user input could be:--   a) a literal string in the program-   b) a path entered via an input device-   c) a path coming from the network--2) If the path was previously acquired from the file system then the-   best thing to do is to never change anything in the path and store it-   as it is and supply exactly the same path when needed. That way we can-   guarantee that the path remains exactly what it was in the file system.--Handling String Literals-========================--The encoding of the source code file depends on the editor used and the-encoding chosen when saving it. The string literals would be parsed-by the GHC parser and then stored in the generated binaries as null-terminated C string literals encoded in UTF-8 (see GHC reference). There are-several possible points of failure here:--a) GHC parser needs to interpret the source code encoding correctly.-b) We assume that the editor does not perform any translation on the-   literal as entered by the user e.g. it does not perform unicode-   normalization on it. If it does then the string as entered by the user-   won't remain the same when it reaches the file system.-c) GHC parser stores the parsed string literal in UTF-8 encoding. We-   assume that GHC does not perform any unicode normalization or any-   other translation on the string.--The UTF-8 encoded string literal can be passed as a blob of bytes to the file-system or it can be converted to String type and re-encoded as UTF-8 both-should work equivalently in this case.--Handling Input From Devices-===========================--The path provided by the user would assume some encoding based on-the terminal settings or the encoding assumed by the sender over the-network. The correctness depends on the contract between the two parties-e.g. the locale setting. We assume that we get a sequence of raw bytes-from the input device. We need to use the sequence as raw bytes and send-it as it is to the file system without any translation.--Manipulating Paths---------------------We need to parse the path components by the separator bytes.  We assume-that the separator can be identified and removed correctly irrespective-of the encoding. We also make sure that none of the bytes in the-components is a separator byte.--Also, we would join the path components by the separator byte-irrespective of the encoding of the components. If the OS treats the-path as a sequence of bytes and nothing else and the components do not-have the separator byte then we are good, we know that the OS would also be-parsing based on the separator as a raw byte.--We may perform some validations on the paths such as the file names are-not "." or "..". Such validations could be optional and we could also-provide a way to not perform any validations and just blindly use the-paths as provided by the user and let the file system/OS fail.--File System Translations---------------------------As we noted earlier, the file system may translate the paths before-using them.  For example, it may store the path after converting it to-NFD unicode normalization. Translation may create some round tripping-issues for programs. For example, a program may use a string literal-which is stored in NFC and the file system converts it to NFD. Later,-when the same path is retrieved from the file system and compared with-the string literal that was to create it then it won't match. For such-cases the programs need to understand the file system and perform-comparisons by performing appropriate translations on the paths. To-perform matching and translations correctly the program needs to-correctly interpret the encoding specific to the file system.--Displaying Paths-------------------When we display the paths to the user then we are forced to interpret-it according to some encoding, to display the path correctly we have to-know exactly how the file system stores the path. Otherwise if we display-it differently, the user may use the displayed result to find the file-and may not find it.--Type Safety Requirements---------------------------* Safety against using an absolute path where a relative path is to be-  used and vice-versa.  -  -  * Validations for absolute or relative path when constructing a path.-  * We cannot append an absolute path to another path-* Safety against using a file name where a directory name is to be used and-  vice-versa.--  * Certain validations can be performed e.g. file names cannot be "." or "..".-  * We should not be appending more directory components to a file path--In don't care situations we should be easily able to use any type-conveniently or cast a type into another.  It is desirable that the-programmer can choose the safety level. For example, we should be able-to instantiate a path type where we only worry about the distinction-between Absolute and Relative paths but no distinction between files and-directories or vice versa.--Requirement Summary----------------------* minimal dependencies, specifically streamly does not depend on bytestring-* round-tripping safety wrt to file system returned paths-* type safety for different path types-* support Posix/Windows-* support URI paths and other ways to represent paths where the separator could-  be different.--Design Considerations------------------------* Should we store path as separate components or single string with-  separators?--* Should we validate the paths returned from the file system or trust-  those and use directly without any validations? Need to see if that makes-  any difference to path heavy benchmarks. If we want to use it directly-  then we have to store it as a single string.--* Parameterize the low level APIs with the separator so that we can-  support arbitrary separators when parsing or reconstructing paths.--* The low level API can support path handling in trees/DAGs/Graphs in general.-  For example, in trees we cannot have multiple parents of a child whereas in-  DAGs that is allowed, in graphs we can have cycles. We may also need ways to-  detect cycles.--* Do we need to support arbitrarily long paths i.e. streaming of path? We do-  not need that for file system paths and file system paths are limited size-  and operating system anyway requires them in strict buffers. In case of-  graphs if we have cycles paths can be infinite, we could generate a stream of-  path and the consumer could be traversing the graph according to the-  generated stream. If we want to support streaming then we have to store paths-  as a stream of chunks rather than a single string.--* In general, paths need not be strings, e.g. they can be references to-  locations in memory or they can be IP addresses of nodes. At an abstract-  level, paths are just a stream of tokens that represent a certain traversal.--* Relative paths are the most general representation. At a low level,-  all paths are relative, absolute paths are relative to a specified root-  whereas relative paths are relative to a dynamic root which is the-  current directory.--* Windows can have the root as different drive letters. So to represent paths-  with a root in general we can also store the specific root along with the-  path. In case of POSIX this will always be "/". In general, it could be a-  host name or IP address or dependent on the protocol whose path we are-  representing.--* We can parameterize the low level path type with the type of path e.g. POSIX,-  WINDOWS, HTTP etc. In general, programs may have to manipulate different-  types of paths at the same time. High level path types can be instantiated-  using the low level type therefore they can be much simpler as desired.--References-------------Some related links found by web search:--* https://gitlab.haskell.org/ghc/ghc/issues/5218-* https://nodejs.org/fr/docs/guides/working-with-different-filesystems/-* https://unix.stackexchange.com/questions/2089/what-charset-encoding-is-used-for-filenames-and-paths-on-linux-* https://docs.microsoft.com/en-us/windows/win32/intl/character-sets-used-in-file-names-* https://beets.io/blog/paths.html
− dev/related-packages.md 
@@ -1,71 +0,0 @@-# Related Haskell Libraries--This document lists some notable libraries in the areas covered by Streamly.--## Lists-* https://hackage.haskell.org/package/base-* http://hackage.haskell.org/package/dlist--## Non-determinism-* https://hackage.haskell.org/package/pipes-* https://hackage.haskell.org/package/list-t-* https://hackage.haskell.org/package/list-transformer-* https://hackage.haskell.org/package/logict-* https://hackage.haskell.org/package/transformers-0.5.4.0/docs/Control-Monad-Trans-Select.html-* http://hackage.haskell.org/package/freer-effects NonDet effects--## Streaming-* https://hackage.haskell.org/package/vector-* https://hackage.haskell.org/package/streams-* https://hackage.haskell.org/package/simple-conduit-* https://hackage.haskell.org/package/streaming-* http://hackage.haskell.org/package/streaming-concurrency-* https://hackage.haskell.org/package/streaming-eversion-* https://hackage.haskell.org/package/conduit-* https://hackage.haskell.org/package/stm-conduit-* https://hackage.haskell.org/package/pipes-* http://hackage.haskell.org/package/pipes-group-* https://hackage.haskell.org/package/pipes-async-* https://hackage.haskell.org/package/pipes-concurrency-* https://hackage.haskell.org/package/pipes-interleave-* https://hackage.haskell.org/package/machines-* https://hackage.haskell.org/package/concurrent-machines-* http://hackage.haskell.org/package/io-streams--## Concurrency-* http://hackage.haskell.org/package/parallel-* http://hackage.haskell.org/package/monad-par-* https://hackage.haskell.org/package/async-* https://hackage.haskell.org/package/haxl-* https://hackage.haskell.org/package/fraxl-* https://hackage.haskell.org/package/free-concurrent-* https://hackage.haskell.org/package/transient--## Distributed-* https://hackage.haskell.org/package/transient-universe-* https://hackage.haskell.org/package/cloud-haskell-* https://hackage.haskell.org/package/distributed-process--## FRP-* https://hackage.haskell.org/package/reactive-banana-* https://hackage.haskell.org/package/Yampa-* https://hackage.haskell.org/package/reflex-* https://hackage.haskell.org/package/frpnow-* https://hackage.haskell.org/package/dunai-* https://hackage.haskell.org/package/bearriver--## Web-* https://hackage.haskell.org/package/axiom-* https://hackage.haskell.org/package/reflex-dom--## Folds-* https://hackage.haskell.org/package/foldl-* https://hackage.haskell.org/package/folds--## Resource Handling-* http://hackage.haskell.org/package/resourcet-* http://hackage.haskell.org/package/pipes-safe-* http://hackage.haskell.org/package/streaming-with--## Events-* https://hackage.haskell.org/package/event-list
− dev/resources.md 
@@ -1,45 +0,0 @@-# Resources--This document lists some resources, papers, documents that might be-related to the areas covered by Streamly and may help in designing and-implementing features in Streamly.--## Non-Determinism/Logic--* [Backtracking, Interleaving, and Terminating Monad Transformers](https://pdfs.semanticscholar.org/42eb/2d71af7e00356a41fae47c7752299dc6700d.pdf)-* [Monad Transformers for Backtracking Search](https://arxiv.org/pdf/1406.2058.pdf)-* [Continuations for Parallel Logic Programming](http://www.softlab.ntua.gr/~nickie/Papers/todoran-2000-cplp.pdf)-* [A Concurrent Extension of Functional Logic-Programming Languages](http://convecs.inria.fr/people/Wendelin.Serwe/Pubs/lopstr99.pdf)--## Arrows-* [Generalising Monads to Arrows](http://www.cse.chalmers.se/~rjmh/Papers/arrows.pdf)-* [Monads, Kleisli Arrows, Comonads and other Rambling Thoughts](http://blog.sigfpe.com/2006/06/monads-kleisli-arrows-comonads-and.html)--## Concurrency-* https://en.wikipedia.org/wiki/Fork-join_model-* https://en.wikipedia.org/wiki/Work_stealing-* https://en.wikipedia.org/wiki/Task_parallelism-* https://en.wikipedia.org/wiki/OpenMP-* https://en.wikipedia.org/wiki/Cilk See the "see also" section on this page-* https://en.wikipedia.org/wiki/Green_threads-* [Fraxl: Abstracting Async.Concurrently](http://elvishjerricco.github.io/2016/09/17/abstracting-async-concurrently.html)--## Streaming-* [Coroutines for streaming](https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/coroutines-for-streaming)-* [Stackless purescript](http://blog.functorial.com/posts/2015-07-31-Stackless-PureScript.html)-* [Coroutine Pipelines](https://themonadreader.files.wordpress.com/2011/10/issue19.pdf)-* [Faster Coroutine Pipelines](https://dl.acm.org/ft_gateway.cfm?id=3110249&ftid=1902054&dwn=1&CFID=982135108&CFTOKEN=78426775)--## Distributed-* [Making reliable distributed systems in the presence of software errors](http://erlang.org/download/armstrong_thesis_2003.pdf)-* [Towards Haskell in the Cloud](https://www.microsoft.com/en-us/research/wp-content/uploads/2016/07/remote.pdf?from=http%3A%2F%2Fresearch.microsoft.com%2Fen-us%2Fum%2Fpeople%2Fsimonpj%2Fpapers%2Fparallel%2Fremote.pdf)-* https://github.com/transient-haskell/transient/wiki/Transient-tutorial-* http://haskell-distributed.github.io/wiki.html-* https://en.wikipedia.org/wiki/MapReduce--## FRP-* https://github.com/HeinrichApfelmus/frp-guides-* [Push-Pull Functional Reactive Programming](http://conal.net/papers/push-pull-frp/push-pull-frp.pdf)-* [Functional Reactive Programming, Refactored](http://www.cs.nott.ac.uk/~psxip1/papers/2016-HaskellSymposium-Perez-Barenz-Nilsson-FRPRefactored-short.pdf)-* [Back to the Future: Time Travel in FRP](http://www.cs.nott.ac.uk/~psxip1/papers/2017-HaskellSymposium-Perez-BackToTheFuture-TimeTravelInFRP-latest.pdf)
− dev/roadmap.md 
@@ -1,36 +0,0 @@-# Roadmap--Some of these items may be present in the issues as well, but this file-lists larger areas, experimental areas and organizes items by areas. We can-also use the areas listed here as labels (aspect:topic) on issues.--## Scheduling--* Free applicative and Free Alternative, batched Alternative (push-  scheduling instead of pull scheduling)-* N-ary operations e.g. real balanced interleave-* Scheduling: Coalescing of tasks based on programmer defined criteria-    * Batching based on the target host-    * Batching/chunking for parallel/distributed execution-    * Batching iterations--## Concurerncy--* Controlled parallelism:-    * Control based on the level in the tree-    * Control based on the CPU/IO utilization based pacing-    * Utilize non-blocking IO-* Performance: Measure lock/CAS contention overhead, an option to-  dequeue work and run in batches instead of one at a time to reduce lock-  contention?-* Cross thread recursion--## Persistence--* Pause and resume using something like-  [monad-recorder](https://hackage.haskell.org/package/monad-recorder)-* Save internal buffered state during a pause?--## Testing--* improve coverage
− dev/unicode.md 
@@ -1,224 +0,0 @@-## Overview--Unicode is a standard which consists of a `char set`, `encodings`, attributes-and properties of characters, processing of strings, paragraphs, processing of-text in `locale` specific manner.--### Char Set--Unicode `char set` represents characters from all languages in the world.  Each-character is assigned a, code point, a unique number identifying the character,-and written as `U+0076` where the four hex digits `0076` represent the unique-number assigned to the character.--### Encodings--A unicode character can be encoded as a:--* fixed length encoding with a 32-bit value directly representing the code-  point in little endian (UTF32LE) or big endian (UTF32BE) byte ordering.  See-  https://en.wikipedia.org/wiki/UTF-32.-* variable length encoding with one or two 16-bit values depending on the code-  point, UTF16LE and UTF16BE. See https://en.wikipedia.org/wiki/UTF-16.-* variable length encoding with one, two or three 8-bit values depending on the-  code point, UTF8. See https://en.wikipedia.org/wiki/UTF-8.--### i18n and L10n--Internationalization (i18n) is being able to represent and process all-languages in the world. Unicode performs i18n by representing all languages and-their common processing rules.--Localization (L10n) is being able to customize the common internationalized-processing to a country or region (`locale`). Unicode specifies various-standard locales which includes customization of the attributes and processing-rules for each locale. Custom locales can be created with custom text-processing rules.--* https://en.wikipedia.org/wiki/Internationalization_and_localization .-* http://userguide.icu-project.org/i18n--## POSIX Locales--On Debian Linux, the default system wide locale can be administered using-`localectl` or `sudo dpkg-reconfigure locales`.--In a shell, the `locale` command shows the current locale settings. When you-start a program from the shell it inherits these settings via the process-environment and the C library loads and uses the appropriate locale. Even some-GUI programs if started from the shell can use the values from the-environment. Other GUI programs may have there own locale settings that can be-configured from their menu.--The following environment variables can override the system wide locale and-determine how a process (handled by libc) performs unicode text processing for-different locale aspects:--```-LC_CTYPE     Defines character classification and case conversion.-LC_COLLATE   Defines collation rules.-LC_MONETARY  Defines the format and symbols used in formatting of monetary information.-LC_NUMERIC   Defines the decimal delimiter, grouping, and grouping symbol for non-monetary numeric editing.-LC_TIME      Defines the format and content of date and time information.-LC_MESSAGES  Defines the format and values of affirmative and negative responses.-```--Each environment variable above can be set to available `locale` settings. For-example `LC_CTYPE=en_US.UTF-8` (locale.charmap) specifies a locale `en_US` for-the language `en` (English) and the territory `US` (USA) to be used for-character classifications (e.g. `iswalpha`) and case conversions (e.g.-`toupper`). `UTF-8` is the charmap used by the locale.--`C` and `POSIX` locales are the same and are used by default. glibc also-provides a generic `i18n` locale.--Use `locale -a` command to see all available locales on a system and `locale--m` for charmaps. See `man locale` as well. Also see-`/usr/share/i18n/SUPPORTED` on Linux (Debian).-https://www.gnu.org/software/libc/manual/html_node/Locale-Names.html for the-format in which these environment variables can be specified.--The environment variables are preferred in the following order:--```-LC_ALL       Overrides everything else-LC_*         Individual aspect customization-LANG         Used as a substitute for any unset LC_* variable-```--Normally only `LANG` should be used. If a particular aspect needs to be-cutsomized then `LC_*` variables can be used. `LC_ALL` overrides everything.-On GNU/Linux `LANGUAGE` can also be used as a list of preferred languages-separated by ":". LANGUAGE is effective only if LANG has been set to something-other than default and has higher priority than anything else.--* https://www.gnu.org/software/gettext/manual/gettext.html#Users has a good-  overview of locale settings.-* https://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap07.html-  POSIX Locales standard--### Localizing Messages--GNU https://www.gnu.org/software/gettext/manual/gettext.html can be used by-programs to translate/localize the user interfacing text to multiple languages.-Catalogs of localized program error, alert, notification messages are installed-at e.g.  `/usr/share/locale/en_US/LC_MESSAGES/`.--* https://www.gnu.org/software/gettext/manual/gettext.html--### Creating Locales--From the `debian` manpage of `localedef` POSIX command:--The  localedef  program  reads  the  indicated charmap and input files,-compiles them to a binary form quickly usable by the locale functions in the C-library (setlocale(3), localeconv(3), etc.), and places the output in-outputpath.--See `locale-gen` for a more high level program to generate locales.-/usr/lib/locale/locale-archive contains the generated binary files. On Debian-you can use `sudo dpkg-reconfigure locales` to select locales and set system-locale.--On Linux/glibc (Debian), installed `charmaps` can be found at-`/usr/share/i18n/charmaps/` and locale definition input files at-`/usr/share/i18n/locales/`. --## ICU Locales--An ICU locale is frequently confused with a POSIX locale ID. An ICU locale ID-is not a POSIX locale ID. ICU locales do not specify the encoding and specify-variant locales differently.--* http://userguide.icu-project.org/locale--### Localizing Messages--* http://userguide.icu-project.org/locale/localizing--## Unicode Text processing--* http://userguide.icu-project.org/posix-* http://userguide.icu-project.org/strings/properties--### Locale Independent--1) Char Properties-2) Normalization-3) Regex matching--### Locale Specific--1) Case Mapping:-    * https://unicode.org/faq/casemap_charprop.html-    * http://www.unicode.org/versions/latest/ch05.pdf#G21180-    * ftp://ftp.unicode.org/Public/UCD/latest/ucd/SpecialCasing.txt-    * ftp://ftp.unicode.org/Public/UCD/latest/ucd/CaseFolding.txt-2) Breaking-3) Collation-4) Charset Conversion--## Haskell--### Haskell Unicode Text Processing--Related packages on hackage:--* [base](https://www.stackage.org/lts/package/base) Data.Char module, uses libc-* [text](https://www.stackage.org/lts/package/text)-* [text-icu](https://stackage.org/lts/package/text-icu) C bindings to icu---* https://github.com/composewell/unicode-transforms-* https://github.com/llelf/prose-* [unicode-properties](https://hackage.haskell.org/package/unicode-properties) Unicode 3.2.0 character properties-* [hxt-charproperties](http://www.stackage.org/lts/package/hxt-charproperties) Character properties and classes for XML and Unicode-* [unicode-names](http://hackage.haskell.org/package/unicode-names) Unicode 3.2.0 character names-* [unicode](https://hackage.haskell.org/package/unicode) Construct and transform unicode characters---* [charset](https://www.stackage.org/lts/package/charset) Fast unicode character sets--None of the existing Haskell packages provide comprehensive and fast access to-properties. `unicode-transforms` provides composition/decomposition data and-the script to extract data from unicode database.--### Haskell Localization--* http://wiki.haskell.org/Internationalization_of_Haskell_programs-* https://hackage.haskell.org/package/localize-* http://hackage.haskell.org/package/localization-* http://hackage.haskell.org/package/hgettext-* http://hackage.haskell.org/package/i18n-* https://hackage.haskell.org/package/setlocale-* http://hackage.haskell.org/package/system-locale-* https://github.com/llelf/numerals--## TODO--Factor out a `unicode-data` package from `unicode-transforms`.-`unicode-transforms` package will depend on unicode-data and can continue to be-used as is. Other packages can take advantage of the `unicode-data` to provide-unicode text processing services.--To begin with, this package will contain:--* char properties data-* case mapping data-* unicode normalization data--This package can be used in `Streamly.Internal.Data.Unicode.*` to provide:--* Fast access to char properties, we will no longer depend on libc for that and-  no FFI will be required to do iswspace, iswalpha etc.-* Correct case mappings from a single char to multi-char-* Stream based unicode normalization-* Breaking (locale independent for now)--## Later--* add locale data from CLDR to `unicode-data` to provide locale specific-  services as well.-* support locale specific breaking, regex, collation and charset conversion-* facility to add customized locale data-* Support providing application level resource data for localization
− dev/utf8-decoder.md 
@@ -1,603 +0,0 @@-Flexible and Economical UTF-8 Decoder-=====================================--Systems with elaborate Unicode support usually confront programmers with-a multitude of different functions and macros to process UTF-8 encoded-strings, often with different ideas on handling buffer boundaries, state-between calls, error conditions, and performance characteristics, making-them difficult to use correctly and efficiently. Implementations also-tend to be very long and complicated; one popular library has over 500-lines of code just for one version of the decoder. This page presents-one that is very easy to use correctly, short, small, fast, and free.--Implementation in C (C99)----------------------------    // Copyright (c) 2008-2009 Bjoern Hoehrmann <bjoern@hoehrmann.de>-    // See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.--    #define UTF8_ACCEPT 0-    #define UTF8_REJECT 1--    static const uint8_t utf8d[] = {-      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, // 00..1f-      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, // 20..3f-      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, // 40..5f-      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, // 60..7f-      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, // 80..9f-      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, // a0..bf-      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, // c0..df-      0xa,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x4,0x3,0x3, // e0..ef-      0xb,0x6,0x6,0x6,0x5,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8, // f0..ff-      0x0,0x1,0x2,0x3,0x5,0x8,0x7,0x1,0x1,0x1,0x4,0x6,0x1,0x1,0x1,0x1, // s0..s0-      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,0,1,0,1,1,1,1,1,1, // s1..s2-      1,2,1,1,1,1,1,2,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1, // s3..s4-      1,2,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,3,1,3,1,1,1,1,1,1, // s5..s6-      1,3,1,1,1,1,1,3,1,3,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1, // s7..s8-    };--    uint32_t inline-    decode(uint32_t* state, uint32_t* codep, uint32_t byte) {-      uint32_t type = utf8d[byte];--      *codep = (*state != UTF8_ACCEPT) ?-        (byte & 0x3fu) | (*codep << 6) :-        (0xff >> type) & (byte);--      *state = utf8d[256 + *state*16 + type];-      return *state;-    }--Usage--------UTF-8 is a variable length character encoding. To decode a character one-or more bytes have to be read from a string. The `decode` function-implements a single step in this process. It takes two parameters-maintaining state and a byte, and returns the state achieved after-processing the byte. Specifically, it returns the value `UTF8_ACCEPT`-(0) if enough bytes have been read for a character, `UTF8_REJECT` (1) if-the byte is not allowed to occur at its position, and some other-positive value if more bytes have to be read.--When decoding the first byte of a string, the caller must set the state-variable to `UTF8_ACCEPT`. If, after decoding one or more bytes the-state `UTF8_ACCEPT` is reached again, then the decoded Unicode character-value is available through the `codep` parameter. If the state-`UTF8_REJECT` is entered, that state will never be exited unless the-caller intervenes. See the examples below for more information on usage-and error handling, and the section on implementation details for how-the decoder is constructed.--Examples-----------### Validating and counting characters--This function checks if a null-terminated string is a well-formed UTF-8-sequence and counts how many code points are in the string.--    int-    countCodePoints(uint8_t* s, size_t* count) {-      uint32_t codepoint;-      uint32_t state = 0;--      for (*count = 0; *s; ++s)-        if (!decode(&state, &codepoint, *s))-          *count += 1;--      return state != UTF8_ACCEPT;-    }--It could be used like so:--    if (countCodePoints(s, &count)) {-      printf("The string is malformed\n");-    } else {-      printf("The string is %u characters long\n", count);-    }--### Printing code point values--This function prints out all code points in the string and an error-message if unexpected bytes are encountered, or if the string ends with-an incomplete sequence.--    void-    printCodePoints(uint8_t* s) {-      uint32_t codepoint;-      uint32_t state = 0;--      for (; *s; ++s)-        if (!decode(&state, &codepoint, *s))-          printf("U+%04X\n", codepoint);--      if (state != UTF8_ACCEPT)-        printf("The string is not well-formed\n");--    }--### Printing UTF-16 code units--This loop prints out UTF-16 code units for the characters in a-null-terminated UTF-8 encoded string.--    for (; *s; ++s) {--      if (decode(&state, &codepoint, *s))-        continue;--      if (codepoint <= 0xFFFF) {-        printf("0x%04X\n", codepoint);-        continue;-      }--      // Encode code points above U+FFFF as surrogate pair.-      printf("0x%04X\n", (0xD7C0 + (codepoint >> 10)));-      printf("0x%04X\n", (0xDC00 + (codepoint & 0x3FF)));-    }--### Error recovery--It is sometimes desirable to recover from errors when decoding strings-that are supposed to be UTF-8 encoded. Programmers should be aware that-this can negatively affect the security properties of their application.-A common recovery method is to replace malformed sequences with a-substitute character like `U+FFFD REPLACEMENT CHARACTER`.--Decoder implementations differ in which octets they replace and where-they restart. Consider for instance the sequence `0xED 0xA0 0x80`. It-encodes a surrogate code point which is prohibited in UTF-8. A-recovering decoder may replace the whole sequence and restart with the-next byte, or it may replace the first byte and restart with the second-byte, replace it, restart with the third, and replace the third byte-aswell.--The following code implements one such recovery strategy. When an-unexpected byte is encountered, the sequence up to that point will be-replaced and, if the error occurred in the middle of a sequence, will-retry the byte as if it occurred at the beginning of a string. Note that-the decode function detects errors as early as possible, so the sequence-`0xED 0xA0 0x80` would result in three replacement characters.--    for (prev = 0, current = 0; *s; prev = current, ++s) {--      switch (decode(&current, &codepoint, *s)) {-      case UTF8_ACCEPT:-        // A properly encoded character has been found.-        printf("U+%04X\n", codepoint);-        break;--      case UTF8_REJECT:-        // The byte is invalid, replace it and restart.-        printf("U+FFFD (Bad UTF-8 sequence)\n");-        current = UTF8_ACCEPT;-        if (prev != UTF8_ACCEPT)-          s--;-        break;-      ...--For some recovery strategies it may be useful to determine the number of-bytes expected. The states in the automaton are numbered such that,-assuming C\'s division operator, `state / 3 + 1` is that number. Of-course, this will only work for states other than `UTF8_ACCEPT` and-`UTF8_REJECT`. This number could then be used, for instance, to skip the-continuation octets in the illegal sequence `0xED 0xA0 0x80` so it will-be replaced by a single replacement character.--### Transcoding to UTF-16 buffer--This is a rough outline of a UTF-16 transcoder. Actual applications-would add code for error reporting, reporting of words written, required-buffer size in the case of a small buffer, and possibly other things.-Note that in order to avoid checking for free space in the inner loop,-we determine how many bytes can be read without running out of space.-This is one utf-8 byte per available utf-16 word, with one exception: if-the last byte read was the third byte in a four byte sequence we would-get two words for the next byte; so we read one byte less than we have-words available. This additional word is also needed for-null-termination, so it\'s never wrong to read one less.--    int-    toUtf16(uint8_t* src, size_t srcBytes, uint16_t* dst, size_t dstWords, ...) {--      uint8_t* src_actual_end = src + srcBytes;-      uint8_t* s = src;-      uint16_t* d = dst;-      uint32_t codepoint;-      uint32_t state = 0;--      while (s < src_actual_end) {--        size_t dst_words_free = dstWords - (d - dst);-        uint8_t* src_current_end = s + dst_words_free - 1;--        if (src_actual_end < src_current_end)-          src_current_end = src_actual_end;--        if (src_current_end <= s)-          goto toosmall;--        while (s < src_current_end) {--          if (decode(&state, &codepoint, *s++))-            continue;--          if (codepoint > 0xffff) {-            *d++ = (uint16_t)(0xD7C0 + (codepoint >> 10));-            *d++ = (uint16_t)(0xDC00 + (codepoint & 0x3FF));-          } else {-            *d++ = (uint16_t)codepoint;-          }-        }-      }--      if (state != UTF8_ACCEPT) {-        ...-      }--      if ((dstWords - (d - dst)) == 0)-        goto toosmall;--      *d++ = 0;-      ...--    toosmall:-      ...-    }--Implementation details-------------------------The `utf8d` table consists of two parts. The first part maps bytes to-character classes, the second part encodes a deterministic finite-automaton using these character classes as transitions. This section-details the composition of the table.--### Canonical UTF-8 automaton--UTF-8 is a variable length character encoding. That means state has to-be maintained while processing a string. The following transition graph-illustrates the process. We start in state zero, and whenever we come-back to it, we\'ve seen a whole Unicode character. Transitions not in-the graph are disallowed; they all lead to state one, which has been-omitted for readability.--![DFA with range transitions](/dev/dfa-bytes.png)--### Automaton with character class transitions--The byte ranges in the transition graph above are not easily encoded in-the automaton in a manner that would allow fast lookup. Instead of-encoding the ranges directly, the ranges are split such that each byte-belongs to exactly one character class. Then the transitions go over-these character classes.--![DFA with class transitions](/dev/dfa-classes.png)--### Mapping bytes to character classes--Primarily to save space in the transition table, bytes are mapped to-character classes. This is the mapping:--|||||-|-|-|-|-|-| 00..7f |  0 | 80..8f | 1 |-| 90..9f |  9 | a0..bf | 7 |-| c0..c1 |  8 | c2..df | 2 |-| e0..e0 | 10 | e1..ec | 3 |-| ed..ed |  4 | ee..ef | 3 |-| f0..f0 | 11 | f1..f3 | 6 |-| f4..f4 |  5 | f5..ff | 8 |---For bytes that may occur at the beginning of a multibyte sequence, the-character class number is also used to remove the most significant bits-from the byte, which do not contribute to the actual code point value.-Note that `0xc0`, `0xc1`, and `0xf5` .. `0xff` have all their bits-removed. These bytes cannot occur in well-formed sequences, so it does-not matter which bits, if any, are retained.--|||||||||||||-|-|-|-|-|-|-|-|-|-|-|-|-|-| c0 | 8 | **11000000** | d0 | 2 | **11**010000 | e0 | 10 | **11100000** | f0 | 11 | **11110000** |-| c1 | 8 | **11000001** | d1 | 2 | **11**010001 | e1 |  3 | **111**00001 | f1 |  6 | **111100**01 |-| c2 | 2 | **11**000010 | d2 | 2 | **11**010010 | e2 |  3 | **111**00010 | f2 |  6 | **111100**10 |-| c3 | 2 | **11**000011 | d3 | 2 | **11**010011 | e3 |  3 | **111**00011 | f3 |  6 | **111100**11 |-| c4 | 2 | **11**000100 | d4 | 2 | **11**010100 | e4 |  3 | **111**00100 | f4 |  5 | **11110**100 |-| c5 | 2 | **11**000101 | d5 | 2 | **11**010101 | e5 |  3 | **111**00101 | f5 |  8 | **11110101** |-| c6 | 2 | **11**000110 | d6 | 2 | **11**010110 | e6 |  3 | **111**00110 | f6 |  8 | **11110110** |-| c7 | 2 | **11**000111 | d7 | 2 | **11**010111 | e7 |  3 | **111**00111 | f7 |  8 | **11110111** |-| c8 | 2 | **11**001000 | d8 | 2 | **11**011000 | e8 |  3 | **111**01000 | f8 |  8 | **11111000** |-| c9 | 2 | **11**001001 | d9 | 2 | **11**011001 | e9 |  3 | **111**01001 | f9 |  8 | **11111001** |-| ca | 2 | **11**001010 | da | 2 | **11**011010 | ea |  3 | **111**01010 | fa |  8 | **11111010** |-| cb | 2 | **11**001011 | db | 2 | **11**011011 | eb |  3 | **111**01011 | fb |  8 | **11111011** |-| cc | 2 | **11**001100 | dc | 2 | **11**011100 | ec |  3 | **111**01100 | fc |  8 | **11111100** |-| cd | 2 | **11**001101 | dd | 2 | **11**011101 | ed |  4 | **1110**1101 | fd |  8 | **11111101** |-| ce | 2 | **11**001110 | de | 2 | **11**011110 | ee |  3 | **111**01110 | fe |  8 | **11111110** |-| cf | 2 | **11**001111 | df | 2 | **11**011111 | ef |  3 | **111**01111 | ff |  8 | **11111111** |---Notes on Variations----------------------There are several ways to change the implementation of this decoder. For-example, the size of the data table can be reduced, at the cost of a-couple more instructions, so it omits the mapping of bytes in the-US-ASCII range, and since all entries in the table are 4 bit values, two-values could be stored in a single byte.--In some situations it may be beneficial to have a separate start state.-This is easily achieved by copying the s0 state in the array to the end,-and using the new state 9 as start state as needed.--Where callers require the code point values, compilers tend to generate-slightly better code if the state calculation is moved into the-branches, for example--    if (*state != UTF8_ACCEPT) {-      *state = utf8d[256 + *state*16 + type];-      *codep = (*codep << 6) | (byte & 63);-    } else {-      *state = utf8d[256 + *state*16 + type];-      *codep = (byte) & (255 >> type);-    }--As the state will be zero in the else branch, this saves a shift and an-addition for each starter. Unfortunately, compilers will then typically-generate worse code if the codepoint value is not needed. Naturally,-then, two functions could be used, one that only calculates the states-for validation, counting, and similar applications, and one for full-decoding. For the sample UTF-16 transcoder a more substantial increase-in performance can be achieved by manually including the decode code in-the inner loop; then it is also worthwhile to make code points in the-US-ASCII range a special case:--    while (s < src_current_end) {--      uint32_t byte = *s++;-      uint32_t type = utf8d[byte];--      if (state != UTF8_ACCEPT) {-        codep = (codep << 6) | (byte & 63);-        state = utf8d[256 + state*16 + type];--        if (state)-          continue;--      } else if (byte > 0x7f) {-        codep = (byte) & (255 >> type);-        state = utf8d[256 + type];-        continue;--      } else {-        *d++ = (uint16_t)byte;-        continue;-      }-      ...--Another variation worth of note is changing the comparison when setting-the code point value to this:--    *codep = (*state >  UTF8_REJECT) ?-      (byte & 0x3fu) | (*codep << 6) :-      (0xff >> type) & (byte);--This ensures that the code point value does not exceed the value `0xff`-after some malformed sequence is encountered.--As written, the decoder disallows encoding of surrogate code points,-overlong 2, 3, and 4 byte sequences, and 4 byte sequences outside the-Unicode range. Allowing them can have serious security implications, but-can easily be achieved by changing the character class assignments in-the table.--The code samples have generally been written to perform well on my-system when compiled with Visual C++ 7.1 and GCC 3.4.5. Slight changes-may improve performance, for example, Visual C++ 7.1 will produce-slightly faster code when, in the manually inlined version of the-transcoder discussed above, the type assignment is moved into the-branches where it is needed, and the state and codepoint assignments in-the non-ASCII starter is swapped (approximately a 5% increase), but GCC-3.4.5 will produce considerably slower code (approximately 10%).--I have experimented with various rearrangements of states and character-classes. A seemingly promising one is the following:--![Re-arranged DFA with class transitions](/dev/dfa-rearr.png)--One of the continuation ranges has been split into two, the other-changes are just renamings. This arrangement allows, when a continuation-octet is expected, to compute the character class with a shift instead-of a table lookup, and when looking at a non-ASCII starter, the next-state is simply the character class. On my system the change in-performance is in the area of +/- 1%. This encoding would have a number-of downsides: more rejecting states are required to account for-continuation octets where starters are expected, the table formatting-would use more hex notation making it longer, and calculating the number-of expected continuation octets from a given state is more difficult.-One thing I\'d still like to try out is if, perhaps by adding a couple-of additional states, for continuation states the next state can be-computed without any table lookup with a few easily paired instructions.--On 24th June 2010 Rich Felker pointed out that the state values in the-transition table can be pre-multiplied with 16 which would save a shift-instruction for every byte. D\'oh! We actually just need 12 and can-throw away the filler values previously in the table making the table 36-bytes shorter and save the shift in the code.--    // Copyright (c) 2008-2010 Bjoern Hoehrmann <bjoern@hoehrmann.de>-    // See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.--    #define UTF8_ACCEPT 0-    #define UTF8_REJECT 12--    static const uint8_t utf8d[] = {-      // 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,-    };--    uint32_t inline-    decode(uint32_t* state, uint32_t* codep, uint32_t byte) {-      uint32_t type = utf8d[byte];--      *codep = (*state != UTF8_ACCEPT) ?-        (byte & 0x3fu) | (*codep << 6) :-        (0xff >> type) & (byte);--      *state = utf8d[256 + *state + type];-      return *state;-    }--Notes on performance-----------------------To conduct some ad-hoc performance testing I\'ve used three different-UTF-8 encoded buffers and passed them through a couple of UTF-8 to-UTF-16 transcoders. The large buffer is a April 2009 Hindi Wikipedia-article XML dump, the medium buffer Markus Kuhn\'s UTF-8-demo.txt, and-the tiny buffer my name, each about the number of times required for-about 1GB of data. All tests ran on a [Intel Prescott-Celeron](http://en.wikipedia.org/wiki/Celeron#Prescott-256) at 2666 MHz.-See [Changes](#changes) for some additional details.--  |                                                                           |  Large  |   Medium |   Tiny   |-  |---------------------------------------------------------------------------|---------| ---------|----------|-  |`NS_CStringToUTF16()` Mozilla 1.9 (*includes malloc/free time*)            |  36924ms|   39773ms|  107958ms|-  |`iconv()` 1.9 compiled with Visual C++ (Cygwin iconv 1.11 similar)         |  22740ms|   21765ms|   32595ms|-  |`g_utf8_to_utf16()` Cygwin Glib 2.0 (*includes malloc/free time*)          |  21599ms|   20345ms|   98782ms|-  |`ConvertUTF8toUTF16()` Unicode Inc., Visual C++ 7.1 -Ox -Ot -G7            |  11183ms|   11251ms|   19453ms|-  |`MultiByteToWideChar()` Windows API (Server 2003 SP2)                      |   9857ms|   10779ms|   12771ms|-  |`u_strFromUTF8` from ICU 4.0.1 (Visual Studio 2008, web site distribution) |   8778ms|    5223ms|    5419ms|-  |`PyUnicode_DecodeUTF8Stateful` (3.1a2), Visual C++ 7.1 -Ox -Ot -G7         |   4523ms|    5686ms|    3138ms|-  |Example section transcoder, Visual C++ 7.1 -Ox -Ot -G7                     |   5397ms|    5789ms|    6250ms|-  |Manually inlined transcoder (see above), Visual C++ 7.1 -Ox -Ot -G7        |   4277ms|    4998ms|    4640ms|-  |Same, Cygwin GCC 3.4.5 -march=prescott -fomit-frame-pointer -O3            |   4492ms|    5154ms|    4432ms|-  |Same, Cygwin GCC 4.3.2 -march=prescott -fomit-frame-pointer -O3            |   5439ms|    6322ms|    5567ms|-  |Same, Visual C++ 6.0 -TP -O2                                               |   5398ms|    6259ms|    6446ms|-  |Same, Visual C++ 7.1 -Ox -Ot -G7 (*includes malloc/free time*)             |   5498ms|    5086ms|   25852ms|--I have also timed functions that `xor` all code points in the large-buffer. In Visual Studio 2008 ICU\'s `U8_NEXT` macro comes out at-\~8000ms, the `U8_NEXT_UNSAFE` macro, which requires complete and-well-formed input, at \~4000ms, and the `decode` function is at-\~5900ms. Using the same manual inlining as for the transcode function,-Cygwin GCC 3.4.5 -march=prescott -O3 -fomit-frame-pointer brings it down-to roughly the same times as the transcode function for all three-buffers.--While these results do not model real-world applications well, it seems-reasonable to suggest that the reduced complexity does not come at the-price of reduced performance. Note that instructions that compute the-code point values will generally be optimized away when not needed. For-example, checking if a null-terminated string is properly UTF-8 encoded-\...--    int-    IsUTF8(uint8_t* s) {-      uint32_t codepoint, state = 0;--      while (*s)-        decode(&state, &codepoint, *s++);--      return state == UTF8_ACCEPT;-    }--\... does not require the individual code point values, and so the loop-becomes something like this:--    l1: movzx  eax,al-        shl    edx,4-        add    ecx,1-        movzx  eax,byte ptr [eax+404000h]-        movzx  edx,byte ptr [eax+edx+256+404000h]-        movzx  eax,byte ptr [ecx]-        test   al,al-        jne    l1--For comparison, this is a typical `strlen` loop:--    l1: mov    cl,byte ptr [eax]-        add    eax,1-        test   cl,cl-        jne    l1--With the large buffer and the same number of times as above, `strlen`-takes 1507ms while `IsUTF8` takes 2514ms.--License----------Copyright (c) 2008-2009 [Bjoern Hoehrmann](http://bjoern.hoehrmann.de/)-\<<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.-:::--Changes----------25 Jun 2010-:   Added an improved variation based on an observation from Rich-    Felker.--30 April 2009-:   Added some more items to the performance table: the manually inlined-    transcoder allocating worst case memory for each run and freeing it-    before the next run; and results for Mozilla\'s NS\_CStringToUTF16-    (a new nsAutoString is created for each run, and truncated before-    the next). This used the XULRunner SDK 1.9.0.7 binary distribution-    from the Mozilla website.--18 April 2009-:   Added notes to the Variations section on handling malformed-    sequences and failed optimization attempts.--14 April 2009-:   Added PyUnicode\_DecodeUTF8Stateful times; the function has been-    modified slightly so it works outside Python and so it uses a-    pre-allocated buffer. Normally does not check output buffer-    boundaries but rather allocates a worst case buffer, then resizes-    it. Apparently the decoder [allows encodings of surrogate code-    points](http://bugs.python.org/issue3672).--Author---------[Björn Höhrmann](http://bjoern.hoehrmann.de) <bjoern@hoehrmann.de>-([Donate via-SourceForge](http://sourceforge.net/developer/user_donations.php?user_id=188003),-[PayPal](https://www.paypal.com/cgi-bin/webscr?cmd=_xclick&business=bjoern@hoehrmann.de&item_name=Support+Bjoern+Hoehrmann))
− docs/API-changelog.txt 
@@ -1,261 +0,0 @@-# API diff as generated by cabal-diff with minor edits.-# ~~~ means deprecated module-# ~~ means deprecated symbol--#-----------------------------# Changes from 0.8.0 to 0.8.1-#------------------------------@@@ Streamly.FileSystem.Handle-++ getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)-++ putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()--#-----------------------------# Changes from 0.7.3 to 0.8.0-#------------------------------# Deprecated, merged into Streamly.Prelude-~~~ Streamly-# Fixity changes-++ infixr 6 `ahead`-++ infixr 6 `async`-++ infixr 6 `parallel`-++ infixr 6 `serial`-++ infixr 6 `wAsync`-++ infixr 6 `wSerial`--# Added-@@@ Streamly.Console.Stdio--# Deprecated, renamed-~~~ Streamly.Memory.Array-@@@ Streamly.Data.Array.Foreign--# Moved from Streamly.Memory.Array-++ data Array a-++ fromList :: Storable a => [a] -> Array a-++ fromListN :: Storable a => Int -> [a] -> Array a-++ length :: forall a. Storable a => Array a -> Int-++ read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-++ toList :: Storable a => Array a -> [a]-++ write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)-++ writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)--# Added-++ asBytes :: Array a -> Array Word8-++ cast :: forall a b. Storable b => Array a -> Maybe (Array b)-++ getIndex :: Storable a => Array a -> Int -> Maybe a-++ readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-++ writeLastN :: (Storable a, MonadIO m) => Int -> Fold m a (Array a)--@@@ Streamly.Data.Fold-# Signature changed- - product :: (Monad m, Num a) => Fold m a a- + product :: (Monad m, Num a, Eq a) => Fold m a a--# Removed (Moved to the Streamly.Data.Fold.Tee module)--- instance (Monad m, Floating b) => Floating (Fold m a b)--- instance (Monad m, GHC.Num.Num b) => GHC.Num.Num (Fold m a b)--- instance (Monad m, GHC.Real.Fractional b) => GHC.Real.Fractional (Fold m a b)--- instance (Semigroup b, Monad m) => Semigroup (Fold m a b)--- instance (Semigroup b, Monoid b, Monad m) => Monoid (Fold m a b)--- instance Applicative m => Applicative (Fold m a)--# Renamed-~~ mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-++ rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c--# Deprecated-~~ sequence :: Monad m => Fold m a (m b) -> Fold m a b--# Added-++ catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b-++ chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c-++ concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c-++ filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r-++ filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r-++ foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b-++ foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b-++ foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b-++ lmap :: (a -> b) -> Fold m b r -> Fold m a r-++ lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r-++ many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-++ mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r-++ rollingHash :: (Monad m, Enum a) => Fold m a Int64-++ rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64-++ sconcat :: (Monad m, Semigroup a) => a -> Fold m a a-++ serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-++ take :: Monad m => Int -> Fold m a b -> Fold m a b-++ takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-++ takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-++ teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-++ toListRev :: Monad m => Fold m a [a]--# Added-@@@ Streamly.Data.Fold.Tee--@@@ Streamly.Data.Unfold-# Added-++ crossWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d-++ drop :: Monad m => Int -> Unfold m a b -> Unfold m a b-++ dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b-++ dropWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b-++ filter :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b-++ filterM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b-++ fromList :: Monad m => Unfold m [a] a-++ fromListM :: Monad m => Unfold m [m a] a-++ fromStream :: (IsStream t, Monad m) => Unfold m (t m a) a-++ function :: Applicative m => (a -> b) -> Unfold m a b-++ functionM :: Applicative m => (a -> m b) -> Unfold m a b-++ iterateM :: Monad m => (a -> m a) -> Unfold m (m a) a-++ lmap :: (a -> c) -> Unfold m c b -> Unfold m a b-++ lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b-++ many :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c-++ mapM :: Monad m => (b -> m c) -> Unfold m a b -> Unfold m a c-++ repeatM :: Monad m => Unfold m (m a) a-++ replicateM :: Monad m => Int -> Unfold m (m a) a-++ take :: Monad m => Int -> Unfold m a b -> Unfold m a b-++ takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b-++ takeWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b-++ unfoldr :: Applicative m => (a -> Maybe (b, a)) -> Unfold m a b-++ unfoldrM :: Applicative m => (a -> m (Maybe (b, a))) -> Unfold m a b-++ zipWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d--# Deprecated, renamed to Streamly.Unicode.Stream-~~~ Streamly.Data.Unicode.Stream--@@@ Streamly.Network.Socket-# Added-++ forSocketM :: (MonadMask m, MonadIO m) => (Socket -> m ()) -> Socket -> m ()-++ readChunk :: Int -> Socket -> IO (Array Word8)-++ writeChunk :: Storable a => Socket -> Array a -> IO ()-++ writeChunksWithBufferOf :: (MonadIO m, Storable a) => Int -> Socket -> Fold m (Array a) ()--@@@ Streamly.Prelude-# Signature changed- - after :: (IsStream t, Monad m) => m b -> t m a -> t m a- + after :: (IsStream t, MonadIO m, MonadBaseControl IO m) => m b -> t m a -> t m a- - bracket :: (IsStream t, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a- + bracket :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a- - concatMapWith :: IsStream t => (forall c. t m c -> t m c -> t m c) -> (a -> t m b) -> t m a -> t m b- + concatMapWith :: IsStream t => (t m b -> t m b -> t m b) -> (a -> t m b) -> t m a -> t m b- - finally :: (IsStream t, MonadCatch m) => m b -> t m a -> t m a- + finally :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> t m a -> t m a- - foldlM' :: Monad m => (b -> a -> m b) -> b -> SerialT m a -> m b- + foldlM' :: Monad m => (b -> a -> m b) -> m b -> SerialT m a -> m b- - postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b- + postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b- - scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b- + scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b--# Renamed-~~ yieldM :: (Monad m, IsStream t) => m a -> t m a-++ fromEffect :: (Monad m, IsStream t) => m a -> t m a-~~ yield :: IsStream t => a -> t m a-++ fromPure :: IsStream t => a -> t m a-~~ concatUnfold :: (IsStream t, Monad m) => Unfold m a b -> t m a -> t m b-++ unfoldMany :: (IsStream t, Monad m) => Unfold m a b -> t m a -> t m b--# Moved from "Streamly" module-## Fixity change-++ infixr 6 `ahead`-++ infixr 6 `async`-++ infixr 6 `parallel`-++ infixr 6 `serial`-++ infixr 6 `wAsync`-++ infixr 6 `wSerial`-## Renamed-~~ foldWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-++ concatFoldableWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-~~ forEachWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-++ concatForFoldableWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-~~ foldMapWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-++ concatMapFoldableWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-~~ aheadly :: IsStream t => AheadT m a -> t m a-++ fromAhead :: IsStream t => AheadT m a -> t m a-~~ asyncly :: IsStream t => AsyncT m a -> t m a-++ fromAsync :: IsStream t => AsyncT m a -> t m a-~~ parallely :: IsStream t => ParallelT m a -> t m a-++ fromParallel :: IsStream t => ParallelT m a -> t m a-~~ serially :: IsStream t => SerialT m a -> t m a-++ fromSerial :: IsStream t => SerialT m a -> t m a-~~ wAsyncly :: IsStream t => WAsyncT m a -> t m a-++ fromWAsync :: IsStream t => WAsyncT m a -> t m a-~~ wSerially :: IsStream t => WSerialT m a -> t m a-++ fromWSerial :: IsStream t => WSerialT m a -> t m a-~~ zipAsyncly :: IsStream t => ZipAsyncM m a -> t m a-++ fromZipAsync :: IsStream t => ZipAsyncM m a -> t m a-~~ zipSerially :: IsStream t => ZipSerialM m a -> t m a-++ fromZipSerial :: IsStream t => ZipSerialM m a -> t m a-## unchanged-++ class (forall m a. MonadAsync m => Semigroup (t m a), forall m a. MonadAsync m => Monoid (t m a), forall m. Monad m => Functor (t m), forall m. MonadAsync m => Applicative (t m)) => IsStream t-++ data AheadT m a-++ data AsyncT m a-++ data ParallelT m a-++ data Rate Rate :: Double -> Double -> Double -> Int -> Rate-++ data SerialT m a-++ data WAsyncT m a-++ data WSerialT m a-++ data ZipAsyncM m a-++ data ZipSerialM m a-++ type Ahead = AheadT IO-++ type Async = AsyncT IO-++ type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)-++ type Parallel = ParallelT IO-++ type Serial = SerialT IO-++ type WAsync = WAsyncT IO-++ type WSerial = WSerialT IO-++ type ZipAsync = ZipAsyncM IO-++ type ZipSerial = ZipSerialM IO-++ (|$) :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> t m a -> t m b-++ (|$.) :: (IsStream t, MonadAsync m) => (t m a -> m b) -> t m a -> m b-++ (|&) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> t m b) -> t m b-++ (|&.) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> m b) -> m b-++ [rateBuffer] :: Rate -> Int-++ [rateGoal] :: Rate -> Double-++ [rateHigh] :: Rate -> Double-++ [rateLow] :: Rate -> Double-++ adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a-++ ahead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-++ async :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-++ avgRate :: IsStream t => Double -> t m a -> t m a-++ constRate :: IsStream t => Double -> t m a -> t m a-++ maxBuffer :: IsStream t => Int -> t m a -> t m a-++ maxRate :: IsStream t => Double -> t m a -> t m a-++ maxThreads :: IsStream t => Int -> t m a -> t m a-++ minRate :: IsStream t => Double -> t m a -> t m a-++ mkAsync :: (IsStream t, MonadAsync m) => t m a -> t m a-++ parallel :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-++ rate :: IsStream t => Maybe Rate -> t m a -> t m a-++ serial :: IsStream t => t m a -> t m a -> t m a-++ wAsync :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-++ wSerial :: IsStream t => t m a -> t m a -> t m a--# Added-++ delay :: (IsStream t, MonadIO m) => Double -> t m a -> t m a-++ foldMany :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b-++ intercalate :: (IsStream t, Monad m) => Unfold m b c -> b -> t m b -> t m c-++ intercalateSuffix :: (IsStream t, Monad m) => Unfold m b c -> b -> t m b -> t m c-++ liftInner :: (Monad m, IsStream t, MonadTrans tr, Monad (tr m)) => t m a -> t (tr m) a-++ runReaderT :: (IsStream t, Monad m) => m s -> t (ReaderT s m) a -> t m a-++ runStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m (s, a)--# Removed: documentation moved to streamly-docs module in docs dir-@@@ Streamly.Tutorial--# Deprecated, renamed-~~~ Streamly.Data.Unicode.Stream-@@@ Streamly.Unicode.Stream-# Moved from Streamly.Data.Unicode.Stream-## Behavior changed-++ decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char-++ encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8-++ encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8-## Unchanged-++ decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char--# Added-++ decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char-++ encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8-++ encodeStrings :: (MonadIO m, IsStream t) => (SerialT m Char -> SerialT m Word8) -> t m String -> t m (Array Word8)-++ encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8
− docs/CONTRIBUTORS.md 
@@ -1,148 +0,0 @@-This is a list of code contributors to this library. For issue contributors-please see https://github.com/composewell/streamly/issues.--Use `git shortlog -sn tag1...tag2` on the git repository to get a list of-contributors between two repository tags.--## 0.8.2--* Adithya Kumar-* Harendra Kumar-* Ranjeet Kumar Ranjan-* Anurag Hooda-* andremarianiello--## 0.8.1.1--* Harendra Kumar-* Julian Ospald--## 0.8.1--* Harendra Kumar-* Adithya Kumar-* Ranjeet Kumar Ranjan-* Julian Ospald-* Sanchayan Maity--## 0.8.0--* Harendra Kumar-* Adithya Kumar-* Pranay Sashank-* Ranjeet Kumar Ranjan-* Anurag Hooda-* Ahmed Zaheer Dadarkar-* Shruti Umat-* Joseph Koshy (Google LLC.)-* Sanchayan Maity-* Kirill Elagin-* Shlok Datye-* Julian Ospald-* George Thomas-* endgame--## 0.7.3--* Pranay Sashank-* Adithya Kumar-* Julian Ospald--## 0.7.2--* Harendra Kumar-* Pranay Sashank-* Adithya Kumar-* Sanchayan Maity-* Julian Ospald-* Shlok Datye--## 0.7.1--* Harendra Kumar-* Pranay Sashank-* Adithya Kumar-* Sanchayan Maity-* Brian Wignall-* Julian Ospald-* Lucian Ursu--## 0.7.0--* Harendra Kumar-* Pranay Sashank-* Artyom Kazak-* David Feuer-* Adithya Kumar-* Aravind Gopal--## 0.6.1--* Harendra Kumar-* Mariusz Ryndzionek-* Luke Clifton-* Nicolas Henin--## 0.6.0--* Harendra Kumar-* Pranay Sashank-* Abhiroop Sarkar-* Michael Sloan--## 0.5.2--* Harendra Kumar-* Keith--## 0.5.1--* Harendra Kumar--## 0.5.0--* Harendra Kumar-* Veladus-* Tim Buckley--## 0.4.1--* Harendra Kumar--## 0.4.0--* Harendra Kumar--## 0.3.0--* Harendra Kumar-* Xiaokui Shu-* k0ral--## 0.2.1--* Harendra Kumar--## 0.2.0--* Harendra Kumar-* Abhiroop Sarkar-* Hussein Ait Lahcen--## 0.1.2--* Harendra Kumar-* Abhiroop Sarkar-* Hussein Ait Lahcen--## 0.1.1--* Harendra Kumar-* Veladus-* Abhiroop Sarkar-* Sibi Prabakaran--## 0.1.0--* Harendra Kumar-* Sibi Prabakaran
− docs/Changelog.md 
@@ -1,539 +0,0 @@-# Changelog--<!-- See rendered changelog at https://streamly.composewell.com -->--## 0.8.2 (Mar 2022)--* Fix performance issues for GHC-9. These changes coupled with GHC changes-  expected to land in 9.2.2 will bring the performance back to the same levels-  as before.--## 0.8.1.1 (Dec 2021)--* Disable building FileSystem.Events where FS Events isn't supported.--## 0.8.1 (Nov 2021)--See API-changelog.txt for new APIs introduced.--### Bug Fixes--* Several bug fixes in the Array module:-    * Fix writeN fold eating away one element when applied multiple times-      [#1258](https://github.com/composewell/streamly/issues/1258).-    * Fix potentially writing beyond allocated memory when shrinking. Likely-      cause of [#944](https://github.com/composewell/streamly/issues/944).-    * Fix potentially writing beyond allocated memory when writing the last-      element. Likely cause of-      [#944](https://github.com/composewell/streamly/issues/944).-    * Fix missing pointer touch could potentially cause use of freed memory.-    * Fix unnecessary additional allocation due to a bug-* Fix a bug in classifySessionsBy, see-  [PR #1311](https://github.com/composewell/streamly/pull/1311). The bug-  could cause premature ejection of a session when input events with the-  same key are split into multiple sessions.--### Notable Internal API Changes--* `tapAsync` from `Streamly.Internal.Data.Stream.Parallel` has been moved to-  `Streamly.Internal.Data.Stream.IsStream` and renamed to `tapAsyncK`.-* `Fold2` has now been renamed to `Refold` and the corresponding `Fold2`-  combinators have been either renamed or removed.--## 0.8.0 (Jun 2021)--See [API Changelog](/docs/API-changelog.txt) for a complete list of signature-changes and new APIs introduced.--### Breaking changes--* `Streamly.Prelude`-    * `fold`: this function may now terminate early without consuming-      the entire stream. For example, `fold Fold.head stream` would-      now terminate immediately after consuming the head element from-      `stream`. This may result in change of behavior in existing programs-      if the program relies on the evaluation of the full stream.-* `Streamly.Data.Unicode.Stream`-    * The following APIs no longer throw errors on invalid input, use new-      APIs suffixed with a prime for strict behavior:-        * decodeUtf8-        * encodeLatin1-        * encodeUtf8-* `Streamly.Data.Fold`:-    * Several instances have been moved to the `Streamly.Data.Fold.Tee`-      module, please use the `Tee` type to adapt to the changes.--### Bug Fixes--* Concurrent Streams: The monadic state for the stream is now propagated across-  threads. Please refer to-  [#369](https://github.com/composewell/streamly/issues/369) for more info.-* `Streamly.Prelude`:-    * `bracket`, `handle`, and `finally` now also work correctly on streams-      that aren't fully drained. Also, the resource acquisition and release is-      atomic with respect to async exceptions.-    * `iterate`, `iterateM` now consume O(1) space instead of O(n).-    * `fromFoldableM` is fixed to be concurrent.-* `Streamly.Network.Inet.TCP`: `accept` and `connect` APIs now close the socket-  if an exception is thrown.-* `Streamly.Network.Socket`: `accept` now closes the socket if an exception is-  thrown.--### Enhancements--* See [API Changelog](/docs/API-changelog.txt) for a complete list of new-  modules and APIs introduced.-* The Fold type is now more powerful, the new termination behavior allows-  to express basic parsing of streams using folds.-* Many new Fold and Unfold APIs are added.-* A new module for console IO APIs is added.-* Experimental modules for the following are added:-    * Parsing-    * Deserialization-    * File system event handling (fsnotify/inotify)-    * Folds for streams of arrays-* Experimental `use-c-malloc` build flag to use the c library `malloc` for-  array allocations. This could be useful to avoid pinned memory fragmentation.---### Notable Internal/Pre-release API Changes--Breaking changes:--* The `Fold` type has changed to accommodate terminating folds.-* Rename: `Streamly.Internal.Prelude` => `Streamly.Internal.Data.Stream.IsStream`-* Several other internal modules have been renamed and re-factored.--Bug fixes:--* A bug was fixed in the conversion of `MicroSecond64` and `MilliSecond64`-  (commit e5119626)-* Bug fix: `classifySessionsBy` now flushes sessions at the end and terminates.--### Miscellaneous--* Drop support for GHC 7.10.3.-* The examples in this package are moved to a new github repo-  [streamly-examples](https://github.com/composewell/streamly-examples)--## 0.7.3 (February 2021)--### Build Issues--* Fix build issues with primitive package version >= 0.7.1.-* Fix build issues on armv7.--## 0.7.2 (April 2020)--### Bug Fixes--* Fix a bug in the `Applicative` and `Functor` instances of the `Fold`-  data type.--### Build Issues--* Fix a bug that occasionally caused a build failure on windows when-  used with `stack` or `stack ghci`.-* Now builds on 32-bit machines.-* Now builds with `primitive` package version >= 0.5.4 && <= 0.6.4.0-* Now builds with newer `QuickCheck` package version >= 2.14 && < 2.15.-* Now builds with GHC 8.10.--## 0.7.1 (February 2020)--### Bug Fixes--* Fix a bug that caused `findIndices` to return wrong indices in some-  cases.-* Fix a bug in `tap`, `chunksOf` that caused memory consumption to-  increase in some cases.-* Fix a space leak in concurrent streams (`async`, `wAsync`, and `ahead`) that-  caused memory consumption to increase with the number of elements in the-  stream, especially when built with `-threaded` and used with `-N` RTS option.-  The issue occurs only in cases when a worker thread happens to be used-  continuously for a long time.-* Fix scheduling of WAsyncT stream style to be in round-robin fashion.-* Now builds with `containers` package version < 0.5.8.-* Now builds with `network` package version >= 3.0.0.0 && < 3.1.0.0.--### Behavior change--* Combinators in `Streamly.Network.Inet.TCP` no longer use TCP `NoDelay` and-  `ReuseAddr` socket options by default. These options can now be specified-  using appropriate combinators.--### Performance--* Now uses `fusion-plugin` package for predictable stream fusion optimizations-* Significant improvement in performance of concurrent stream operations.-* Improved space and time performance of `Foldable` instance.--## 0.7.0 (November 2019)--### Breaking changes--* Change the signature of `foldrM` to ensure that it is lazy-* Change the signature of `iterateM` to ensure that it is lazy.-* `scanx` would now require an additional `Monad m` constraint.--### Behavior change--* Earlier `ParallelT` was unaffected by `maxBuffer` directive, now `maxBuffer`-  can limit the buffer of a `ParallelT` stream as well. When the buffer becomes-  full, the producer threads block.-* `ParallelT` streams no longer have an unlimited buffer by default. Now the-  buffer for parallel streams is limited to 1500 by default, the same as other-  concurrent stream types.--### Deprecations--* In `Streamly.Prelude`:-    * `runStream` has been replaced by `drain`-    * `runN` has been replaced by `drainN`-    * `runWhile` has been replaced by `drainWhile`-    * `fromHandle` has been deprecated. Please use-      `Streamly.FileSystem.Handle.read`, `Streamly.Data.Unicode.Stream.decodeUtf8` and-      `splitOnSuffix` with `Streamly.Data.Fold.toList` to split the-       stream to a stream of `String` separated by a newline.-    * `toHandle` has been deprecated. Please use `intersperse` and `concatUnfold` to-      add newlines to a stream, `Streamly.Data.Unicode.Stream.encodeUtf8` for encoding and-      `Streamly.FileSystem.Handle.write` for writing to a file handle.-    * Deprecate `scanx`, `foldx`, `foldxM`, `foldr1`-    * Remove deprecated APIs `foldl`, `foldlM`-    * Replace deprecated API `scan` with a new signature, to scan using Fold.--* In `Streamly` module:-    * `runStream` has been deprecated, please use `Streamly.Prelude.drain`--* Remove deprecated module `Streamly.Time` (moved to Streamly.Internal.Data.Time)-* Remove module `Streamly.Internal` (functionality moved to the Internal hierarchy)--### Bug Fixes--* Fix a bug that caused `uniq` function to yield the same element twice.-* Fix a bug that caused "thread blocked indefinitely in an MVar operation"-  exception in a parallel stream.-* Fix unbounded memory usage (leak) in `parallel` combinator. The bug manifests-  when large streams are combined using `parallel`.--### Major Enhancements--This release contains a lot of new features and major enhancements.  For more-details on the new features described below please see the haddock docs of the-modules on hackage.--#### Exception Handling--See `Streamly.Prelude` for new exception handling combinators like `before`,-`after`, `bracket`, `onException`, `finally`, `handle` etc.--#### Composable Folds--`Streamly.Data.Fold` module provides composable folds (stream consumers). Folds-allow splitting, grouping, partitioning, unzipping and nesting a stream onto-multiple folds without breaking the stream. Combinators are provided for-temporal and spatial window based fold operations, for example, to support-folding and aggregating data for timeout or inactivity based sessions.--#### Composable Unfolds--`Streamly.Data.Unfold` module provides composable stream generators. Unfolds allow-high performance merging/flattening/combining of stream generators.--#### Streaming File IO--`Streamly.FileSystem.Handle` provides handle based streaming file IO-operations.--#### Streaming Network IO--* `Streamly.Network.Socket` provides socket based streaming network IO-operations.--* `Streamly.Network.Inet.TCP` provides combinators to build Inet/TCP-clients and servers.--#### Concurrent concatMap--The new `concatMapWith` in `Streamly.Prelude` combinator performs a-`concatMap` using a supplied merge/concat strategy. This is a very-powerful combinator as you can, for example, concat streams-concurrently using this.--### Other Enhancements--* Add the following new features/modules:-  * _Unicode Strings_: `Streamly.Data.Unicode.Stream` module provides-    encoding/decoding of character streams and other character stream-    operations.-  * _Arrays_: `Streamly.Memory.Array` module provides arrays for efficient-    in-memory buffering and efficient interfacing with IO.--* Add the following to `Streamly.Prelude`:-    * `unfold`, `fold`, `scan` and `postscan`-    * `concatUnfold` to concat a stream after unfolding each element-    * `intervalsOf` and `chunksOf`-    * `splitOn`, `splitOnSuffix`, `splitWithSuffix`, and `wordsBy`-    * `groups`, `groupsBy` and `groupsByRolling`-    * `postscanl'` and `postscanlM'`-    * `intersperse` intersperse an element in between consecutive elements in-      stream-    * `trace` combinator maps a monadic function on a stream just for side-      effects-    * `tap` redirects a copy of the stream to a `Fold`--## 0.6.1 (March 2019)--### Bug Fixes--* Fix a bug that caused `maxThreads` directive to be ignored when rate control-  was not used.--### Enhancements--* Add GHCJS support-* Remove dependency on "clock" package--## 0.6.0 (December 2018)--### Breaking changes--* `Monad` constraint may be needed on some of the existing APIs (`findIndices`-  and `elemIndices`).--### Enhancements--* Add the following functions to Streamly.Prelude:-    * Generation: `replicate`, `fromIndices`, `fromIndicesM`-    * Enumeration: `Enumerable` type class, `enumerateFrom`, `enumerateFromTo`,-      `enumerateFromThen`, `enumerateFromThenTo`, `enumerate`, `enumerateTo`-    * Running: `runN`, `runWhile`-    * Folds: `(!!)`, `maximumBy`, `minimumBy`, `the`-    * Scans: `scanl1'`, `scanl1M'-    * Filters: `uniq`, `insertBy`, `deleteBy`, `findM`-    * Multi-stream: `eqBy`, `cmpBy`, `mergeBy`, `mergeByM`, `mergeAsyncBy`,-      `mergeAsyncByM`, `isPrefixOf`, `isSubsequenceOf`, `stripPrefix`,-      `concatMap`, `concatMapM`, `indexed`, `indexedR`-* Following instances were added for `SerialT m`, `WSerialT m` and-  `ZipSerialM m`:-  * When `m` ~ `Identity`: IsList, Eq, Ord, Show, Read, IsString, NFData,-    NFData1, Traversable-  * When `m` is `Foldable`: Foldable-* Performance improvements-* Add benchmarks to measure composed and iterated operations--## 0.5.2 (October 2018)--### Bug Fixes--* Cleanup any pending threads when an exception occurs.-* Fixed a livelock in ahead style streams. The problem manifests sometimes when-  multiple streams are merged together in ahead style and one of them is a nil-  stream.-* As per expected concurrency semantics each forked concurrent task must run-  with the monadic state captured at the fork point.  This release fixes a bug,-  which, in some cases caused an incorrect monadic state to be used for a-  concurrent action, leading to unexpected behavior when concurrent streams are-  used in a stateful monad e.g. `StateT`. Particularly, this bug cannot affect-  `ReaderT`.--## 0.5.1 (September 2018)--* Performance improvements, especially space consumption, for concurrent-  streams--## 0.5.0 (September 2018)--### Bug Fixes--* Leftover threads are now cleaned up as soon as the consumer is garbage-  collected.-* Fix a bug in concurrent function application that in certain cases would-  unnecessarily share the concurrency state resulting in incorrect output-  stream.-* Fix passing of state across `parallel`, `async`, `wAsync`, `ahead`, `serial`,-  `wSerial` combinators. Without this fix combinators that rely on state-  passing e.g.  `maxThreads` and `maxBuffer` won't work across these-  combinators.--### Enhancements--* Added rate limiting combinators `rate`, `avgRate`, `minRate`, `maxRate` and-  `constRate` to control the yield rate of a stream.-* Add `foldl1'`, `foldr1`, `intersperseM`, `find`, `lookup`, `and`, `or`,-  `findIndices`, `findIndex`, `elemIndices`, `elemIndex`, `init` to Prelude--### Deprecations--* The `Streamly.Time` module is now deprecated, its functionality is subsumed-  by the new rate limiting combinators.--## 0.4.1 (July 2018)--### Bug Fixes--* foldxM was not fully strict, fixed.--## 0.4.0 (July 2018)--### Breaking changes--* Signatures of `zipWithM` and `zipAsyncWithM` have changed-* Some functions in prelude now require an additional `Monad` constraint on-  the underlying type of the stream.--### Deprecations--* `once` has been deprecated and renamed to `yieldM`--### Enhancements--* Add concurrency control primitives `maxThreads` and `maxBuffer`.-* Concurrency of a stream with bounded concurrency when used with `take` is now-  limited by the number of elements demanded by `take`.-* Significant performance improvements utilizing stream fusion optimizations.-* Add `yield` to construct a singleton stream from a pure value-* Add `repeat` to generate an infinite stream by repeating a pure value-* Add `fromList` and `fromListM` to generate streams from lists, faster than-  `fromFoldable` and `fromFoldableM`-* Add `map` as a synonym of fmap-* Add `scanlM'`, the monadic version of scanl'-* Add `takeWhileM` and `dropWhileM`-* Add `filterM`--## 0.3.0 (June 2018)--### Breaking changes--* Some prelude functions, to whom concurrency capability has been added, will-  now require a `MonadAsync` constraint.--### Bug Fixes--* Fixed a race due to which, in a rare case, we might block indefinitely on-  an MVar due to a lost wakeup.-* Fixed an issue in adaptive concurrency. The issue caused us to stop creating-  more worker threads in some cases due to a race. This bug would not cause any-  functional issue but may reduce concurrency in some cases.--### Enhancements-* Added a concurrent lookahead stream type `Ahead`-* Added `fromFoldableM` API that creates a stream from a container of monadic-  actions-* Monadic stream generation functions `consM`, `|:`, `unfoldrM`, `replicateM`,-  `repeatM`, `iterateM` and `fromFoldableM` can now generate streams-  concurrently when used with concurrent stream types.-* Monad transformation functions `mapM` and `sequence` can now map actions-  concurrently when used at appropriate stream types.-* Added concurrent function application operators to run stages of a-  stream processing function application pipeline concurrently.-* Added `mapMaybe` and `mapMaybeM`.--## 0.2.1 (June 2018)--### Bug Fixes-* Fixed a bug that caused some transformation ops to return incorrect results-  when used with concurrent streams. The affected ops are `take`, `filter`,-  `takeWhile`, `drop`, `dropWhile`, and `reverse`.--## 0.2.0 (May 2018)--### Breaking changes-* Changed the semantics of the Semigroup instance for `InterleavedT`, `AsyncT`-  and `ParallelT`. The new semantics are as follows:-  * For `InterleavedT`, `<>` operation interleaves two streams-  * For `AsyncT`, `<>` now concurrently merges two streams in a left biased-    manner using demand based concurrency.-  * For `ParallelT`, the `<>` operation now concurrently meges the two streams-    in a fairly parallel manner.--  To adapt to the new changes, replace `<>` with `serial` wherever it is used-  for stream types other than `StreamT`.--* Remove the `Alternative` instance.  To adapt to this change replace any usage-  of `<|>` with `parallel` and `empty` with `nil`.-* Stream type now defaults to the `SerialT` type unless explicitly specified-  using a type combinator or a monomorphic type.  This change reduces puzzling-  type errors for beginners. It includes the following two changes:-  * Change the type of all stream elimination functions to use `SerialT`-    instead of a polymorphic type. This makes sure that the stream type is-    always fixed at all exits.-  * Change the type combinators (e.g. `parallely`) to only fix the argument-    stream type and the output stream type remains polymorphic.--  Stream types may have to be changed or type combinators may have to be added-  or removed to adapt to this change.-* Change the type of `foldrM` to make it consistent with `foldrM` in base.-* `async` is renamed to `mkAsync` and `async` is now a new API with a different-  meaning.-* `ZipAsync` is renamed to `ZipAsyncM` and `ZipAsync` is now ZipAsyncM-  specialized to the IO Monad.-* Remove the `MonadError` instance as it was not working correctly for-  parallel compositions. Use `MonadThrow` instead for error propagation.-* Remove Num/Fractional/Floating instances as they are not very useful. Use-  `fmap` and `liftA2` instead.--### Deprecations-* Deprecate and rename the following symbols:-    * `Streaming` to `IsStream`-    * `runStreaming` to `runStream`-    * `StreamT` to `SerialT`-    * `InterleavedT` to `WSerialT`-    * `ZipStream` to `ZipSerialM`-    * `ZipAsync` to `ZipAsyncM`-    * `interleaving` to `wSerially`-    * `zipping` to `zipSerially`-    * `zippingAsync` to `zipAsyncly`-    * `<=>` to `wSerial`-    * `<|` to `async`-    * `each` to `fromFoldable`-    * `scan` to `scanx`-    * `foldl` to `foldx`-    * `foldlM` to `foldxM`-* Deprecate the following symbols for future removal:-    * `runStreamT`-    * `runInterleavedT`-    * `runAsyncT`-    * `runParallelT`-    * `runZipStream`-    * `runZipAsync`--### Enhancements-* Add the following functions:-    * `consM` and `|:` operator to construct streams from monadic actions-    * `once` to create a singleton stream from a monadic action-    * `repeatM` to construct a stream by repeating a monadic action-    * `scanl'` strict left scan-    * `foldl'` strict left fold-    * `foldlM'` strict left fold with a monadic fold function-    * `serial` run two streams serially one after the other-    * `async` run two streams asynchronously-    * `parallel` run two streams in parallel (replaces `<|>`)-    * `WAsyncT` stream type for BFS version of `AsyncT` composition-* Add simpler stream types that are specialized to the IO monad-* Put a bound (1500) on the output buffer used for asynchronous tasks-* Put a limit (1500) on the number of threads used for Async and WAsync types--## 0.1.2 (March 2018)--### Enhancements-* Add `iterate`, `iterateM` stream operations--### Bug Fixes-* Fixed a bug that caused unexpected behavior when `pure` was used to inject-  values in Applicative composition of `ZipStream` and `ZipAsync` types.--## 0.1.1 (March 2018)--### Enhancements-* Make `cons` right associative and provide an operator form `.:` for it-* Add `null`, `tail`, `reverse`, `replicateM`, `scan` stream operations-* Improve performance of some stream operations (`foldl`, `dropWhile`)--### Bug Fixes-* Fix the `product` operation. Earlier, it always returned 0 due to a bug-* Fix the `last` operation, which returned `Nothing` for singleton streams--## 0.1.0 (December 2017)--* Initial release
− docs/Compiling.md 
@@ -1,137 +0,0 @@-# Build Guide--## Building--### Compiler (GHC) Versions--GHC 8.6 and above are recommended.  For best performance use GHC 8.8 or-8.10 along with `fusion-plugin` (see below).  Benchmarks show that GHC-8.8 has significantly better performance than GHC 8.6 in many cases.--GHC 9.0 and GHC 9.2.1 have some performance issues, please see [this-issue](https://github.com/composewell/streamly/issues/1061) for details.-GHC 9.2.2 is expected to have the fixes that will bring the performance on par-with previous versions.--### Distributions--Tested with stackage `lts-18.27` and `nix 21.05`.--### Memory requirements--Building streamly itself may require upto 4GB memory. Depending on the-size of the application you may require 1-16GB memory to build. For most-applications up to 8GB of memory should be sufficient.--To reduce the memory footprint you may want to break big modules into-smaller ones and reduce unnecessary inlining on large functions. You can-also use the `-Rghc-timing` GHC option to report the memory usage during-compilation.--See the "Build times and space considerations" section below for more-details.--### Compilation Options--#### Recommended Options--Add `fusion-plugin` to the `build-depends` section of your program in-the cabal file and use the following GHC options:--```-  -O2-  -fdicts-strict-  -fmax-worker-args=16-  -fspec-constr-recursive=16-  -fplugin Fusion.Plugin-```--Important Notes:--1. [fusion-plugin](https://hackage.haskell.org/package/fusion-plugin) can-   improve performance significantly by better stream fusion, many-   cases. If the perform regresses due to fusion-plugin please open-   an issue.  You may remove the `-fplugin` option for regular builds-   but it is recommended for deployment builds and performance-   benchmarking. Note, for GHC 8.4 or lower fusion-plugin cannot be used.-2. In certain cases it is possible that GHC takes too long to compile-   with `-fspec-constr-recursive=16`, if that happens please reduce the-   value or remove that option.-3. At the very least `-O -fdicts-strict` compilation options are-   absolutely required to avoid issues in some cases. For example, the-   program `main = S.drain $ S.concatMap S.fromList $ S.repeat []` may-   hog memory without these options.--See [Explanation](#explanation) for details about these flags.--#### Explanation--* `-fdicts-strict` is needed to avoid [a GHC-issue](https://gitlab.haskell.org/ghc/ghc/issues/17745) leading to-memory leak in some cases.--* `-fspec-constr-recursive` is needed for better stream fusion by enabling-the `SpecConstr` optimization in more cases. Large values used with this flag-may lead to huge compilation times and code bloat, if that happens please avoid-it or use a lower value (e.g. 3 or 4).--* `-fmax-worker-args` is needed for better stream fusion by enabling the-`SpecConstr` optimization in some important cases.--* `-fplugin=Fusion.Plugin` enables predictable stream fusion-optimization in certain cases by helping the compiler inline internal-bindings and therefore enabling case-of-case optimization. In some-cases, especially in some file IO benchmarks, it can make a difference of-5-10x better performance.--### Multi-core Parallelism--Concurrency without a threaded runtime may be a bit more efficient. Do not use-threaded runtime unless you really need multi-core parallelism. To get-multi-core parallelism use the following GHC options:--  `-threaded -with-rtsopts "-N"`--## Platform Specific Features--Streamly supports Linux, macOS and Windows operating systems. Some-modules and functionality may depend on specific OS kernel features.-Features/modules may get disabled if the kernel/OS does not support it.--### Linux--File system events notification module is supported only for kernel versions-2.6.36 onwards.--### macOS--File system events notification module supports macOS 10.7+ . You must-have the ``Cocoa`` framework installed which is supplied by the macOS-SDK.  If ``Cocoa`` is not installed, you may see an error like this:--```-error: ld: framework not found Cocoa-```--### Native build--Usually, if you have a working GHC you would already have the SDK-installed. See the documentation of `Xcode` or `xcode-select` tool for-more details.--### Nix build--Please note that cabal2nix may not always be able to generate a complete nix-expression on `macOS`. See [this-issue](https://github.com/NixOS/cabal2nix/issues/470).--You may need to add ``nixpkgs.darwin.apple_sdk.frameworks.Cocoa`` to-your ``buildInputs`` or ``executableFrameworkDepends``. Something like-this:--```-executableFrameworkDepends =-    if builtins.currentSystem == "x86_64-darwin"-    then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]-    else [];-```
− docs/ConcurrentStreams.hs 
@@ -1,781 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- |--- Module      : ConcurrentStreams--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com------ In this tutorial we will show how streamly can be used for idiomatic and--- declarative concurrent programming.  Before you go through this tutorial we--- recommend that you take a look at the Streamly serial streams tutorial.--module ConcurrentStreams-    (-    -- * Concurrent Streams-    -- $concurrentStreams--    -- * Combining Streams-    -- $flavors--    -- * Imports and Supporting Code-    -- $imports--    -- * Generating Streams Concurrently-    -- $generatingConcurrently--    -- * Concurrent Pipeline Stages-    -- $concurrentApplication--    -- * Mapping Concurrently-    -- $concurrentTransformation--    -- * Merging Streams--    -- ** Semigroup Style--    -- *** Deep Speculative Composition ('Ahead')-    -- $ahead--    -- *** Deep Asynchronous Composition ('Async')-    -- $async--    -- *** Wide Asynchronous Composition ('WAsync')-    -- $wasync--    -- *** Parallel Asynchronous Composition ('Parallel')-    -- $parallel--    -- XXX we should deprecate and remove the mkAsync API-    -- Custom composition-    -- custom--    -- ** Monoid Style-    -- $monoid--    -- * Nesting Streams--    -- ** Monad-    -- *** Deep Speculative Nesting ('Ahead')-    -- $aheadNesting--    -- *** Deep Asynchronous Nesting ('Async')-    -- $concurrentNesting--    -- *** Wide Asynchronous Nesting ('WAsync')-    -- $wasyncNesting--    -- *** Parallel Asynchronous Nesting ('Parallel')-    -- $parallelNesting--    -- ** Applicative-    -- $applicative--    -- * Zipping Streams--    -- ** Parallel Zipping-    -- $parallelzip--    -- * Concurrent Programming-    -- $concurrent--    -- * Writing Concurrent Programs-    -- $programs--    -- * Where to go next?-    -- $furtherReading-    )-where--import Streamly.Prelude-import Data.Semigroup-import Control.Applicative-import Control.Monad-import Control.Monad.IO.Class      (MonadIO(..))-import Control.Monad.Trans.Class   (MonadTrans (lift))---- CAUTION: please keep setup and imports sections in sync---- $setup--- >>> :m--- >>> import Data.Function ((&))--- >>> import Streamly.Prelude ((|:), (|&))--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold------ >>> import Control.Concurrent (threadDelay, myThreadId)--- >>> :{---   delay n = Stream.fromEffect $ do---      threadDelay (n * 1000000)---      tid <- myThreadId---      putStrLn (show tid ++ ": Delay " ++ show n)--- :}------ >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))--- >>> hSetBuffering stdout LineBuffering------- $imports------ In most of example snippets we do not repeat the imports. Where imports are--- not explicitly specified use the imports shown below.------ >>> :m--- >>> import Data.Function ((&))--- >>> import Streamly.Prelude ((|:), (|&))--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold------ To illustrate concurrent vs serial composition aspects, we will use the--- following @delay@ function to introduce a sleep or delay specified in--- seconds. After the delay it prints the number of seconds it slept.------ >>> import Control.Concurrent (threadDelay, myThreadId)--- >>> :{---   delay n = Stream.fromEffect $ do---      threadDelay (n * 1000000)---      tid <- myThreadId---      putStrLn (show tid ++ ": Delay " ++ show n)--- :}------ For concurrent examples, use line buffering, otherwise output from different--- threads may get mixed:------ >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))--- >>> hSetBuffering stdout LineBuffering------- $concurrentStreams------ Many stream operations can be done concurrently:------ * Streams can be generated concurrently.------ * Streams can be merged concurrently.------ * Multiple stages in a streaming pipeline can run concurrently.------ * Streams can be mapped and zipped concurrently.------ * In monadic composition they combine like a list transformer,---   providing concurrent non-determinism.------ There are three basic concurrent stream styles, 'Ahead', 'Async', and--- 'Parallel'. The 'Ahead' style streams are similar to 'Serial' except that--- they can speculatively execute multiple stream actions concurrently in--- advance. 'Ahead' would return exactly the same stream as 'Serial' except--- that it may execute the actions concurrently. The 'Async' style streams,--- like 'Ahead', speculatively execute multiple stream actions in advance but--- return the results in their finishing order rather than in the stream--- traversal order.  'Parallel' is like 'Async' except that it provides--- unbounded parallelism instead of controlled parallelism.------ For easy reference, we can classify the stream types based on /execution order/,--- /consumption order/, and /bounded or unbounded/ concurrency.--- Execution could be serial (i.e. synchronous) or asynchronous. In serial--- execution we execute the next action in the stream only after the previous--- one has finished executing. In asynchronous execution multiple actions in--- the stream can be executed asynchronously i.e. the next action can start--- executing even before the first one has finished. Consumption order--- determines the order in which the outputs generated by the composition are--- consumed.  Consumption could be serial or asynchronous. In serial--- consumption, the outputs are consumed in the traversal order, in--- asynchronous consumption the outputs are consumed as they arrive i.e. first--- come first serve order.------ +------------+--------------+--------------+--------------+--- | Type       | Execution    | Consumption  | Concurrency  |--- +============+==============+==============+==============+--- | 'Serial'   | Serial       | Serial       | None         |--- +------------+--------------+--------------+--------------+--- | 'Ahead'    | Asynchronous | Serial       | bounded      |--- +------------+--------------+--------------+--------------+--- | 'Async'    | Asynchronous | Asynchronous | bounded      |--- +------------+--------------+--------------+--------------+--- | 'Parallel' | Asynchronous | Asynchronous | unbounded    |--- +------------+--------------+--------------+--------------+------ All these types can be freely inter-converted using type conversion--- combinators or type annotations, without any cost, to achieve the desired--- composition style.  To force a particular type of composition, we coerce the--- stream type using the corresponding type adapting combinator from--- 'fromSerial', 'fromAhead', 'fromAsync', or 'fromParallel'.  The default stream type--- is inferred as 'Serial' unless you change it by using one of the combinators--- or by using a type annotation.---- $flavors------ Streams can be combined using '<>' or 'mappend' to form a--- composite. Composite streams can be interpreted in a depth first or--- breadth first manner using an appropriate type conversion before--- consumption. Deep (e.g. 'Serial') stream type variants traverse a--- composite stream in a depth first manner, such that each stream is--- traversed fully before traversing the next stream. Wide--- (e.g. 'WSerial') stream types traverse it in a breadth first--- manner, such that one element from each stream is traversed before--- coming back to the first stream again.------ Each stream type has a wide traversal variant prefixed by 'W'. The wide--- variant differs only in the Semigroup\/Monoid, Applicative\/Monad--- compositions of the streams.--- The following table summarizes the basic types and the corresponding wide--- variants:------ @--- +------------+-----------+--- | Deep       | Wide      |--- +============+===========+--- | 'Serial'     | 'WSerial'   |--- +------------+-----------+--- | 'Ahead'      | 'WAhead'    |--- +------------+-----------+--- | 'Async'      | 'WAsync'    |--- +------------+-----------+--- @------ Other than these types there are also 'ZipSerial' and 'ZipAsync' types that--- zip streams serially or concurrently using 'Applicative' operation. These--- types are not monads they are only applicatives and they do not differ in--- 'Semigroup' composition.------- $programs------ When writing concurrent programs it is advised to not use the concurrent--- style stream combinators blindly at the top level. That might create too--- much concurrency where it is not even required, and can even degrade--- performance in some cases. In some cases it can also lead to surprising--- behavior because of some code that is supposed to be serial becoming--- concurrent. Please be aware that all concurrency capable APIs that you may--- have used under the scope of a concurrent stream combinator will become--- concurrent. For example if you have a 'repeatM' somewhere in your program--- and you use 'fromParallel' on top, the 'repeatM' becomes fully parallel,--- resulting into an infinite parallel execution . Instead, use the--- /Keep It Serial and Stupid/ principle, start with the default serial--- composition and enable concurrent combinators only when and where necessary.--- When you use a concurrent combinator you can use an explicit 'fromSerial'--- combinator to suppress any unnecessary concurrency under the scope of that--- combinator.---- $generatingConcurrently------ Monadic construction and generation functions like 'consM', 'unfoldrM',--- 'replicateM', 'repeatM', 'iterateM' and 'fromFoldableM' work concurrently--- when used with appropriate stream type combinator. The pure versions of--- these APIs are not concurrent, however you can use the monadic versions even--- for pure computations by wrapping the pure value in a monad to get the--- concurrent generation capability where required.------ The following code finishes in 3 seconds (6 seconds when serial):------ >>> let p n = threadDelay (n * 1000000) >> return n--- >>> Stream.toList $ Stream.fromParallel $ p 3 |: p 2 |: p 1 |: Stream.nil--- [1,2,3]------ >>> Stream.toList $ Stream.fromAhead $ p 3 |: p 2 |: p 1 |: Stream.nil--- [3,2,1]------ The following finishes in 10 seconds (100 seconds when serial):------ >>> Stream.drain $ Stream.fromAsync $ Stream.replicateM 10 $ p 10------- $concurrentTransformation------ Monadic transformation functions 'mapM' and 'sequence' work concurrently--- when used with appropriate stream type combinators. The pure versions do not--- work concurrently, however you can use the monadic versions even for pure--- computations to get the concurrent transformation capability where required.------ This would print a value every second (2 seconds when serial):------ >>> let p n = threadDelay (n * 1000000) >> return n--- >>> :{--- parMap =---       Stream.repeatM (p 1)---     & Stream.fromSerial   -- repeatM is serial---     & Stream.mapM (\x -> p 1 >> print x)---     & Stream.fromAhead    -- mapM is cocnurrent using Ahead style---     & Stream.drain--- :}------- $concurrentApplication------ The concurrent function application operators '|$' and '|&' apply a stream--- argument to a stream function concurrently to compose a concurrent pipeline--- of stream processing functions:------ Because both the stages run concurrently, we would see a delay of only 1--- second instead of 2 seconds in the following:------ >>> let p n = threadDelay (n * 1000000) >> return n--- >>> :{--- parApp =---        Stream.repeatM (p 1)---     |& Stream.mapM (\x -> p 1 >> print x)---      & Stream.drain--- :}---- $ahead------ The 'Semigroup' operation '<>' of the 'Ahead' type combines two streams in a--- /serial depth first/ manner with concurrent lookahead. We use the 'fromAhead'--- type combinator to effect 'Ahead' style of composition. We can also use an--- explicit 'Ahead' type annotation for the stream to achieve the same effect.------ When two streams are combined in this manner, the streams are traversed in--- depth first manner just like 'Serial', however it can execute the next--- stream concurrently and keep the results ready when its turn arrives.--- Concurrent execution of the next stream(s) is performed if the first stream--- blocks or if it cannot produce output at the rate that is enough to meet the--- consumer demand. Multiple streams can be executed concurrently to meet the--- demand.  The following example would print the result in a second even--- though each action in each stream takes one second:------ >>> p n = threadDelay 1000000 >> return n--- >>> stream1 = p 1 |: p 2 |: Stream.nil--- >>> stream2 = p 3 |: p 4 |: Stream.nil--- >>> Stream.toList $ Stream.fromAhead $ stream1 <> stream2--- [1,2,3,4]------ Each stream is constructed 'fromAhead' and then both the streams are merged--- 'fromAhead', therefore, all the actions can run concurrently but the result is--- presented in serial order.------ You can also use the polymorphic combinator 'ahead' in place of '<>' to--- compose any type of streams in this manner.---- $async------ The 'Semigroup' operation '<>' of the 'Async' type combines the two--- streams in a depth first manner with parallel look ahead. We use the--- 'fromAsync' type combinator to effect 'Async' style of composition. We--- can also use the 'Async' type annotation for the stream type to achieve--- the same effect.------ When two streams with multiple elements are combined in this manner, the--- streams are traversed in depth first manner just like 'Serial', however it--- can execute the next stream concurrently and return the results from it--- as they arrive i.e. the results from the next stream may be yielded even--- before the results from the first stream. Concurrent execution of the next--- stream(s) is performed if the first stream blocks or if it cannot produce--- output at the rate that is enough to meet the consumer demand. Multiple--- streams can be executed concurrently to meet the demand.--- In the example below each element in the stream introduces a constant delay--- of 1 second, however, it takes just one second to produce all the results.--- The results are not guaranteed to be in any particular order:------ >>> p n = threadDelay 1000000 >> return n--- >>> stream1 = p 1 |: p 2 |: Stream.nil--- >>> stream2 = p 3 |: p 4 |: Stream.nil--- >>> Stream.toList $ Stream.fromAsync $ stream1 <> stream2--- ...------ The constituent streams are also composed in 'Async' manner and the--- composition of streams too. We can compose the constituent streams to run--- serially, in that case it would take 2 seconds to produce all the results.--- The elements in the serial streams would be in serial order in the results:------ >>> p n = threadDelay 1000000 >> return n--- >>> stream = (Stream.fromSerial stream1) <> (Stream.fromSerial stream2)--- >>> Stream.toList $ Stream.fromAsync stream--- ...------ In the following example we can see that new threads are started when a--- computation blocks.  Notice that the output from the stream with the--- shortest delay is printed first. The whole computation takes @maximum of--- (3, 2, 1) = 3@ seconds:------ >>> Stream.drain $ Stream.fromAsync $ delay 3 <> delay 2 <> delay 1--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ When we have a tree of computations composed using this style, the tree is--- traversed in DFS style just like the 'Serial' style, the only difference is--- that here we can move on to executing the next stream if a stream blocks.--- However, we will not start new threads if we have sufficient output to--- saturate the consumer.  This is why we call it left-biased demand driven or--- adaptive concurrency style, the concurrency tends to stay on the left side--- of the composition as long as possible. More threads are started based on--- the pull rate of the consumer. The following example prints an output every--- second as all of the actions are concurrent.------ >>> Stream.drain $ Stream.fromAsync $ (delay 1 <> delay 2) <> (delay 3 <> delay 4)--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3--- ThreadId ...: Delay 4------ All the computations may even run in a single thread when more threads are--- not needed. As you can see, in the following example the computations are--- run in a single thread one after another, because none of them blocks.--- However, if the thread consuming the stream were faster than the producer--- then it would have started parallel threads for each computation to keep up--- even if none of them blocks:------ >>> :{--- traced m = Stream.fromEffect (myThreadId >>= print) >> return m--- stream = traced (sqrt 9) <> traced (sqrt 16) <> traced (sqrt 25)--- main = Stream.drain $ Stream.fromAsync stream--- :}------ Note that the order of printing in the above examples may change due to--- variations in scheduling latencies for concurrent threads.------ The polymorphic version of the 'Async' binary operation '<>' is called--- 'async'. We can use 'async' to join streams in a left biased--- adaptively concurrent manner irrespective of the type, notice that we have--- not used the 'fromAsync' combinator in the following example:------ >>> Stream.drain $ delay 3 `Stream.async` delay 2 `Stream.async` delay 1--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ Since the concurrency provided by this operator is demand driven it cannot--- be used when the composed computations start timers that are relative to--- each other because all computations may not be started at the same time and--- therefore timers in all of them may not start at the same time.  When--- relative timing among all computations is important or when we need to start--- all computations at once for any reason 'Parallel' style must be used--- instead.------ 'Async' style utilizes resources optimally and should be preferred over--- 'Parallel' or 'WAsync' unless you really need those. 'Async' should be used--- when we know that the computations can run in parallel but we do not care if--- they actually run in parallel or not, that decision can be left to the--- scheduler based on demand. Also, note that 'async' operator can be used to fold--- infinite number of streams in contrast to the 'Parallel' or 'WAsync' styles,--- because it does not require us to run all of them at the same time in a fair--- manner.---- $wasync------ The 'Semigroup' operation '<>' of the 'WAsync' type combines two streams in--- a concurrent manner using /breadth first traversal/. We use the 'fromWAsync'--- type combinator to effect 'WAsync' style of composition. We can also use the--- 'WAsync' type annotation for the stream to achieve the same effect.------ When streams with multiple elements are combined in this manner, we traverse--- all the streams concurrently in a breadth first manner i.e. one action from--- each stream is performed and yielded to the resulting stream before we come--- back to the first stream again and so on. Even though we execute the actions--- in a breadth first order the outputs are consumed on a first come first--- serve basis.------ In the following example we can see that outputs are produced in the breadth--- first traversal order but this is not guaranteed.------ >>> stream1 = print 1 |: print 2 |: Stream.nil--- >>> stream2 = print 3 |: print 4 |: Stream.nil--- >>> Stream.drain $ Stream.fromWAsync $ stream1 <> stream2--- 1--- 3--- 2--- 4------ The polymorphic version of the binary operation '<>' of the 'WAsync' type is--- 'wAsync'.  We can use 'wAsync' to join streams using a breadth first--- concurrent traversal irrespective of the type, notice that we have not used--- the 'fromWAsync' combinator in the following example:------ >>> Stream.drain $ delay 3 `Stream.wAsync` delay 2 `Stream.wAsync` delay 1--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ Since the concurrency provided by this style is demand driven it may not--- be used when the composed computations start timers that are relative to--- each other because all computations may not be started at the same time and--- therefore timers in all of them may not start at the same time.  When--- relative timing among all computations is important or when we need to start--- all computations at once for any reason 'Parallel' style must be used--- instead.------- $parallel------ The 'Semigroup' operation '<>' of the 'Parallel' type combines the two--- streams in a fairly concurrent manner with round robin scheduling. We use--- the 'fromParallel' type combinator to effect 'Parallel' style of composition.--- We can also use the 'Parallel' type annotation for the stream type to--- achieve the same effect.------ When two streams with multiple elements are combined in this manner, the--- monadic actions in both the streams are performed concurrently with a fair--- round robin scheduling.  The outputs are yielded in the order in which the--- actions complete. This is pretty similar to the 'WAsync' type, the--- difference is that 'WAsync' is adaptive to the consumer demand and may or--- may not execute all actions in parallel depending on the demand, whereas--- 'Parallel' runs all the streams in parallel irrespective of the demand.------ The polymorphic version of the binary operation '<>' of the 'Parallel' type--- is 'parallel'. We can use 'parallel' to join streams in a fairly concurrent--- manner irrespective of the type, notice that we have not used the--- 'fromParallel' combinator in the following example:------ >>> Stream.drain $ delay 3 `Stream.parallel` delay 2 `Stream.wAsync` delay 1--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ Note that this style of composition cannot be used to combine infinite--- number of streams, as it will lead to an infinite sized scheduling queue.------- XXX to be removed--- $custom------ The 'mkAsync' API can be used to create references to asynchronously running--- stream computations. We can then use 'uncons' to explore the streams--- arbitrarily and then recompose individual elements to create a new stream.--- This way we can dynamically decide which stream to explore at any given--- time.  Take an example of a merge sort of two sorted streams. We need to--- keep consuming items from the stream which has the lowest item in the sort--- order.  This can be achieved using async references to streams. See--- "MergeSort.hs" in <https://github.com/composewell/streamly-examples Streamly Examples>.---- $monoid------ All of the following are equivalent and start ten concurrent tasks each with--- a delay from 1 to 10 seconds, resulting in the printing of each number every--- second:------ >>> :{--- main = do---  Stream.drain $ Stream.fromAsync $ foldMap delay [1..10]---  Stream.drain $ Stream.concatFoldableWith Stream.async (map delay [1..10])---  Stream.drain $ Stream.concatMapFoldableWith Stream.async delay [1..10]---  Stream.drain $ Stream.concatForFoldableWith Stream.async [1..10] delay--- :}------- $aheadNesting------ The 'Monad' composition of 'Ahead' type behaves just like 'Serial' except--- that it can speculatively perform a bounded number of next iterations of a--- loop concurrently.------ >>> :{--- Stream.toList $ Stream.fromAhead $ do---     x <- Stream.fromFoldable [3,2,1]---     delay x---     return x--- :}--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3--- [3,2,1]------ This code finishes in 3 seconds, 'Serial' would take 6 seconds.  As we can--- see all the three iterations are concurrent and run in different threads,--- however, the results are returned in the serial order.------ Concurrency is demand driven, when multiple streams are composed using this--- style, the iterations are executed in a depth first manner just like--- 'Serial' i.e. nested iterations are executed before we proceed to the next--- outer iteration. The only difference is that we may execute multiple future--- iterations concurrently and keep the results ready.------ The 'fromAhead' type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'Ahead'.------- $concurrentNesting------ The 'Monad' composition of 'Async' type can perform the iterations of a--- loop concurrently.------ >>> :{--- Stream.drain $ Stream.fromAsync $ do---      x <- Stream.fromFoldable [3,2,1]---      delay x--- :}--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ As we can see the code after the @fromFoldable@ statement is run three--- times, once for each value of @x@. All the three iterations are concurrent--- and run in different threads. The iteration with least delay finishes first.--- When compared to imperative programming, this can be viewed as a @for@ loop--- with three concurrent iterations.------ Concurrency is demand driven i.e. more concurrent iterations are started--- only if the previous iterations are not able to saturate the consumer of the--- output stream.  This works exactly the same way as the merging of two--- streams using 'async' works.------ The 'fromAsync' type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'Async'.------ When multiple streams are nested using this style, the iterations are--- concurrently evaluated in a depth first manner:--------- >>> :{--- Stream.drain $ Stream.fromAsync $ do---     x <- Stream.fromFoldable [1,2]---     y <- Stream.fromFoldable [3,4]---     Stream.fromEffect $ putStrLn $ show (x, y)--- :}--- (1,3)--- (1,4)--- (2,3)--- (2,4)------ Nested iterations are given preference for concurrent evaluation i.e.--- (1,4) will be scheduled in preference to (2,3).---- $wasyncNesting------ Like 'Async', the 'Monad' composition of 'WAsync' runs the iterations of a--- loop concurrently. It differs from 'Async' in the nested loop behavior. Like--- 'WSerial', the nested loops in this type are traversed and executed in a--- breadth first manner rather than the depth first manner of 'Async' style.------ >>> :{--- Stream.drain $ Stream.fromWAsync $ do---     x <- Stream.fromSerial $ Stream.fromFoldable [1,2]---     y <- Stream.fromSerial $ Stream.fromFoldable [3,4]---     Stream.fromEffect $ putStrLn $ show (x, y)--- :}--- (1,3)--- (1,4)--- (2,3)--- (2,4)------ Note that (2,3) is preferred to (1,4) when evaluating the iterations--- concurrently.  This works exactly the same way as the merging of two streams--- using 'wAsync' works.------ The 'fromWAsync' type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'WAsync'.------- $parallelNesting------ Just like 'Async' or 'WAsync' the 'Monad' composition of 'Parallel' runs the--- iterations of a loop concurrently.------ >>> :{--- Stream.drain $ Stream.fromParallel $ do---    x <- Stream.fromFoldable [3,2,1]---    delay x--- :}--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ It differs from 'Async' and 'WAsync' in the nested loop behavior. All--- iterations of the loop are run fully concurrently irrespective of the--- demand.  This works exactly the same way as the merging of streams using--- 'parallel' works.------ The 'fromParallel' type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'Parallel'.------- $applicative------ 'Async' can run the iterations concurrently, therefore, it takes a total--- of 6 seconds which is max (1, 2) + max (3, 4):------ >>> (Stream.toList $ Stream.fromAsync $ (,) <$> s1 <*> s2) >>= print--- ...------ @--- ThreadId 34: Delay 1--- ThreadId 36: Delay 2--- ThreadId 35: Delay 3--- ThreadId 36: Delay 3--- ThreadId 35: Delay 4--- ThreadId 36: Delay 4--- [(1,3),(2,3),(1,4),(2,4)]--- @------ Similarly, 'WAsync' as well can run the iterations concurrently, but with a--- different style of scheduling than 'Async' as explained in the Monad--- section, therefore, it too takes a total of 6 seconds (2 + 4):------ >>> (Stream.toList $ Stream.fromWAsync $ (,) <$> s1 <*> s2) >>= print--- ...------ @--- ThreadId 34: Delay 1--- ThreadId 36: Delay 2--- ThreadId 35: Delay 3--- ThreadId 36: Delay 3--- ThreadId 35: Delay 4--- ThreadId 36: Delay 4--- [(1,3),(2,3),(1,4),(2,4)]--- @---- $parallelzip------ The applicative instance of 'ZipAsync' type zips streams concurrently.--- 'fromZipAsync' type combinator can be used to switch to parallel applicative--- zip composition:------ >>> d n = delay n >> return n--- >>> s1 = Stream.fromSerial $ d 2 <> d 4--- >>> s2 = Stream.fromSerial $ d 3 <> d 1--- >>> (Stream.toList $ Stream.fromZipAsync $ (,) <$> s1 <*> s2) >>= print--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3--- ThreadId ...: Delay 1--- ThreadId ...: Delay 4--- [(2,3),(4,1)]------ The actions within each stream are executed serially, however, the two--- streams are run concurrently with respect to each other. Therefore, it takes--- 6 seconds to zip the two streams, which is the maximum of the time to--- evaluate stream s1 (2 + 4 = 6 seconds) and stream s2 (3 + 1 = 4 seconds).---- $concurrent------ When writing concurrent programs there are two distinct places where the--- programmer can control the concurrency. First, when /composing/ a stream by--- merging multiple streams we can choose an appropriate sum style operators to--- combine them concurrently or serially. Second, when /processing/ a stream in--- a monadic composition we can choose one of the monad composition types to--- choose the desired type of concurrency.------ In the following example the squares of @x@ and @y@ are computed--- concurrently using the 'async' operation and the square roots of their--- sum are computed serially because of the 'fromSerial' combinator. We can--- choose different combinators for the monadic processing and the stream--- generation, to control the concurrency.  We can also use the 'fromAsync'--- combinator instead of explicitly folding with 'async'.------ >>> import Data.List (sum)--- >>> :{--- main = do---     z <-   Stream.toList---          $ Stream.fromSerial     -- Serial monadic processing (sqrt below)---          $ do---              x2 <- Stream.concatForFoldableWith Stream.async [1..100] $ -- Concurrent @"for"@ loop---                          \x -> return $ x * x  -- body of the loop---              y2 <- Stream.concatForFoldableWith Stream.async [1..100] $---                          \y -> return $ y * y---              return $ sqrt (x2 + y2)---     print $ sum z--- :}------ We can see how this directly maps to the imperative style--- <https://en.wikipedia.org/wiki/OpenMP OpenMP> model, we use combinators--- and operators instead of the ugly pragmas.------ For more concurrent programming examples see,--- <https://github.com/composewell/streamly-examples>.---- $furtherReading------ * Read the reactive programming tutorial--- * See the examples in <https://github.com/composewell/streamly-examples streamly-examples> repo.
− docs/Credits.md 
@@ -1,43 +0,0 @@-# Credits and Contributions--This library builds upon many good ideas from the existing body of Haskell-work.  We would like to thank all the Haskellers whose work might have-influenced this library. It is not possible to quantify that contribution and-give proper credits for it. Below, we have listed the copyright attributions-and contributions to this library.  We do due diligence in giving credit where-its due, if something got missed please do point out by [raising an issue on-github](https://github.com/composewell/streamly/issues) or [sending an email to-the maintainers](mailto:streamly@composewell.com).--## Attributions--See LICENSE for parts of other works included in this package.--## Contributions--See CONTRIBUTORS.md for a release wise list of contributors to this library.--## References--Some (among many others) of the Haskell packages that we looked at and might-have taken some ideas or inspiration from include:--* http://hackage.haskell.org/package/base--* https://hackage.haskell.org/package/logict-* https://hackage.haskell.org/package/list-transformer-* http://hackage.haskell.org/package/transient--* http://hackage.haskell.org/package/streaming-* http://hackage.haskell.org/package/machines-* https://hackage.haskell.org/package/simple-conduit-* http://hackage.haskell.org/package/pipes-* http://hackage.haskell.org/package/conduit--* http://hackage.haskell.org/package/vector-* http://hackage.haskell.org/package/bytestring-* http://hackage.haskell.org/package/text--* http://hackage.haskell.org/package/split-* https://hackage.haskell.org/package/foldl-* https://github.com/effectfully/prefolds
+ docs/Developer/Benchmarks.md view
@@ -0,0 +1,342 @@+# Benchmarking++## Build and run benchmarks directly++```+$ cabal run bench:Prelude.Serial  # run selected+$ cabal run bench:Prelude.Serial -- --help # help on arguments+$ cabal run bench:Prelude.Serial -- --stdev 100000 # specify arguments+$ cabal run bench:Prelude.Serial --flag fusion-plugin # with fusion-plugin++$ cabal build bench:Prelude.Serial # build selected+$ cabal build --enable-benchmarks streamly-benchmarks # build all+$ cabal build --enable-benchmarks all # build all, alternate method++$ cabal build --flag "-opt" ... # disable optimization, faster build+```++## Building and Running Benchmarks with bench-runner++The executable `bench-runner` is the top level driver for+running benchmarks. It runs the requested benchmarks and then creates a+report from the results using the `bench-show` package.++IMPORTANT NOTE:  The first time you run this executable it may take a long+time because it has to build the `bench-report` executable which has a+lot of dependencies.++You can install it once in the root of the repository and use it multiple times.++You can use `cabal.project.report` to install bench-runner like so:+```+$ cabal install bench-runner --project-file=cabal.project.report --installdir=./  --overwrite-policy=always+$ ./bench-runner <bench-runner-args>+```++If you're using nix, you can install bench-runner like so:+```+$ cd benchmark/bench-runner+$ nix-shell --run 'cabal install bench-runner --installdir=../../  --overwrite-policy=always'+$ cd ../../+$ ./bench-runner <bench-runner-args>+```++You can run the `bench-runner` without installing, like so:+```+$ cabal run bench-runner --project-file=cabal.project.report -- <bench-runner-args>+```++## bench-runner: Quick start++Assuming `bench-runner` is the executable. You can replace `./bench-runner` with+`cabal run bench-runner --project-file=cabal.project.report --`++Note, you need to pass two mandatory arguments to bench-runner,+`package-version` and `package-name`. For the streamly-benchmarks package, pass+these as below:++```+bin/bench-runner --package-version 0.0.0 --package-name streamly-benchmarks+```++Useful commands:++```+$ ./bench-runner --help+$ ./bench-runner --quick # run all the benchmark suites+$ ./bench-runner --targets help # Show available benchmark suites+$ ./bench-runner --targets serial_grp # Run all serial benchmark suites+$ ./bench-runner --targets "Prelude.Serial Data.Parser" # run selected suites+$ ./bench-runner --no-measure # don't run benchmarks just show previous results++# Run all O(1) space complexity benchmarks in `Prelude.Serial` suite+$ ./bench-runner --targets Prelude.Serial --prefix Prelude.Serial/o-1-space++# Run a specific benchmark in `Prelude.Serial` suite+$ ./bench-runner --targets Prelude.Serial --prefix Prelude.Serial/o-1-space.generation.unfoldr+```++Note: `bench-runner` enables fusion-plugin by default.++## Comparing results with baseline++```+# Checkout baseline commit+$ ./bench-runner --quick++# Checkout commit with new changes+$ ./bench-runner --quick --append++# To add another result to comparisons just repeat the above command on+# desired commit++# To display the current results without running the benchmarks.+# See "Reporting without measuring" for more info.+$ ./bench-runner --no-measure+```++## Comparing benchmark suites++First see the available benchmark suites:++```+$ ./bench-runner --targets help+```++You will see some benchmark suites end with `_cmp`, these are comparison+groups. If you run a comparison group benchmark, comparison of all the+benchmark suites in that group will be shown in the end. For example to compare+all array benchmark suites:++```+$ ./bench-runner --targets array_cmp+```++## Reporting without measuring++You can use the `--no-measure` option to report the already measured results in+the benchmarks results file. A results file may collect an arbitrary number of+results by running with `--append` multiple times. Each benchmark has its own+results file, for example the `Prelude.Serial` benchmark has the results file at+`charts/Prelude.Serial/results.csv`.++You can also manually edit the file to remove a set of results if you like or+to append results from previously saved results or from some other results+file. After editing you can run `bench-runner` with the `--no-measure` option to+see the reports corresponding to the results.++## Additional benchmark configuration++### Stream size++You can specify the stream size (default is 100000) to be used for+benchmarking:++```+$ cabal run bench:Prelude.Serial -- --stream-size 1000000+```++### External input file++In the `FileSystem.Handle` benchmark you can specify the input file as an+environment variable:++```+$ export Benchmark_FileSystem_Handle_InputFile=./gutenberg-500.txt+$ cabal run FileSystem.Handle -- FileSystem.Handle/o-1-space/reduce/read/S.splitOnSeq+```++The automatic tests do not test unicode input, this option is useful to specify+a unicode text file manually.++## Running benchmarks on valid UTF8 input++To run the unicode benchmarks on valid utf8 input, you can do the following,++```+$ Benchmark_FileSystem_Handle_InputFile=<valid-unicode-filepath> ./bench-runner --benchmarks Unicode.Stream --cabal-build-options "-f include-strict-utf8"+```++## Benchmarking notes++We run each benchmark in an isolated process to minimize interference+of benchmarks and to be able to control the RTS memory restrictions per+benchmark.++### Gotchas++The benchmark driver forces a GC before and after the measurement.+However, we have observed+that sometimes the GC stats may not be accurate when the number of iterations+in the measurement is small (e.g. 1 iteration).  In such cases usually the+number of GCs and GC times would also be 0.++## Diagnosing Performance Issues++### Reproducible comparison++When comparing different compilers we need to make sure that we are+using exactly the same versions of the libraries for apples to apples+comparison. We have seen cases where a change in the "random" library+caused allocations regressions in the new version of compiler because of+the way in which the benchmark code was generated due to the change.++When it is required to reproduce benchmark results precisely across+different systems, it is recommended that you create and use a cabal+freeze file so that the versions of all libraries are pinned.++### Identifying issues++There are two ways to find problematic code:++1. Run performance benchmarks using `bench-runner`, select the benchmarks+   that are taking more than expected time.+2. When making a new change, compare with the baseline and select benchmarks+   with the most regression reported by `bench-runner`.++Number of allocations are the most stable measure that do not vary from+run to run. `cpuTime` and `bytesCopied` may vary. When comparing two+runs for regression the first thing to look at is the difference in+allocations. Also note that allocations may vary from run to run for+concurrent benchmarks.++The next thing to look at is cpuTime. Please note that cpuTime may+fluctuate quite a bit, you may want to run the relevant benchmarks+without the --quick mode for confirming and make sure no other load is+running on the system when measuring.++Usually the increase is cpuTime is proportional to the increase in+allocations but sometimes it may increase independently because more cpu+instructions are being executed. TBD - we should count the instructions+instead.++### Inspection Testing++Before you proceed make sure have to run the benchmarks with+`inspection` flag on. It may catch any obvious issues or regressions.++```+$ cabal build --flag inspection --flag fusion-plugin --enable-benchmarks streamly-benchmarks+```++### Compiling with diagnostics++1. Comment out all other benchmarks in the given benchmark suite, and+   keep only the one you are examining.+2. Edit the file and add the following line on top:++```+{-# OPTIONS_GHC+  -ddump-simpl+  -ddump-to-file+  -dsuppress-all+  -Wmissed-specialisations+  -Wall-missed-specialisations+  -fplugin-opt=Fusion.Plugin:verbose=2+  -fplugin-opt=Fusion.Plugin:dump-core+#-}+```+3. Build the benchmark suite with fusion-plugin enabled:++```+$ cabal build bench:Prelude.Serial --flag fusion-plugin+```++See the `.dump-simpl` file in the cabal build directory. You can find it+like this:++```+$ find dist-newstyle/ -name "*.dump-simpl"+```++Make sure you are looking into the right build dir (`--build-dir` may change+`dist-newstyle` to something else), and check in the appropriate GHC+version dir.++### Compiling standalone example++Sometimes you may want to create a separate program from the benchmark code+removing the benchmarking harness to simplify and isolate the code for better+reasoning and simpler core.++Add the following GHC options at the top of your file, say, example.hs:++```+{-# OPTIONS_GHC+  -ddump-simpl+  -ddump-to-file+  -dsuppress-all+  -Wmissed-specialisations+  -Wall-missed-specialisations+  -fplugin Fusion.Plugin+  -fplugin-opt=Fusion.Plugin:verbose=2+  -fplugin-opt=Fusion.Plugin:dump-core+#-}+```++Do not include the optimization options in OPTIONS_GHC pragma, instead, specify+them on the command line. This is to avoid optimization failing if you import+another module which is not compiled with the same optimization options.++```+$ cabal build # build and write ghc environment file+$ ghc -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 example.hs+```++To pinpoint where the optimization is going wrong you can examine the+plugin generated core files for each optimization pass. The files are+numbered for each optimization pass. You can compare successive files+using side-by-side diff and see what the compiler is doing between each+pass.++### Diagnosing the Problem++#### Specialization Issues++Look for missed specialization messages. When you are comparing against a+baseline, check if something that was specialized before is no longer+specialized.++In the core you have to look for type class dictionaries e.g.++```+exc_r6DD = \ @s_a6ai -> try $fMonadCatchIO $fExceptionSomeException+```++Search for `$f` in the core.++#### Fusion Issues++Look for unfused function warnings emitted by fusion-plugin. You may+want to take a look at the unfused constructors or functions that+fusion-plugin is warning about.  Beware that:++* fusion-plugin emits warnings for unfused stuff in intermediate functions as+  well, those should be ignored.+* the constructors may remain genuinely unfused unless the loop is+  closed. So you should look at the warnings in the file where the loop is+  closed and everything is supposed to be fused.++Also, look at the core for unfused constructors. At times you may need+to look for the boxed primitive type constructors e.g. W8# or I#, these+may not be eliminated, usually, due to strictness issues.++Often it is useful to diff and compare the core without the problem and+the core with the problem especially in cases when the problem is due to+GHC version changes, or smaller changes in the code.++Note, some operations are inherently fusion breaking, those cannot fuse,+they are usually annotated so in their documentation.++### Resolving the problem++Review the problematic code, see [the optimization+guide](/docs/Developer/optimization-guidelines.md) for common problems and how to+solve those. If no obvious issues are found on review, then generate and+examine the core.++You may want to add the `Fuse` annotation on some of those constructors+to make the code fuse. Please note that unnecessary `Fuse` annotations+may cause unnecessary inlining. Also, make sure that the constructor you+are adding fuse annotation is not shared by any other code where you may+not want inlining/fusion.
+ docs/Developer/Contributing.md view
@@ -0,0 +1,271 @@+# Contributors' Guide++## Bug Reports++Please feel free to [open an+issue](https://github.com/composewell/streamly/issues) for any questions,+suggestions, issues or bugs in the library. In case you are reporting a bug+we will appreciate if you provide as much detail as possible to reproduce or+understand the problem, but nevertheless you are encouraged to open an issue+for any problem that you may encounter.++## Picking Issues to Work on++Beginners are encouraged to pick up issues that are marked `help wanted`. It is+a good idea to update the issue expressing your intent so that others do not+duplicate the effort and people with a background on the issue can help.++## Build and test++Some common commands:++```+$ cabal repl+$ cabal build+$ cabal build --disable-optimization --flags -opt+$ bin/test.sh --quick+$ bin/bench.sh --quick # For nix use "--use-nix"+$ bin/run-ci --targets help # Only supported with nix+$ cabal haddock+$ cabal-docspec --timeout 60 --check-properties --property-variables xs+```++The `bin/test.sh` and `bin/bench.sh` are custom scripts to perform test+and benchmarking tasks conveniently. They support running a group of+tests or benchmarks, coverage, using correct optimization flags for+benchmarking, benchmark comparison reports etc. Use the `--help` option+to see how to use these.  See [benchmark/README.md](/docs/Developer/Benchmarks.md)+and [test/README.md](/docs/Developer/Tests.md) for more details.++You can also run tests or benchmarks directly for example:++```+$ cabal test --disable-optimization --flags -opt --test-show-details=streaming --test-option=--color streamly-tests+```++To view haddock docs open the link printed at the end of the haddock+command, in your browser.++Nix users: There is a `default.nix` available which can be used to start+a nix-shell and then use the above commands as usual. nix-shell started+by `default.nix` creates a `.cabal.nix` for cabal configuration and sets+`CABAL_DIR` environment variable to point to that. Therefore, `~/.cabal`+would not be used.++## Contributing A Change++If the feature makes significant changes to design, we encourage you to open an+issue as early as possible so that you do not have to redo much work because of+changes in design decisions. However, if you are confident, you can still go+ahead and take that risk as the maintainers are supposed to be reasonable+people.++### Pull Requests (PR)++Please feel free to [send a pull+request (PR)](https://github.com/composewell/streamly/pulls) whether it is a+single letter typo fix or a complex change.  We will accept any PR that makes a+net positive change to the package. We encourage you to provide a complete,+consistent change with test, documentation and benchmarks. You can contact the+[maintainers](https://gitter.im/composewell/streamly) for any help or+collaboration needed in that regard. However, if due to lack of time you are+not able to complete the PR, you are still welcome to submit it, maintainers+will try their best to actively contribute and pick up your change as long as+the change is approved.++### Pull Request (PR) Checklist++Here is a quick checklist for a PR, for details please see the next section:++* PR contains one logical changeset+* Each commit in the PR consists of a logical change+* Commits are rebased/squashed/fixup/reordered as needed+* Stylistic changes to irrelevant parts of the code are separated in+  independent commits.+* Code is formatted as per the style of the file or that of other files+* Compiler warnings are fixed+* Reasonable hlint suggestions are accepted+* Tests are added to cover the changed parts+* All [tests](/test) pass+* [Performance benchmarks](/benchmark) are added, where applicable+* No significant regressions are reported by [performance benchmarks](/docs/Developer/Benchmarks.md)+* Haddock documentation is added to user visible APIs and data types+* [Docs](/docs) are updated if necessary.+* [Changelog](/docs/User/ProjectRelated/Changelog.md) is updated if needed+* The code conforms to the license, it is not stolen, credit is given,+  copyright notices are retained, original license is included if needed.++### Structuring Pull Requests++__Lean PR:__ Please keep the reviewer in mind when sending pull+requests. Use one PR for each logical changeset. A lean and thin+PR with one independent logical change is more likely to be reviewed and+merged quickly than a big monolithic PR with several unrelated changes.++__PR Dependencies:__ If your change depends on an earlier PR you can+create a branch from the old PR's branch, and raise a new PR targeting+to merge into the old PR branch. Do not push the commits to the same PR+just because the commit depends on that PR.++__Commits:__ You are encouraged to group a logically related set of+changes into a single commit.  When the overall changeset is largish you+can divide it into multiple smaller commits, with each commit having+a logically grouped changeset and the title summarizing the logical+grouping.  Always keep in mind a logical division helps reviewers+understand and review your code quickly, easier history tracking and+when required clean reversal changes.++__Functional Changes:__ Keep the reviewer in mind when making+changes.  Please resist the temptation to make style related changes to+surrounding code unless you are changing that code anyway . Whenever+possible, try to separate unrelated refactoring changes which do not+affect functionality in separate commits so that it is easier for the+reviewer to verify functional changes.++__Style Changes:__ Make sure that your IDE/Editor is not automatically+making sweeping style changes to all the files you are editing. That+makes separating the signal from the noise very difficult and makes+everything harder. If you would like to make style related changes+then please send a separate PR with just those changes and no other+functionality changes.++__Rebasing:__ If your commits reflect how you fixed intermediate+problems during testing or made random changes at different times you+may have to squash your changes (`git rebase -i`) into a single commit+or logically related set of commits.++### Resolving Conflicts++If during the course of development or before you send the PR you find that+your changes are conflicting with the master branch then use `git rebase+master` to rebase your changes on top of master. DO NOT MERGE MASTER INTO YOUR+BRANCH.++### Testing++It is a good idea to include tests for the changes where applicable. See+the existing tests in the [test](/test) directory.  Also see the+[test/README.md](/docs/Developer/Tests.md) for more details on how to run the tests.++### Documentation++For user visible APIs, it is a good idea to provide haddock documentation that+is easily understood by the end programmer and does not sound highfalutin,+and preferably with examples. If your change affects the tutorial or needs to+be mentioned in the tutorial then please update the tutorial. Check if the+additional [guides](/docs) are affected or need to updated.++### Performance Benchmarks++It is a good idea to run performance benchmarks to see if your change affects+any of the existing performance benchmarks. If you introduced something new+then you may want to add benchmarks to check if it performs as well as expected+by the programmers to deem it usable.++See the [README](/docs/Developer/Benchmarks.md) file in the `benchmark` directory for more+details on how to run the benchmarks.++The first level of check is the regression in "allocations", this is+the most stable measure of regression. "bytesCopied" is another stable+measure, it gives an idea of the amount of long lived data being copied+across generations of GC.++The next measure to look at is "cpuTime" this may have some variance+from run to run because of factors like cpu frequency scaling, load on+the system or the number of context switches etc. However, the variance+would usually be within 5-10%, anything more than that is likely to be a+red flag.++Quite often an increase in "cpuTime" would correspond to an increase+in "allocations". Increase in "allocations" indicates an inefficiency+in computing due to too much GC activity e.g. due to lack of+fusion. However, it is also possible for the cpu time to go up without+the allocations going up, this indicates an inefficiency in processing+in general or more CPU being used for the same task. It could be because+of inefficient code generation, branch mis-predictions or lack of cache+locality etc.++For concurrent benchmarks we can compare "cpuTime" and "time" to check+the degree of concurrency and total efficiency.++### Changelog++Any new changes that affect the user of the library in some way must be+documented under `Unreleased` section at the top of the `Changelog`.  The+changes in the changelog must be organized in the following categories, in that+order:++* Breaking Changes+* Enhancements+* Bug Fixes+* Deprecations++If there are very few changes then you can just prefix a bullet with these+annotations. If there are many changes make sections to group them. A section+can be absent if there is nothing to add in it.++If you make changes that are incompatible with the released versions+of the library please indicate that in the `Changelog` as `Breaking Changes`+and also write short notes regarding what the programmers need to do to adapt+their existing code to the new change.++### Licensing++If you have copied code from elsewhere you need to conform to the+licensing terms of the original code. Usually you would need to add a+copyright notice in the source header, and include the license of the+original code as per the terms of the license. If the code you are+copying does not have an associated license please do not use it.++## Developer documentation++* Use https://streamly.composewell.com/ for searching in reference docs+* Build haddock docs for latest reference docs+* See [the dev directory](/docs/Developer) for design guidelines and dev documents.++## Coding Guidelines++### Coding Style++Please see [the Haskell coding style guide](https://github.com/composewell/haskell-dev/blob/master/coding-style.rst).++### Type variable ordering++Ordering of variables in `forall` may be important in type applications. In+streams, we usually declare them in this order `t m a`.++Use the same order in constraints as well++Example,++```+func :: forall m a. (MonadIO m, Storable a) => ...+```++### StreamD coding style++Some conventions that we follow in the StreamD code are illustrated by the+following example:++```+mapM f (Stream step1 state1) = Stream step state+    where++    step gst st = do+        r <- step1 (adaptState gst) st+        case r of+            Yield x s -> f x >>= \a -> return $ Yield a s+            Skip s    -> return $ Skip s+            Stop      -> return Stop+```++* For the input streams use numbering for `step` and `state` e.g.+  step1/state1. For the output stream use `step` and `state`.+* For state argument of `step`, use `st`.+* For result of executing a `step` use `r` or `res`+* For the yielded element use `x`+* For the yielded state use `s`++In general, the rule is - the shorter the scope of a variable the shorter its+name can be. For example, `s` has the shortest scope in the above code, `st`+has a bigger scope and `state` has the biggest scope.
@@ -0,0 +1,1 @@+https://github.com/composewell/streamly
+ docs/Developer/MAINTAINING.md view
@@ -0,0 +1,422 @@+# Maintainers' Guide++## PR Merge Checklist++* All the CI tests pass+* New tests are added where applicable+* Benchmarks are added where applicable+* Run benchmarks locally if you suspect any regressions+* Documentation is added for any new combinators+  * New combinators have time and space complexity annotations+  * New combinators have `since` annotation+* Changelog entry is added for exposed combinators.+* Identify breaking changes, or changes that may require depndency+  version bound changes. See https://pvp.haskell.org/. Also see the+  "Breaking changes section below".+* Optionally, look at hlint output if anything in that is worth fixing.+* Merge the PR by rebasing. Note that github always creates new commits when+  merged with rebase, it records the committer as well as the author in the+  commit. This makes the local branch diverge from master. You can rebase and+  merge the commit manually in your local git tree and push the resulting+  master branch to avoid new commits and divergence from the original tree.++## Release Checklist++* Check if any critical pending bugs or issues are to be included+* If this is a major release check if any previously deprecated features are to+  be removed in this release.+* Check pre-release APIs to be exposed, especially from streamly-examples+* PVP is adhered to, additionally do not change pre-release APIs in a+  minor release++* _Documentation_:++    * Documentation is updated.+    * Check if all the links in the docs are stable.+      * External links might point to the `master` branch of a few+        repositories. Pin them to a specific version that works with the current+        release.+      * You can run `rg '/blob/'` and `rg '/tree/'` to search for github links.+      * For example, links that point to `streamly-examples` point to its+        `master` branch. Instead, while making the release we need to pin the+        links to a specific revision that works with the latest commit of the+        current release.+      * Ideally, the distribution process should automatically replace these+        with current stable references.+    * The markdown documentation files have no broken links. See the section+      about [checking for broken+      links](#checking-for-broken-links-in-the-markdown-files) for more info.+    * Haddock docs are consistent with the changes in the release+    * Tutorial has been updated for new changes+    * Documents in the `docs` directory are consistent with new changes+    * All combinators have time and space complexity annotations+    * All combinators have `since` annotation+    * Modules that were renamed or APIs that moved to other modules should be+      marked as "since" the current release.+    * Check all released modules to ensure that they do not have any leftover+      `Internal` or `Pre-release` annotations.+    * Unreleased combinators should be marked with `Pre-release` or+      `Internal` annotations+    * Streamly homepage is updated with the release docs+      * FileSystem.Event.Windows/Darwin modules require special handling++* _Build and Test_:++    * All CIs are green+    * Run tests using bin/test.sh to test with memory restrictions+    * Manually build and test for all flags (esp. `dev` flag) not covered by CIs+    * Test prime GHC version with -O0 and -O1++* _Benchmarks_:++    * Check regressions from previous release+    * Run benchmarks with large stream size (`bench-runner --long --quick`) to+      check for space leaks and to ensure constant memory usage for streaming+      operations.+    * Run benchmarks with `dev` flag on. Some `fileio` benchmarks are disabled+      in regular runs.+    * Check comparative benchmarks using streaming-benchmarks++* _Dependencies_:++    * Make sure all dependency bounds can use latest versions+    * Update `stack.yaml` to latest stable resolver, cleanup extra-deps+    * Make sure fusion-plugin is up to date and uploaded+    * Check the dependency footprint of the library. See+      [Generating Dependency Graph](#generating-dependency-graph) section.++* _Dependent Packages_:++    * Update+      [streamly-examples](https://github.com/composewell/streamly-examples)+      to make sure it runs with the latest release.+    * Check the performance of examples where applicable+    * Update:+      * streamly-bytestring+      * streamly-process+      * streamly-lz4++* _Update Package Metadata:_++    * Make sure the description in cabal file is in sync with the docs+    * Make sure CI configs include last three major releases of GHC in CI testing.+    * Update GHC `tested-with` field+    * Update `docs/Compiling.md` with the distributions tested with+    * Any docs linked inside haddock/cabal/changelog or any other such file+      should go in the extra-doc-files section instead of+      extra-source-files. Otherwise hackage shows the links as broken.+    * Make sure any additional files are added to `extra-source-files` in cabal+      file. Artifacts required for build, test, benchmarks, docs, licenses+      should be packaged. Build environment customization may or may not be+      packaged.++* _Copyrights and Contibutors_++    * Make sure contributors to the release are listed in `docs/CONTRIBUTORS.md`+      under the current release title.+    * Make sure any third party code included in the release has been listed in+      `docs/Credits.md` and the license is added to the repo.++* _Update changelog & Version_:++    * Find API changes using `./packdiff streamly ver1 streamly ver2`+      and record them in `docs/User/ProjectRelated/ApiChangelogs/ver1-ver2.txt`.+    * Make sure all the bug fixes being included in this release are marked+      with a target release on github. So that users can search by release if+      they want.+    * Make sure the package version in configure.ac has the correct release+      version, else set the version correctly and run autoreconf. This might+      need to be done for a minor release.+    * Make sure the `Unreleased` section at the top of changelog file has the+      new release version number and the month/year of publishing.+    * Make sure the package version in the cabal file and package.yaml has the+      correct release version, else set the version correctly. This might need+      to be done on a minor release.+    * Bump the package version in any docs/links, use something like+      `rg '0\.8\.'|grep -v -i since` to find any remaining occurrences of the+      old release.  Check `rg -i unreleased` for any remaining todos.++* _Upload_:++    * Wait for final CI tests to pass:++        * Manually run packcheck for ghcjs, `bin/run-ci.sh --targets ghcjs`.+        * Mask out the build status lines from the+          [README](/docs/User/ProjectRelated/README.md)+        * Upload to hackage+          * Use a clean workspace to create source distribution+          by freshly cloning the git repository. The reason for+          doing this is that we use wild-cards in cabal file for+          `extra-source-files`, these wild-cards may match additional+          files lying around in the workspace and unintentionally ship+          them as well.+          * Upload and verify the candidate+            * `cabal v2-sdist; cabal upload <tarpath>`+            * `cabal v2-haddock --haddock-for-hackage --enable-doc; cabal upload -d <tarpath>`+          * Publish the package+            * `cabal v2-sdist`; `cabal upload --publish <tarpath>`+            * Run packcheck on the uploaded package. To get the latest uploaded+              version from hackage, run `cabal unpack <package-name>`. You might+              have to run `cabal update`.+        * Create a git tag of the form P-X.Y.Z corresponding to the release+          where X.Y.Z is the new package version and P is the package name (`git+          tag P-X.Y.Z && git push -f origin P-X.Y.Z`). If the package name is+          implicit, P can be omitted and the tag can be of the form vX.Y.Z+        * Add to stackage (`build-constraints.yaml` in Stackage repo) if needed+        * Update and if needed release streaming-benchmarks package+        * Check https://matrix.hackage.haskell.org/package/streamly+        * Check haddocks on Hackage, upload if not built+        * Announce to haskell-cafe@haskell.org++### Post Release Tasks++* _Bump package version_:+    * After a major release, bump the package version in cabal file or+      package.yaml to the next major release target.+    * Bump the package version in configure.ac to the next major release target+      and run autoreconf.+    * Sync the package version of `streamly`.+    * Add an `Unreleased` section at the top of changelog file with the next+      major release target.++## Breaking Changes++This section lists what constitutes breaking changes.  See+https://pvp.haskell.org/ breaking changes that can be determined by the+API alone. We specify some additional recommendations here:++Behavior changes, this kind of changes are nasty and should be avoided. If such+changes are made they should be emphasized adequately in the changelog:++* Silent changes in the behavior of an API without any changes to the+  signature.+* Even fixing a bug could break things as users may have employed workarounds+  for the bug.+* Changes in the behavior of a dependency may also cause a change in behavior.++Be cautious about the following:++* Change in version bounds of dependencies may cause compilation failure for+  some programs because they may not be able to find a build plan.+* Ideally, new warnings should not be considered breaking, dependencies+  should never be compiled with -Werror. But packages may not be following+  it perfectly.+* Deprecating an API may issue new warnings, however the code can still be+  compiled if warnings are not treated as errors.++Internal APIs:++* Internal APIs can change without having to change the major version. However,+  we should try to align the Internal API changes with a major release as long+  as possible.++## Managing Issues++We label the issues in different dimensions based on the lifecyle and different+management aspects of the issue. The folowing sections discuss the labels used+to manage the issues. If a new label is required, it should be discussed before+creating it.++### Disposition++The level-1 triaging of the issue determines the current disposition+of the issue. If no change is required the issue must have one of the+following labels:++* disposition:invalid+* disposition:question+* disposition:discussion+* disposition:duplicate+* disposition:wontfix++If a change is required we need to do level-2 triage of the issue, see the+sections below.++### Change type++When a change is required we need to put one of the __change type__+labels as part of level-2 triaging:++* type:performance: User visible impact on performance.+* type:testing: Improves testing or related to testing.+* type:usability: It is not convenient to use the library.+* type:documentation: documentation is not correct or sufficient.+* type:bug: A functionality issue, not working as expected.+* type:enhancement: includes a new feature or enhancement+* type:maintenance: A refactor or any other change with no user visible impact.++### Aspect++In addition we can put a __product aspect__ label describing a feature name or+any other product specific classification bucket.++* aspect:<aspect name>++### Severity++Optionally we can add a severity label to indicate how severe is the+impact of the bug/issue, which may determine how important it is to fix it. By+default the severity is normal, if it is high we put a label:++* severity:high++### API impact++For a user visible issue whether it has a release/changelog impact:++* api:new: includes a new feature or enhancement+* api:breaking: has a breaking impact on existing deployments+* api:deprecating: deprecates an existing functionality++__RULE__: Any commit that may affect the end user in some way MUST have+either a changelog entry OR MUST have an issue marked with one of the+above labels OR both.++### Priority++By default the issues are normal priority. We use a label for high priority+issues:++* priority:high++### Scheduling++If the issue is assigned to someone then it is considered scheduled. Otherwise+it is unscheduled.  Unassigned issues may have the following labels:++* sched:deferred: deliberately deferred for some reason.+* sched:blocked: blocked on any other fix or a decision to be mad++### For Contributors++* help-wanted: anyone can take the issue and contribute+* good-first-issue: good for new contributors++## Correlating Changes, Issues and Releases++For planning purposes, open issues may be marked with milestones or target+releases.  However, it may not always be known which release a fix will finally+land in.  For example, we may decide to make a minor release instead of a major+one if there are no breaking changes yet, so we may not always know what would+be the next release version.++Trackability means that we should be able to find which issues got fixed in+which release. Or what all issues got fixed in a particular release. We track+significant changes using the changelog. However, there may be more changes+that can only be tracked via issues, PRs or commits.  When we make a release we+can mark all the issues fixed in that release with a correct release target for+future trackability.++For better trackability of which issue got fixed in which release we need the+following:++* Before you close an issue make sure a commit or a PR fixing the issue is+  attached with it. In the commit message you can reference an issue like+  "fixes #50", you can do the same in a PR as well.+* Before we make a new release EVERY issue with a commit included in that+  release that affects the end user, especially bugs and breaking changes MUST+  have the target release correctly set.++## Changelog Management++Keep the unreleased changes in the `Unreleased` section at the top of changelog+file.  Using `Unreleased` instead of the next release number for unreleased+changes is important. First, we do not know the next release number in advance,+it could be a major or minor release.  Second, if we use the next release+number instead, then when adding a new change to the changelog, at one look we+cannot know whether the release number on top is unreleased or released.++## TODO++* GPG signed releases and tags++## Generating Dependency Graph++Ways to get the dependencies. In the streamly package top dir:++```+# Keep only streamly in the packages section of stack.yaml+$ stack --system-ghc dot . --external|dot -Tpdf > streamly.pdf+```++Using nix, remove the test and benchmark components from+`shellFor/packages` in `default.nix` to get library only+dependencies. May show additional ghc boot libraries.++```+$ nix-shell --run "ghc-pkg dot | dot -Tpdf > streamly.pdf"+```++## Checking for broken symlinks++The following command - when run from the repository root - finds all the+broken symlinks in the project.++```+find . -xtype l \+    -not -path "./dist*" \+    -not -path "./.stack*" \+    -not -path "./benchmark/bench-report/dist*"+```++## Checking for broken links in the markdown files++You can use [markdown-link-check](https://github.com/tcort/markdown-link-check)+for finding broken links.++You can run it using `npx` like so:+```+npx markdown-link-check <markdown-file>+```++The following command - when run from the repository root - finds all the+markdown files that we need to consider:++```+find . -type f -name "*.md" \+    -not -path "./dist*" \+    -not -path "./.stack*" \+    -not -path "./benchmark/bench-report/dist*"+```++The following executes the markdown link checking with proper configuration on+the results. This also checks all the links are absolute to the root of the+repo.++```+find . -type f -name "*.md" \+    -not -path "./dist*" \+    -not -path "./.stack*" \+    -not -path "./benchmark/bench-report/dist*" \+    -exec npx markdown-link-check -c /dev/stdin --quiet {} \; <<EOF+{+  "ignorePatterns": [+    {+      "pattern": "^http"+    },+    {+      "pattern": "^ftp"+    },+    {+      "pattern": "^mailto"+    }+  ],+  "replacementPatterns": [+    {+      "pattern": "^", "replacement": "{{BASEURL}}"+    }+  ]+}+EOF+```++Once you run that, you can check all the links again without the config,+filtering in only `http`, `ftp`, and `mailto` links.++```+find . -type f -name "*.md" \+    -not -path "./dist*" \+    -not -path "./.stack*" \+    -not -path "./benchmark/bench-report/dist*" \+    -exec npx markdown-link-check --quiet {} \; 2>&1 | grep -e "http" -e "ftp" -e "mailto"+```
+ docs/Developer/Tests.md view
@@ -0,0 +1,139 @@+# Streamly Tests++## Running tests using bin/test.sh++`bin/test.sh` (path relative to the top level repo dir) can run selected+test groups, generate coverage report, pass GHC RTS options when+running tests. `test.sh` runs the tests with restricted memory, see+`bin/test.sh` source for details on the amount of memory used or to change it.++To generate coverage report:++```+$ bin/test.sh --coverage+```++To view coverage report, open `./hpc_index.html` in browser.++See `bin/test.sh --help` for more info.++## Building and Running Tests using cabal++### Build a single test++```+$ cabal build test:Prelude.Serial+```++or:++```+$ cd test; cabal build Prelude.Serial+```++Build with optimizations:++```+$ cabal build --flag opt ...+```++### Build all tests++```+$ cabal build --enable-tests all+```++or:++```+$ cd test; cabal build --enable-tests+```++Or this, note this command does not work as expected when in the "test" dir:++```+$ cabal build --enable-tests streamly-tests+```++### Build and run++Running all test suites, use any of the following:++```+$ cabal test all+```++or:++```+$ cd test; cabal test+```++Or this, note this command does not work as expected when in the "test" dir:++```+$ cabal test streamly-tests+```++### Build and Run a single test suite++To run `Prelude.Serial` test-suite:++```+$ cabal run test:Prelude.Serial+```++or:++```+$ cd test; cabal run Prelude.Serial+```++Note you could use `cabal test Prelude.Serial` but that unfortunately builds+all the test suites before running `Prelude.Serial`.++## Writing doctests++* We use `cabal-docspec` to run all the code snippets in a source module+  that are written using the `>>>` markup in haddock.+* Make sure you do not enclose your snippets in the `@ .. @` markup otherwise+  they will show up verbatim in the docs and not as ghci styled snippets.+* A haddock section named `$setup` contains a snippet that is always run before+  any other.++An example setup section:++```+-- $setup+-- >>> :m+-- >>> import Control.Monad.IO.Class (MonadIO(..))+-- >>> import Data.Function ((&))+```++Some tests that may take long can be written as follows.  Just defining+the snippet as a function makes it compile but not run.++```+>>> :{+main = do+ Stream.drain $ Stream.fromAsync $ foldMap delay [1..10]+ Stream.drain $ Stream.concatFoldableWith Stream.async (map delay [1..10])+ Stream.drain $ Stream.concatMapFoldableWith Stream.async delay [1..10]+ Stream.drain $ Stream.concatForFoldableWith Stream.async [1..10] delay+:}+```++## Running doctests++```+$ cabal build all+$ cabal-docspec --timeout 60 --check-properties --property-variables xs+```++## Naming of test modules++Tests are organized by source modules. For example, for the source+module `Streamly.Data.Array.Generic` and `Streamly.Internal.Data.Array.Generic` we have+a test module `Data.Array.Generic`. For some modules tests for a source module+are broken into multiple modules. For example, for `Streamly.Prelude` we have+`Streamly.Prelude.Serial`, `Streamly.Prelude.Async` etc.
+ docs/Developer/ci-tests.md view
@@ -0,0 +1,64 @@+# Continuous integration tests++This file documents the required CI test matrix so that we do not accidentally+remove or miss any tests when making changes to CI configs:++## Mono repo++We host "streamly" and "streamly-core" packages in the same repo. This+creates a problem for the sdist build for the "streamly" package because+it depends on the "streamly-core" package. In the "streamly" sdist build+we use a cabal.project file to pick up "streamly-core" from github+master branch HEAD. If we make changes to both the packages at the same+time we won't be able to do this.++We use one sdist build for "streamly" package and one for "streamly-core". The+sdist build for "streamly" might fail because of the reason described above.++## For prime GHC version:++Distribution:+  * build "streamly" from source distribution WITHOUT a cabal.project file+  * build "streamly-core" from source distribution WITHOUT a cabal.project file++Performance:+  * `--flag inspection` + `--flag fusion-plugin`+  * Run `benchmark/bench-runner --quick --raw`+  * Run `test/test-runner`+  * -Werror (for lib, test, bench)++Lint:+  * -Werror (for lib, test, bench) (Need a Werror with default flags)+  * hlint++Doctests:+  * Run cabal-docspec++Coverage:+  * `coverage` build++Debug:+  * --flag debug++Windows:+  * Windows + stack++MacOS:+  * MacOS + stack++## Other GHC versions++GHC head:+  * `--flag inspection` + `--flag fusion-plugin` tests to catch any+    issues early.+  * Ideally we should also be running perf tests and compare+    against the prime version.++Other GHC versions:+* build lib, test, bench, docs, run tests, on Linux platform, using+  cabal build++## GHCJS++GHCJS:+* Latest version ghcjs build (lib, test, bench), run tests
+ docs/Developer/container-api.md view
@@ -0,0 +1,132 @@+# Data Containers++Containers are persistent containers of data e.g. files, arrays, maps. For+consistency we use similar API for all such containers where possible. Usually+the API names are relative to the current module e.g. toBytes in an array+module means converting the array to bytes, it sounds intuitive if read+qualified with the module name e.g. Array.toBytes. This doc lists some+conventions and guidelines to be followed.++## Bytes and Chunks++APIs that deal with streams of Word8 may have "bytes" in their names+while the ones dealing with "Array Word8" have "chunks" in their+names. Usually the default is bytes when there is no explicit mention in+the name.++## Unfolds and Folds++* Unfolds are named as "reader" or with a "reader" suffix (e.g. chunkReader).+* Refolds are named as "writer" or with a "writer" suffix.+* Streams are names as "read" or with a "read" prefix.+* Folds are named as "write" or with a "write" prefix (e.g. writeChunks).++Streams and fold API names are in line with the file system calls for reading+writing.++## To and from Stream++### From and Put++* Immutable construction from some external source is named with a "from"+  prefix (e.g.  fromList).+* Mutation of an existing container uses a "put" prefix instead of "from". When+  an API uses an existing container to write to and does not return a newly+  constructed container then use "put".+* "from" vs "put": "from" assumes creation of a new object, it may fail if the+  object being created already exists (e.g. the file exists), it may not take a+  lock as it assumes immutability. "put" may create a new object or overwrite+  an existing one, it may take a lock for writing as it assumes mutability.++### To and Get++* Converting the complete object to an external representation is prefixed with+  "to" (e.g. toBytes).+* For mutable objects "get" APIs may be used instead of "to" APIs.+* "to" vs "get": "to" assumes immutable object so does not have to take a lock.+  "get" assumes mutable object so may take a lock.++### Append++* Use "append" prefix for appending data at the end of a mutable container++## With additional config++Sometimes we need to modify the behavior of a combinator using some additional+config. For example, combinators to read/write using a specified size of+buffer. For such cases we apply the "With" suffix to standard combinator names:++* readWith+* readChunksWith+* toBytesWith+* getBytesWith++## Random Access (Arrays)++### Single elements++Especially for mutable arrays, the names "get" and "put" make better+sense as effectful APIs.++* getIndex (for arrays)+* putIndex (for mutable arrays)++### Ranges++* ...FromTo (e.g. readFromTo, readChunksFromTo, toBytesFromTo, getBytesFromTo)+* ...FromThenTo+* ...Indices++FromThenTo vs FromStepN:++We could use `fromThenTo` or `fromStepN` style APIs for stepwise+enumeration. The first one uses absolute numbers whereas the second one+uses relative positioning. We prefer FromThenTo style where possible for+the following reasons:++* It is the style used in base lists, and we are already using it in Enumerable+  type class.+* Both have their pros and cons. In `fromThenTo`, (1) it may be+  non-intuitive whether `To` is inclusive, (2) specifying an empty range+  is a bit awkward (e.g. fromThenTo 1 1 0). In `fromStepN`, if we know+  the first and the last element then we will have to compute the offset+  correctly. Ideally, when we know the elements then former is more+  suitable while if we know the count then the latter is more suitable.++Note that in case of floating point numbers `FromStep` style may have an+advantage over `FromThen` style. Here is a quote from the documentation of+`enumerateFromThenNum`:++```+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.+```++### Appending++* append (for mutable arrays)++## Key-Value Store Access (Maps)++* getKey+* findKey (test existence)+* createKey (insert new key for mutable maps)+* putKey (insert or update for mutable maps)+* updateKey (update existing or fail)+* deleteKey  (delete existing or fail)+* destroyKey (delete existing or not)++## Points to Consider++The fold and unfold APIs can be used to express the to/from stream APIs. So we+may not need both, it may just add to more APIs being proliferated.++We may need an "append" style fold as well? What would "stream" append+operations be called then?++We may need locked version of "write" folds for mutable containers for+concurrent access.
+ docs/Developer/cps-vs-direct.rst view
@@ -0,0 +1,328 @@+Structured Loops (Direct Style)+===============================++::++  -- | Result of taking a single step in a stream+  data Step s a where+    Yield :: a -> s -> Step s a+    Stop  :: Step s a++  -- | Representation of a loop, step and state. Step returns the next value and+  -- the next state. We iterate on the state to keep producing more values.+  data Stream m a = forall s. Stream (s -> m (Step s a)) s++Generating+----------++::++  nil :: Monad m => Stream m a+  nil = Stream (const (return Stop)) ()++  -- | A single value+  fromPure :: Applicative m => a -> Stream m a+  fromPure x = Stream step True++      where++      step True  = return $ Yield x False+      step False = return $ Stop++  fromList :: Applicative m => [a] -> Stream m a+  fromList = Stream step++      where++      step _ (x:xs) = pure $ Yield x xs+      step _ []     = pure Stop++Eliminating+-----------++::++  foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b+  foldrM f z (Stream step state) = go state++      where++      go st = do+            r <- step st+            case r of+              Yield x s -> f x (go s)+              Stop      -> z++In the above code the state is explicit and being threaded around in a+recursive loop. The state from the previous iteration is to be consumed+by the next iteration to generate the next value.  This mandates a+closed recursive loop. This is straightforward translation of imperative+loops to functional paradigm.++Transforming Loops+------------------++::++  mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b+  mapM f (Stream step state) = Stream step' state++      where++      step' st = do+          r <- step st+          case r of+              Yield x s -> f x >>= \a -> return $ Yield a s+              Stop      -> return Stop++State wrapping+--------------++Some operations like "drop" (uniq, intersperse, deleteBy, insertBy) may+have to introduce a branch in the code by wrapping the state in another+layer::++  drop :: Monad m => Int -> Stream m a -> Stream m a+  drop n (Stream step state) = Stream step' (state, Just n)++      where++      step' (st, Just i)+        | i > 0 = do+            r <- step st+            return $+              case r of+                Yield _ s -> step' (s, Just (i - 1))+                Stop      -> Stop+        | otherwise = step' (st, Nothing)++      step' (st, Nothing) = do+        r <- step st+        return $+          case r of+            Yield x s -> Yield x (s, Nothing)+            Stop      -> Stop++Note that the branch is always checked for every element in the stream.+It is still quite efficient because the code fuses.++We should use rewrite rules to fuse such consecutive operations together as+they introduce branching which could be costly.++Composing Loops+---------------++Composing two independent loops together is not scalable, we need+to create a wrapper state, wrapping the state of the old stream:++::++  cons :: Monad m => m a -> Stream m a -> Stream m a+  cons m (Stream step state) = Stream step1 Nothing++      where++      step1 Nothing   = m >>= \x -> return $ Yield x (Just state)+      step1 (Just st) = do+          r <- step st+          return $+            case r of+              Yield a s -> Yield a (Just s)+              Stop      -> Stop++As we keep consing we keep creating more layers wrapping the state in+``Maybe``. These layers need to be traversed every time we run the step+function of the composed stream. In the above example ``step1`` needs+to always branch on ``Nothing/Just`` to reach to the wrapped stream. More+layers we add the more branching needs to occur to generate an element+of the stream. If we have ``n`` "cons" operations we need to go through:++* 1 branch at the top level to generate the first element+* 2 branches to generate the next element+* 3 branches to generate the third element+* n branches to generate the nth element++The total number of branches that we need to take is: ``1 + 2 + 3 ... n`` i.e.+``n * (n + 1)/2 = O(n^2)`` where ``n`` is the number of cons operations.++Conceptually, to avoid the introduction of a branch we could use a+mutable step function and state to modify step1/state after yielding+the first element. The next time we call it, it would be a different+function that i.e. "step" and its state "st". However, that would introduce+an indirection and mutability. There is a better way to do it with+immutability i.e. CPS.++CPS representation+==================++In the direct representation we represented a stream using a step and a+state. This model requires us to iterate the step on the state creating+an explicit loop. The state machine implemented by the step function is+incrementally modified by adding new layers in the state which introduce+branches to be traversed every time we go through the loop.++::++  newtype Stream m a = Stream+      { runStream :: forall r. (a -> Stream m a -> m r) -> m r -> m r }++Here we represent the stream as a single function.  Instead, the+function is provided with functions to be called next.++Notice, the function does not have to be called again and again to+iterate on a state for generating new values.  Therefore, there is no+closed recursion. There is no explicit loop.++We (the current ``runStream`` function) can choose which one of the supplied+functions (continuations) to call next.  If we decide to terminate+the stream execution we call the "stop" continuation. If we decide to+generate a value we call the "yield" continuation.++A stream execution is composed of a progression of such continuations+until one of those decides to call the stop continuation.  It is a+composition of functions, a tree of functions composed together.++Yield continuation+------------------++The yield continuation is provided with the generated value "a" and the+"Stream m a", the function representing the rest of the stream. Notice+that the stream function is done with one shot execution, there is no+closed loop or recursion, the future execution of the stream is the+responsibility of the continuation.++The continuation consumes the element "a" and then proceeds to call+"Stream m a" using a "yield" and "stop" continuation. By modifying the+"yield" and "stop" continuations that it passes to call "Stream m a", it+can control the execution of the stream.++Generating+----------++::++  nil :: Stream m a+  nil = Stream $ \_ stp -> stp++  fromPure :: a -> Stream m a+  fromPure a = Stream $ \yield _ -> yield a nil++  cons :: a -> Stream m a -> Stream m a+  cons a r = Stream $ \yld _ -> yld a r++  fromList :: [a] -> Stream m a+  fromList = Prelude.foldr cons nil++Eliminating+-----------++::++  foldrM :: (a -> m b -> m b) -> m b -> Stream m a -> m b+  foldrM step acc m = go m+      where+      go m1 =+          let stop = acc+              yieldk a r = step a (go r)+          in runStream yieldk stop m1++Note that unlike in direct style fold, there is no generator state being+threaded around here instead the function yielded by the continuation is+being executed.++Transforming+------------++::++  map :: (a -> b) -> Stream m a -> Stream m b+  map f = go++      where++      go m1 =+          Stream $ \yld stp ->+            let yieldk a r = yld (f a) (go r)+            in runStream yieldk stp m1++In direct style we had to examine the constructors to determine the+current state and execute code based on that. Here, we have to make+the next function call at each step. The former is much more efficient+because the compiler can optimize well to remove the constructors and+generate code with direct branches not involving the constructors. On+the other hand placing a function call is costlier. Though in some cases+it can be avoided by using foldr/build fusion but not always.++goto+----++::++  drop :: Int -> Stream m a -> Stream m a+  drop n = Stream $ go n++      where++      go n1 m1 =+        Stream $ \yld stp ->+          let yieldk _ r = runStream yld stp $ go (n1 - 1) r+          in if n1 <= 0+             then runStream yld stp m1+             else runStream yieldk stp m1++This shows a crucial difference between direct style and CPS. In direct+style we have to always check for the branch to determine if we are+dropping the elements or consuming. In this case we can see that once+we have taken the "then" path we never have to check the condition "n1+<= 0", it is out of the way.++Basically CPS provides us the ability to take an exit path and forget+about the past code forever. So if we have a million "drop" composed+together CPS would have no problem, after the final drop there won't be+any branches in the way whereas direct style would introduce a million+branches to be traversed forever.++Combining Streams+-----------------++::++  cons :: a -> Stream m a -> Stream m a+  cons a r = Stream $ \yld _ -> yld a r++Unlike in direct style representation, the performance of stream+generation is independent of the number of "cons" operations. There is+no quadratic complexity, we simply call the next continuation at each+step.++Similarly appending streams is independent of number of appends.++::++  serial :: Stream m a -> Stream m a -> Stream m a+  serial m1 m2 = go m1++      where++      go m =+        Stream $ \yld stp ->+           let stop       = runStream yld stp m2+               yieldk a r = yld a (go r)+           in runStream yieldk stop m++Interleaved production and consumption+--------------------------------------++In the direct style we have an explicit stream generator. A consumer+generates values using the generator and consumes them. In CPS the+consumer and generator are interleaved. The ``runStream`` function is a+generator and the "yield" continuation is a consumer. The consumer then+calls the generator again and so on.++Loop vs goto+------------++The direct style representation is like a structured loop with well+defined exit points. Whereas the CPS representation can exit from+anywhere. Therefore, exception handling and resource management in+direct style is much simpler to implement.
+ docs/Developer/dfa-bytes.png view

binary file changed (absent → 18288 bytes)

+ docs/Developer/dfa-classes.png view

binary file changed (absent → 15413 bytes)

+ docs/Developer/dfa-rearr.png view

binary file changed (absent → 16619 bytes)

+ docs/Developer/module-organization.md view
@@ -0,0 +1,223 @@+# Internal vs External Modules++## Exposing Internal Modules++We keep all modules exposed to facilitate convenient exposure of experimental+APIs and constructors to users. It allows users of the library to experiment+much more easily but carry a caveat that these APIs can change in future+without notice.  Since everything is exposed, maintainers do not have to think+about what to expose as experimental and what remains completely hidden every+time something is added to the library.++However, some modules are created purely for the purpose of breaking a module+into multiple smaller modules, or for organizing similar functionality in a+separate file, such modules are exported as entire module from a higher level+modules. These modules can remain hidden as they are fully exported via another+module.++## Internal module Namespace++We expose the internal modules via `Streamly.Internal.*` namespace to keep all+the internal modules together under one module tree and to have their+documentation also separated under one head in haddock docs.++## Exposed Modules as Wrappers++Another decision point is about two choices:++* Keep the implementation of all the APIs in an internal module and just+reexport selected APIs through the external module. The disadvantages of this+approach are:++  1) users may not be able to easily figure out what unexposed APIs are available+  other than the ones exposed through the external module. To avoid this problem+  we can mark the unexposed APIs in the docs with a special comment.++  2) In tests and benchmarks we will be using internal modules to test internal+  and unexposed APIs. Since exposed APIs are exported via both internal and+  external modules we will have to be careful in not accidentally using+  the internal module for testing, instead we should always be using the+  exposed module so that we are always testing exactly the way users+  will be using the APIs.++* Keep the implementations of unexposed APIs in the internal module file+and exposed APIs in the external module file. In this approach, users can+easily figure out the unexposed vs exposed APIs. But maintaining this would+require us to move the APIs from internal to external module file whenever we+expose an API.++We choose the first approach.++# Module Types and Naming++## Abstract modules++An abstract module represents an abstract interface using a type+class.  Multiple concrete modules can make use of this interface and possibly+extend it.++For example we have an `IsStream` type class that all stream types+implement.  The concrete stream types are `SerialT`, `AsyncT`+etc. Assuming `Streamly.Data.Stream` is the containing name space for+all stream modules, there are multiple ways to organize abstract and+concrete modules. The `IsStream` type class can be placed in:++* `Streamly.Data.Stream.Class` or `Streamly.Data.Stream.Interface`+* `Streamly.Data.Stream.IsStream`+* `Streamly.Data.Stream`++Using `Streamly.Data.Stream.IsStream` is preferred over `.Class` because it+conveys more information by the class name. We can place it in+`Streamly.Data.Stream` as well.++Concrete modules depend on the abstract module `IsStream` to implement+that interface.++Polymorphic operations utilizing the abstract interface can go in the+parent module `Streamly.Data.Stream`.++## Constrained Modules++Some modules represent operations on a type which constrain the type using a type+class or a specific instance of a general type. For example, we may have Arrays+that operate on an `Unbox` type.++One possible way to organize such modules is to have an `Unbox`+hierarchy and all data structures using that type constraint are bundled under+it. However, in general, a data structure may have multiple such+constraints or may have to be organized based on some other dimension+like an abstract interface it is implementing.++General purpose constraints like `Unbox` can be defined in their own module+hierarchy and can be used everywhere. For example, we can have the following+Array types, here we have organized all array types under the `Array` hierarchy+rather than having e.g. `Unbox.Array` for unboxed arrays.++```+Streamly.Internal.Data.Array -- Unboxed arrays+Streamly.Internal.Data.Array.Generic -- Boxed arrays+Streamly.Internal.Data.MutArray -- Unboxed mutable arrays+Streamly.Internal.Data.MutArray.Generic -- Boxed mutable arrays+```++## Common Modules++Some modules represent common types or utility functions that are shared across+multiple higher level modules. Possible naming for such modules are:++* `Module.Types`+* `Module.Common`+* `Module.Core`+* `Module.Shared`++## Aggregate modules++In some cases we may want to aggregate the functionality of several small+modules in a combined aggregate module. In many cases, the aggregate module is+made a parent module of the constituent modules.  The parent module depends on+the child modules and exposes the functionality from the constituent modules.++## Placeholder Modules++In some cases a parent module is just a placeholder in the namespace and does+not export any functionality.++# Polymorphic vs Monomorphic Modules++In general we can just provide a polymorphic stream API and let the user use it+at the type he/she wants to use it. However, it has some disadvantages:++* Some constraints e.g. "MonadAsync" are unnecessarily imposed on all APIs even+  though they are needed by only concurrent types.+* type errors could be harder to resolve when using polymorphic types+* combinators like `fromAsync` can make all the combinators concurrent in one go+  which is usually problematic. If we use monorphic combinators it encourages+  to pick the required concurrent combinators one at a time which is+  usually better for performance.++Keeping this in mind our plan is to provide monomoprhic modules for each stream+type, keep the combinators that are specific to that stream type in the+monomorphic module and combinators that are exactly the same for all stream+types can be kept in the polymorphic module or in both the modules. Having+complete set of operations available in the monomorphic module has the+advantage that if we want we can just import a `Serial` module and get+everything if we just want to use the Serial stream.++# Streamly Modules++We use the "Streamly" prefix to all the module names so that they do not+conflict with any other module on Hackage.++We have the following module hierarchy under Streamly:++* Data: This is a generic bucket for basic data structures a la the `base`+  package's `Data` hierarchy.+    * Streamly.Data.Array.Generic++  Streams can be classified under `Data` or `Control`.  Though they are+  mostly used for processing, they can also be used to store data in+  memory.+    * Streamly.Data.Stream++  The following modules could in fact be classified under `Control`+  too as they are about processing of data rather than data itself:+    * Streamly.Data.Unfold+    * Streamly.Data.Fold+    * Streamly.Data.Parser++* Unicode: Unicode text processing:+    * Streamly.Unicode.Char       -- operations on individual chars+    * Streamly.Unicode.Stream     -- operations on streams of Char+    * Streamly.Unicode.Array.Char -- compact strings of UTF-32 chars+    * Streamly.Unicode.Array.Utf8 -- compact strings of UTF-8 encoded chars++* FileSystem: This name space is for data structures that reside in files+  provided by a file system interface on top of storage devices.++* Network: This name space is for APIs that access data from remote computers+  over the network.++## Stream modules++Effectful streams are fused or CPS types:++* `Streamly.Data.Stream`+* `Streamly.Data.StreamK`+* `Streamly.Data.Stream.Prelude`++Pure streams are a special case of effectful streams and have the same+interface as lists, so we put them under `Streamly.Data.List`:++* `Streamly.Data.List`+* `Streamly.Data.ListK`++## Array modules++Similarly, the immutable Array modules would go in:++* Streamly.Data.Array -- Unboxed arrays+* Streamly.Data.Array.Generic -- Boxed arrays++Mutable arrays are a generalization of immutable arrays:++* Streamly.Data.MutArray -- Unboxed mutable arrays+* Streamly.Data.MutArray.Generic -- Boxed mutable arrays++## Stream and Fold Channels (SVar)++* `Streamly.Data.Stream.Channel`+* `Streamly.Data.Stream.Channel.Unboxed`+* `Streamly.Data.Fold.Channel`+* `Streamly.Data.Fold.Channel.Unboxed`++## Mutable variables++Unboxed IORef:++* `Streamly.Data.IORef.Unboxed`++## Strict Data++* `Streamly.Data.Tuple.Strict`+* `Streamly.Data.Maybe.Strict`+* `Streamly.Data.Either.Strict`
+ docs/Developer/optimization-guidelines.md view
@@ -0,0 +1,437 @@+# Guidelines for writing well optimized code++Stream operations are always part of a loop. Usually the loop consists of a+stream generation or an unfold operation followed by stream transformation+functions (e.g. map) and then a stream elimination operation or a fold+operation.++The default or most common stream representation used in streamly is+`StreamD` which is a direct style (compare with CPS representation+`StreamK`) stream representation.  All the direct style operations in+a loop "fuse" together to form a tight machine loop eliminating any+intermediate constructors, therefore, reducing allocations and cpu cost.+This elimination of intermediate constructors in a stream loop is known+as stream fusion.++## Writing high performance code using streamly++This section outlines guidelines for writing code using the available+combinators. The guidelines for writing new combinators are provided in+the following section.++Note that there is no absolute benchmark for performance, most of+the time even without following the guidelines you may get excellent+performance for the task at hand. Two important points to keep in mind+before you optimize:++* See if you actually need more performance+* See if the code you are optimizing is in fast path of your application++### Stream Fusion++When your performance requirements are stringent you may want to care+about not breaking stream fusion unnecessarily.  Certain operations do+not fuse and act as a barrier to stream fusion. If these operations are+part of a loop, the loop won't fuse completely. In some cases these may+be necessary but in others it may be possible to replace these with+better fusing operations. These operations include:++* Avoid unnecessary use of stream append operations in code that should+  fuse.  Append operations in general force CPS style breaking stream+  fusion.  Some direct style append operations can fuse but they won't+  scale for more than a few appends.+* Avoid unnecessary use of the stream monad if fusion is important. You+  may use functor or applicative though.+* Concurrent stream operations cannot fuse+* Operations involving exception primitives like catch/throw/mask+  on elements of the stream cannot fuse.+* Stream loops involving FFI calls on the elements of the stream++The haddock documentation includes a note when an operation cannot fuse.++### Unfolds++* Use unfolds especially when higher order operations are involved. For+  example, `unfoldMany` can fuse completely whereas `concatMap` would+  not fuse.+* Use `outerProduct` from the `Unfold` module instead of using the monad instance of+  streams to fuse nested loops where performance matters. See the unfold+  benchmarks for an example. `outerProduct` can give you C like nested loop+  performance.++### Inlining++To make sure fusion can occur INLINE any operations that are part of a+stream loop but factored out as separate functions.++### Strictness++Keep the fold and scan accumulators strict. You could also consider+using mutable state in a fold accumulator if the state is large. A+large immutable structure as an accumulator may cause optimization+issues. See the `WordCount` example for an example of this case.++## Writing streamly combinators++To enable stream fusion in a direct style stream all the operations that+are part of a loop must be inlined:++* Use an explicit INLINE pragma on any combinator that could be part of a loop+  to ensure they will be inlined.+* When a higher order function consumes another function then ensure that the+  higher order function is inlined in the same phase or before the function it+  is consuming. Use appropriate inline phases to ensure proper inline ordering+  when required.++### Streams and Unfolds++Stream and Unfold State: Direct style stream and unfold combinators use a+state data type to represent the internal state of the stream/unfold generator.++* In some cases we may have to add a `FUSE` annotation on the state type to+  ensure that all the internal join points created by GHC are inlined with the+  help of the `fusion-plugin`.+* In rare cases we may need to use a strictness annotation on the state+  to allow fusion. `parseMany` and `splitOnSeq` are such examples.++Step function of a stream or unfold:++* Do not introduce unnecessary states. If there is only one entry point of a+  state then perhaps you want to collapse the state into the state from which+  it is called. More states means more jumps and may affect code locality, and+  efficiency of low level code (e.g. register allocation) because of+  independent placement of the code blocks in different states.++  In some cases we may have to go against the above guideline and introduce a+  separate state even though it is not necessary. See the GroupConsume state in+  foldMany for an example.+* Keep minimum possible data in state. More variables in state may lead+  to poor performance because the state may not fit into registers and the+  spill may cause allocations on each iteration of the loop. Mutable state+  may help in such cases.+* The step function must be annotated such that it gets inlined after the main+  combinator (`INLINE_LATE`).++Multiple yield points or single?:++* A single yield point is usually desirable, however, not always necessary.+  In some cases multiple yield points may in fact be needed for fusion,+  see `splitOnSeq` for an example. Or maybe its fusing because of a+  direct yield instead of going through an indirect common yielding+  state.++Recursion in step function:++* In general, we avoid making the step function recursive. Use the+  `Skip` constructor to remove recursion. Recursive step function can+  introduce optimization barriers that are harder to remove by the GHC+  simplifier.++  However, in some cases it may be better to have a local recursive+  loop. A recursive loop can help us avoid threading around some large+  state values every time. Values that do not change across a loop can+  be factored in the scope outside the loop (static argument transform),+  this way we can create a local loop which is more efficient than+  threading around the state in a larger loop.  See the `splitOnSeq`+  combinator as an example where we use a local recursive loop, it fuses+  and is significantly efficient compared to using `Skip`.++  In a local recursive loop use SPEC and annotate even the rest of the+  loop arguments as strict where needed. We have observed that when the+  arguments were not strict the loop does not fuse (splitOnSeq).++### Fold and Parser drivers++Recursive loop closing operations:++* When writing recursive looping combinators using StreamD (e.g. foldlM' in+  StreamD) use a strict SPEC argument in the recursive loops to ensure that+  "Spec Constructor" optimization removes boxed arguments and reduces+  allocations.++### Fold and Parser combinators++State of a Fold or Parser:++* The accumulator of a fold must be a strict data structure. Use the strict+  data structures provided in `Streamly.Internal.Data` for this purpose or use+  explicit bang annotation to make the data strict.+* In some cases you may need a `FUSE` annotation on the state type to ensure+  that any internal join points created by GHC are always inlined with the help+  of the fusion-plugin.++The step function of a Fold or Parser:++* Never make the fold step recursive, recursion creates an optimization barrier+  for the GHC simplifier. Use `Partial` or `Continue` constructors to avoid+  recursion.++* Sometimes you may need an explicit INLINE on the step function.++### NOINLINE, isolating the closed loop++We want the loop iterations to be optimized and the loop stages to be fused to+generate a tighter loop. However, it is not necessarily optimal to inline the+whole loop itself into a parent function. For example, consider the following+function in the `FileSystem.Handle` benchmarks:++```+{-# NOINLINE readWriteAfter_Stream #-}+readWriteAfter_Stream :: Handle -> Handle -> IO ()+readWriteAfter_Stream inh devNull =+    let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)+     in S.fold (FH.write devNull) readEx+```++If this is inlined into a parent benchmark group list, this leads to+many times performance degradation. That's because inlining the loop+into a bigger structure interferes with the optimization of the loop+body itself and it may not fuse. Whereas it is desirable to INLINE all+the stages of a loop, it is often not useful to inline the whole loop+itself, in fact we may have to occasionally use a `NOINLINE` so that the+compiler does not inline it.++We need to be careful about NOINLINE on polymorphic functions. When+NOINLINE is used, the function cannot be specialized causing huge+performance degradation.  To avoid that we can either make the+function monomorphic or sometimes using `NOINLINE [0]` can do the+trick. `NOINLINE [0]` blocks inlining in earlier phases but lets it+specialize in the last phase, inlining in the last phase is left to+the compiler. `INLINE [0]` may sound the same as `NOINLINE [0]`,+however, it behaves differently because we ask the compiler to INLINE+it compulsorily and it may not give us the desired results. The+Data.Fold.createOfLast benchmark is one such case where `NOINLINE [0]`+provides much better performance than `INLINE [0]`.++### NoSpecConstr++It is not always useful to specialize function calls for all constructors, some+constructors may just add to code bloat or add overhead of passing unboxed+values in a loop. In such cases the `NoSpecConstr` annotation can be useful.+See the `parselMx'` function in `StreamD` module.++### StreamK operations++StreamK (CPS based stream type) uses foldr/build fusion to a very+limited degree. StreamK is not the primary representation in streamly+but is used for several operations that cannot scale in fused `Stream`+type representation. StreamK is relatively immune to compiler+optimizations. In some cases you may need an INLINE pragma on the+StreamK operation to improve its performance.++## Debugging Fusion Issues++### How to find non-fusing code?++The fusion-plugin reports operations that do not fuse. It has many verbosity+options to give even more information about the constructors that are not+fusing. Read the readme of the fusion-plugin package for more details.++When the code is not fusing you will see a lot more (e.g. 10x) allocations+compared to the case when it is fusing.++<!-- It is important to note where to expect fusion and where fusion is not+possible. -->++### How to debug non-fusing code?++Strip down the code to a minimal version until it starts fusing and then+start building it up from there adding more things incrementally. At+each stage keep checking if the code is fusing. At some point it+won't fuse. See what we added that made the code not fuse. Go through+the guidelines above to check if we did something that is not+recommended. Or raise an issue for GHC to be fixed if possible.++# GHC Optimizations In Streamly++There are three important levels of optimizations used in streamly:++* CPS style stream representation (StreamK) to direct style (StreamD)+  conversion and vice-versa using rewrite rules+* Stream fusion using case-of-case optimization in StreamD+* foldr/build fusion using rewrite rules in StreamK++## INLINE Phases++Inlining of functions at the right time is crucial for all these optimization+to work.  A missing inline or inline in an incorrect GHC simplifier phase can+adversely impact performance.  We use three builtin phases of GHC simplifier+for inlining i.e. phase 0, 1 and 2. We have defined them as follows in+  `src/inline.hs`:++```+#define INLINE_EARLY  INLINE [2]+#define INLINE_NORMAL INLINE [1]+#define INLINE_LATE   INLINE [0]+```++We also use INLINE [3] in some cases.++## `fromStreamD/toStreamD` Fusion++The combinators in `Streamly.Prelude` are defined in terms of combinators in+`Streamly.Internal.Data.Stream.StreamD` (Direct style streams) or+`Streamly.Internal.Data.StreamK` (CPS style streams). We convert the+stream from `StreamD` to `StreamK` representation or vice versa in some cases.++Most operations use the StreamD representation, however, stream append+operations and monad instances use StreamK representation because StreamD would+not perform well in these cases. We use rewrite rules to convert from one+representation to another when required. For this reason the combinators in+Streamly.Prelude are written using fromStreamD/fromStreamK etc.++In the first inlining phase (INLINE_EARLY or INLINE) we expand the combinators+in `Streamly.Prelude` into fromStreamD/fromStreamK/toStreamD/toStreamK and+combinators defined in StreamD or StreamK modules. Once we do that+fromStreamD/toStreamD get exposed and we can apply rewrite rules to rewrite+transformations like `fromStreamK .  toStreamK` to `id`. A plain `INLINE`+pragma is usually enough on combinators in `Streamly.Prelude`.++```+{-# RULES "fromStreamK/toStreamK fusion"+  forall s. toStreamK (fromStreamK s) = s #-}+```++Also, we have to prevent fromStreamK and toStreamK themselves from inlining in+this phase so that rewrite rules can be applied on them, therefore, we annotate+these functions with `INLINE_LATE`.++## Fallback Rules++In some cases, if the operation could not fuse we want to use a fallback+rewrite rule in the next phase. For such cases we use the INLINE_EARLY phase+for the first rewrite and the INLINE_NORMAL phase for the fallback rules.++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.++```+{-# INLINE_EARLY unfoldr #-}+unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a+unfoldr step seed = fromStreamS (S.unfoldr step seed)+{-# RULES "unfoldr fallback to StreamK" [1]+     forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}+```++## High Level Operation Fusion++Since each high level combinator in `Streamly.Prelude` is wrapped in+`fromStreamD/toStreamD` etc. the combinator fusion cannot work unless we have+removed those and exposed consecutive operations e.g. a `map` followed by+another `map`.  Assuming that redundant `fromStreamK/toStreamK` have been+removed in the `INLINE_EARLY` phase, we can then apply the combinator fusion+rules in the `INLINE_NORMAL` phase.  For example, we can fuse two `map`+operations into a single `map` operation.  Note that now we have exposed the+`StreamD/StreamK` implementations of combinators and the rules would apply on+those.++## Inlining Higher Order Functions++Note that partially applied functions cannot be inlined. So if we have a code+like this:++```+concatMap1 src = runStream $ S.concatMap (S.replicate 3) src+```++We want to ensure that `concatMap` gets inlined before `replicate` so that+`replicate` becomes fully applied before it gets inlined. Currently ensuring+that both of them are inlined in the same phase (`INLINE_NORMAL`) seems to be+enough to achieve that. In general, we should try to ensure that higher order+functions are inlined before or in the same phase as the functions they can+consume as arguments. This means `StreamD` combinators should not be marked+as `INLINE` or `INLINE_EARLY`, instead they should all be marked as+`INLINE_NORMAL` because higher order functions like `concatMap`/`map`/`mapM`+etc are marked as `INLINE_NORMAL`. `StreamD` functions in other modules like+`Streamly.Data.Array` should also follow the same rules.++Use INLINE_NORMAL on functions like `pipe`, `Pipe.compose`, `Pipe.teeMerge` for+complete fusion in a pipeline of multiple such operations e.g. in the `pipesX4`+benchmarks.++## Stream Fusion++In fused `Stream` type combinators, inlining the inner step or loop functions too early+i.e. in the same phase or before the outer function is inlined may block stream+fusion opportunities. Therefore, the inner step functions and folding loops are+marked as INLINE_LATE.++## Specialization++In some cases, the `step` function in `Stream` does not get specialized when+inlined unless it is provided with an explicit signature or made a lambda, for+example, in the `replicate/replicateM` combinator we need the type annotation+on `i` to get it specialized:++```+    {-# INLINE_LATE step #-}+    step _ (i :: Int) =+        if i <= 0+        then return Stop+        else do+                x <- action+                return $ Yield x (i - 1)+```++`-flate-specialise` also helps in this case.++## Stream and Fold State Data Structures++Since state is an internal data structure threaded around in the loop, it is a+good practice to use strict unboxed fields for state data structures where+possible. In most cases it is not necessary, but in some cases it may affect+fusion and make a difference of 10x performance or more.  For example, using+non-strict fields can increase the code size for internal join points and+functions created during transformations, which can affect the inlining of+these code blocks which in turn can affect stream fusion.++See https://gitlab.haskell.org/ghc/ghc/issues/17075 .++## Avoiding polymorphism++Polymorphism can add unwanted inefficiencies, so avoid where possible. For+example, more efficient code:++```+asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> IO b) -> m b+```++Less efficient version, because of a wroker-wrapper indirection (see+https://github.com/composewell/streamly/issues/2589):++```+asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+```++Using explicit type annotation+------------------------------++Having polymorphic types may hinder specialization and hurt performance. See+the specialization section in design/inlining.md in streamly docs++In some cases, the `step` function in `Stream` does not get specialized when+inlined unless it is provided with an explicit signature or made a lambda, for+example, in the `replicate/replicateM` combinator we need the type annotation+on `i` to get it specialized:++```+    {-# INLINE_LATE step #-}+    step _ (i :: Int) =+        if i <= 0+        then return Stop+        else do+                x <- action+                return $ Yield x (i - 1)+```++In this case if the compiler does not infer the type of i automatically then we+will be forced to provide the type and get it specialized.++Strict State in Streams+-----------------------++Depending on the context, sometimes using strict data structures for+stream state can provide better performance. In case the state does not+fuse, making it strict will avoid performance problems due to state+being lazy.
+ docs/Developer/overview.md view
@@ -0,0 +1,24 @@+# Streamly++This document is yet to be written. It is supposed to provide an overall+design overview for developers.++## Tricky Parts++The state-passing through each API is currently fragile. Every time we run a+stream we need to be careful about the state we are passing to it. In case of+folds where there is no incoming state, we start with the initial state+`defState`. When we have an incoming state passed to us there are two cases:++1. When we are building a concurrent stream that needs to share the same `SVar`+   we pass the incoming state as is.+2. In all other cases we must not share the SVar and every time we pass on the+   state to run a stream we must use `adaptState` to reset the `SVar` in the+   state.++When in doubt just use `adaptState` on the state before passing it on, we will at+most lose concurrency but the behavior will be correct.++There is no type level enforcement about this as of now, and therefore we need+to be careful when coding. There are specific tests to detect and report any+problems due to this, all transform operations must be added to those tests.
+ docs/Developer/paths.rst view
@@ -0,0 +1,263 @@+Introduction+------------++Paths are used by file systems as well as protocols to represent paths to files+and other resources. We need a generic type safe way to represent paths in+general and file system paths in particular.++Path limits+-----------++OS include files generally define PATH_MAX to 4K and NAME_MAX to 255,+however, it is possible to create paths bigger than these depending on+the file system.++Scalability+-----------++In general directory trees could be quite deep and a directory can contain+millions of entries. A good benchmark to measure the efficiency of path+representation would be to traverse a directory tree recursively and list all+the nodes under the tree. We could do this many times so that we do not need a+really big directory tree.++Compatibility+-------------++A file system starts with just the root directory and then files are+created in the file system by the user or by programs storing their data+on the file system. When a directory or file is created, or when a directory is+listed, the following operations are performed:++1. for lookups an existing directory name must be resolved based on the name+   supplied by the user.+2. for creation the file name to be created is supplied by the user++When the user asks the file system to lookup or create a file or+directory in the file system:++1) The operating system passes the name, as it is without any changes+   whatsoever, to the file system. or does it? Windows?+2) The file system may translate the name to its own conventions before a+   lookup or create, e.g. it may++   * change the name to upper case+   * translate the name to 8.3 chars+   * change the character encoding?+   * change the unicode normalization form of the name (Apple)++When resolving an existing directory name in the file system we need+to supply a path which consists of component names separated by a separator+byte. Separators are of no consequence to the file system, they are+resolved by the OS and the path components are used to lookup the paths+one components at a time. The path for lookup is acquired either by a+user input, device input or by the program which previously got the path+entries by traversing the file system itself.++1) When the path is acquired by a user input,  the user input could be:++   a) a literal string in the program+   b) a path entered via an input device+   c) a path coming from the network++2) If the path was previously acquired from the file system then the+   best thing to do is to never change anything in the path and store it+   as it is and supply exactly the same path when needed. That way we can+   guarantee that the path remains exactly what it was in the file system.++Handling String Literals+========================++The encoding of the source code file depends on the editor used and the+encoding chosen when saving it. The string literals would be parsed+by the GHC parser and then stored in the generated binaries as null+terminated C string literals encoded in UTF-8 (see GHC reference). There are+several possible points of failure here:++a) GHC parser needs to interpret the source code encoding correctly.+b) We assume that the editor does not perform any translation on the+   literal as entered by the user e.g. it does not perform unicode+   normalization on it. If it does then the string as entered by the user+   won't remain the same when it reaches the file system.+c) GHC parser stores the parsed string literal in UTF-8 encoding. We+   assume that GHC does not perform any unicode normalization or any+   other translation on the string.++The UTF-8 encoded string literal can be passed as a blob of bytes to the file+system or it can be converted to String type and re-encoded as UTF-8 both+should work equivalently in this case.++Handling Input From Devices+===========================++The path provided by the user would assume some encoding based on+the terminal settings or the encoding assumed by the sender over the+network. The correctness depends on the contract between the two parties+e.g. the locale setting. We assume that we get a sequence of raw bytes+from the input device. We need to use the sequence as raw bytes and send+it as it is to the file system without any translation.++Manipulating Paths+------------------++We need to parse the path components by the separator bytes.  We assume+that the separator can be identified and removed correctly irrespective+of the encoding. We also make sure that none of the bytes in the+components is a separator byte.++Also, we would join the path components by the separator byte+irrespective of the encoding of the components. If the OS treats the+path as a sequence of bytes and nothing else and the components do not+have the separator byte then we are good, we know that the OS would also be+parsing based on the separator as a raw byte.++We may perform some validations on the paths such as the file names are+not "." or "..". Such validations could be optional and we could also+provide a way to not perform any validations and just blindly use the+paths as provided by the user and let the file system/OS fail.++File System Translations+------------------------++As we noted earlier, the file system may translate the paths before+using them.  For example, it may store the path after converting it to+NFD unicode normalization. Translation may create some round tripping+issues for programs. For example, a program may use a string literal+which is stored in NFC and the file system converts it to NFD. Later,+when the same path is retrieved from the file system and compared with+the string literal that was to create it then it won't match. For such+cases the programs need to understand the file system and perform+comparisons by performing appropriate translations on the paths. To+perform matching and translations correctly the program needs to+correctly interpret the encoding specific to the file system.++Displaying Paths+----------------++When we display the paths to the user then we are forced to interpret+it according to some encoding, to display the path correctly we have to+know exactly how the file system stores the path. Otherwise if we display+it differently, the user may use the displayed result to find the file+and may not find it.++OS Specific Path Encodings+--------------------------++In general, the OS does not have to look inside the path components+other than the ability to recognize the separator char to parse the+path into components and to construct it from components. However, in+some cases the OS may may have to look inside the path e.g. "." or ".."+special paths on Unix.++On Unix a path component is just a blob of bytes. The user can encode+and decode this blob of bytes as they desire. All they need to care+about is that the path separator byte is respected. However, the the+path component blobs may be changed by the underlying filesystem+e.g. apple HFS may normalize the path before storing, therefore, the+representation may change when it is returned back to the user.++On modern Windows systems a path component is UTF16-LE+encoded. Theoretically, from the OS perspective, it does not have to+look inside the path components other than determining whether a 16-bit+unit represents the separator character, therefore, users can use any+encoding as long as it encodes to 16-bit multiples and the separator is+preserved as equivalent to the UTF16-LE representation.++Type Safety Requirements+------------------------++* Safety against using an absolute path where a relative path is to be+  used and vice-versa.++  * Validations for absolute or relative path when constructing a path.+  * We cannot append an absolute path to another path+* Safety against using a file name where a directory name is to be used and+  vice-versa.++  * Certain validations can be performed e.g. file names cannot be "." or "..".+  * We should not be appending more directory components to a file path++In don't care situations we should be easily able to use any type+conveniently or cast a type into another.  It is desirable that the+programmer can choose the safety level. For example, we should be able+to instantiate a path type where we only worry about the distinction+between Absolute and Relative paths but no distinction between files and+directories or vice versa.++Requirement Summary+-------------------++* minimal dependencies, specifically streamly does not depend on bytestring+* round-tripping safety wrt to file system returned paths+* type safety for different path types+* support Posix/Windows+* support URI paths and other ways to represent paths where the separator could+  be different.++Design Considerations+---------------------++* Should we store path as separate components or single string with+  separators?++* Should we validate the paths returned from the file system or trust+  those and use directly without any validations? Need to see if that makes+  any difference to path heavy benchmarks. If we want to use it directly+  then we have to store it as a single string.++* Parameterize the low level APIs with the separator so that we can+  support arbitrary separators when parsing or reconstructing paths.++* The low level API can support path handling in trees/DAGs/Graphs in general.+  For example, in trees we cannot have multiple parents of a child whereas in+  DAGs that is allowed, in graphs we can have cycles. We may also need ways to+  detect cycles.++* Do we need to support arbitrarily long paths i.e. streaming of path? We do+  not need that for file system paths and file system paths are limited size+  and operating system anyway requires them in strict buffers. In case of+  graphs if we have cycles paths can be infinite, we could generate a stream of+  path and the consumer could be traversing the graph according to the+  generated stream. If we want to support streaming then we have to store paths+  as a stream of chunks rather than a single string.++* In general, paths need not be strings, e.g. they can be references to+  locations in memory or they can be IP addresses of nodes. At an abstract+  level, paths are just a stream of tokens that represent a certain traversal.++* Relative paths are the most general representation. At a low level,+  all paths are relative, absolute paths are relative to a specified root+  whereas relative paths are relative to a dynamic root which is the+  current directory.++* Windows can have the root as different drive letters. So to represent paths+  with a root in general we can also store the specific root along with the+  path. In case of POSIX this will always be "/". In general, it could be a+  host name or IP address or dependent on the protocol whose path we are+  representing.++* We can parameterize the low level path type with the type of path e.g. POSIX,+  WINDOWS, HTTP etc. In general, programs may have to manipulate different+  types of paths at the same time. High level path types can be instantiated+  using the low level type therefore they can be much simpler as desired.++References+----------++Some related links found by web search:++* https://gitlab.haskell.org/ghc/ghc/issues/5218+* https://nodejs.org/fr/docs/guides/working-with-different-filesystems/+* https://unix.stackexchange.com/questions/2089/what-charset-encoding-is-used-for-filenames-and-paths-on-linux+* https://docs.microsoft.com/en-us/windows/win32/intl/character-sets-used-in-file-names+* https://beets.io/blog/paths.html++Related Packages+----------------++* https://hackage.haskell.org/package/paths+* https://hackage.haskell.org/package/path+* https://hackage.haskell.org/package/hpath+* https://hackage.haskell.org/package/filepath+* https://hackage.haskell.org/package/file-io+* https://hackage.haskell.org/package/os-string
+ docs/Developer/related-packages.md view
@@ -0,0 +1,71 @@+# Related Haskell Libraries++This document lists some notable libraries in the areas covered by Streamly.++## Lists+* https://hackage.haskell.org/package/base+* http://hackage.haskell.org/package/dlist++## Non-determinism+* https://hackage.haskell.org/package/pipes+* https://hackage.haskell.org/package/list-t+* https://hackage.haskell.org/package/list-transformer+* https://hackage.haskell.org/package/logict+* https://hackage.haskell.org/package/transformers-0.5.4.0/docs/Control-Monad-Trans-Select.html+* http://hackage.haskell.org/package/freer-effects NonDet effects++## Streaming+* https://hackage.haskell.org/package/vector+* https://hackage.haskell.org/package/streams+* https://hackage.haskell.org/package/simple-conduit+* https://hackage.haskell.org/package/streaming+* http://hackage.haskell.org/package/streaming-concurrency+* https://hackage.haskell.org/package/streaming-eversion+* https://hackage.haskell.org/package/conduit+* https://hackage.haskell.org/package/stm-conduit+* https://hackage.haskell.org/package/pipes+* http://hackage.haskell.org/package/pipes-group+* https://hackage.haskell.org/package/pipes-async+* https://hackage.haskell.org/package/pipes-concurrency+* https://hackage.haskell.org/package/pipes-interleave+* https://hackage.haskell.org/package/machines+* https://hackage.haskell.org/package/concurrent-machines+* http://hackage.haskell.org/package/io-streams++## Concurrency+* http://hackage.haskell.org/package/parallel+* http://hackage.haskell.org/package/monad-par+* https://hackage.haskell.org/package/async+* https://hackage.haskell.org/package/haxl+* https://hackage.haskell.org/package/fraxl+* https://hackage.haskell.org/package/free-concurrent+* https://hackage.haskell.org/package/transient++## Distributed+* https://hackage.haskell.org/package/transient-universe+* https://hackage.haskell.org/package/cloud-haskell+* https://hackage.haskell.org/package/distributed-process++## FRP+* https://hackage.haskell.org/package/reactive-banana+* https://hackage.haskell.org/package/Yampa+* https://hackage.haskell.org/package/reflex+* https://hackage.haskell.org/package/frpnow+* https://hackage.haskell.org/package/dunai+* https://hackage.haskell.org/package/bearriver++## Web+* https://hackage.haskell.org/package/axiom+* https://hackage.haskell.org/package/reflex-dom++## Folds+* https://hackage.haskell.org/package/foldl+* https://hackage.haskell.org/package/folds++## Resource Handling+* http://hackage.haskell.org/package/resourcet+* http://hackage.haskell.org/package/pipes-safe+* http://hackage.haskell.org/package/streaming-with++## Events+* https://hackage.haskell.org/package/event-list
+ docs/Developer/resources.md view
@@ -0,0 +1,46 @@+# Resources++This document lists some resources, papers, documents that might be+related to the areas covered by Streamly and may help in designing and+implementing features in Streamly.++## Non-Determinism/Logic++* [Backtracking, Interleaving, and Terminating Monad Transformers](https://pdfs.semanticscholar.org/42eb/2d71af7e00356a41fae47c7752299dc6700d.pdf)+* [Monad Transformers for Backtracking Search](https://arxiv.org/pdf/1406.2058.pdf)+* [Continuations for Parallel Logic Programming](http://www.softlab.ntua.gr/~nickie/Papers/todoran-2000-cplp.pdf)+* [A Concurrent Extension of Functional Logic+Programming Languages](http://convecs.inria.fr/people/Wendelin.Serwe/Pubs/lopstr99.pdf)++## Arrows+* [Generalising Monads to Arrows](http://www.cse.chalmers.se/~rjmh/Papers/arrows.pdf)+* [Monads, Kleisli Arrows, Comonads and other Rambling Thoughts](http://blog.sigfpe.com/2006/06/monads-kleisli-arrows-comonads-and.html)++## Concurrency+* https://en.wikipedia.org/wiki/Fork-join_model+* https://en.wikipedia.org/wiki/Work_stealing+* https://en.wikipedia.org/wiki/Task_parallelism+* https://en.wikipedia.org/wiki/OpenMP+* https://en.wikipedia.org/wiki/Cilk See the "see also" section on this page+* https://en.wikipedia.org/wiki/Green_threads+* [Fraxl: Abstracting Async.Concurrently](http://elvishjerricco.github.io/2016/09/17/abstracting-async-concurrently.html)++## Streaming+* [Coroutines for streaming](https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/coroutines-for-streaming)+* [Stackless purescript](http://blog.functorial.com/posts/2015-07-31-Stackless-PureScript.html)+* [Coroutine Pipelines](https://themonadreader.files.wordpress.com/2011/10/issue19.pdf)+* [Faster Coroutine Pipelines](https://dl.acm.org/ft_gateway.cfm?id=3110249&ftid=1902054&dwn=1&CFID=982135108&CFTOKEN=78426775)+* [Faster Coroutine Pipelines: A Reconstruction](https://rubenpieters.github.io/assets/papers/JFP20-pipes.pdf)++## Distributed+* [Making reliable distributed systems in the presence of software errors](http://erlang.org/download/armstrong_thesis_2003.pdf)+* [Towards Haskell in the Cloud](https://www.microsoft.com/en-us/research/wp-content/uploads/2016/07/remote.pdf?from=http%3A%2F%2Fresearch.microsoft.com%2Fen-us%2Fum%2Fpeople%2Fsimonpj%2Fpapers%2Fparallel%2Fremote.pdf)+* https://github.com/transient-haskell/transient/wiki/Transient-tutorial+* http://haskell-distributed.github.io/wiki.html+* https://en.wikipedia.org/wiki/MapReduce++## FRP+* https://github.com/HeinrichApfelmus/frp-guides+* [Push-Pull Functional Reactive Programming](http://conal.net/papers/push-pull-frp/push-pull-frp.pdf)+* [Functional Reactive Programming, Refactored](http://www.cs.nott.ac.uk/~psxip1/papers/2016-HaskellSymposium-Perez-Barenz-Nilsson-FRPRefactored-short.pdf)+* [Back to the Future: Time Travel in FRP](http://www.cs.nott.ac.uk/~psxip1/papers/2017-HaskellSymposium-Perez-BackToTheFuture-TimeTravelInFRP-latest.pdf)
+ docs/Developer/roadmap.md view
@@ -0,0 +1,36 @@+# Roadmap++Some of these items may be present in the issues as well, but this file+lists larger areas, experimental areas and organizes items by areas. We can+also use the areas listed here as labels (aspect:topic) on issues.++## Scheduling++* Free applicative and Free Alternative, batched Alternative (push+  scheduling instead of pull scheduling)+* N-ary operations e.g. real balanced interleave+* Scheduling: Coalescing of tasks based on programmer defined criteria+    * Batching based on the target host+    * Batching/chunking for parallel/distributed execution+    * Batching iterations++## Concurerncy++* Controlled parallelism:+    * Control based on the level in the tree+    * Control based on the CPU/IO utilization based pacing+    * Utilize non-blocking IO+* Performance: Measure lock/CAS contention overhead, an option to+  dequeue work and run in batches instead of one at a time to reduce lock+  contention?+* Cross thread recursion++## Persistence++* Pause and resume using something like+  [monad-recorder](https://hackage.haskell.org/package/monad-recorder)+* Save internal buffered state during a pause?++## Testing++* improve coverage
+ docs/Developer/unicode.md view
@@ -0,0 +1,224 @@+## Overview++Unicode is a standard which consists of a `char set`, `encodings`, attributes+and properties of characters, processing of strings, paragraphs, processing of+text in `locale` specific manner.++### Char Set++Unicode `char set` represents characters from all languages in the world.  Each+character is assigned a, code point, a unique number identifying the character,+and written as `U+0076` where the four hex digits `0076` represent the unique+number assigned to the character.++### Encodings++A unicode character can be encoded as a:++* fixed length encoding with a 32-bit value directly representing the code+  point in little endian (UTF32LE) or big endian (UTF32BE) byte ordering.  See+  https://en.wikipedia.org/wiki/UTF-32.+* variable length encoding with one or two 16-bit values depending on the code+  point, UTF16LE and UTF16BE. See https://en.wikipedia.org/wiki/UTF-16.+* variable length encoding with one, two or three 8-bit values depending on the+  code point, UTF8. See https://en.wikipedia.org/wiki/UTF-8.++### i18n and L10n++Internationalization (i18n) is being able to represent and process all+languages in the world. Unicode performs i18n by representing all languages and+their common processing rules.++Localization (L10n) is being able to customize the common internationalized+processing to a country or region (`locale`). Unicode specifies various+standard locales which includes customization of the attributes and processing+rules for each locale. Custom locales can be created with custom text+processing rules.++* https://en.wikipedia.org/wiki/Internationalization_and_localization .+* http://userguide.icu-project.org/i18n++## POSIX Locales++On Debian Linux, the default system wide locale can be administered using+`localectl` or `sudo dpkg-reconfigure locales`.++In a shell, the `locale` command shows the current locale settings. When you+start a program from the shell it inherits these settings via the process+environment and the C library loads and uses the appropriate locale. Even some+GUI programs if started from the shell can use the values from the+environment. Other GUI programs may have there own locale settings that can be+configured from their menu.++The following environment variables can override the system wide locale and+determine how a process (handled by libc) performs unicode text processing for+different locale aspects:++```+LC_CTYPE     Defines character classification and case conversion.+LC_COLLATE   Defines collation rules.+LC_MONETARY  Defines the format and symbols used in formatting of monetary information.+LC_NUMERIC   Defines the decimal delimiter, grouping, and grouping symbol for non-monetary numeric editing.+LC_TIME      Defines the format and content of date and time information.+LC_MESSAGES  Defines the format and values of affirmative and negative responses.+```++Each environment variable above can be set to available `locale` settings. For+example `LC_CTYPE=en_US.UTF-8` (locale.charmap) specifies a locale `en_US` for+the language `en` (English) and the territory `US` (USA) to be used for+character classifications (e.g. `iswalpha`) and case conversions (e.g.+`toupper`). `UTF-8` is the charmap used by the locale.++`C` and `POSIX` locales are the same and are used by default. glibc also+provides a generic `i18n` locale.++Use `locale -a` command to see all available locales on a system and `locale+-m` for charmaps. See `man locale` as well. Also see+`/usr/share/i18n/SUPPORTED` on Linux (Debian).+https://www.gnu.org/software/libc/manual/html_node/Locale-Names.html for the+format in which these environment variables can be specified.++The environment variables are preferred in the following order:++```+LC_ALL       Overrides everything else+LC_*         Individual aspect customization+LANG         Used as a substitute for any unset LC_* variable+```++Normally only `LANG` should be used. If a particular aspect needs to be+cutsomized then `LC_*` variables can be used. `LC_ALL` overrides everything.+On GNU/Linux `LANGUAGE` can also be used as a list of preferred languages+separated by ":". LANGUAGE is effective only if LANG has been set to something+other than default and has higher priority than anything else.++* https://www.gnu.org/software/gettext/manual/gettext.html#Users has a good+  overview of locale settings.+* https://pubs.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap07.html+  POSIX Locales standard++### Localizing Messages++GNU https://www.gnu.org/software/gettext/manual/gettext.html can be used by+programs to translate/localize the user interfacing text to multiple languages.+Catalogs of localized program error, alert, notification messages are installed+at e.g.  `/usr/share/locale/en_US/LC_MESSAGES/`.++* https://www.gnu.org/software/gettext/manual/gettext.html++### Creating Locales++From the `debian` manpage of `localedef` POSIX command:++The  localedef  program  reads  the  indicated charmap and input files,+compiles them to a binary form quickly usable by the locale functions in the C+library (setlocale(3), localeconv(3), etc.), and places the output in+outputpath.++See `locale-gen` for a more high level program to generate locales.+/usr/lib/locale/locale-archive contains the generated binary files. On Debian+you can use `sudo dpkg-reconfigure locales` to select locales and set system+locale.++On Linux/glibc (Debian), installed `charmaps` can be found at+`/usr/share/i18n/charmaps/` and locale definition input files at+`/usr/share/i18n/locales/`. ++## ICU Locales++An ICU locale is frequently confused with a POSIX locale ID. An ICU locale ID+is not a POSIX locale ID. ICU locales do not specify the encoding and specify+variant locales differently.++* http://userguide.icu-project.org/locale++### Localizing Messages++* http://userguide.icu-project.org/locale/localizing++## Unicode Text processing++* http://userguide.icu-project.org/posix+* http://userguide.icu-project.org/strings/properties++### Locale Independent++1) Char Properties+2) Normalization+3) Regex matching++### Locale Specific++1) Case Mapping:+    * https://unicode.org/faq/casemap_charprop.html+    * http://www.unicode.org/versions/latest/ch05.pdf#G21180+    * ftp://ftp.unicode.org/Public/UCD/latest/ucd/SpecialCasing.txt+    * ftp://ftp.unicode.org/Public/UCD/latest/ucd/CaseFolding.txt+2) Breaking+3) Collation+4) Charset Conversion++## Haskell++### Haskell Unicode Text Processing++Related packages on hackage:++* [base](https://www.stackage.org/lts/package/base) Data.Char module, uses libc+* [text](https://www.stackage.org/lts/package/text)+* [text-icu](https://stackage.org/lts/package/text-icu) C bindings to icu+++* https://github.com/composewell/unicode-transforms+* https://github.com/llelf/prose+* [unicode-properties](https://hackage.haskell.org/package/unicode-properties) Unicode 3.2.0 character properties+* [hxt-charproperties](http://www.stackage.org/lts/package/hxt-charproperties) Character properties and classes for XML and Unicode+* [unicode-names](http://hackage.haskell.org/package/unicode-names) Unicode 3.2.0 character names+* [unicode](https://hackage.haskell.org/package/unicode) Construct and transform unicode characters+++* [charset](https://www.stackage.org/lts/package/charset) Fast unicode character sets++None of the existing Haskell packages provide comprehensive and fast access to+properties. `unicode-transforms` provides composition/decomposition data and+the script to extract data from unicode database.++### Haskell Localization++* http://wiki.haskell.org/Internationalization_of_Haskell_programs+* https://hackage.haskell.org/package/localize+* http://hackage.haskell.org/package/localization+* http://hackage.haskell.org/package/hgettext+* http://hackage.haskell.org/package/i18n+* https://hackage.haskell.org/package/setlocale+* http://hackage.haskell.org/package/system-locale+* https://github.com/llelf/numerals++## TODO++Factor out a `unicode-data` package from `unicode-transforms`.+`unicode-transforms` package will depend on unicode-data and can continue to be+used as is. Other packages can take advantage of the `unicode-data` to provide+unicode text processing services.++To begin with, this package will contain:++* char properties data+* case mapping data+* unicode normalization data++This package can be used in `Streamly.Internal.Data.Unicode.*` to provide:++* Fast access to char properties, we will no longer depend on libc for that and+  no FFI will be required to do iswspace, iswalpha etc.+* Correct case mappings from a single char to multi-char+* Stream based unicode normalization+* Breaking (locale independent for now)++## Later++* add locale data from CLDR to `unicode-data` to provide locale specific+  services as well.+* support locale specific breaking, regex, collation and charset conversion+* facility to add customized locale data+* Support providing application level resource data for localization
+ docs/Developer/utf8-decoder.md view
@@ -0,0 +1,603 @@+Flexible and Economical UTF-8 Decoder+=====================================++Systems with elaborate Unicode support usually confront programmers with+a multitude of different functions and macros to process UTF-8 encoded+strings, often with different ideas on handling buffer boundaries, state+between calls, error conditions, and performance characteristics, making+them difficult to use correctly and efficiently. Implementations also+tend to be very long and complicated; one popular library has over 500+lines of code just for one version of the decoder. This page presents+one that is very easy to use correctly, short, small, fast, and free.++Implementation in C (C99)+-------------------------++    // Copyright (c) 2008-2009 Bjoern Hoehrmann <bjoern@hoehrmann.de>+    // See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.++    #define UTF8_ACCEPT 0+    #define UTF8_REJECT 1++    static const uint8_t utf8d[] = {+      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, // 00..1f+      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, // 20..3f+      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, // 40..5f+      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, // 60..7f+      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, // 80..9f+      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, // a0..bf+      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, // c0..df+      0xa,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x3,0x4,0x3,0x3, // e0..ef+      0xb,0x6,0x6,0x6,0x5,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8,0x8, // f0..ff+      0x0,0x1,0x2,0x3,0x5,0x8,0x7,0x1,0x1,0x1,0x4,0x6,0x1,0x1,0x1,0x1, // s0..s0+      1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,0,1,0,1,1,1,1,1,1, // s1..s2+      1,2,1,1,1,1,1,2,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1, // s3..s4+      1,2,1,1,1,1,1,1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1,3,1,3,1,1,1,1,1,1, // s5..s6+      1,3,1,1,1,1,1,3,1,3,1,1,1,1,1,1,1,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1, // s7..s8+    };++    uint32_t inline+    decode(uint32_t* state, uint32_t* codep, uint32_t byte) {+      uint32_t type = utf8d[byte];++      *codep = (*state != UTF8_ACCEPT) ?+        (byte & 0x3fu) | (*codep << 6) :+        (0xff >> type) & (byte);++      *state = utf8d[256 + *state*16 + type];+      return *state;+    }++Usage+-----++UTF-8 is a variable length character encoding. To decode a character one+or more bytes have to be read from a string. The `decode` function+implements a single step in this process. It takes two parameters+maintaining state and a byte, and returns the state achieved after+processing the byte. Specifically, it returns the value `UTF8_ACCEPT`+(0) if enough bytes have been read for a character, `UTF8_REJECT` (1) if+the byte is not allowed to occur at its position, and some other+positive value if more bytes have to be read.++When decoding the first byte of a string, the caller must set the state+variable to `UTF8_ACCEPT`. If, after decoding one or more bytes the+state `UTF8_ACCEPT` is reached again, then the decoded Unicode character+value is available through the `codep` parameter. If the state+`UTF8_REJECT` is entered, that state will never be exited unless the+caller intervenes. See the examples below for more information on usage+and error handling, and the section on implementation details for how+the decoder is constructed.++Examples+--------++### Validating and counting characters++This function checks if a null-terminated string is a well-formed UTF-8+sequence and counts how many code points are in the string.++    int+    countCodePoints(uint8_t* s, size_t* count) {+      uint32_t codepoint;+      uint32_t state = 0;++      for (*count = 0; *s; ++s)+        if (!decode(&state, &codepoint, *s))+          *count += 1;++      return state != UTF8_ACCEPT;+    }++It could be used like so:++    if (countCodePoints(s, &count)) {+      printf("The string is malformed\n");+    } else {+      printf("The string is %u characters long\n", count);+    }++### Printing code point values++This function prints out all code points in the string and an error+message if unexpected bytes are encountered, or if the string ends with+an incomplete sequence.++    void+    printCodePoints(uint8_t* s) {+      uint32_t codepoint;+      uint32_t state = 0;++      for (; *s; ++s)+        if (!decode(&state, &codepoint, *s))+          printf("U+%04X\n", codepoint);++      if (state != UTF8_ACCEPT)+        printf("The string is not well-formed\n");++    }++### Printing UTF-16 code units++This loop prints out UTF-16 code units for the characters in a+null-terminated UTF-8 encoded string.++    for (; *s; ++s) {++      if (decode(&state, &codepoint, *s))+        continue;++      if (codepoint <= 0xFFFF) {+        printf("0x%04X\n", codepoint);+        continue;+      }++      // Encode code points above U+FFFF as surrogate pair.+      printf("0x%04X\n", (0xD7C0 + (codepoint >> 10)));+      printf("0x%04X\n", (0xDC00 + (codepoint & 0x3FF)));+    }++### Error recovery++It is sometimes desirable to recover from errors when decoding strings+that are supposed to be UTF-8 encoded. Programmers should be aware that+this can negatively affect the security properties of their application.+A common recovery method is to replace malformed sequences with a+substitute character like `U+FFFD REPLACEMENT CHARACTER`.++Decoder implementations differ in which octets they replace and where+they restart. Consider for instance the sequence `0xED 0xA0 0x80`. It+encodes a surrogate code point which is prohibited in UTF-8. A+recovering decoder may replace the whole sequence and restart with the+next byte, or it may replace the first byte and restart with the second+byte, replace it, restart with the third, and replace the third byte+aswell.++The following code implements one such recovery strategy. When an+unexpected byte is encountered, the sequence up to that point will be+replaced and, if the error occurred in the middle of a sequence, will+retry the byte as if it occurred at the beginning of a string. Note that+the decode function detects errors as early as possible, so the sequence+`0xED 0xA0 0x80` would result in three replacement characters.++    for (prev = 0, current = 0; *s; prev = current, ++s) {++      switch (decode(&current, &codepoint, *s)) {+      case UTF8_ACCEPT:+        // A properly encoded character has been found.+        printf("U+%04X\n", codepoint);+        break;++      case UTF8_REJECT:+        // The byte is invalid, replace it and restart.+        printf("U+FFFD (Bad UTF-8 sequence)\n");+        current = UTF8_ACCEPT;+        if (prev != UTF8_ACCEPT)+          s--;+        break;+      ...++For some recovery strategies it may be useful to determine the number of+bytes expected. The states in the automaton are numbered such that,+assuming C\'s division operator, `state / 3 + 1` is that number. Of+course, this will only work for states other than `UTF8_ACCEPT` and+`UTF8_REJECT`. This number could then be used, for instance, to skip the+continuation octets in the illegal sequence `0xED 0xA0 0x80` so it will+be replaced by a single replacement character.++### Transcoding to UTF-16 buffer++This is a rough outline of a UTF-16 transcoder. Actual applications+would add code for error reporting, reporting of words written, required+buffer size in the case of a small buffer, and possibly other things.+Note that in order to avoid checking for free space in the inner loop,+we determine how many bytes can be read without running out of space.+This is one utf-8 byte per available utf-16 word, with one exception: if+the last byte read was the third byte in a four byte sequence we would+get two words for the next byte; so we read one byte less than we have+words available. This additional word is also needed for+null-termination, so it\'s never wrong to read one less.++    int+    toUtf16(uint8_t* src, size_t srcBytes, uint16_t* dst, size_t dstWords, ...) {++      uint8_t* src_actual_end = src + srcBytes;+      uint8_t* s = src;+      uint16_t* d = dst;+      uint32_t codepoint;+      uint32_t state = 0;++      while (s < src_actual_end) {++        size_t dst_words_free = dstWords - (d - dst);+        uint8_t* src_current_end = s + dst_words_free - 1;++        if (src_actual_end < src_current_end)+          src_current_end = src_actual_end;++        if (src_current_end <= s)+          goto toosmall;++        while (s < src_current_end) {++          if (decode(&state, &codepoint, *s++))+            continue;++          if (codepoint > 0xffff) {+            *d++ = (uint16_t)(0xD7C0 + (codepoint >> 10));+            *d++ = (uint16_t)(0xDC00 + (codepoint & 0x3FF));+          } else {+            *d++ = (uint16_t)codepoint;+          }+        }+      }++      if (state != UTF8_ACCEPT) {+        ...+      }++      if ((dstWords - (d - dst)) == 0)+        goto toosmall;++      *d++ = 0;+      ...++    toosmall:+      ...+    }++Implementation details+----------------------++The `utf8d` table consists of two parts. The first part maps bytes to+character classes, the second part encodes a deterministic finite+automaton using these character classes as transitions. This section+details the composition of the table.++### Canonical UTF-8 automaton++UTF-8 is a variable length character encoding. That means state has to+be maintained while processing a string. The following transition graph+illustrates the process. We start in state zero, and whenever we come+back to it, we\'ve seen a whole Unicode character. Transitions not in+the graph are disallowed; they all lead to state one, which has been+omitted for readability.++![DFA with range transitions](/docs/Developer/dfa-bytes.png)++### Automaton with character class transitions++The byte ranges in the transition graph above are not easily encoded in+the automaton in a manner that would allow fast lookup. Instead of+encoding the ranges directly, the ranges are split such that each byte+belongs to exactly one character class. Then the transitions go over+these character classes.++![DFA with class transitions](/docs/Developer/dfa-classes.png)++### Mapping bytes to character classes++Primarily to save space in the transition table, bytes are mapped to+character classes. This is the mapping:++|||||+|-|-|-|-|+| 00..7f |  0 | 80..8f | 1 |+| 90..9f |  9 | a0..bf | 7 |+| c0..c1 |  8 | c2..df | 2 |+| e0..e0 | 10 | e1..ec | 3 |+| ed..ed |  4 | ee..ef | 3 |+| f0..f0 | 11 | f1..f3 | 6 |+| f4..f4 |  5 | f5..ff | 8 |+++For bytes that may occur at the beginning of a multibyte sequence, the+character class number is also used to remove the most significant bits+from the byte, which do not contribute to the actual code point value.+Note that `0xc0`, `0xc1`, and `0xf5` .. `0xff` have all their bits+removed. These bytes cannot occur in well-formed sequences, so it does+not matter which bits, if any, are retained.++|||||||||||||+|-|-|-|-|-|-|-|-|-|-|-|-|+| c0 | 8 | **11000000** | d0 | 2 | **11**010000 | e0 | 10 | **11100000** | f0 | 11 | **11110000** |+| c1 | 8 | **11000001** | d1 | 2 | **11**010001 | e1 |  3 | **111**00001 | f1 |  6 | **111100**01 |+| c2 | 2 | **11**000010 | d2 | 2 | **11**010010 | e2 |  3 | **111**00010 | f2 |  6 | **111100**10 |+| c3 | 2 | **11**000011 | d3 | 2 | **11**010011 | e3 |  3 | **111**00011 | f3 |  6 | **111100**11 |+| c4 | 2 | **11**000100 | d4 | 2 | **11**010100 | e4 |  3 | **111**00100 | f4 |  5 | **11110**100 |+| c5 | 2 | **11**000101 | d5 | 2 | **11**010101 | e5 |  3 | **111**00101 | f5 |  8 | **11110101** |+| c6 | 2 | **11**000110 | d6 | 2 | **11**010110 | e6 |  3 | **111**00110 | f6 |  8 | **11110110** |+| c7 | 2 | **11**000111 | d7 | 2 | **11**010111 | e7 |  3 | **111**00111 | f7 |  8 | **11110111** |+| c8 | 2 | **11**001000 | d8 | 2 | **11**011000 | e8 |  3 | **111**01000 | f8 |  8 | **11111000** |+| c9 | 2 | **11**001001 | d9 | 2 | **11**011001 | e9 |  3 | **111**01001 | f9 |  8 | **11111001** |+| ca | 2 | **11**001010 | da | 2 | **11**011010 | ea |  3 | **111**01010 | fa |  8 | **11111010** |+| cb | 2 | **11**001011 | db | 2 | **11**011011 | eb |  3 | **111**01011 | fb |  8 | **11111011** |+| cc | 2 | **11**001100 | dc | 2 | **11**011100 | ec |  3 | **111**01100 | fc |  8 | **11111100** |+| cd | 2 | **11**001101 | dd | 2 | **11**011101 | ed |  4 | **1110**1101 | fd |  8 | **11111101** |+| ce | 2 | **11**001110 | de | 2 | **11**011110 | ee |  3 | **111**01110 | fe |  8 | **11111110** |+| cf | 2 | **11**001111 | df | 2 | **11**011111 | ef |  3 | **111**01111 | ff |  8 | **11111111** |+++Notes on Variations+-------------------++There are several ways to change the implementation of this decoder. For+example, the size of the data table can be reduced, at the cost of a+couple more instructions, so it omits the mapping of bytes in the+US-ASCII range, and since all entries in the table are 4 bit values, two+values could be stored in a single byte.++In some situations it may be beneficial to have a separate start state.+This is easily achieved by copying the s0 state in the array to the end,+and using the new state 9 as start state as needed.++Where callers require the code point values, compilers tend to generate+slightly better code if the state calculation is moved into the+branches, for example++    if (*state != UTF8_ACCEPT) {+      *state = utf8d[256 + *state*16 + type];+      *codep = (*codep << 6) | (byte & 63);+    } else {+      *state = utf8d[256 + *state*16 + type];+      *codep = (byte) & (255 >> type);+    }++As the state will be zero in the else branch, this saves a shift and an+addition for each starter. Unfortunately, compilers will then typically+generate worse code if the codepoint value is not needed. Naturally,+then, two functions could be used, one that only calculates the states+for validation, counting, and similar applications, and one for full+decoding. For the sample UTF-16 transcoder a more substantial increase+in performance can be achieved by manually including the decode code in+the inner loop; then it is also worthwhile to make code points in the+US-ASCII range a special case:++    while (s < src_current_end) {++      uint32_t byte = *s++;+      uint32_t type = utf8d[byte];++      if (state != UTF8_ACCEPT) {+        codep = (codep << 6) | (byte & 63);+        state = utf8d[256 + state*16 + type];++        if (state)+          continue;++      } else if (byte > 0x7f) {+        codep = (byte) & (255 >> type);+        state = utf8d[256 + type];+        continue;++      } else {+        *d++ = (uint16_t)byte;+        continue;+      }+      ...++Another variation worth of note is changing the comparison when setting+the code point value to this:++    *codep = (*state >  UTF8_REJECT) ?+      (byte & 0x3fu) | (*codep << 6) :+      (0xff >> type) & (byte);++This ensures that the code point value does not exceed the value `0xff`+after some malformed sequence is encountered.++As written, the decoder disallows encoding of surrogate code points,+overlong 2, 3, and 4 byte sequences, and 4 byte sequences outside the+Unicode range. Allowing them can have serious security implications, but+can easily be achieved by changing the character class assignments in+the table.++The code samples have generally been written to perform well on my+system when compiled with Visual C++ 7.1 and GCC 3.4.5. Slight changes+may improve performance, for example, Visual C++ 7.1 will produce+slightly faster code when, in the manually inlined version of the+transcoder discussed above, the type assignment is moved into the+branches where it is needed, and the state and codepoint assignments in+the non-ASCII starter is swapped (approximately a 5% increase), but GCC+3.4.5 will produce considerably slower code (approximately 10%).++I have experimented with various rearrangements of states and character+classes. A seemingly promising one is the following:++![Re-arranged DFA with class transitions](/docs/Developer/dfa-rearr.png)++One of the continuation ranges has been split into two, the other+changes are just renamings. This arrangement allows, when a continuation+octet is expected, to compute the character class with a shift instead+of a table lookup, and when looking at a non-ASCII starter, the next+state is simply the character class. On my system the change in+performance is in the area of +/- 1%. This encoding would have a number+of downsides: more rejecting states are required to account for+continuation octets where starters are expected, the table formatting+would use more hex notation making it longer, and calculating the number+of expected continuation octets from a given state is more difficult.+One thing I\'d still like to try out is if, perhaps by adding a couple+of additional states, for continuation states the next state can be+computed without any table lookup with a few easily paired instructions.++On 24th June 2010 Rich Felker pointed out that the state values in the+transition table can be pre-multiplied with 16 which would save a shift+instruction for every byte. D\'oh! We actually just need 12 and can+throw away the filler values previously in the table making the table 36+bytes shorter and save the shift in the code.++    // Copyright (c) 2008-2010 Bjoern Hoehrmann <bjoern@hoehrmann.de>+    // See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.++    #define UTF8_ACCEPT 0+    #define UTF8_REJECT 12++    static const uint8_t utf8d[] = {+      // 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,+    };++    uint32_t inline+    decode(uint32_t* state, uint32_t* codep, uint32_t byte) {+      uint32_t type = utf8d[byte];++      *codep = (*state != UTF8_ACCEPT) ?+        (byte & 0x3fu) | (*codep << 6) :+        (0xff >> type) & (byte);++      *state = utf8d[256 + *state + type];+      return *state;+    }++Notes on performance+--------------------++To conduct some ad-hoc performance testing I\'ve used three different+UTF-8 encoded buffers and passed them through a couple of UTF-8 to+UTF-16 transcoders. The large buffer is a April 2009 Hindi Wikipedia+article XML dump, the medium buffer Markus Kuhn\'s UTF-8-demo.txt, and+the tiny buffer my name, each about the number of times required for+about 1GB of data. All tests ran on a [Intel Prescott+Celeron](http://en.wikipedia.org/wiki/Celeron#Prescott-256) at 2666 MHz.+See [Changes](#changes) for some additional details.++  |                                                                           |  Large  |   Medium |   Tiny   |+  |---------------------------------------------------------------------------|---------| ---------|----------|+  |`NS_CStringToUTF16()` Mozilla 1.9 (*includes malloc/free time*)            |  36924ms|   39773ms|  107958ms|+  |`iconv()` 1.9 compiled with Visual C++ (Cygwin iconv 1.11 similar)         |  22740ms|   21765ms|   32595ms|+  |`g_utf8_to_utf16()` Cygwin Glib 2.0 (*includes malloc/free time*)          |  21599ms|   20345ms|   98782ms|+  |`ConvertUTF8toUTF16()` Unicode Inc., Visual C++ 7.1 -Ox -Ot -G7            |  11183ms|   11251ms|   19453ms|+  |`MultiByteToWideChar()` Windows API (Server 2003 SP2)                      |   9857ms|   10779ms|   12771ms|+  |`u_strFromUTF8` from ICU 4.0.1 (Visual Studio 2008, web site distribution) |   8778ms|    5223ms|    5419ms|+  |`PyUnicode_DecodeUTF8Stateful` (3.1a2), Visual C++ 7.1 -Ox -Ot -G7         |   4523ms|    5686ms|    3138ms|+  |Example section transcoder, Visual C++ 7.1 -Ox -Ot -G7                     |   5397ms|    5789ms|    6250ms|+  |Manually inlined transcoder (see above), Visual C++ 7.1 -Ox -Ot -G7        |   4277ms|    4998ms|    4640ms|+  |Same, Cygwin GCC 3.4.5 -march=prescott -fomit-frame-pointer -O3            |   4492ms|    5154ms|    4432ms|+  |Same, Cygwin GCC 4.3.2 -march=prescott -fomit-frame-pointer -O3            |   5439ms|    6322ms|    5567ms|+  |Same, Visual C++ 6.0 -TP -O2                                               |   5398ms|    6259ms|    6446ms|+  |Same, Visual C++ 7.1 -Ox -Ot -G7 (*includes malloc/free time*)             |   5498ms|    5086ms|   25852ms|++I have also timed functions that `xor` all code points in the large+buffer. In Visual Studio 2008 ICU\'s `U8_NEXT` macro comes out at+\~8000ms, the `U8_NEXT_UNSAFE` macro, which requires complete and+well-formed input, at \~4000ms, and the `decode` function is at+\~5900ms. Using the same manual inlining as for the transcode function,+Cygwin GCC 3.4.5 -march=prescott -O3 -fomit-frame-pointer brings it down+to roughly the same times as the transcode function for all three+buffers.++While these results do not model real-world applications well, it seems+reasonable to suggest that the reduced complexity does not come at the+price of reduced performance. Note that instructions that compute the+code point values will generally be optimized away when not needed. For+example, checking if a null-terminated string is properly UTF-8 encoded+\...++    int+    IsUTF8(uint8_t* s) {+      uint32_t codepoint, state = 0;++      while (*s)+        decode(&state, &codepoint, *s++);++      return state == UTF8_ACCEPT;+    }++\... does not require the individual code point values, and so the loop+becomes something like this:++    l1: movzx  eax,al+        shl    edx,4+        add    ecx,1+        movzx  eax,byte ptr [eax+404000h]+        movzx  edx,byte ptr [eax+edx+256+404000h]+        movzx  eax,byte ptr [ecx]+        test   al,al+        jne    l1++For comparison, this is a typical `strlen` loop:++    l1: mov    cl,byte ptr [eax]+        add    eax,1+        test   cl,cl+        jne    l1++With the large buffer and the same number of times as above, `strlen`+takes 1507ms while `IsUTF8` takes 2514ms.++License+-------++Copyright (c) 2008-2009 [Bjoern Hoehrmann](http://bjoern.hoehrmann.de/)+\<<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.+:::++Changes+-------++25 Jun 2010+:   Added an improved variation based on an observation from Rich+    Felker.++30 April 2009+:   Added some more items to the performance table: the manually inlined+    transcoder allocating worst case memory for each run and freeing it+    before the next run; and results for Mozilla\'s NS\_CStringToUTF16+    (a new nsAutoString is created for each run, and truncated before+    the next). This used the XULRunner SDK 1.9.0.7 binary distribution+    from the Mozilla website.++18 April 2009+:   Added notes to the Variations section on handling malformed+    sequences and failed optimization attempts.++14 April 2009+:   Added PyUnicode\_DecodeUTF8Stateful times; the function has been+    modified slightly so it works outside Python and so it uses a+    pre-allocated buffer. Normally does not check output buffer+    boundaries but rather allocates a worst case buffer, then resizes+    it. Apparently the decoder [allows encodings of surrogate code+    points](http://bugs.python.org/issue3672).++Author+------++[Björn Höhrmann](http://bjoern.hoehrmann.de) <bjoern@hoehrmann.de>+([Donate via+SourceForge](http://sourceforge.net/developer/user_donations.php?user_id=188003),+[PayPal](https://www.paypal.com/cgi-bin/webscr?cmd=_xclick&business=bjoern@hoehrmann.de&item_name=Support+Bjoern+Hoehrmann))
+ docs/Documentation.md view
@@ -0,0 +1,5 @@+# Documentation++Browse the documentation tree by clicking on the links on the left.  Please+write to us at [streamly@composewell.com](mailto:streamly@composewell.com) if+you see something incorrect.
− docs/Introduction.md 
@@ -1,651 +0,0 @@-# [Streamly][]: Idiomatic Haskell with the Performance of C--[![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)-[![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly)--Streamly is a Haskell library that provides the building blocks to build-safe, scalable, modular and high performance software.  Streamly offers:--* The type safety of Haskell.-* The performance of C programs.-* Powerful abstractions for structuring your code.-* Idiomatic functional programming.-* Declarative concurrency for the seamless use of multiprocessing hardware.--## About This Document--This guide introduces programming with [Streamly][] using a few practical-examples:--*  We will start with a simple program that [counts the number of words-   in a text](#modular-word-counting). We will then transform this program-   into a [concurrent](#concurrent-word-counting) program that can efficiently-   use multiprocessing hardware.-*  Next, we will create a [concurrent network-   server](#a-concurrent-network-server). We then show-   how to write a network server that [merges multiple-   streams](#merging-incoming-streams) concurrently.-*  Our third example shows how to list a directory tree concurrently,-   by reading [multiple directories in-   parallel](#listing-directories-recursivelyconcurrently).-*  Finally, we will look at how to [rate limit](#rate-limiting) stream-   processing.--The guide then looks at how Streamly achieves its-[performance](#performance).  It [concludes](#notes) with a brief-discussion about Streamly's design philosophy, and with suggestions for-further reading.--## Getting Started--### Installing Streamly--If you wish to follow along with this guide, you will need to have-[Streamly][] installed.--Please see the [Getting Started With The Streamly Package](/docs/getting-started.md)-guide for instructions on how to install [Streamly][].--If you wish to run benchmarks, please be sure to build your-application using the instructions in the [Build Guide](/docs/Compiling.md).--### An overview of the types used in these examples--As an expository device, we have indicated the types at the intermediate-stages of stream computations as comments in the examples below.-The meaning of these types are:--* A `SerialT IO a` is a serial stream of values of type `a` in the IO Monad.-* An `AsyncT IO a` is a concurrent (asynchronous) stream of values of type-  `a` in the IO Monad.-* An `Unfold IO a b` is a representation of a function that converts a seed-  value of type `a` into a stream of values of type `b` in the IO Monad.-* A `Fold IO a b` is a representation of a function that converts a stream of-  type `a` to a final accumulator of type `b` in the IO Monad.--### A Note on Module Naming--Some of the examples below use modules from the `Internal` Streamly package-hierarchy.  These are not really internal to the library.  We classify-`Streamly` modules into two categories:--* _Released modules and APIs_: These modules and APIs are-  stable. Significant changes to these modules and APIs will cause-  Streamly's version number to change according to the package versioning-  policy.-* _Pre-release modules and APIs_: These modules and APIs have not been-  formally released yet.  They may change in the near future, and such-  changes will not necessarily be reflected in Streamly's package-  version number.  As yet unreleased modules and APIs reside in the-  `Internal` namespace.--Please use a minor release upper bound to adhere to the Haskell PVP when-using the pre-release (internal) modules.--## The Examples--### Modular Word Counting--A `Fold` in Streamly is a composable stream consumer.  For our first-example, we will use `Fold`s to count the number of bytes, words and lines-present in a file.  We will then compose individual `Fold`s together to-count words, bytes and lines at the same time.--Please see the file [WordCountModular.hs][] for the complete example-program, including the imports that we have omitted here.--#### Count Bytes (wc -c)--We start with a code fragment that counts the number of bytes in a file:--```haskell-import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Internal.FileSystem.File as File-import qualified Streamly.Prelude as Stream--wcb :: String -> IO Int-wcb file =-    File.toBytes file        -- SerialT IO Word8-  & Stream.fold Fold.length  -- IO Int-```--### Count Lines (wc -l)--The next code fragment shows how to count the number of lines in a file:--```haskell--- ASCII character 10 is a newline.-countl :: Int -> Word8 -> Int-countl n ch = if ch == 10 then n + 1 else n---- The fold accepts a stream of `Word8` and returns a line count (`Int`).-nlines :: Monad m => Fold m Word8 Int-nlines = Fold.foldl' countl 0--wcl :: String -> IO Int-wcl file =-    File.toBytes file  -- SerialT IO Word8-  & Stream.fold nlines -- IO Int-```--### Count Words (wc -w)--Our final code fragment counts the number of whitespace-separated words-in a stream:--```haskell-countw :: (Int, Bool) -> Word8 -> (Int, Bool)-countw (n, wasSpace) ch =-    if isSpace $ chr $ fromIntegral ch-    then (n, True)-    else (if wasSpace then n + 1 else n, False)---- The fold accepts a stream of `Word8` and returns a word count (`Int`).-nwords :: Monad m => Fold m Word8 Int-nwords = fst <$> Fold.foldl' countw (0, True)--wcw :: String -> IO Int-wcw file =-    File.toBytes file   -- SerialT IO Word8-  & Stream.fold nwords  -- IO Int-```--### Counting Bytes, Words and Lines Together--By using the `Tee` combinator we can compose the three folds that count-bytes, lines and words individually into a single fold that counts all-three at once.  The applicative instance of `Tee` distributes its input-to all the supplied folds (`Fold.length`, `nlines`, and `nwords`) and-then combines the outputs from the folds using the supplied combiner-function (`(,,)`).--```haskell-import qualified Streamly.Internal.Data.Fold.Tee as Tee---- The fold accepts a stream of `Word8` and returns the three counts.-countAll :: Fold IO Word8 (Int, Int, Int)-countAll = Tee.toFold $ (,,) <$> Tee Fold.length <*> Tee nlines <*> Tee nwords--wc :: String -> IO (Int, Int, Int)-wc file =-    File.toBytes file    -- SerialT IO Word8-  & Stream.fold countAll -- IO (Int, Int, Int)-```--This example demonstrates the excellent modularity offered by-[Streamly][]'s simple and concise API.  Experienced Haskellers will-notice that we have not used bytestrings&mdash;we instead used a stream of-`Word8` values, simplifying our program.--### The Performance of Word Counting--We compare two equivalent implementations: one using [Streamly][],-and the other using C.--The performance of the [Streamly word counting-implementation][WordCount.hs] is:--```-$ time WordCount-hs gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m1.825s-user    0m1.697s-sys     0m0.128s-```--The performance of an equivalent [wc implementation in C][WordCount.c] is:--```-$ time WordCount-c gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m2.100s-user    0m1.935s-sys     0m0.165s-```--### Concurrent Word Counting--In our next example we show how the task of counting words, lines,-and bytes could be done in parallel on multiprocessor hardware.--To count words in parallel we first divide the stream into chunks-(arrays), do the counting within each chunk, and then add all the-counts across chunks.  We use the same code as above except that we use-arrays for our input data.--Please see the file [WordCountParallel.hs][] for the complete working-code for this example, including the imports that we have omitted below.--The `countArray` function counts the line, word, char counts in one chunk:--```haskell-import qualified Streamly.Data.Array.Foreign as Array--countArray :: Array Word8 -> IO Counts-countArray arr =-      Stream.unfold Array.read arr            -- SerialT IO Word8-    & Stream.decodeLatin1                     -- SerialT IO Char-    & Stream.foldl' count (Counts 0 0 0 True) -- IO Counts-```--Here the function `count` and the `Counts` data type are defined in the-`WordCount` helper module defined in [WordCount.hs][].--When combining the counts in two contiguous chunks, we need to check-whether the first element of the next chunk is a whitespace character-in order to determine if the same word continues in the next chunk or-whether the chunk starts with a new word. The `partialCounts` function-adds a `Bool` flag to `Counts` returned by `countArray` to indicate-whether the first character in the chunk is a space.--```haskell-partialCounts :: Array Word8 -> IO (Bool, Counts)-partialCounts arr = do-    let r = Array.getIndex arr 0-    case r of-        Just x -> do-            counts <- countArray arr-            return (isSpace (chr (fromIntegral x)), counts)-        Nothing -> return (False, Counts 0 0 0 True)-```--`addCounts` then adds the counts from two consecutive chunks:--```haskell-addCounts :: (Bool, Counts) -> (Bool, Counts) -> (Bool, Counts)-addCounts (sp1, Counts l1 w1 c1 ws1) (sp2, Counts l2 w2 c2 ws2) =-    let wcount =-            if not ws1 && not sp2 -- No space between two chunks.-            then w1 + w2 - 1-            else w1 + w2-     in (sp1, Counts (l1 + l2) wcount (c1 + c2) ws2)-```--To count in parallel we now only need to divide the stream into arrays,-apply our counting function to each array, and then combine the counts-from each chunk.--```haskell-wc :: String -> IO (Bool, Counts)-wc file = do-      Stream.unfold File.readChunks file -- AheadT IO (Array Word8)-    & Stream.mapM partialCounts          -- AheadT IO (Bool, Counts)-    & Stream.maxThreads numCapabilities  -- AheadT IO (Bool, Counts)-    & Stream.fromAhead                   -- SerialT IO (Bool, Counts)-    & Stream.foldl' addCounts (False, Counts 0 0 0 True) -- IO (Bool, Counts)-```--Please note that the only difference between a concurrent and a-non-concurrent program lies in the use of the `Stream.fromAhead`-combinator.  If we remove the call to `Stream.fromAhead`, we would-still have a perfectly valid and performant serial program. Notice-how succinctly and idiomatically we have expressed the concurrent word-counting problem.--A benchmark with 2 CPUs:--```-$ time WordCount-hs-parallel gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m1.284s-user    0m1.952s-sys     0m0.140s-```--These example programs have assumed ASCII encoded input data.  For UTF-8-streams, we have a [concurrent wc implementation][WordCountParallelUTF8.hs]-with UTF-8 decoding.  This concurrent implementation performs as well-as the standard `wc` program in serial benchmarks. In concurrent mode-[Streamly][]'s implementation can utilise multiple processing cores if-these are present, and can thereby run much faster than the standard-binary.--Streamly provides concurrency facilities similar-to [OpenMP](https://en.wikipedia.org/wiki/OpenMP) and-[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative-style of expression.  With Streamly you can write concurrent programs-with ease, with support for different types of concurrent scheduling.--### A Concurrent Network Server--We now move to a slightly more complicated example: we simulate a-dictionary lookup server which can serve word meanings to multiple-clients concurrently.  This example demonstrates the use of the concurrent-`mapM` combinator.--Please see the file [WordServer.hs][] for the complete code for this-example, including the imports that we have omitted below.--```haskell-import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Network.Inet.TCP as TCP-import qualified Streamly.Network.Socket as Socket-import qualified Streamly.Unicode.Stream as Unicode---- Simulate network/db query by adding a delay.-fetch :: String -> IO (String, String)-fetch w = threadDelay 1000000 >> return (w,w)---- Read lines of whitespace separated list of words from a socket, fetch the--- meanings of each word concurrently and return the meanings separated by--- newlines, in same order as the words were received. Repeat until the--- connection is closed.-lookupWords :: Socket -> IO ()-lookupWords sk =-      Stream.unfold Socket.read sk               -- SerialT IO Word8-    & Unicode.decodeLatin1                       -- SerialT IO Char-    & Stream.wordsBy isSpace Fold.toList         -- SerialT IO String-    & Stream.fromSerial                          -- AheadT  IO String-    & Stream.mapM fetch                          -- AheadT  IO (String, String)-    & Stream.fromAhead                           -- SerialT IO (String, String)-    & Stream.map show                            -- SerialT IO String-    & Stream.intersperse "\n"                    -- SerialT IO String-    & Unicode.encodeStrings Unicode.encodeLatin1 -- SerialT IO (Array Word8)-    & Stream.fold (Socket.writeChunks sk)        -- IO ()--serve :: Socket -> IO ()-serve sk = finally (lookupWords sk) (close sk)---- | Run a server on port 8091. Accept and handle connections concurrently. The--- connection handler is "serve" (i.e. lookupWords).  You can use "telnet" or--- "nc" as a client to try it out.-main :: IO ()-main =-      Stream.unfold TCP.acceptOnPort 8091 -- SerialT IO Socket-    & Stream.fromSerial                   -- AsyncT IO ()-    & Stream.mapM serve                   -- AsyncT IO ()-    & Stream.fromAsync                    -- SerialT IO ()-    & Stream.drain                        -- IO ()-```--### Merging Incoming Streams--In the next example, we show how to merge logs coming from multiple-nodes in your network.  These logs are merged at line boundaries and-the merged logs are written to a file or to a network destination.-This example uses the `concatMapWith` combinator to merge multiple-streams concurrently.--Please see the file [MergeServer.hs][] for the complete working code,-including the imports that we have omitted below.--```haskell-import qualified Streamly.Data.Unfold as Unfold-import qualified Streamly.Network.Socket as Socket---- | Read a line stream from a socket.--- Note: lines are buffered, and we could add a limit to the--- buffering for safety.-readLines :: Socket -> SerialT IO (Array Char)-readLines sk =-    Stream.unfold Socket.read sk                 -- SerialT IO Word8-  & Unicode.decodeLatin1                         -- SerialT IO Char-  & Stream.splitWithSuffix (== '\n') Array.write -- SerialT IO String--recv :: Socket -> SerialT IO (Array Char)-recv sk = Stream.finally (liftIO $ close sk) (readLines sk)---- | Starts a server at port 8091 listening for lines with space separated--- words. Multiple clients can connect to the server and send streams of lines.--- The server handles all the connections concurrently, merges the incoming--- streams at line boundaries and writes the merged stream to a file.-server :: Handle -> IO ()-server file =-      Stream.unfold TCP.acceptOnPort 8090        -- SerialT IO Socket-    & Stream.concatMapWith Stream.parallel recv  -- SerialT IO (Array Char)-    & Stream.unfoldMany Array.read               -- SerialT IO Char-    & Unicode.encodeLatin1                       -- SerialT IO Word8-    & Stream.fold (Handle.write file)            -- IO ()--main :: IO ()-main = withFile "output.txt" AppendMode server-```--### Listing Directories Recursively/Concurrently--Our next example lists a directory tree recursively, reading-multiple directories concurrently.--This example uses the tree traversing combinator `iterateMapLeftsWith`.-This combinator maps a stream generator on the `Left` values in its-input stream (directory names in this case), feeding the resulting `Left`-values back to the input, while it lets the `Right` values (file names-in this case) pass through to the output. The `Stream.ahead` stream-joining combinator then makes it iterate on the directories concurrently.--Please see the file [ListDir.hs][] for the complete working code,-including the imports that we have omitted below.--```haskell-import Streamly.Internal.Data.Stream.IsStream (iterateMapLeftsWith)--import qualified Streamly.Prelude as Stream-import qualified Streamly.Internal.FileSystem.Dir as Dir (toEither)---- Lists a directory as a stream of (Either Dir File).-listDir :: String -> SerialT IO (Either String String)-listDir dir =-      Dir.toEither dir               -- SerialT IO (Either String String)-    & Stream.map (bimap mkAbs mkAbs) -- SerialT IO (Either String String)--    where mkAbs x = dir ++ "/" ++ x---- | List the current directory recursively using concurrent processing.-main :: IO ()-main = do-    hSetBuffering stdout LineBuffering-    let start = Stream.fromPure (Left ".")-    Stream.iterateMapLeftsWith Stream.ahead listDir start-        & Stream.mapM_ print-```--### Rate Limiting--For bounded concurrent streams, a stream yield rate can be specified-easily.  For example, to print "tick" once every second you can simply-write:--```haskell-main :: IO ()-main =-      Stream.repeatM (pure "tick")  -- AsyncT IO String-    & Stream.timestamped            -- AsyncT IO (AbsTime, String)-    & Stream.avgRate 1              -- AsyncT IO (AbsTime, String)-    & Stream.fromAsync              -- SerialT IO (AbsTime, String)-    & Stream.mapM_ print            -- IO ()-```--Please see the file [Rate.hs][] for the complete working code.--The concurrency of the stream is automatically controlled to match the-specified rate. [Streamly][]'s rate control works precisely even at-throughputs as high as millions of yields per second.--For more sophisticated rate control needs please see the Streamly [reference-documentation][Streamly].--### Reactive Programming--Streamly supports reactive (time domain) programming because of its-support for declarative concurrency. Please see the `Streamly.Prelude`-module for time-specific combinators like `intervalsOf`, and-folds like `takeInterval` in `Streamly.Internal.Data.Fold`.-Please also see the pre-release sampling combinators in the-`Streamly.Internal.Data.Stream.IsStream.Top` module for `throttle` and-`debounce` like operations.--The examples [AcidRain.hs][] and [CirclingSquare.hs][] demonstrate-reactive programming using [Streamly][].--### More Examples--If you would like to view more examples, please visit the [Streamly-Examples][streamly-examples] web page.--### Further Reading--* [Streaming Benchmarks][streaming-benchmarks]-* [Concurrency Benchmarks][concurrency-benchmarks]-* Functional Conf 2019 [Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)-* [Other Guides](/)-* [Streamly Homepage][Streamly]--## Performance--As you have seen in the word count example above, [Streamly][] offers-highly modular abstractions for building programs while also offering-the performance close to an equivalent (imperative) C program.--Streamly offers excellent performance even for byte-at-a-time stream-operations using efficient abstractions like `Unfold`s and terminating-`Fold`s.  Byte-at-a-time stream operations can simplify programming-because the developer does not have to deal explicitly with chunking-and re-combining data.--Streamly exploits GHC's stream fusion optimizations (`case-of-case` and-`spec-constr`) aggressively to achieve C-like speed, while also offering-highly modular abstractions to developers.--[Streamly][] will usually perform very well without any-compiler plugins.  However, we have fixed some deficiencies-that we had noticed in GHC's optimizer using a [compiler-plugin](https://github.com/composewell/fusion-plugin).  We hope to fold-these optimizations into GHC in the future; until then we recommend that-you use this plugin for applications that are performance sensitive.--### Benchmarks--We measured several Haskell streaming implementations-using various micro-benchmarks. Please see the [streaming-benchmarks][streaming-benchmarks] page for a detailed comparison of-Streamly against other streaming libraries.--Our results show that [Streamly][] is the fastest effectful streaming-implementation on almost all the measured microbenchmarks. In many cases-it runs up to 100x faster, and in some cases even 1000x faster than-some of the tested alternatives. In some composite operation benchmarks-[Streamly][] turns out to be significantly faster than Haskell's list-implementation.--*Note*: If you can write a program in some other way or with some other-language that runs significantly faster than what [Streamly][] offers,-please let us know and we will improve.--## Notes--Streamly comes equipped with a very powerful set of abstractions to-accomplish many kinds of programming tasks: it provides support for-programming with streams and arrays, for reading and writing from the-file system and from the network, for time domain programming (reactive-programming), and for reacting to file system events using `fsnotify`.--Please view [Streamly's documentation][Streamly] for more information-about Streamly's features.--### Concurrency--Streamly uses lock-free synchronization for achieving concurrent-operation with low overheads.  The number of tasks performed concurrently-are determined automatically based on the rate at which a consumer-is consuming the results. In other words, you do not need to manage-thread pools or decide how many threads to use for a particular task.-For CPU-bound tasks Streamly will try to keep the number of threads-close to the number of CPUs available; for IO-bound tasks it will utilize-more threads.--The parallelism available during program execution can be utilized with-very little overhead even where the task size is very-small, because Streamly will automatically switch between-serial or batched execution of tasks on the same CPU depending-on whichever is more efficient.  Please see our [concurrency-benchmarks][concurrency-benchmarks] for more detailed performance-measurements, and for a comparison with the `async` package.--### Design Goals--Our goals for [Streamly][] from the very beginning have been:--1. To achieve simplicity by unifying abstractions.-2. To offer high performance.--These goals are hard to achieve simultaneously because they are usually-inversely related.  We have spent many years trying to get the abstractions-right without compromising performance.--`Unfold` is an example of an abstraction that we have created to achieve-high performance when mapping streams on streams.  `Unfold` allows stream-generation to be optimized well by the compiler through stream fusion.-A `Fold` with termination capability is another example which modularizes-stream elimination operations through stream fusion.  Terminating folds-can perform many simple parsing tasks that do not require backtracking.-In Streamly, `Parser`s are a natural extension to terminating `Fold`s;-`Parser`s add the ability to backtrack to `Fold`s.  Unification leads-to simpler abstractions and lower cognitive overheads while also not-compromising performance.--## Credits--The following authors/libraries have influenced or inspired this library in a-significant way:--  * Roman Leshchinskiy ([vector](http://hackage.haskell.org/package/vector))-  * Gabriella Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))-  * Alberto G. Corona ([transient](https://hackage.haskell.org/package/transient))--Please see the [`credits`](/docs/Credits.md) directory for a full-list of contributors, credits and licenses.--## Licensing--Streamly is an [open source](https://github.com/composewell/streamly)-project available under a liberal [BSD-3-Clause license][LICENSE]--## Contributing to Streamly--As an open project we welcome contributions:--* [Streamly Contributor's Guide][CONTRIBUTING.md]-* [Contact the streamly development team](mailto:streamly@composewell.com)--## Getting Support--Professional support is available for [Streamly][]: please contact-[support@composewell.com](mailto:support@composewell.com).--You can also join our [community chat-channel](https://gitter.im/composewell/streamly) on Gitter.--<!---Link References.--->--[Streamly]: https://streamly.composewell.com/-[streamly-examples]: https://github.com/composewell/streamly-examples-[streaming-benchmarks]: https://github.com/composewell/streaming-benchmarks-[concurrency-benchmarks]: https://github.com/composewell/concurrency-benchmarks--<!---Keep all the unstable links here so that they can be updated to stable-links (for online docs) before we release.--->--<!-- examples -->-[WordCountModular.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountModular.hs-[WordCount.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.hs-[WordCount.c]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.c-[WordCountParallel.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallel.hs-[WordCountParallelUTF8.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallelUTF8.hs-[WordServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordServer.hs-[MergeServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/MergeServer.hs-[ListDir.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/ListDir.hs-[Rate.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/Rate.hs-[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs-[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs--<!-- local files -->-[LICENSE]: /LICENSE-[CONTRIBUTING.md]: /CONTRIBUTING.md-[docs]: docs/
− docs/Overview.md 
@@ -1,468 +0,0 @@-# Streaming--These are some notes from an old version of README that may be-useful. For a quick introduction please read the README.md at the repo-root first.--## Streamly--Streamly is a general computing framework based on data flow programming also-known as streaming. Moreover streamly supports concurrent dataflow programming.--Streaming in general enables writing modular, composable and scalable-applications with ease, and concurrency allows you to make them scale and-perform well.  Streamly enables writing scalable concurrent applications-without being aware of threads or synchronization. No explicit thread-control is needed. Where applicable, concurrency rate is automatically-controlled based on the demand by the consumer. However, combinators can be-used to fine tune the concurrency control.--Streaming and concurrency together enable expressing reactive applications-conveniently. See the @CirclingSquare@ example in-<https://github.com/composewell/streamly-examples Streamly Examples> for-a simple SDL based FRP example. To summarize, streamly provides a unified-computing framework for streaming, non-determinism and functional reactive-programming in an elegant and simple API that is a natural extension of pure-lists to monadic streams.--## What are streams?--In simple terms, streams are the functional equivalent of loops in-imperative programming.--A stream is a representation of potentially infinite data sequence.  You-can compose a pipeline of functions or stream processors to process-an input stream of data to produce an output stream. We call it a-form of dataflow programming as data flows through the processing-logic. In imperative programming there is no clear separation of data-and logic. The logic can arbitrarily examine and mutate data which-creates a problem due to complex interleaving of state and logic in the-program.--In streamly there are two fundamental data structures, streams and arrays.-Streams are for dataflow style processing while arrays are for storing data.-Both taken together are powerful tools for general purpose programming in a-functional or dataflow style.--## Loops vs Streams--In imperative programming when we have to process a sequence of items-or an array of data we run a loop over it, each iteration of the loop-examines the data to do something with it and produce an output.--Loops are a low level, monolithic and general concept. Whereas streams-are high level, structured and modular way of expressing what you usualy-do with loops. Streams allow you to write different parts of the loop-as separate modular combinators and then compose them to create bigger-loops.--## Streaming Concurrently--Haskell lists express pure computations using composable stream operations like-`:`, `unfold`, `map`, `filter`, `zip` and `fold`.  Streamly is exactly like-lists except that it can express sequences of pure as well as monadic-computations aka streams. More importantly, it can express monadic sequences-with concurrent execution semantics without introducing any additional APIs.--Streamly expresses concurrency using standard, well known abstractions.-Concurrency semantics are defined for list operations, semigroup, applicative-and monadic compositions. Programmer does not need to know any low level-notions of concurrency like threads, locking or synchronization.  Concurrent-and non-concurrent programs are fundamentally the same.  A chosen segment of-the program can be made concurrent by annotating it with an appropriate-combinator.  We can choose a combinator for lookahead style or asynchronous-concurrency.  Concurrency is automatically scaled up or down based on the-demand from the consumer application, we can finally say goodbye to managing-thread pools and associated sizing issues.  The result is truly fearless-and declarative monadic concurrency.--## Where to use streamly?--Streamly is a general purpose programming framework.  It can be used equally-efficiently from a simple `Hello World!` program to a massively concurrent-application. The answer to the question, "where to use streamly?" - would be-similar to the answer to - "Where to use Haskell lists or the IO monad?".--Streamly simplifies streaming and makes it as intuitive as plain lists. Unlike-other streaming libraries, no fancy types are required.  Streamly is simply a-generalization of Haskell lists to monadic streaming optionally with concurrent-composition. The basic stream type in streamly `SerialT m a` can be considered-as a list type `[a]` parameterized by the monad `m`. For example, `SerialT IO-a` is a moral equivalent of `[a]` in the IO monad. `SerialT Identity a`, is-equivalent to pure lists.  Streams are constructed very much like lists, except-that they use `nil` and `cons` instead of `[]` and `:`.  Unlike lists, streams-can be constructed from monadic effects, not just pure elements.  Streams are-processed just like lists, with list like combinators, except that they are-monadic and work in a streaming fashion. In other words streamly just completes-what lists lack, you do not need to learn anything new. Please see [streamly vs-lists](/docs/streamly-vs-lists.md) for a detailed comparison.--Not surprisingly, the monad instance of streamly is a list transformer, with-concurrency capability.--## Why data flow programming?--If you need some convincing for using streaming or data flow programming-paradigm itself then try to answer this question - why do we use lists in-Haskell? It boils down to why we use functional programming in the first place.-Haskell is successful in enforcing the functional data flow paradigm for pure-computations using lists, but not for monadic computations. In the absence of a-standard and easy to use data flow programming paradigm for monadic-computations, and the IO monad providing an escape hatch to an imperative-model, we just love to fall into the imperative trap, and start asking the same-fundamental question again - why do we have to use the streaming data model?--## Streaming Pipelines--The following snippet provides a simple stream composition example that reads-numbers from stdin, prints the squares of even numbers and exits if an even-number more than 9 is entered.--``` haskell-import qualified Streamly.Prelude as S-import Data.Function ((&))--main = S.drain $-       S.repeatM getLine-     & fmap read-     & S.filter even-     & S.takeWhile (<= 9)-     & fmap (\x -> x * x)-     & S.mapM print-```--Unlike `pipes` or `conduit` and like `vector` and `streaming`, `streamly`-composes stream data instead of stream processors (functions).  A stream is-just like a list and is explicitly passed around to functions that process the-stream.  Therefore, no special operator is needed to join stages in a streaming-pipeline, just the standard function application (`$`) or reverse function-application (`&`) operator is enough.--## Concurrent Stream Generation--`consM` or its operator form `|:` can be used to construct a stream from-monadic actions. A stream constructed with `consM` can run the monadic actions-in the stream concurrently when used with appropriate stream type combinator-(e.g. `fromAsync`, `fromAhead` or `fromParallel`).--The following code finishes in 3 seconds (6 seconds when serial), note the-order of elements in the resulting output, the outputs are consumed as soon as-each action is finished (asyncly):--``` haskell-> let p n = threadDelay (n * 1000000) >> return n-> S.toList $ S.fromAsync $ p 3 |: p 2 |: p 1 |: S.nil-[1,2,3]-```--Use `fromAhead` if you want speculative concurrency i.e. execute the actions in-the stream concurrently but consume the results in the specified order:--``` haskell-> S.toList $ S.fromAhead $ p 3 |: p 2 |: p 1 |: S.nil-[3,2,1]-```--Monadic stream generation functions e.g. `unfoldrM`, `replicateM`, `repeatM`,-`iterateM` and `fromFoldableM` etc. can work concurrently.--The following finishes in 10 seconds (100 seconds when serial):--``` haskell-S.drain $ S.fromAsync $ S.replicateM 10 $ p 10-```--## Concurrent Streaming Pipelines--Use `|&` or `|$` to apply stream processing functions concurrently. The-following example prints a "hello" every second; if you use `&` instead of-`|&` you will see that the delay doubles to 2 seconds instead because of serial-application.--``` haskell-main = S.drain $-      S.repeatM (threadDelay 1000000 >> return "hello")-   |& S.mapM (\x -> threadDelay 1000000 >> putStrLn x)-```--## Mapping Concurrently--We can use `mapM` or `sequence` functions concurrently on a stream.--``` haskell-> let p n = threadDelay (n * 1000000) >> return n-> S.drain $ S.fromAhead $ S.mapM (\x -> p 1 >> print x) (S.fromSerial $ S.repeatM (p 1))-```--## Serial and Concurrent Merging--Semigroup and Monoid instances can be used to fold streams serially or-concurrently. In the following example we compose ten actions in the-stream, each with a delay of 1 to 10 seconds, respectively. Since all the-actions are concurrent we see one output printed every second:--``` haskell-import qualified Streamly.Prelude as S-import Control.Concurrent (threadDelay)--main = S.toList $ S.fromParallel $ foldMap delay [1..10]- where delay n = S.fromEffect $ threadDelay (n * 1000000) >> print n-```--Streams can be combined together in many ways. We provide some examples-below, see the tutorial for more ways. We use the following `delay`-function in the examples to demonstrate the concurrency aspects:--``` haskell-import qualified Streamly.Prelude as S-import Control.Concurrent--delay n = S.fromEffect $ do-    threadDelay (n * 1000000)-    tid <- myThreadId-    putStrLn (show tid ++ ": Delay " ++ show n)-```-### Serial--``` haskell-main = S.drain $ delay 3 <> delay 2 <> delay 1-```-```-ThreadId 36: Delay 3-ThreadId 36: Delay 2-ThreadId 36: Delay 1-```--### Parallel--``` haskell-main = S.drain . S.fromParallel $ delay 3 <> delay 2 <> delay 1-```-```-ThreadId 42: Delay 1-ThreadId 41: Delay 2-ThreadId 40: Delay 3-```--## Nested Loops (aka List Transformer)--The monad instance composes like a list monad.--``` haskell-import qualified Streamly.Prelude as S--loops = do-    x <- S.fromFoldable [1,2]-    y <- S.fromFoldable [3,4]-    S.fromEffect $ putStrLn $ show (x, y)--main = S.drain loops-```-```-(1,3)-(1,4)-(2,3)-(2,4)-```--## Concurrent Nested Loops--To run the above code with speculative concurrency i.e. each iteration in the-loop can run concurrently but the results are presented to the consumer of the-output in the same order as serial execution:--``` haskell-main = S.drain $ S.fromAhead $ loops-```--Different stream types execute the loop iterations in different ways. For-example, `fromWSerial` interleaves the loop iterations. There are several-concurrent stream styles to execute the loop iterations concurrently in-different ways, see the `Streamly.Tutorial` module for a detailed treatment.--## Magical Concurrency--Streams can perform semigroup (<>) and monadic bind (>>=) operations-concurrently using combinators like `fromAsync`, `parallelly`. For example,-to concurrently generate squares of a stream of numbers and then concurrently-sum the square roots of all combinations of two streams:--``` haskell-import qualified Streamly.Prelude as S--main = do-    s <- S.sum $ S.fromAsync $ do-        -- Each square is performed concurrently, (<>) is concurrent-        x2 <- foldMap (\x -> return $ x * x) [1..100]-        y2 <- foldMap (\y -> return $ y * y) [1..100]-        -- Each addition is performed concurrently, monadic bind is concurrent-        return $ sqrt (x2 + y2)-    print s-```--## Rate Limiting--For bounded concurrent streams, stream yield rate can be specified. For-example, to print hello once every second you can simply write this:--``` haskell-import Streamly.Prelude as S--main = S.drain $ S.fromAsync $ S.avgRate 1 $ S.repeatM $ putStrLn "hello"-```--For some practical uses of rate control, see-[AcidRain.hs](https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs)-and-[CirclingSquare.hs](https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs)-.-Concurrency of the stream is automatically controlled to match the specified-rate. Rate control works precisely even at throughputs as high as millions of-yields per second. For more sophisticated rate control see the haddock-documentation.--## Arrays--The `Streamly.Data.Array.Foreign` module provides immutable arrays.  Arrays are the-computing duals of streams. Streams are good at sequential access and immutable-transformations of in-transit data whereas arrays are good at random access and-in-place transformations of buffered data. Unlike streams which are potentially-infinite, arrays are necessarily finite. Arrays can be used as an efficient-interface between streams and external storage systems like memory, files and-network. Streams and arrays complete each other to provide a general purpose-computing system. The design of streamly as a general purpose computing-framework is centered around these two fundamental aspects of computing and-storage.--`Streamly.Data.Array.Foreign` uses pinned memory outside GC and therefore avoid any-GC overhead for the storage in arrays. Streamly allows efficient-transformations over arrays using streams. It uses arrays to transfer data to-and from the operating system and to store data in memory.--## Folds--Folds are consumers of streams.  `Streamly.Data.Fold` module provides a `Fold`-type that represents a `foldl'`.  Such folds can be efficiently composed-allowing the compiler to perform stream fusion and therefore implement high-performance combinators for consuming streams. A stream can be distributed to-multiple folds, or it can be partitioned across multiple folds, or-demultiplexed over multiple folds, or unzipped to two folds. We can also use-folds to fold segments of stream generating a stream of the folded results.--If you are familiar with the `foldl` library, these are the same composable-left folds but simpler and better integrated with streamly, and with many more-powerful ways of composing and applying them.--## Unfolds--Unfolds are duals of folds. Folds help us compose consumers of streams-efficiently and unfolds help us compose producers of streams efficiently.-`Streamly.Data.Unfold` provides an `Unfold` type that represents an `unfoldr`-or a stream generator. Such generators can be combined together efficiently-allowing the compiler to perform stream fusion and implement high performance-stream merging combinators.--## File IO--The following code snippets implement some common Unix command line utilities-using streamly.  You can compile these with `ghc -O2 -fspec-constr-recursive=16--fmax-worker-args=16` and compare the performance with regular GNU coreutils-available on your system.  Though many of these are not most optimal solutions-to keep them short and elegant. Source file-[CoreUtilsHandle.hs](https://github.com/composewell/streamly-examples/blob/master/examples/CoreUtilsHandle.hs)-in the examples directory includes these examples.--``` haskell-module Main where--import qualified Streamly.Prelude as S-import qualified Streamly.Data.Fold as FL-import qualified Streamly.Data.Array.Foreign as A-import qualified Streamly.FileSystem.Handle as FH-import qualified System.IO as FH--import Data.Char (ord)-import System.Environment (getArgs)-import System.IO (openFile, IOMode(..), stdout)--withArg f = do-    (name : _) <- getArgs-    src <- openFile name ReadMode-    f src--withArg2 f = do-    (sname : dname : _) <- getArgs-    src <- openFile sname ReadMode-    dst <- openFile dname WriteMode-    f src dst-```--### cat--``` haskell-cat = S.fold (FH.writeChunks stdout) . S.unfold FH.readChunks-main = withArg cat-```--### cp--``` haskell-cp src dst = S.fold (FH.writeChunks dst) $ S.unfold FH.readChunks src-main = withArg2 cp-```--### wc -l--``` haskell-wcl = S.length . S.splitOn (== 10) FL.drain . S.unfold FH.read-main = withArg wcl >>= print-```--### Average Line Length--``` haskell-avgll =-      S.fold avg-    . S.splitOn (== 10) FL.length-    . S.unfold FH.read--    where avg      = (/) <$> toDouble FL.sum <*> toDouble FL.length-          toDouble = fmap (fromIntegral :: Int -> Double)--main = withArg avgll >>= print-```--### Line Length Histogram--`classify` is not released yet, and is available in-`Streamly.Internal.Data.Fold`--``` haskell-llhisto =-      S.fold (FL.classify FL.length)-    . S.map bucket-    . S.splitOn (== 10) FL.length-    . S.unfold FH.read--    where-    bucket n = let i = n `mod` 10 in if i > 9 then (9,n) else (i,n)--main = withArg llhisto >>= print-```--## Exceptions--Exceptions can be thrown at any point using the `MonadThrow` instance. Standard-exception handling combinators like `bracket`, `finally`, `handle`,-`onException` are provided in `Streamly.Prelude` module.--In presence of concurrency, synchronous exceptions work just the way they are-supposed to work in non-concurrent code. When concurrent streams-are combined together, exceptions from the constituent streams are propagated-to the consumer stream. When an exception occurs in any of the constituent-streams other concurrent streams are promptly terminated.--There is no notion of explicit threads in streamly, therefore, no-asynchronous exceptions to deal with. You can just ignore the zillions of-blogs, talks, caveats about async exceptions. Async exceptions just don't-exist.  Please don't use things like `myThreadId` and `throwTo` just for fun!
− docs/ReactiveProgramming.hs 
@@ -1,124 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- |--- Module      : ReactiveProgramming--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com------ In this tutorial we will show how Streamly can be used for reactive--- programming.  Before you go through this tutorial we recommend that you take--- a look at the Streamly concurrent programming tutorial.--module ReactiveProgramming-    (-    -- * Reactive Programming-    -- $reactive--    -- * Where to go next?-    -- $furtherReading-    )-where--import Streamly.Prelude-import Data.Semigroup-import Control.Applicative-import Control.Monad-import Control.Monad.IO.Class      (MonadIO(..))-import Control.Monad.Trans.Class   (MonadTrans (lift))---- $reactive------ Reactive programming is nothing but concurrent streaming which is what--- streamly is all about. With streamly we can generate streams of events,--- merge streams that are generated concurrently and process events--- concurrently. We can do all this without any knowledge about the specifics--- of the implementation of concurrency. In the following example you will see--- that the code is just regular Haskell code without much streamly APIs used--- (active hyperlinks are the streamly APIs) and yet it is a reactive--- application.------ This application has two independent and concurrent sources of event--- streams, @acidRain@ and @userAction@. @acidRain@ continuously generates--- events that deteriorate the health of the character in the game.--- @userAction@ can be "potion" or "quit". When the user types "potion" the--- health improves and the game continues.------ @--- {-\# LANGUAGE FlexibleContexts \#-}------ import "Streamly.Prelude" (MonadAsync, SerialT)--- import "Streamly.Prelude" as Stream--- import Control.Monad (void)--- import Control.Monad.IO.Class (MonadIO(liftIO))--- import Control.Monad.State (MonadState, get, modify, runStateT)------ data Event = Quit | Harm Int | Heal Int deriving (Show)------ userAction :: MonadAsync m => 'SerialT' m Event--- userAction = Stream.'repeatM' $ liftIO askUser---     where---     askUser = do---         command <- getLine---         case command of---             "potion" -> return (Heal 10)---             "harm"   -> return (Harm 10)---             "quit"   -> return Quit---             _        -> putStrLn "Type potion or harm or quit" >> askUser------ acidRain :: MonadAsync m => 'SerialT' m Event--- acidRain = Stream.'fromAsync' $ Stream.'constRate' 1 $ Stream.'repeatM' $ liftIO $ return $ Harm 1------ data Result = Check | Done------ runEvents :: (MonadAsync m, MonadState Int m) => 'SerialT' m Result--- runEvents = do---     event \<- userAction \`Stream.'parallel'` acidRain---     case event of---         Harm n -> modify (\\h -> h - n) >> return Check---         Heal n -> modify (\\h -> h + n) >> return Check---         Quit -> return Done------ data Status = Alive | GameOver deriving Eq------ getStatus :: (MonadAsync m, MonadState Int m) => Result -> m Status--- getStatus result =---     case result of---         Done  -> liftIO $ putStrLn "You quit!" >> return GameOver---         Check -> do---             h <- get---             liftIO $ if (h <= 0)---                      then putStrLn "You die!" >> return GameOver---                      else putStrLn ("Health = " <> show h) >> return Alive------ main :: IO ()--- main = do---     putStrLn "Your health is deteriorating due to acid rain, type \\\"potion\\\" or \\\"quit\\\""---     let runGame = Stream.'drainWhile' (== Alive) $ Stream.'mapM' getStatus runEvents---     void $ runStateT runGame 60--- @------ You can also find the source of this example in the streamly-examples repo--- as <https://github.com/composewell/streamly-examples/tree/master/AcidRain.hs AcidRain.hs>.--- It has been adapted from Gabriel's--- <https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html pipes-concurrency>--- package.--- This is much simpler compared to the pipes version because of the builtin--- concurrency in streamly. You can also find a SDL based reactive programming--- example adapted from Yampa in--- <https://github.com/composewell/streamly-examples/tree/master/CirclingSquare.hs CirclingSquare.hs>.---- $performance------ Streamly is highly optimized for performance, it is designed for serious--- high performing, concurrent and scalable applications. We have created the--- <https://hackage.haskell.org/package/streaming-benchmarks streaming-benchmarks>--- package which is specifically and carefully designed to measure the--- performance of Haskell streaming libraries fairly and squarely in the right--- way. Streamly performs at par or even better than most streaming libraries--- for serial operations even though it needs to deal with the concurrency--- capability.---- $furtherReading------ * See the examples in <https://github.com/composewell/streamly-examples streamly-examples> repo.
@@ -1,1 +0,0 @@-https://github.com/composewell/streamly/issues/1046
− docs/Setup.hs 
@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain
− docs/Tutorial.hs 
@@ -1,542 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- |--- Module      : Tutorial--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com------ In this tutorial we will show how Streamly can be used for idiomatic--- dataflow programming.  Before you go through this tutorial we recommend that--- you take a look at the Streamly Getting Started guide so that you are ready--- to try out the examples.--module Tutorial-    (-    -- * Stream Types-    -- $streams--    -- * Imports and Supporting Code-    -- $imports--    -- * Generating Streams-    -- $generating--    -- * Eliminating Streams-    -- $eliminating--    -- * Transforming Streams-    -- $transformation--    -- * Merging Streams--    -- ** Semigroup Style-    -- $semigroup--    -- *** Deep Serial Composition ('Serial')-    -- $serial--    -- *** Wide Serial Composition ('WSerial')-    -- $interleaved--    -- ** Monoid Style-    -- $monoid--    -- * Nesting Streams-    -- $nesting--    -- ** Monad-    -- $monad--    -- *** Deep Serial Nesting ('Serial')-    -- $regularSerial--    -- *** Wide Serial Nesting ('WSerial')-    -- $interleavedNesting--    -- *** Exercise-    -- $monadExercise--    -- ** Applicative-    -- $applicative--    -- ** Functor-    -- $functor--    -- * Zipping Streams-    -- $zipping--    -- ** Serial Zipping-    -- $serialzip--    -- * Where to go next?-    -- $furtherReading-    )-where--import Streamly.Prelude-import Data.Semigroup-import Control.Applicative-import Control.Monad-import Control.Monad.IO.Class      (MonadIO(..))-import Control.Monad.Trans.Class   (MonadTrans (lift))---- CAUTION: please keep setup and imports sections in sync---- $setup--- >>> :m--- >>> import Data.Function ((&))--- >>> import Streamly.Prelude ((|:), (|&))--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold------- $imports------ In most of example snippets we do not repeat the imports. Where imports are--- not explicitly specified use the imports shown below.------ >>> :m--- >>> import Data.Function ((&))--- >>> import Streamly.Prelude ((|:), (|&))--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold------- $streams------ The monadic stream API offered by Streamly is very close to the Haskell--- "Prelude" pure lists' API, it can be considered as a natural extension of--- lists to monadic actions. Streamly streams provide concurrent composition--- and merging of streams. It can be considered as a concurrent list--- transformer.------ The 'Serial' type is almost a drop in replacement for pure lists,--- pure lists are a special case of monadic streams. If you use 'nil' in place--- of '[]' and '|:' in place ':' you can replace a list with a 'Serial' stream.--- The only difference is that the elements must be monadic type and to operate--- on the streams we must use the corresponding functions from--- "Streamly.Prelude" instead of using the base "Prelude".---- $generating------ 'nil' represents an empty stream and 'consM' or its operator form '|:' adds--- a monadic action at the head of the stream.------ >>> Stream.toList Stream.nil--- []------ Stream.toList $ getLine |: getLine |: Stream.nil--- hello--- world--- ["hello","world"]------ To create a singleton stream from a pure value use 'fromPure' or 'pure' and to--- create a singleton stream from a monadic action use 'fromEffect'. Note that in--- case of Zip applicative streams "pure" repeats the value to generate an--- infinite stream.------ >>> Stream.toList $ pure 1--- [1]------ >>> Stream.toList $ Stream.fromPure 1--- [1]------ Stream.toList $ Stream.fromEffect getLine--- hello--- ["hello"]------ To create a stream from pure values in a 'Foldable' container use--- 'fromFoldable' which is equivalent to a fold using 'cons' and 'nil':------ >>> Stream.toList $ Stream.fromFoldable [1..3]--- [1,2,3]------ >>> Stream.toList $ Prelude.foldr Stream.cons Stream.nil [1..3]--- [1,2,3]------ To create a stream from monadic actions in a 'Foldable' container just use a--- right fold using 'consM' and 'nil':------ >>> Stream.drain $ Prelude.foldr (|:) Stream.nil [putStr "Hello ", putStrLn "world!"]--- Hello world!------ For more ways to construct a stream see the module "Streamly.Prelude".---- $eliminating------ We have already seen 'drain' and toList to eliminate a stream in the--- examples above.  'drain' runs a stream discarding the results i.e. only--- for effects.  'toList' runs the stream and collects the results in a list.------ For other ways to eliminate a stream see the @Folding@ section in--- "Streamly.Prelude" module.---- $transformation------ Transformation over a stream is the equivalent of a @for@ loop construct in--- imperative paradigm. We iterate over every element in the stream and perform--- certain transformations for each element.  Transformations may involve--- mapping functions over the elements, filtering elements from the stream or--- folding all the elements in the stream into a single value. Streamly streams--- are exactly like lists and you can perform all the transformations in the--- same way as you would on lists.------ Here is a simple console echo program that just echoes every input line,--- forever:------ >>> :{--- echo =---       Stream.repeatM getLine---     & Stream.mapM putStrLn---     & Stream.drain--- :}------ The following code snippet reads lines from standard input, filters blank--- lines, drops the first non-blank line, takes the next two, up cases them,--- numbers them and prints them:------ >>> import Data.Char (toUpper)--- >>> :{--- main =---       Stream.repeatM getLine---     & Stream.filter (not . null)---     & Stream.drop 1---     & Stream.take 2---     & fmap (map toUpper)---     & Stream.zipWith (\n s -> show n ++ " " ++ s) (Stream.fromFoldable [1..])---     & Stream.mapM putStrLn---     & Stream.drain--- :}------- $semigroup------ We can combine two streams into a single stream using semigroup composition--- operation '<>'.  Streams can be combined in many different ways as described--- in the following sections, the '<>' operation behaves differently depending--- on the stream type in effect. The stream type and therefore the composition--- style can be changed at any point using one of the type combinators as--- discussed earlier.---- $serial------ The 'Semigroup' operation '<>' of the 'Serial' type combines the two streams--- in a /serial depth first/ manner. We use the 'fromSerial' type combinator to--- effect 'Serial' style of composition. We can also use an explicit 'Serial'--- type annotation for the stream to achieve the same effect.  However, since--- 'Serial' is the default type unless explicitly specified by using a--- combinator, we can omit using an explicit combinator or type annotation for--- this style of composition.------ When two streams with multiple elements are combined in this manner, the--- monadic actions in the two streams are performed sequentially i.e. first all--- actions in the first stream are performed sequentially and then all actions--- in the second stream are performed sequentially. We call it--- /serial depth first/ as the full depth of one stream is fully traversed--- before we move to the next. The following example prints the sequence 1, 2,--- 3, 4:------ >>> stream1 = print 1 |: print 2 |: Stream.nil--- >>> stream2 = print 3 |: print 4 |: Stream.nil--- >>> Stream.drain $ stream1 <> stream2--- 1--- 2--- 3--- 4------ All actions in both the streams are performed serially in the same thread.------ The polymorphic version of the binary operation '<>' of the 'Serial' type is--- 'serial'. We can use 'serial' to join streams in a sequential manner--- irrespective of the type of stream:------ >>> Stream.drain $ stream1 `Stream.serial` stream2--- 1--- 2--- 3--- 4------- $interleaved------ The 'Semigroup' operation '<>' of the 'WSerial' type combines the two--- streams in a /serial breadth first/ manner. We use the fromWSerial type--- combinator to effect 'WSerial' style of composition. We can also use the--- 'WSerial' type annotation for the stream to achieve the same effect.------ When two streams with multiple elements are combined in this manner, we--- traverse all the streams in a breadth first manner i.e. one action from each--- stream is performed and yielded to the resulting stream before we come back--- to the first stream again and so on.--- The following example prints the sequence 1, 3, 2, 4------ >>> stream1 = print 1 |: print 2 |: Stream.nil--- >>> stream2 = print 3 |: print 4 |: Stream.nil--- >>> Stream.drain $ Stream.fromWSerial $ stream1 <> stream2--- 1--- 3--- 2--- 4------ Even though the monadic actions of the two streams are performed in an--- interleaved manner they are all performed serially in the same thread.------ The polymorphic version of the 'WSerial' binary operation '<>' is called--- 'wSerial'. We can use 'wSerial' to join streams in an interleaved manner--- irrespective of the type, notice that we have not used the fromWSerial--- combinator in the following example:------ >>> Stream.drain $ stream1 `Stream.wSerial` stream2--- 1--- 3--- 2--- 4------ Note that this composition cannot be used to fold infinite number of streams--- since it requires preserving the state until a stream is finished.---- $monoid------ We can use 'Monoid' instances to fold a container of streams in the desired--- style using 'fold' or 'foldMap'.  We have also provided some fold utilities--- to fold streams using the polymorphic combine operations:------ * 'concatFoldableWith' is like 'fold', it folds a 'Foldable' container of--- streams using the given composition operator.--- * 'concatMapFoldableWith' is like 'foldMap', it folds like--- @concatFoldableWith@ but also maps a function before folding.--- * 'concatForFoldableWith' is like @concatMapFoldableWith@ but the container--- argument comes before the function argument.------ All of the following are equivalent:------ >>> :{--- traced = Stream.fromEffect . print--- main = do---  Stream.drain $ foldMap traced [1..10]---  Stream.drain $ Stream.concatFoldableWith Stream.serial (map traced [1..10])---  Stream.drain $ Stream.concatMapFoldableWith Stream.serial traced [1..10]---  Stream.drain $ Stream.concatForFoldableWith Stream.serial [1..10] traced--- :}------- $nesting------ Till now we discussed ways to apply transformations on a stream or to merge--- streams together to create another stream. We mentioned earlier that--- transforming a stream is similar to a @for@ loop in the imperative paradigm.--- We will now discuss the concept of a nested composition of streams which is--- analogous to nested @for@ loops in the imperative paradigm. Functional--- programmers call this style of composition a list transformer or @ListT@.--- Logic programmers call it a logic monad or non-deterministic composition,--- but for ordinary imperative minded people like me it is easier to think in--- terms of good old nested @for@ loops.------ $monad------ In functional programmer's parlance the 'Monad' instances of different--- 'IsStream' types implement non-determinism, exploring all possible--- combination of choices from both the streams. From an imperative--- programmer's point of view it behaves like nested loops i.e.  for each--- element in the first stream and for each element in the second stream--- execute the body of the loop.------ The 'Monad' instances of 'Serial', 'WSerial', 'Async' and 'WAsync'--- stream types support different flavors of nested looping.  In other words,--- they are all variants of list transformer.  The nesting behavior of these--- types correspond exactly to the way they merge streams as we discussed in--- the previous section.------- $regularSerial------ The 'Monad' composition of the 'Serial' type behaves like a standard list--- transformer. This is the default when we do not use an explicit type--- combinator. However, the 'fromSerial' type combinator can be used to switch to--- this style of composition. We will see how this style of composition works--- in the following examples.------ Let's start with an example with a simple @for@ loop without any nesting.--- For simplicity of illustration we are using streams of pure values in all--- the examples.  However, the streams could also be made of monadic actions--- instead.------ >>> :{--- Stream.drain $ do---     x <- Stream.fromFoldable [3,2,1]---     Stream.fromEffect $ print x--- :}--- 3--- 2--- 1------ As we can see, the code after the @fromFoldable@ statement is run three--- times, once for each value of @x@ drawn from the stream. All the three--- iterations are serial and run in the same thread one after another. In--- imperative terms this is equivalent to a @for@ loop with three iterations.------ We can write the console echo program that we wrote earlier using the monad--- instance:------ >>> :{--- main =---     Stream.drain $ do---         x <- Stream.repeatM getLine---         Stream.fromEffect $ putStrLn x--- :}------ When multiple streams are composed using this style they nest in a DFS--- manner:------ >>> :{--- Stream.drain $ do---   x <- Stream.fromFoldable [1,2]---   y <- Stream.fromFoldable [3,4]---   Stream.fromEffect $ print (x, y)--- :}--- (1,3)--- (1,4)--- (2,3)--- (2,4)------ i.e. inner loop iterations ((1,3), (1,4)) are executed before we proceed to--- the next iteration of the outer loop ((2,3), (2,4)). This behaves just like--- nested @for@ loops in imperative programming.------ Notice that this is analogous to merging streams of type 'Serial' or merging--- streams using 'serial'.---- $interleavedNesting------ The 'Monad' composition of 'WSerial' type interleaves the iterations of--- outer and inner loops in a nested loop composition.------ >>> :{--- Stream.drain $ Stream.fromWSerial $ do---      x <- Stream.fromFoldable [1,2]---      y <- Stream.fromFoldable [3,4]---      Stream.fromEffect $ print (x, y)--- :}--- (1,3)--- (2,3)--- (1,4)--- (2,4)------ Note that (2,3) is preferred to (1,4).  This works exactly the same way as--- the merging of two streams using 'wSerial' works.------ The fromWSerial type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'WSerial'.------- $monadExercise------ Streamly code is usually written in a way that is agnostic of the--- specific monadic composition type. We use a polymorphic type with a--- 'IsStream' type class constraint. When running the stream we can choose the--- specific mode of composition. For example take a look at the following code.------ >>> :{--- composed :: (Stream.IsStream t, Monad (t IO)) => t IO ()--- composed = do---     sz <- sizes---     cl <- colors---     sh <- shapes---     Stream.fromEffect $ print (sz, cl, sh)---     where---     sizes  = Stream.fromFoldable [1, 2, 3]---     colors = Stream.fromFoldable ["red", "green", "blue"]---     shapes = Stream.fromFoldable ["triangle", "square", "circle"]--- :}------ Now we can interpret this in whatever way we want:------ @--- main = Stream.'drain' $ Stream.'fromSerial'  $ composed--- main = Stream.'drain' $ Stream.'fromWSerial' $ composed--- main = Stream.'drain' $ Stream.'fromAsync'   $ composed--- main = Stream.'drain' $ Stream.'fromWAsync'  $ composed--- main = Stream.'drain' $ Stream.'fromParallel' $ composed--- @------  As an exercise try to figure out the output of this code for each mode of---  composition.---- $functor------ 'fmap' transforms a stream by mapping a function on all elements of the--- stream. 'fmap' behaves in the same way for all stream types, it is always--- serial.------ >>> (Stream.toList $ fmap show $ Stream.fromFoldable [1..10]) >>= print--- ["1","2","3","4","5","6","7","8","9","10"]------ Also see functions 'mapM' and 'sequence' from "Streamly.Prelude" module--- which can map actions concurrently depending on the type of the input stream.---- $applicative------ Applicative is precisely the same as the 'ap' operation of 'Monad'. For--- zipping applicatives separate types 'ZipSerial' and 'ZipAsync' are--- provided.------ The following is an example of 'Serial' applicative, it runs all iterations--- serially:------ >>> p n = Stream.fromEffect (print n) >> return n--- >>> s1 = p 1 <> p 2--- >>> s2 = p 3 <> p 4------ >>> (Stream.toList $ Stream.fromSerial $ (,) <$> s1 <*> s2) >>= print--- 1--- 3--- 4--- 2--- 3--- 4--- [(1,3),(1,4),(2,3),(2,4)]------ Similarly, 'WSerial' applicative runs the iterations in an interleaved--- order but being serial it too takes a total of 17 seconds:------ >>> (Stream.toList $ Stream.fromWSerial $ (,) <$> s1 <*> s2) >>= print--- 1--- 3--- 2--- 3--- 4--- 4--- [(1,3),(2,3),(1,4),(2,4)]---- $zipping------ Zipping is a special transformation where the corresponding elements of two--- streams are combined together using a zip function producing a new stream of--- outputs. Two different types are provided for serial and concurrent zipping.--- These types provide an applicative instance that can be used to lift--- functions to zip the argument streams.--- Also see the zipping functions in the "Streamly.Prelude" module.---- $serialzip------ The applicative instance of 'ZipSerial' type zips streams serially.--- 'fromZipSerial' type combinator can be used to switch to serial applicative--- zip composition:------ >>> p n = Stream.fromEffect (print n) >> return n--- >>> s1 = Stream.fromSerial $ p 1 <> p 2--- >>> s2 = Stream.fromSerial $ p 3 <> p 4--- >>> (Stream.toList $ Stream.fromZipSerial $ (,) <$> s1 <*> s2) >>= print--- 1--- 3--- 2--- 4--- [(1,3),(2,4)]------- $furtherReading------ * Read the concurrent streams tutorial--- * See the examples in <https://github.com/composewell/streamly-examples streamly-examples> repo.
+ docs/User/Explanatory/design.md view
@@ -0,0 +1,42 @@+## Design++### Design Goals++Our goals for [Streamly][] from the very beginning have been:++1. To achieve simplicity by unifying abstractions.+2. To offer high performance.++These goals are hard to achieve simultaneously because they are usually+inversely related.  We have spent many years trying to get the abstractions+right without compromising performance.++`Unfold` is an example of an abstraction that we have created to achieve+high performance when mapping streams on streams.  `Unfold` allows stream+generation to be optimized well by the compiler through stream fusion.+A `Fold` with termination capability is another example which modularizes+stream elimination operations through stream fusion.  Terminating folds+can perform many simple parsing tasks that do not require backtracking.+In Streamly, `Parser`s are a natural extension to terminating `Fold`s;+`Parser`s add the ability to backtrack to `Fold`s.  Unification leads+to simpler abstractions and lower cognitive overheads while also not+compromising performance.++### Concurrency Design++Streamly uses lock-free synchronization for achieving concurrent+operation with low overheads.  The number of tasks performed concurrently+are determined automatically based on the rate at which a consumer+is consuming the results. In other words, you do not need to manage+thread pools or decide how many threads to use for a particular task.+For CPU-bound tasks Streamly will try to keep the number of threads+close to the number of CPUs available; for IO-bound tasks it will utilize+more threads.++The parallelism available during program execution can be utilized with+very little overhead even where the task size is very small, because+Streamly will automatically switch between serial or batched execution+of tasks on the same CPU depending on whichever is more efficient.+Please see our [concurrency benchmarks][concurrency-benchmarks] for more+detailed performance measurements, and for a comparison with the `async`+package.
+ docs/User/Explanatory/monad-transformers.md view
@@ -0,0 +1,65 @@+# Monad Transformers++In the stream tutorials we mostly used streams in the IO monad.  In+general, the type `SerialT` is a monad transformer, @SerialT m a@+represents a stream of values of type 'a' in some underlying monad+'m'. For example, @SerialT IO Int@ is a stream of 'Int' in 'IO'+monad. Similarly, `SerialT Identity Int` would be a pure stream+equivalent to `[a]`.++Similarly we have monad transformer types for other stream types as well+viz.  'WSerialT', 'AsyncT', 'WAsyncT' and 'ParallelT'.++To lift a value from an underlying monad in a monad transformer stack into a+singleton stream use 'lift' and to lift from an IO action use 'liftIO'.++```+>>> import Control.Monad.IO.Class (liftIO)+>>> Stream.drain $ liftIO $ putStrLn "Hello world!"+Hello world!++>>> import Control.Monad.Trans.Class (MonadTrans(lift))+>>> Stream.drain $ lift $ putStrLn "Hello world!"+Hello world!+```++## Using Monad Transformers++Common monad transformers can be used with streamly serial streams, without any+issues. `ReaderT` can be used with concurrent streams as well without any+issues.++The semantics of monads other than `ReaderT` with concurrent streams are+not yet finalized and will change in future, therefore, as of now they are not+recommended to be used with concurrent streams.++## Ordering of Monad Transformers++In most cases it is a good idea to keep streamly as the top level monad.+[This+example](https://github.com/composewell/streamly-examples/blob/master/examples/ControlFlow.hs)+demonstrates how various control flow modifying monads can be combined+with streamly stream monads.++## State Sharing+### Serial Applications++Read only global state can always be shared using the `Reader` monad.+Read-write global state can be shared either using an `IORef` in the `Reader`+monad or using the `State` monad.++See `AcidRain.hs` example for a usage of `StateT` in the serially executing+portion of the program.++### Concurrent Applications++The current recommended method for sharing modifiable global state across+concurrent tasks is to put the shared state inside an `IORef` in a `Reader`+monad or just share the `IORef` by passing it to the required functions. The+`IORef` can be updated atomically using `atomicModifyIORef`.++The `CirclingSquare.hs` example shares an `IORef` across parallel tasks.++## See also++* [Examples of control flow monads with Streamly](https://github.com/composewell/streamly-examples/blob/master/examples/ControlFlow.hs)
+ docs/User/Explanatory/performance-benchmarks.md view
@@ -0,0 +1,7 @@+# Performance++Streamly is highly optimized for performance, it is designed for+high performing, concurrent and scalable applications. Please see the+[streaming-benchmarks](https://github.com/composewell/streaming-benchmarks)+package for microbencmarks measuring the performance of streamly and comparing+it with other streaming libraries.
+ docs/User/Explanatory/streaming-pradigms.rst view
@@ -0,0 +1,117 @@+Streaming Paradigms+-------------------++There are two dual paradigms for stream processing in Haskell. In the first+paradigm we represent a stream as a data type and use functions to work on it.+In the second paradigm we represent *stream processors* as data types and+provide them individual data elements to process, there is no explicit+representation of the stream as a data type. In the first paradigm we work with+data representation and in the second paradigm we work with function+representations. Both of these paradigms have equal expressive power. The+latter uses the monadic composition for data flow whereas the former does not+need monadic composition for straight line stream processing and therefore can+use it for higher level composition e.g.  to compose streams in a product+style.++To see an example of the first paradigm, let us use the ``vector`` package to+represent a monadic stream of integers as ``Stream IO Int``. This data+representation of stream is passed explicitly to the stream processing+functions like ``filter`` and ``drop`` to manipulate it::++  import qualified Data.Vector.Fusion.Stream.Monadic as S++  stream :: S.Stream IO Int+  stream = S.fromList [1..100]++  main =  do+    let str = (S.filter even . S.drop 10) stream+    toList str >>= putStrLn . show++Pure lists and vectors are the most basic examples of streams in this paradigm.+The streaming IO libraries just extend the same paradigm to monadic streaming.+The API of these libraries is very much similar to lists with a monad parameter+added.++The second paradigm is direct opposite of the first one, there is no stream+representation in this paradigm, instead we represent *stream processors* as+data types. A stream processor represents a particular process rather than+data, and we compose them together to create composite processors. We can call+them stream transducers or simply pipes. Using the ``machines`` package::++  import qualified Data.Machine as S++  producer :: S.SourceT IO Int+  producer = S.enumerateFromTo 1 100++  main =  do+    let processor = producer S.~> S.dropping 10 S.~> S.filtered even+    S.runT processor >>= putStrLn . show++Both of these paradigms look almost the same, right? To see the difference+let's take a look at some types. In the first paradigm we have an explicit+stream type and the processing functions take the stream as input and produce+the transformed stream::++  stream :: S.Stream IO Int+  filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a++In the second paradigm, there is no stream data type, there are stream+processors, let's call them boxes that represent a process.  We have a+*SourceT* box that represents a singled ended producer and a *Process* box or a+pipe that has two ends, an input end and an output end, a ``MachineT``+represents any kind of box. We put these boxes together using the ``~>``+operator and then run the resulting machine using ``runT``::++  producer :: S.SourceT IO Int+  filtered :: (a -> Bool) -> Process a a+  dropping :: Int -> Process a a+  (~>) :: Monad m => MachineT m k b -> ProcessT m b c -> MachineT m k c++Custom pipes can be created using a Monadic composition and primitives to+receive and send data usually called ``await`` and ``yield``.++.. |str| replace:: `streamly <https://github.com/composewell/streamly>`__+++-----------------------------------------------------------------------------++| Streaming libraries using the direct paradigm.                              |++------------------------+----------------------------------------------------++| Library                | Remarks                                            |++========================+====================================================++| vector                 | The simplest in this category, provides            |+|                        | transformation and combining of monadic            |+|                        | streams but no monadic composition of streams.     |+|                        | Provides a very simple list like API.              |++------------------------+----------------------------------------------------++| streaming              | * Encodes a return value to be supplied when the   |+|                        |   stream ends. The monad instance passes on the    |+|                        |   streams and combines the return values.          |+|                        | * Functor general                                  |+|                        | * The API is more complicated than vector because  |+|                        |   of the return value and the functor layer.       |++------------------------+----------------------------------------------------++| list-t                 | Provides straight line composition of streams      |+|                        | as well as a list like monadic composition.        |+|                        | The API is simple, just like ``vector``.           |++------------------------+----------------------------------------------------++|                        | Like list-t, in addition to straight line          |+|                        | composition it provides a list like monadic        |+|                        | composition of streams, supports combining streams |+|                        | concurrently supports concurrent applicative and   |+|                        | monadic composition.                               |+| |str|                  | The basic API is very much like lists and          |+|                        | almost identical to ``vector`` streams.            |++------------------------+----------------------------------------------------++++-----------------------------------------------------------------------------++| Streaming libraries using the pipes paradigm.                               |++------------------------+----------------------------------------------------++| Library                | Remarks                                            |++========================+====================================================++| conduit                | ``await`` and ``yield`` data to upstream or        |+|                        | downstream pipes; supports pushing leftovers back. |++------------------------+----------------------------------------------------++| pipes                  | ``await`` and ``yield`` data to upstream or        |+|                        | downstream pipes                                   |++------------------------+----------------------------------------------------++| machines               | Can await from two sources, left and right.        |++------------------------+----------------------------------------------------+
+ docs/User/Explanatory/streams.md view
@@ -0,0 +1,88 @@+# Stream Fusion++The fused 'Stream' type employs stream fusion for C-like performance when+looping over data. It represents the stream as a state machine using an+explicit state, and a step function working on the state. A typical stream+operation consumes elements from the previous state machine in a stream+pipeline, transforms the elements and yields new values for the next stage to+consume. One stream operation typically represents one stage of a modular+pipeline, representing a single task, stages in the pipeline have no knowledge+of the state of the previous or next stage.++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 (like a for or while loop) processing the stream+elements. Elements are transferred between stages using a boxed data+constructor. However, all the stages of the pipeline are "fused" together by+GHC, eliminating the boxing of intermediate constructors, and thus forming a+tight C like loop without any boxed data being used in the loop.++Stream fusion works effectively when:++* the stream pipeline is composed statically (known at compile time)+* all the operations forming the loop are inlined+* the loop is not recursively defined, recursion breaks inlining++If these conditions cannot be met, the CPS style stream type 'StreamK' may+turn out to be a better choice than the fused stream type 'Stream'.++## Stream vs StreamK++The fused stream model avoids constructor allocations and function call+overheads. However, the stream is represented as a state machine, and to+generate stream elements it has to navigate the decision tree of the state+machine. Moreover, the state machine is cranked for each element in the stream.+This performs extremely well when the number of states are limited. The state+machine starts getting expensive as the number of states increase. For example,+generating a stream from a list requires a single state and is very efficient,+even if it has millions of elements, there is only one state machine. However,+using 'cons' to construct a million element stream would be a disaster because+it is statically fusing a million state machines.++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, much faster than a CPS style stream because CPS involves a+function call for each element whereas fused stream involves a few+conditional branches in the state machine. However, constructing a large+stream using `cons` introduces as many states in the state machine as the+number of elements. If we compose `cons` as a balanced binary tree it will+take @n * log n@ time to navigate the tree, and @n * n@ if it is a right+associative composition.++Operations like 'cons' or 'append' are typically recursively called to+construct a lazy infinite stream. For such use cases the CPS style 'StreamK'+should be used. CPS streams do not use an explicit state machine that needs to be+cranked for each element, past state has no effect on the future element+processing. However, CPS incurs a function call overhead for each element+processed, the overhead could be large compared to a fused state machine+even if it has many states. However, because of its linear performance+characteristics, after a certain threshold of stream compositions the CPS+stream would perform much better than the quadratic fused stream operations.++As a general guideline, you need to use 'StreamK' when you have to use+'cons', 'append' or other operations having quadratic complexity at a large+scale. Typically, in such cases you need to compose the stream recursively,+by calling an operation in a loop. The decision to compose the stream is+taken at run time rather than statically at compile time.++Typically you would compose a 'StreamK' of chunks of data so that the StreamK+function call overhead is mitigated, and then process each chunk using 'Stream'+type operations by using statically fused stream pipeline operations on the+chunks.++'Stream' and 'StreamK' types can be interconverted. See+"Streamly.Data.StreamK" module for conversion operations.++## Fold Fusion++Folds support stream fusion for generating loops comparable to the speed of+C. However, it has some limitations. For fusion to work, the folds must be+inlined, folds must be statically known and not generated dynamically, folds+should not be passed recursively.++Another limitation is due to the quadratic complexity causing slowdown when+too many nested compositions are used. Especially, the performance of the+Applicative instance and splitting operations (e.g. 'splitWith') degrades+quadratically (O(n^2)) when combined @n@ times, roughly 8 or less sequenced+operations are fine. For these cases folds can be converted to parsers and+then used as ParserK.
+ docs/User/Explanatory/unified-abstractions.md view
@@ -0,0 +1,318 @@+# Unified Functional Abstractions in Streamly++The goal of Streamly is to provide unified abstractions with high+performance.  The basic abstractions in Streamly are streams and arrays+and yet it provides the functionality of many packages in the Haskell+ecosystem.++This document discusses the related packages in the Haskell ecosystem+and how streamly unifies, overlaps, or compares with those. We provide+simple code snippets for illustrations, for a better overview of the+library please see the [Streamly Quick Overview](/docs/User/Tutorials/learn-by-examples.md) document.++## Existing Haskell Libraries++In the Haskell ecosystem effectful streaming functionality is provided+by several streaming libraries e.g. `streaming`, nested looping by list+transformers e.g. `list-t`, interleaved scheduling by `logict`,+concurrency by `async`, time-domain programming by FRP libraries like+`Yampa` and `reflex`, and array functionality by `bytestring`, `text`,+`vector`, and `arrays` packages.++For basic programming needs, one needs to discover and learn all of+these or roll something on their own. These libraries have evolved+independently for specialized needs. They are not designed with a big+picture in mind to eliminate duplicate functionality and to come up with+the most optimal abstractions on the whole. For example, there is no+reason why streaming, list-t, and logict cannot be provided by the same+implementation. Concurrency and reactive programming also naturally fit+with the streaming model and can be unified. `Bytestring`, `text`,+`vector`, and `arrays` all provide the same functionality which can+be unified under one umbrella of arrays. Moreover, there are many+of flavors some of these packages like lazy bytestring, Char8 bytestrings,+lazy text which can be eliminated by using streams instead.++On the performance side, existing streaming libraries lack stream fusion+leading to a function call overhead in each iteration of the loop,+therefore, providing orders of magnitude lower performance in tight+loops compared to writing a monolithic loop by hand. Similarly, `logict`+shows quadratic performance characteristics in some basic use cases.+These problems are solved by Streamly.++## How Streamly Unifies them?++Streamly unifies streaming, nested looping, scheduling, concurrency,+time, and array functionality using two basic constructs, namely streams+and arrays. Streams provide efficient, immutable, composable serial+processing capabilities for in-flight data, whereas arrays provide+efficient storage, mutability, and random access for data at rest.++Streamly builds all the functionality on top of these two building+blocks. It takes a big picture view of programming in general and+provides well-integrated APIs with the same look and feel. Moreover,+performance is a primary goal of streamly, all the functionality is+built for performance comparable to C.++Streamly streams are like lists and provide non-determinism just like+lists.  Streamly also adds asynchronicity and concurrency to+streaming composition.  This seemingly simple change unifies several+disparate abstractions into one powerful, concise, and elegant+abstraction.  A wide variety of programming problems can be solved+elegantly with this abstraction. In particular, it unifies three major+programming domains namely non-deterministic (logic) programming,+concurrent programming, and functional Reactive programming.++## Streaming++The basic, bare-bones functionality of Streamly is processing streams of+data.  In simple terms, stream processing is the functional equivalent+of loops in imperative programming.++Like Haskell lists, `vector`, and `streaming` packages, Streamly composes+streams of data rather than stream processor functions as in other+streaming libraries like `pipes` and `machines`. This makes the types+and API very simple and is very similar to Haskell lists which is+familiar to everyone. The fundamental difference is that Streamly adds+concurrency support but the good thing is that it does not change the+API.++This simple console echo program shows the simplicity of Streamly API+and its similarity with the list API:++```haskell unshared+import Data.Function ((&))+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++echo =+      Stream.repeatM getLine+    & Stream.mapM putStrLn+    & Stream.fold Fold.drain+```++Streamly uses dual representation for streams. On top it uses Scott+encoded CPS streams which provide a way to incrementally construct and+append streams efficiently. Under the good, for tight loops, Streamly+uses a vector-like stream representation which is amenable to+`case-of-case` and `SPEC constructor` optimizations by GHC resulting in+low-level code having performance comparable to C.++To further understand the similarity with list API, please see [Streamly vs.+lists](/docs/User/HowTo/streamly-vs-lists.md).+For comparison of Streamly performance with other libraries see+[streaming benchmarks](https://github.com/composewell/streaming-benchmarks).++## Non-determinism++Roughly speaking, non-determinism is a fancy term that functional+programmers use for what you call nested loops in imperative+programming. List transformers are the basic implementations for+non-determinism.++You can use `Streamly.Data.Stream.MkType` to create a custom type and specify+the behaviour of non-determinism. The basic `concatMap` would result in a+list-transformer with behavior similar to the list monad. It provides the+functionality provided by `list-t` or `logict` packages for free.  Here is an+example of nested looping using the new type:++```haskell+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}++import Streamly.Data.Stream.Prelude (Stream, MonadAsync)+import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Data.StreamK as StreamK+import Streamly.Data.Stream.MkType++bindSerial :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+bindSerial = flip Stream.concatMap+$(mkCrossType "CrossT" "bindSerial" False)++loopsCross :: Stream IO ()+loopsCross = unCrossT $ do+    x <- CrossT $ Stream.fromList [1,2]+    y <- CrossT $ Stream.fromList [3,4]+    CrossT $ Stream.fromEffect $ print (x, y)+```++`Streamly.Data.Stream.CrossStream` and `Streamly.Data.StreamK.CrossStreamK`+provide the same functionality as `CrossT` type created above.++Moreover, the list transformer in Streamly can be concurrent. The Scott+encoding of streams also avoids the quadratic performance issue of+`logict`.++## Scheduling Behaviors++When we execute a stream or combine two streams, the actions in the+stream need to be scheduled for execution.  Existing streaming libraries+are limited to just one form of scheduling of actions in the stream+which is serial execution. Streamly provides several ways of scheduling+the actions in the stream. The good thing is the API does not change, we+just need to use a combinator or a different type to change the+scheduling behavior.++In a single stream, the actions in the stream can be executed+concurrently with different concurrent scheduling behaviors.  Two or+more streams can be combined in several ways. For example, the actions+from two streams being combined can be interleaved.  Similarly, streams+can be interleaved with concurrent execution providing a fair,+concurrent round-robin scheduling of streams.++The monad instance provides a convenient way to combine streams in+different ways. It is just non-determinism with different flavors of+scheduling behavior. The scheduling behavior can be controlled as follows.++```haskell+bindWSerialK = StreamK.bfsConcatFor+bindWSerial a f = StreamK.toStream $ bindWSerialK (StreamK.fromStream a) (StreamK.fromStream . f)+$(mkCrossType "WSerialT" "bindWSerial" True)++loopsWSerial :: Stream IO ()+loopsWSerial = unWSerialT $ do+    x <- WSerialT $ Stream.fromList [1,2]+    y <- WSerialT $ Stream.fromList [3,4]+    WSerialT $ Stream.fromEffect $ print (x, y)+```++Scheduling is fundamental to expressing many common programming problems+in an idiomatic functional manner.  One example application of+interleaving is breadth-first search mechanism for logic programming.+Please see [mini kanren implementation using streamly](https://github.com/composewell/ds-kanren).++## Declarative Concurrency++The same combinators that are used for serial streams e.g. 'unfoldrM',+'replicateM', 'repeatM' work concurrently when used at the appropriate type.++There are several concurrent combinators in streamly which are prefixed with+`par`. These combinators fit into the default composition very cleanly.+It allows concurrent programs to be written declaratively and composed+idiomatically. They are not much different than serial programs.  See+[Streamly vs async](/docs/User/HowTo/streamly-vs-async.md)+for a comparison of Streamly with the `async` package.++Streamly provides concurrent scheduling and looping similar to to+[OpenMP](https://en.wikipedia.org/wiki/OpenMP) and+[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative+style.  The list transformer example can be run with concurrent+execution of loop iterations as follows:++```haskell+bindAhead :: MonadAsync m => Stream m a -> (a -> Stream m b) -> Stream m b+bindAhead = flip (Stream.parConcatMap (Stream.ordered True))+$(mkCrossType "AheadT" "bindAhead" True)++loopsAhead :: Stream IO ()+loopsAhead = unAheadT $ do+    x <- AheadT $ Stream.fromList [1,2]+    y <- AheadT $ Stream.fromList [3,4]+    AheadT $ Stream.fromEffect $ print (x, y)+```++And interleaving with concurrent execution of the loop iterations can be+written like this:++```haskell+bindWAsync :: MonadAsync m => Stream m a -> (a -> Stream m b) -> Stream m b+bindWAsync = flip (Stream.parConcatMap (Stream.interleaved True))+$(mkCrossType "WAsyncT" "bindWAsync" True)++loopsWAsync :: Stream IO ()+loopsWAsync = unWAsyncT $ do+    x <- WAsyncT $ Stream.fromList [1,2]+    y <- WAsyncT $ Stream.fromList [3,4]+    WAsyncT $ Stream.fromEffect $ print (x, y)+```++All this comes with no change in the streaming APIs.++## Reactive Programming++The combination of non-determinism, concurrency, and streaming makes+Streamly a strong reactive programming library as well. Reactive+programming fundamentally deals with streams of events that can be+processed concurrently. The [Acid Rain][AcidRain.hs] and+[Circling Square][CirclingSquare.hs]+examples demonstrate the basic reactive capability of Streamly.++In core concepts, Streamly is strikingly similar to `dunai`.  `dunai` was+designed from a FRP perspective and Streamly was originally designed+from a concurrency perspective. However, both have similarities at the+core.++## Arrays++Streamly provides immutable, mutable, pinned, unpinned, boxed, and+unboxed arrays with streaming interfaces.  The combination of efficient+streaming and polymorphic arrays lets it express the functionality of+`bytestring` and `text` packages as special cases of arrays with no loss+of performance. Since we can use explicit streaming, the lazy versions+of `bytestring` and `text` are not required.++## Conclusion++Streamly, provides effectful streams, with a simple API, almost+identical to standard lists, and in-built support for concurrency.+By using stream-style combinators on stream composition, streams can be+generated, merged, chained, mapped, zipped, and consumed concurrently –+providing a generalized high-level programming framework unifying+streaming and concurrency. Controlled concurrency allows even infinite+streams to be evaluated concurrently.  Concurrency is auto-scaled based+on feedback from the stream consumer.++Streamly is a programmer-first library, designed to be useful and+friendly to programmers for solving practical problems in a simple and+concise manner. Some key points that Streamly stresses are:++* _Simplicity_: Simple list like streaming API, if you know how to use lists+  then you know how to use Streamly. This library is built with simplicity+  and ease of use as a design goal.+* _Concurrency_: Simple, powerful, and scalable concurrency.  Concurrency is+  built-in, and not intrusive, concurrent programs are written exactly+  as non-concurrent ones.+* _Generality_: Unifies functionality provided by several disparate packages+  (streaming, concurrency, list transformer, logic programming, reactive+  programming) in a concise API.+* _Performance_: Streamly is designed for high performance. It employs stream+  fusion optimizations for the best possible performance. Serial performance is+  equivalent to the venerable `vector` library in most cases and even better+  in some cases.  Concurrent performance is unbeatable.  See+  [streaming-benchmarks](https://github.com/composewell/streaming-benchmarks)+  for a comparison of popular streaming libraries on micro-benchmarks.++## Appendix++Streamly unifies the functionality overlapping the following Haskell+libraries:++### Streaming++* [vector](https://hackage.haskell.org/package/vector)+* [streaming](https://hackage.haskell.org/package/streaming)+* [pipes](https://hackage.haskell.org/package/pipes)+* [conduit](https://hackage.haskell.org/package/conduit)++### List Transformers and Logic Programming++* [pipes](https://hackage.haskell.org/package/pipes)+* [list-t](https://hackage.haskell.org/package/list-t)+* [logict](https://hackage.haskell.org/package/logict)++### Concurrency++* [async](https://hackage.haskell.org/package/async)++### Reactive Programming++* [Yampa](https://hackage.haskell.org/package/Yampa)+* [reflex](https://hackage.haskell.org/package/reflex)++### Arrays++* [vector](https://hackage.haskell.org/package/vector)++<!-- Markdown Links -->++[AcidRain.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/AcidRain.hs+[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/CirclingSquare.hs
+ docs/User/HowTo/Compiling.md view
@@ -0,0 +1,151 @@+# Build Guide++## Building++### Compiler (GHC) Versions++1. Do not use ghc 8.2 or earlier because in those versions it is not+   safe to pass heap allocated objects to unsafe FFI calls. We depend on this+   for array implementation.+2. Do not use ghc 9.0.x and 9.2.1 becuse of performance issues. GHC 9.6.x may+   have a small memory leak issue in some concurrent stream cases,+   see below for more details. ghc 9.10 shows significant performance+   degradations, should not be used until it is fixed.++For best performance, use `fusion-plugin` (see below) when compiling.++### Memory requirements++Building streamly itself may require upto 4GB memory. Depending on the+size of the application you may require 1-16GB memory to build. For most+applications up to 8GB of memory should be sufficient.++To reduce the memory footprint you may want to break big modules+into smaller ones and reduce unnecessary INLINE pragmas on large+functions. You can also use the `-Rghc-timing` GHC option to report the+memory usage during compilation.++See the "Build times and space considerations" section below for more+details.++### GHC Plugin for Stream Fusion++Streamly usually performs very well without any compiler plugins.+However, we have fixed some deficiencies in GHC's optimizer using a+[compiler plugin](https://github.com/composewell/fusion-plugin).  We+hope to fold these optimizations into GHC in the future; until then we+recommend that you use this plugin for applications that are performance+sensitive.++### Compilation Options++#### Recommended Options++Add `fusion-plugin` to the `build-depends` section of your program in+the cabal file and use the following GHC options:++```+  -O2+  -fdicts-strict+  -fmax-worker-args=16+  -fspec-constr-recursive=16+  -fplugin Fusion.Plugin+```++See [Explanation](#explanation) section for details about these flags.++Important Notes:++1. [fusion-plugin](https://hackage.haskell.org/package/fusion-plugin) can+   improve performance significantly by better stream fusion, in many+   cases. If the performance regresses due to fusion-plugin please open+   an issue.  You may remove the `-fplugin` option for regular builds+   but it is recommended for deployment builds and performance+   benchmarking.+2. In certain cases it is possible that GHC takes too long to compile+   with `-fspec-constr-recursive=16`, if that happens please reduce the+   value or remove that option. This may happen especially when using Parsers.++#### Explanation++* `-fdicts-strict` is needed to avoid [a GHC+issue](https://gitlab.haskell.org/ghc/ghc/issues/17745) leading to+memory leak in some cases. In GHC 9.6.x this issue cannot be avoided+even with `-fdicts-strict` option.++* `-fspec-constr-recursive` is needed for better stream fusion, it+allows the `SpecConstr` optimization to occur in more cases. Large+values used with this flag may lead to huge compilation times and code+bloat, if that happens please avoid it or use a lower value (e.g. 3 or+4).++* `-fmax-worker-args` is needed for better stream fusion, it allows the+`SpecConstr` optimization to occur in some important cases.++* `-fplugin=Fusion.Plugin` enables predictable stream fusion+optimization in certain cases by helping the compiler inline internal+bindings, therefore, enabling case-of-case optimization. In some cases,+it can make a difference of 5-10x better performance.++### Multi-core Parallelism++Concurrency without a threaded runtime may be a bit more efficient. Do not use+threaded runtime unless you really need multi-core parallelism. To get+multi-core parallelism use the following GHC options:++  `-threaded -with-rtsopts "-N"`++## Platform Specific Features++Streamly supports Linux, macOS and Windows operating systems. Some+modules and functionality may depend on specific OS kernel features.+Features/modules may get disabled if the kernel/OS does not support it.++### Linux++File system events notification module is supported only for kernel versions+2.6.36 onwards.++### macOS++File system events notification module supports macOS 10.7+ . You must+have the ``Cocoa`` framework installed which is supplied by the macOS+SDK.  If ``Cocoa`` is not installed, you may see an error like this:++```+error: ld: framework not found Cocoa+```++#### cabal build++Usually, if you have a working GHC you would already have the SDK+installed. See the documentation of `Xcode` or `xcode-select` tool for+more details.++#### Nix build++Please note that `cabal2nix` may not always be able to generate a complete nix+expression on `macOS`. See [this+issue](https://github.com/NixOS/cabal2nix/issues/470).++You may need to add ``nixpkgs.darwin.apple_sdk.frameworks.Cocoa``+to ``librarySystemDepends``. For example, to create a streamly-0.9.0+derivation from Hackage:++```+  streamly =+    nixpkgs.haskell.lib.overrideCabal+        (+          super.callHackageDirect+            { pkg = "streamly";+              ver = "0.9.0";+              sha256 = "sha256-eOxVb8qQjZDo1+S7CStqYSExOg2QHWkMY+zlOYqwZak=";+            } {}+        )+        (old:+          { librarySystemDepends =+              if nixpkgs.lib.strings.hasInfix "darwin" builtins.currentSystem+              then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]+              else [];+          });+```
+ docs/User/HowTo/faq.md view
@@ -0,0 +1,101 @@+# Frequently Asked Questions++This document provides idioms or examples to solve common programming+problems using streamly. To start with please go through the [Learn By+Examples](/docs/User/Tutorials/learn-by-examples.md) page and [`Examples Package`](https://github.com/composewell/streamly-examples).+This document provides additional examples.++## Distribute and Zip Concurrently++Transform a stream in multiple ways, generating multiple transformed+streams and then zip the corresponding elements of each resulting stream+together to create a single transformed stream.++Distributing a value to a stream of consumers concurrently:++```haskell docspec+>>> :set -XFlexibleContexts+>>> import Data.Function ((&))+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Stream.Prelude as Stream++>>> :{+f1 x =+    Stream.fromList [return . (+ 1), return . (+ 2)] -- Stream of functions+        & fmap ($ x)                                 -- Stream of lazy actions+        & Stream.parSequence (Stream.ordered True)   -- Evaluate concurrently+        & Stream.fold Fold.toList                    -- Fold to list+:}+```++Use `parZipWith` to zip streams concurrently. Here, we zip three singleton+streams:++```haskell docspec+>>> :{+f2 x =+  let app = Stream.parZipWith id ($)+  in (,,)+      `fmap` Stream.fromEffect (return $ show x)+      `app`  Stream.fromEffect (return $ x + 1)+      `app`  Stream.fromEffect (return $ fromIntegral x / 2)+  & Stream.fold Fold.one+:}+```++Applying a function concurrently to your input stream:++```haskell docspec+>>> :{+g f xs =+  Stream.fromList xs+    & Stream.parMapM (Stream.ordered True) f+    & Stream.fold Fold.toList+:}+```++You can now use the concurrent map to pipe each element through multiple+transformations using the distribute/zip operations.++```haskell docspec+>>> g f1 [1,2,3,4::Int]+[[2,3],[3,4],[4,5],[5,6]]++>>> g f2 [1,2,3,4::Int]+[Just ("1",2,0.5),Just ("2",3,1.0),Just ("3",4,1.5),Just ("4",5,2.0)]+```++Instead of using `parZipWith` directly, you can use `mkZipType` to+create a zip Applicative newtype so that you can use the `Applicative`+instance.++```haskell+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}++import Control.Monad.Trans.Control (MonadBaseControl)+import Streamly.Data.Stream.Prelude (MonadAsync, Stream)+import qualified Streamly.Data.Stream.Prelude as Stream+import Streamly.Data.Stream.MkType++app :: MonadAsync m => Stream m (a -> b) -> Stream m a -> Stream m b+app = Stream.parZipWith id ($)+$(mkZipType "ZipConcurrent" "app" True)+```++## Sliding Window++The `createOfLast` fold can be used to create a stream of sliding windows.++```haskell docspec+>>> :set -Wno-deprecations+>>> import qualified Streamly.Data.Array as Array+>>> :{+  Stream.fromList [1,2,3,4,5::Int]+& Stream.scan (Array.createOfLast 2)+& Stream.fold Fold.toList+:}+[fromList [],fromList [1],fromList [1,2],fromList [2,3],fromList [3,4],fromList [4,5]]+```++Also see the "Streamly.Internal.Data.Fold.Window" module for widnow based folds.
+ docs/User/HowTo/interoperation.md view
@@ -0,0 +1,11 @@+# Interoperation with streaming libraries++We can use `unfoldr` and `uncons` operations to convert one streaming+type to another. See the following interoperation examples in the+[streamly-examples](https://github.com/composewell/streamly-examples)+repository.++* [Interoperation with `streaming`](https://github.com/composewell/streamly-examples/blob/master/examples/Interop/Streaming.hs)+* [Interoperation with `pipes`](https://github.com/composewell/streamly-examples/blob/master/examples/Interop/Pipes.hs)+* [Interoperation with `conduit`](https://github.com/composewell/streamly-examples/blob/master/examples/Interop/Conduit.hs)+* [Interoperation with `vector`](https://github.com/composewell/streamly-examples/blob/master/examples/Interop/Vector.hs)
+ docs/User/HowTo/optimizing.md view
@@ -0,0 +1,583 @@+# Haskell Streamly Optimization Guide++See also the streamly developer's optimization guide.++## When to Optimize?++Focus on performance only where it truly matters. Avoid optimizing+everything blindly—concentrate on the *fast path* or the parts of the+code that run most frequently. Optimizing rarely executed code offers+little benefit and can introduce unnecessary complexity. Prioritize the+hot spots where performance gains will have the greatest impact.++It’s important to be deliberate and informed about what to+optimize. Many developers fall into the trap of over-optimizing+unimportant code, while overlooking bottlenecks that actually impact+performance. Strive to profile first, understand the real costs, and+then optimize where it makes a measurable difference.++## Loop Optimizations: Stream Fusion++A "closed loop" is any streamly code that generates a stream using+unfold (or conceptually any stream generation combinator) and ends+up eliminating it with a fold (conceptually any stream elimination+combinator). It is essentially a loop processing multiple elements in+a stream sequence, just like a `for` or `while` loop in imperative+programming.++Closed loops are synthesized in a modular fashion by stream generation,+transformation and elimination combinators in streamly. Combinators+transfer data to the next stream pipeline stage using data constructors.+These data constructors are eliminated by the compiler using `stream+fusion` optimizations, generating a very efficient loop. Streamly is designed+to utilize the stream fusion opitmization to the fullest such that the loops+are highly optimized providing similar performance as hand written C.++### Fusion Plugin++Stream fusion optimization depends on proper inlining of the combinators+involved. To take full advantage of stream fusion in streamly you should+compile your code with the `fusion-plugin` enabled. The fusion-plugin+package fills the gaps for several optimizations that GHC does not+perform automatically. It automatically inlines the internal definitions+that involve the constructors we want to eliminate. In some cases+fusion-plugin may not help and programmer may have to annotate the code+manually for complete fusion.++In the following sections we mention some of the cases where programmer+annotation may help in stream fusion.++### INLINE Annotations++It can be helpful to add `INLINE` annotations to intermediate functions+involved in a closed loop. In some cases, you may also need to specify+an `INLINE` phase, as discussed in the following sections.++As a rule of thumb, any function that takes `Stream`, `Fold`, or+`Unfold` types as arguments — or returns these types — should be+inlined.++GHC typically uses three inline phases:++- **Phase 2** (the earliest),+- **Phase 1**, and+- **Phase 0** (the latest).++Inlining can be controlled with phase-specific annotations like:+``` haskell+{-# INLINE [1] functionName #-}+```+to guide when inlining occurs during compilation.++### Early INLINE++Generally, you only have to inline the combinators or functions+participating in a loop and not the whole loop itself.  But sometimes+you may want to inline the whole loop itself inside a larger+function. In most cases you can just add an INLINE pragma on+the function containing the loop. But you may need some special+considerations in some (not common) cases.++In some cases you may have to use INLINE[2] instead of INLINE which+means inline the function early in phase-2.  This may sometimes be+needed on the because the performance of several combinators in streamly+depends on getting inlined in phase-2 and if you use a plain `INLINE`+annotation GHC may decide to delay the inlining in some cases. This is+not very common but may be needed sometimes. Perhaps GHC can be fixed or+we can resolve this using fusion-plugin in future.++### Delayed INLINE++When a function is passed to a higher order function e.g. a function+passed to `concatMap` or `unfoldMany` then we want the function to be+inlined after the higher order is inlined so that proper fusion of the+higher order function can occur. For such cases we usually add INLINE[1]+on the function being passed to instruct GHC not to inline it too early.++## Chunked Processing (Inner and Outer Loops)++Processing data in larger chunks can significantly reduce loop overhead+by minimizing the number of iterations. Chunked processing enables the+inner loop to run more efficiently through stream fusion—reducing+heap allocations, improving cache locality, minimizing branching, and+enhancing opportunities for vectorization.++In libraries like *streamly*, this can be achieved by streaming arrays+and applying a fused operation to each array—either using built-in+combinators or writing custom logic per chunk. Whether the **outer+loop** is fused or not is usually less important, so you can choose+either the fused `Stream` type or the more flexible CPS-based `StreamK`+type.++However, for the **inner loop**, fusion is more critical, especially+when it runs frequently. To achieve this, you should prefer using+`Unfold` or fused `Stream` operations for chunk processing. Likewise, on+the consumer side, it's recommended to use the fused `Fold` or `Parser`+types to maintain performance.++This chunking strategy is especially effective in performance-critical+applications, such as numerical computing or high-throughput data+processing.++## When Fusion Matters++In stream processing, **fusion is most important in inner loops**—the+parts of your program that run most frequently. Outer loops, which are+executed less often, can afford to use non-fused combinators without+significant performance penalties.++Some operations in Streamly explicitly break fusion. These are clearly+annotated in the documentation. It's best to place such fusion-breaking+operations in the outer loop to keep the fast path—the inner+loop—fully fused and efficient.++That said, breaking fusion doesn't always have a noticeable performance+impact. The cost is primarily proportional to the number of loop+iterations. For example:++- A stream of 1,000 items, each 1KB in size, will likely show negligible+impact from a fusion break.+- A stream of 1 million items, each just 1 byte, will suffer+significantly—even though the total data volume is the same—because+the loop runs far more times.++This overhead arises from copying intermediate structures when fusion is+broken. The more iterations, the greater the cumulative cost.++In imperative programming, it's easier to see this: the loop body+is explicit, and the number of iterations is obvious. In stream+abstractions, however, the loop is hidden, making it harder to notice+when fusion matters.++Think of a fused stream as a **superhighway** for data processing. A+fusion break is like a **toll booth** or **junction** where each item+pays a small tax. Whether that toll matters depends on how much load you are+carrying per trip.++To give you a rough idea: let's assume the overhead of breaking fusion is+around **30–50 nanoseconds per item**. If you're processing something+like a database row and the processing takes a few microseconds per+item, this overhead is negligible—less than 0.05% of the total+cost. But if you're doing lightweight processing—say, ~100ns per+item—the toll becomes significant.++In general:  **Optimize the core processing first. Once that’s+efficient, look at fusion.**++## Breaking fusion: Monad binds++If fusion matters it is always good to have function having a type `...+-> Stream m a` instead of `... -> m (Stream m a)`. The first one is a+stream that can fuse with other streams, whereas the second is a monadic+action that returns a stream, the monadic action needs to be flattened+e.g. using `concatEffect` to generate a stream. Also, note that since+fusion breaks anyway inlining a function returning a `m (Stream m a)`+may not matter as much from fusion perspective.++The simple rule is that you do not break a stream pipeline to perform+an action and return the stream from the monad. If you do that then you+are deliberately breaking a fused pipeline. You need to compose all the+stream functions without cutting the pipeline by sandwiching a monadic+effect. Stream has an underlying monad and you should use available+stream combinators to perform any action in that monad and not outside+of the stream.++## Breaking Fusion: Monad Binds++When fusion performance matters, it's generally better to use functions +of type `... -> Stream m a` rather than `... -> m (Stream m a)`.++The former creates a stream directly, allowing it to fuse seamlessly+with other stream operations. The latter wraps the stream in a monadic+action, requiring an additional step—such as `concatEffect`—to+flatten it into a stream, which breaks fusion.++Guiding Principle:+Avoid interrupting a fused stream pipeline with monadic effects that+return new streams. Doing so effectively breaks the pipeline, making it+harder for the compiler to optimize and fuse subsequent operations.++Instead, try to express all effects within the stream itself. Streamly+provides combinators that work inside the stream’s underlying monad,+allowing you to stay within the fused pipeline. Use those to perform+effects without stepping outside the streaming abstraction.++## `concatMap` vs `unfoldEach`++As mentioned in the previous section, `concatEffect` belongs to the+class of `concatMap`-style operations. These operations do **not**+fuse, because they generate streams *dynamically* at runtime. Since the+structure of the resulting stream isn't statically known, the compiler+cannot apply fusion optimizations effectively.++To achieve full fusion in nested streams, use the `unfoldEach` family+of operations instead. These operate with statically known structure,+allowing the compiler to completely fuse the inner and outer loops. This+results in highly optimized code with minimal allocation and maximum+performance.++## Breaking Fusion: Stream Conversion++The `Stream` type in Streamly is fully fused—operations on it can+be composed without allocating intermediate structures. However,+when converting a `Stream` to or from other stream types—such as+the CPS-based `StreamK`, or third-party libraries like `streaming`,+`conduit`, or `pipes`—fusion is broken.++Such conversions involve exiting the fused pipeline and constructing+a new stream representation. This results in allocation of new data+constructors and loss of compiler optimizations that rely on the fusible+stream structure.++While interoperation with other libraries is sometimes necessary,+it's important to be aware that converting stream types introduces+overhead. To preserve fusion and maximize performance, stay within the+fused `Stream` type whenever possible.++## Strictness annotations++* Strictness annotations on data, specially the data used as accumulator in+  folds and scans, can help in improving performance.+* Strictness annotations on function arguments can help the compiler unbox+  constructors in certain cases, improving performance.+* Sometimes using `-XStrict` extension can help improve performance, if so you+  may be missing some strictness annotations. `-XStrict` can be used as an aid+  to detect missing annotations, but using it blindly may regress performance.++## Use tail recursion++If you are manually writing recursive code, try to use tail recursion+where possible. When using recursion via fold operations, do not use a+strict `foldr` or a lazy `foldl` unless you know what you are doing.+Always use lazy `foldr` for lazily transforming the stream and strict+`foldl` for reducing the stream. In streamly, this comes naturally as+the stream operations are lazy foldr like and the fold operations via+the Fold module are strict foldl like.++## Static Argument Transformation++Static Argument Transformation (SAT) is a valuable optimization for+reducing unnecessary overhead in recursive loops. It becomes especially+impactful when other inefficiencies have already been addressed.++GHC includes support for SAT via the `-fstatic-argument-transformation`+flag, which is enabled with the `-O2` optimization level. However, it+may not always trigger automatically or optimally in all cases.++For this reason, it's recommended that programmers understand and apply+this transformation manually when appropriate. Fortunately, it's simple+to do by habit, and in practice, we've observed substantial performance+improvements from applying it by hand in certain critical code paths.++See the `loopDir` function in [this example](https://github.com/composewell/streamly-examples/blob/ebf9470ce2e96f9882653bb1e0ae1b1a239487e3/examples/BasicDirStream.hsc)+for a case where static argument transformation was used to acheive+performance equivalent to C.++<!--+It will be nice if compiler can automatically detect and point out such+opportunities instead of doing it, the programmer can do it selectively.+-->++## Using `SpecConstr` in Recursive Loops++Consider leveraging the `SpecConstr` optimization when writing recursive+loops manually, this happens automatically when recursion is implemented+using combinators from streamly e.g. using streams or folds. By passing the+`SPEC` argument, you can guide GHC to specialize the loop based on the+constructor of the argument being threaded through the recursion.++This can lead to significant performance improvements in certain cases,+especially when the recursive argument has a known or predictable+constructor.++Understanding when and why this helps requires some familiarity with how+`SpecConstr` works internally. If you understand the mechanics of this+optimization, you'll be better equipped to spot opportunities where it+can make a real difference.++## Reducing Duplicate Branches++Duplicating branches in conditional expressions is a common pattern+in Haskell. This often occurs because an `if` expression in Haskell+**requires both** a `then` and an `else` branch.++In contrast, languages like C allow a series of single-branch `if`+statements, followed by a common operation. In Haskell, programmers+often end up duplicating that common operation in each `else` branch.++### Better Approaches++Instead of duplicating code:++- **Use `when`** from `Control.Monad` for single-branch conditions where+there's no `else`. This avoids unnecessary duplication.+- **Extract common code** into a `let` binding. This ensures the code is+only written once and reused across branches.++### Example++Instead of:++``` haskell+if condition1+  then doSomething1+  else doCommonThing++if condition2+  then doSomething2+  else doCommonThing+```++Refactor to:++``` haskell+    when condition1 doSomething1+    when condition2 doSomething2+    doCommonThing+```++Or, if multiple branches share a computation:++``` haskell+    let common = doCommonThing+    in if condition+         then doSomething >> common+         else doSomethingElse >> common+```++Using shared definitions not only improves readability and+maintainability but also reduces code bloat and allows the compiler to+optimize common expressions more effectively.++## Delay the Specialization++Suppose we want to choose between two functions, `f` and `g`, based on+a flag. One option is to make this decision early and pass the chosen+(inner) function to other parts of the code (outer). Another option is+to pass the flag itself and defer the decision until inside the outer+function that needs it.++In many cases, **delaying the decision**—i.e., passing the flag—is+preferable. This makes it easier for the compiler to optimize, since it+doesn't need to inline the outer function in order to inline the inner+one. By postponing specialization, the code stays more flexible and+often performs better, especially in larger or more abstract codebases.++## Reduce Allocations++One useful way to gauge whether an optimization is effective is by+measuring memory allocations. Most optimizations work by reducing the+number of allocations, though some CPU-focused optimizations may not.++Fewer allocations result in lower CPU utilization and reduced GC+pressure. In general, when writing code, keep in mind how it will be+translated by the compiler, and aim to be frugal with allocations.++<!--+Our GHC perf patch can help in precisely pin-pointing the places where+more allocations are happening.++TODO: static analyzer for allocations. GHC support to statically calculate the+allocations in different parts of the code.++AI like optimizations. Try different ways of optimizing the code and choose the+one with least allocations. Do or don't do a particular optimization based on+the context, e.g. exitify in some cases helps but in other cases it makes+things worse. We can make it learn the cases using training.+-->++## Mutable Memory in Local Loops++Using mutable memory in local loops can improve performance+significantly due to better cache utilization and reduced allocations+and garbage collection overhead. Instead of repeatedly allocating and+deallocating memory, we can reuse the same memory buffer.++For example, consider a print buffer that's copied during the print+operation. Rather than allocating and freeing the buffer on each+iteration, we can use a mutable buffer that persists across loop+iterations. This avoids unnecessary heap traffic.++Haskell currently lacks ergonomic abstractions for mutable memory, which+is a gap that should be addressed. However, we can still use low-level+tools like `allocaBytes` to allocate pinned mutable memory within a+loop.++In C, local memory is typically allocated on the stack, which is+automatically and efficiently deallocated as the function returns. In+contrast, Haskell makes minimal use of the stack—most allocations+occur on the heap. While heap allocation in Haskell can be as cheap+as in C, deallocation involves garbage collection, which introduces+overhead. To mitigate this, we can simulate stack-like behavior using+reusable mutable buffers, improving performance in performance-critical+code.++Interestingly, in multithreaded programs, Haskell may have an advantage:+each C thread requires a dedicated stack (with potential memory limits),+whereas Haskell uses the heap for all memory needs, avoiding stack-size+constraints. This makes memory use in Haskell more flexible and often+more efficient in highly concurrent applications.++See the `loopDir0` function in [this example](https://github.com/composewell/streamly-examples/blob/ebf9470ce2e96f9882653bb1e0ae1b1a239487e3/examples/BasicDirStream.hsc)+for a case where a mutable `buffer` is passed to the function which is+reused in each iteration of the loop to avoid unnecessary allocation+work to achieve performance equivalent to C.++## `unsafePerformIO`++When using `unsafePerformIO`, you should almost always add the+`NOINLINE` pragma. Without it, the compiler may inline the expression,+potentially duplicating side effects or violating assumptions about+evaluation order—leading to unsafe or unpredictable behavior. It can+also result in reduced performance.++``` haskell+    {-# NOINLINE myGlobal #-}+    myGlobal :: IORef Int+    myGlobal = unsafePerformIO (newIORef 0)+```++Using `NOINLINE` ensures that the `IO` action is performed only once,+helping preserve referential transparency as much as possible when+working with `unsafePerformIO`.++### File IO++Avoid using the standard file read/write functions from the `base`+library, as they are not optimized for performance. Instead, prefer+`streamly`’s file IO operations, which are significantly more+efficient—especially for high-throughput or streaming applications.++Alternatively, if you’re not using `streamly`, consider the lazy+`ByteString` or `Text`-based file IO functions from the `bytestring`+and `text` libraries. These provide better performance than the default+`String`-based APIs in `base`.++## Accumulating Folds vs Streaming++Consider the following fold function a Streamly user wanted to use for+stream processing:++``` haskell+    runQueryFold+      :: QueryRunner columns haskells+      -> Postgres.Connection+      -> Query columns+      -> b+      -> (b -> haskells -> IO b)+      -> IO b+```++This function starts with an initial value `b`, repeatedly applies+the step function `(b -> haskells -> IO b)`, and finally returns the+accumulated result `b`.++The user proposed to use this fold to build a stream, then process that+stream—for example:++``` haskell+    runQueryFold conn q StreamK.nil $ \xs x -> pure $ StreamK.cons x xs+```++This approach is counter-productive. The fold above runs an IO loop+that *accumulates* all input elements into a stream in memory before+returning it. The memory consumption grows proportionally with input+size, so for infinite or very large inputs, this will lead to memory+exhaustion.++### Why This Is a Problem++This is *not* how streaming is intended to be used. Streaming is+for *on-the-fly* processing, not accumulation. Instead of building+the entire stream first and then consuming it, the generation and+consumption should happen simultaneously in the same loop. This way,+each element is processed as soon as it is generated, keeping memory+usage constant regardless of input size.++Streaming operations are part of a *generate-transform-eliminate*+loop, fused together for efficiency. In each iteration, one element is+generated, processed by subsequent stream operations (like `map` or+`fold`), and then the loop continues with the next element.++### Proper Streaming Pipeline++To use streaming properly in this context, you can lift a step-wise+generation function into a stream with `unfoldrM`. For example, if your+generation logic provides a step function returning `Maybe` values, you+can convert it into a stream like this:++``` haskell+    Stream.unfoldrM step  -- generate step in the pipeline+      & Stream.mapM transform  -- transform step+      & ...                   -- additional stream operations+      & Stream.fold Fold.drain  -- eliminate step+```++This way, the entire pipeline remains fused, processes elements+incrementally, and avoids accumulating the entire input in memory.++<!--+Need to provide exact way how folds can be used in this context. Specifically,+in the step part of the runQueryFold we can run a Fold one input at a time and+return the Fold. Thus the type b would actually be a `Fold m haskells b`.++### Using Consumer Stream++The signature of the function `runQueryFold` tells us that it wants you+to do all the processing in the `b -> haskells -> IO b` step and only+return a final value `b` after the entire processing is done.++If you want to use this function and compose your processing in a+streaming manner then you have to essentially compose your streams as+part of the step of this function itself. And, you can do that very well+using the Fold type in streamly. Fold is basically like Stream but it is+consumer side stream rather than producer side stream.++You can lift the `runQueryFold` function into a streaming `Fold` using:++``` haskell+foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b+```++Then you can use routines from the Fold module to compose and process+the stream. Fold and Stream provide you equivalent functionality, they+just compose in opposite manner.+-->++## Streamly Specific Optimizations++### `fold` vs `foldBreak`++`fold` and `foldBreak` provide two different ways to consume a+stream. We can compose the cosumer folds into a single `Fold` type and+then run it using `fold`. Alternatively, we can use `foldBreak` to run+individual folds on the stream and get back the remaining stream each+time, then run the next fold on the remaining stream. For streams that+use a mutable state e.g. a stream from a file handle or a socket, the+`foldBreak` method may turn out to be more efficient.++## Build times and space considerations++Haskell, being a pure functional language, confers special powers on+GHC. It allows GHC to do whole program optimization. In a closed loop+all the components of the loop are inlined and GHC fuses them together,+performs many optimizing transformations and churns out an optimized+fused loop code. Let's call it whole-loop-optimization.++To be able to fuse the loop by whole-loop-optimization all the parts of the+loop must be operated on by GHC at the same time to fuse them together. The+amount of time and memory required to do so depends on the size of the loop.+Huge loops can take a lot of time and memory. We have seen GHC take 4-5 GB of+memory when a lot of combinators are used in a single module.++If a module takes too much time and space we can break it into multiple+modules moving some non-inlined parts in another module. There is+another advantage of breaking large modules, it can take advantage of+parallel compilation if they do not depend on each other.++## perf-lint++A `perf-lint` tool is planned as part of the roadmap to help automate+many of these performance optimizations. The goal is to provide+actionable feedback on common performance pitfalls and suggest+improvements—similar to how `hlint` works for general code style.
+ docs/User/HowTo/streamly-vs-async.md view
@@ -0,0 +1,222 @@+# Streamly++THIS TUTORIAL IS OBSOLETE.++Streamly is a library to make concurrent programming a joy. The venerable+`async` package is the go to package for concurrent programming for most+Haskellers. Streamly is a higher level library than `async` and provides a lot+more power and functionality, using a simpler and concise expression of+concurrency. At a high level, you should be able to express everything with+streamly that you can with `async`, if you can't please raise an issue. If you+are familiar with `async`, in this document we highlight how streamly can be+used where you would use `async`.++## `async/wait` vs Concurrent Streams++Unlike `async`, streamly does not use a spawn and `wait` model.  Streamly uses+a more high level approach to concurrency and has no explicit notion of+threads. In streamly, we compose multiple actions as a stream and then express+whether you want to run the actions in the stream `serially` or `parallely`.+There are many different ways in which you can run streams concurrently, see+the reference documentation for details.++Since there is no explicit notion of threads in streamly, there are no+equivalents of `async`, `wait`, `cancel`, `poll` or `link` combinators from the+`async` package.++Since streamly is a monad transformer it can work with all monads and not just+IO, you won't need adaptations like `lifted-async` to use it for a generic+monad.++## Using Streamly for Concurrency++You can write all of your program in a streamly monad and use the full power of+the library.  Streamly can be used as a direct replacement of the IO monad with+no loss of performance, and no change in code except using `liftIO` or `fromEffect`+to run any IO actions.  Streamly IO monads (e.g. `SerialT IO`) are just a+generalization of the IO monad with non-deterministic composition of streams+added on top.++However, if you would like to just run only some concurrent portions of your+program using streamly, you can do that too. Just use `drain` if you want+to run the stream without collecting the outputs of the concurrent actions or+use `toList` if you want to convert the output stream into a list.  Other+stream folding operations can also be used, see the docs for more details.++## Features as Compared with `async`++Use the following imports to run the snippets shown below:++```haskell+import qualified Streamly.Data.Stream.Prelude as S+import qualified Streamly.Data.Fold as F+import qualified Data.Text as Text+import Control.Concurrent (threadDelay)+import Control.Exception (Exception, SomeException)+import Control.Monad.Catch (throwM, try)+```++Let us simulate a URL fetch with a delay of `n` seconds using the following+functions:++```haskell+getURL :: Int -> IO String+getURL n = threadDelay (n * 1000000) >> return (show n)+getURLString = getURL+getURLText n = getURL n >>= return . Text.pack+```++### concurrently++You can run any number of actions concurrently. For example, to fetch two URLs+concurrently:++```haskell+getUrlsConcurrently = S.parSequence id $ S.fromList [getURL 2, getURL 1]+```++This would return the results in their arrival order i.e. first 1 and then 2.+If you want to preserve the order of the results, use the lookahead style+using `fromAhead` instead. In the following example both URLs are fetched+concurrently, and even though URL 1 arrives before URL 2 the results will+return 2 first and then 1.++```haskell+getUrlsOrdered = S.parSequence (S.ordered True) $ S.fromList [getURL 2, getURL 1]+```++### concurrently_++Use `drain` instead of `toList` to run the actions but ignore the results:++```haskell+drainUrlsConcurrently = S.fold F.drain $ S.parMapM id getURL $ S.fromList [1, 2]+```++### Concurrent Zipping++If the actions that you are executing result in different output types you can+use zip to collect the results or to directly apply them to a function:++```haskell+concurrentZipping =+    S.parZipWith id (,) (S.fromEffect (getURLString 1)) (S.fromEffect (getURLText 2))+```++### race++There are two ways to achieve the race functionality, using `take` or using+exceptions.++#### `race` Using `take`++We can run multiple actions concurrently and take the first result that+arrives:++```haskell+fastest = S.toList $ S.take 1 $ S.parSequence id $ S.fromList [getURL 1, getURL 2]+```++After the first result arrives, the rest of the actions are canceled+automatically.  In general, we can take first `n` results as they arrive:++```haskell+fastestN n = S.toList $ S.take n $ S.parSequence id $ S.fromList [getURL 1, getURL 2]+```++#### `race` Using Exceptions++When an exception occurs in a concurrent stream all the concurrently running+actions are cacnceled on arrival of the exception. This can be used to+implement the race functionality. Each action in the stream can use an+exception to communicate the result. As soon as the first result arrives all+other actions will be canceled, for example:++```haskell+data Result = Result String deriving Show+instance Exception Result++raceUsingExceptions = do+    url <- try $ S.fold F.drain $ S.parSequence id $ S.fromList+               [ (getURL 2 >>= throwM . Result)+               , (getURL 1 >>= throwM . Result)+               ]+    case url of+        Left (e :: SomeException) -> print e+        Right _ -> undefined+```++### mapConcurrently++There are many ways to map concurrently on a container and collect the results.+The recommended way is to first convert itinto a stream and then map an action+on the stream concurrently:++```haskell+mapConcurrently = S.toList $ S.parMapM id getURL $ S.fromList [1..3]+```++### replicateConcurrently++Streamly has not just the equivalent of `replicateConcurrently` which is+`parReplicateM` but many more ways to generate concurrent streams, for example,+`parRepeatM`, `parBuffered`, etc. See the `Streamly.Data.Stream.Prelude` module+documentation for more details.++```haskell+replicateConcurrently = S.toList $ S.parReplicateM id 2 $ getURL 1+```++### Functor++The stream resulting from concurrent actions can be mapped serially or+concurrently.++To map serially just use `fmap`:++```haskell+serialMap = S.toList $ fmap (+1) (S.fromList [1, 2] :: S.Stream IO Int)++```++To map a monadic action concurrently on all elements of the stream use `parMapM`:++```haskell+concurrentMap =+    S.toList $ S.parMapM id (\x -> pure (x + 1) :: IO Int) $ S.fromList [1, 2]+```++### Semigroup++The `Semigroup` instances of streamly merge multiple streams serially or+concurrently.++### Monad++The `Monad` instances of streamly nest loops concurrently (concurrent+non-determinism).++### Performance++Streamly has very little concurrency overhead (ranging from a few 100+nanoseconds to a few microseconds on a 2.2 GHz Intel Core i7), you can even run+very lightweight actions in parallel without worrying about the overhead of+concurrency. See the performance benchmarks [comparing streamly with the `async`+package in this repo](https://github.com/composewell/concurrency-benchmarks).++## Further Reading++There is much more that you can do with streamly. For example, you can use the+`maxThreads` combinator to restrict the total number of concurrent threads or+use the `maxBuffer` combinator to restrict the total number of bufferred+results or you can use the `avgRate` combinator to control the rate at which+the concurrent actions are executed.++See the [haddock documentation on+hackage](https://hackage.haskell.org/package/streamly) and [a comprehensive tutorial+here](https://streamly.composewell.com/streamly-0.8.2/Tutorial.html).++## References++* https://hackage.haskell.org/package/async+* https://hackage.haskell.org/package/lifted-async
+ docs/User/HowTo/streamly-vs-list-time.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"><svg xmlns="http://www.w3.org/2000/svg" height="600.0000" stroke-opacity="1" viewBox="0 0 800 600" font-size="1" width="800.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 0.0000,0.0000 v 600.0000 h 800.0000 v -600.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 118.4035,20.1694 ZM 120.5852,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 128.2341,20.1694 ZM 131.7762,5.5647 c -0.9497,-0.0000 -1.5657,-0.5518 -1.5657 -0.5518c -0.6160,-0.5518 -0.6160,-1.4245 -0.6160 -1.4245c 0.0000,-0.8727 0.6160,-1.4117 0.6160 -1.4117c 0.6160,-0.5390 1.5657,-0.5390 1.5657 -0.5390c 0.9754,0.0000 1.5785,0.5390 1.5785 0.5390c 0.6032,0.5390 0.6032,1.4117 0.6032 1.4117c 0.0000,0.8727 -0.6032,1.4245 -0.6032 1.4245c -0.6032,0.5518 -1.5785,0.5518 -1.5785 0.5518ZM 131.7762,5.5647 ZM 129.9025,7.4384 h 3.7731 v 12.7310 h -3.7731 v -12.7310 ZM 135.3183,20.1694 ZM 136.9867,7.4384 h 3.0801 l 0.2567,1.6427 h 0.1027 c 0.7957,-0.7957 1.6940,-1.3732 1.6940 -1.3732c 0.8984,-0.5775 2.1561,-0.5775 2.1561 -0.5775c 1.3604,0.0000 2.1946,0.5518 2.1946 0.5518c 0.8342,0.5518 1.3219,1.5785 1.3219 1.5785c 0.8470,-0.8727 1.7839,-1.5015 1.7839 -1.5015c 0.9369,-0.6289 2.2202,-0.6289 2.2202 -0.6289c 2.0534,0.0000 3.0159,1.3732 3.0159 1.3732c 0.9625,1.3732 0.9625,3.7603 0.9625 3.7603v 7.9055 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9497,-0.0000 -2.1817,1.2320 -2.1817 1.2320v 8.5986 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9754,-0.0000 -2.1561,1.2320 -2.1561 1.2320v 8.5986 h -3.7731 v -12.7310 ZM 157.3152,20.1694 ZM 158.2392,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 158.2392,13.8039 ZM 166.4528,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 175.9497,20.1694 ZM 178.1314,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 185.4723,20.1694 ZM 186.6786,16.6273 c 0.0000,-2.0021 1.6940,-3.1314 1.6940 -3.1314c 1.6940,-1.1294 5.4671,-1.5144 5.4671 -1.5144c -0.0513,-0.8470 -0.5133,-1.3475 -0.5133 -1.3475c -0.4620,-0.5005 -1.4887,-0.5005 -1.4887 -0.5005c -0.8214,-0.0000 -1.6427,0.3080 -1.6427 0.3080c -0.8214,0.3080 -1.7454,0.8470 -1.7454 0.8470l -1.3347,-2.4897 c 1.2320,-0.7444 2.5796,-1.2064 2.5796 -1.2064c 1.3475,-0.4620 2.8619,-0.4620 2.8619 -0.4620c 2.4641,0.0000 3.7603,1.3989 3.7603 1.3989c 1.2962,1.3989 1.2962,4.3506 1.2962 4.3506v 7.2895 h -3.0801 l -0.2823,-1.3090 h -0.0770 c -0.8214,0.7187 -1.7325,1.1679 -1.7325 1.1679c -0.9112,0.4492 -1.9892,0.4492 -1.9892 0.4492c -0.8727,-0.0000 -1.5657,-0.2952 -1.5657 -0.2952c -0.6930,-0.2952 -1.1807,-0.8214 -1.1807 -0.8214c -0.4877,-0.5262 -0.7572,-1.2192 -0.7572 -1.2192c -0.2695,-0.6930 -0.2695,-1.5144 -0.2695 -1.5144ZM 186.6786,16.6273 ZM 190.2721,16.3450 c 0.0000,0.6160 0.3978,0.9112 0.3978 0.9112c 0.3978,0.2952 1.0652,0.2952 1.0652 0.2952c 0.6674,0.0000 1.1294,-0.2823 1.1294 -0.2823c 0.4620,-0.2823 0.9754,-0.7957 0.9754 -0.7957v -2.2331 c -2.0277,0.2823 -2.7977,0.8214 -2.7977 0.8214c -0.7700,0.5390 -0.7700,1.2834 -0.7700 1.2834ZM 199.1786,20.1694 ZM 200.8470,2.1766 h 3.6704 v 10.3183 h 0.1027 l 4.0298,-5.0565 h 4.1068 l -4.4661,5.2361 l 4.7998,7.4949 h -4.0811 l -2.8747,-4.9538 l -1.6170,1.8224 v 3.1314 h -3.6704 v -17.9928 ZM 212.5257,20.1694 ZM 213.4497,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 213.4497,13.8039 ZM 221.6632,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 225.8214,20.1694 ZM 227.4897,7.4384 h 3.0801 l 0.2567,1.6170 h 0.1027 c 0.8214,-0.7700 1.7967,-1.3475 1.7967 -1.3475c 0.9754,-0.5775 2.2844,-0.5775 2.2844 -0.5775c 2.0791,0.0000 3.0159,1.3604 3.0159 1.3604c 0.9369,1.3604 0.9369,3.7731 0.9369 3.7731v 7.9055 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.7187,-0.0000 -1.2320,0.3208 -1.2320 0.3208c -0.5133,0.3208 -1.1294,0.9112 -1.1294 0.9112v 8.5986 h -3.7731 v -12.7310 ZM 245.8419,20.1694 ZM 247.5103,2.1766 h 3.7731 v 4.4148 l -0.1027,1.9507 c 0.7444,-0.6674 1.6042,-1.0395 1.6042 -1.0395c 0.8599,-0.3722 1.7582,-0.3722 1.7582 -0.3722c 1.1550,0.0000 2.0791,0.4620 2.0791 0.4620c 0.9240,0.4620 1.5785,1.2962 1.5785 1.2962c 0.6545,0.8342 1.0010,2.0277 1.0010 2.0277c 0.3465,1.1935 0.3465,2.6566 0.3465 2.6566c 0.0000,1.6427 -0.4492,2.9261 -0.4492 2.9261c -0.4492,1.2834 -1.2064,2.1689 -1.2064 2.1689c -0.7572,0.8855 -1.7197,1.3475 -1.7197 1.3475c -0.9625,0.4620 -1.9892,0.4620 -1.9892 0.4620c -0.8470,-0.0000 -1.7069,-0.4107 -1.7069 -0.4107c -0.8599,-0.4107 -1.6042,-1.2320 -1.6042 -1.2320h -0.1027 l -0.3080,1.3347 h -2.9517 v -17.9928 ZM 247.5103,2.1766 ZM 251.2834,16.5760 c 0.5133,0.4620 1.0267,0.6417 1.0267 0.6417c 0.5133,0.1797 1.0010,0.1797 1.0010 0.1797c 0.9754,0.0000 1.6684,-0.8855 1.6684 -0.8855c 0.6930,-0.8855 0.6930,-2.8619 0.6930 -2.8619c 0.0000,-3.4394 -2.2074,-3.4394 -2.2074 -3.4394c -1.1294,-0.0000 -2.1817,1.1550 -2.1817 1.1550v 5.2105 ZM 260.3439,20.1694 ZM 262.2947,22.0175 c 0.1797,0.0513 0.4107,0.1027 0.4107 0.1027c 0.2310,0.0513 0.4363,0.0513 0.4363 0.0513c 0.9497,0.0000 1.4630,-0.4620 1.4630 -0.4620c 0.5133,-0.4620 0.7700,-1.2064 0.7700 -1.2064l 0.1797,-0.6674 l -4.9025,-12.3973 h 3.7988 l 1.8224,5.4671 c 0.2823,0.8727 0.5133,1.7710 0.5133 1.7710c 0.2310,0.8984 0.4877,1.8480 0.4877 1.8480h 0.1027 c 0.2053,-0.8984 0.4235,-1.8095 0.4235 -1.8095c 0.2182,-0.9112 0.4492,-1.8095 0.4492 -1.8095l 1.5400,-5.4671 h 3.6191 l -4.4148,12.8593 c -0.4620,1.2064 -0.9625,2.1176 -0.9625 2.1176c -0.5005,0.9112 -1.1550,1.5144 -1.1550 1.5144c -0.6545,0.6032 -1.4887,0.9112 -1.4887 0.9112c -0.8342,0.3080 -1.9636,0.3080 -1.9636 0.3080c -0.5903,-0.0000 -1.0010,-0.0642 -1.0010 -0.0642c -0.4107,-0.0642 -0.7957,-0.1925 -0.7957 -0.1925l 0.6674,-2.8747 h 0.0000 ZM 279.0554,20.1694 ZM 281.1345,5.9754 l -0.1283,-3.4138 h 3.7988 l -0.1283,3.4138 l -0.7444,5.1078 h -2.0534 ZM 286.7556,20.1694 ZM 288.4240,2.1766 h 3.7731 v 14.1940 c 0.0000,0.5903 0.2182,0.8214 0.2182 0.8214c 0.2182,0.2310 0.4492,0.2310 0.4492 0.2310h 0.2182 c 0.0000,0.0000 0.2438,-0.0513 0.2438 -0.0513l 0.4620,2.7977 c -0.3080,0.1283 -0.7829,0.2182 -0.7829 0.2182c -0.4748,0.0898 -1.1165,0.0898 -1.1165 0.0898c -0.9754,-0.0000 -1.6427,-0.3080 -1.6427 -0.3080c -0.6674,-0.3080 -1.0652,-0.8599 -1.0652 -0.8599c -0.3978,-0.5518 -0.5775,-1.3347 -0.5775 -1.3347c -0.1797,-0.7829 -0.1797,-1.7582 -0.1797 -1.7582v -14.0400 ZM 294.0965,20.1694 ZM 297.6386,5.5647 c -0.9497,-0.0000 -1.5657,-0.5518 -1.5657 -0.5518c -0.6160,-0.5518 -0.6160,-1.4245 -0.6160 -1.4245c 0.0000,-0.8727 0.6160,-1.4117 0.6160 -1.4117c 0.6160,-0.5390 1.5657,-0.5390 1.5657 -0.5390c 0.9754,0.0000 1.5785,0.5390 1.5785 0.5390c 0.6032,0.5390 0.6032,1.4117 0.6032 1.4117c 0.0000,0.8727 -0.6032,1.4245 -0.6032 1.4245c -0.6032,0.5518 -1.5785,0.5518 -1.5785 0.5518ZM 297.6386,5.5647 ZM 295.7649,7.4384 h 3.7731 v 12.7310 h -3.7731 v -12.7310 ZM 301.1807,20.1694 ZM 303.4138,16.3450 c 0.8727,0.6674 1.6684,1.0010 1.6684 1.0010c 0.7957,0.3337 1.6170,0.3337 1.6170 0.3337c 0.8470,0.0000 1.2320,-0.2823 1.2320 -0.2823c 0.3850,-0.2823 0.3850,-0.7957 0.3850 -0.7957c 0.0000,-0.3080 -0.2182,-0.5518 -0.2182 -0.5518c -0.2182,-0.2438 -0.5903,-0.4492 -0.5903 -0.4492c -0.3722,-0.2053 -0.8342,-0.3722 -0.8342 -0.3722c -0.4620,-0.1668 -0.9497,-0.3722 -0.9497 -0.3722c -0.5903,-0.2310 -1.1807,-0.5390 -1.1807 -0.5390c -0.5903,-0.3080 -1.0780,-0.7572 -1.0780 -0.7572c -0.4877,-0.4492 -0.7957,-1.0524 -0.7957 -1.0524c -0.3080,-0.6032 -0.3080,-1.3989 -0.3080 -1.3989c 0.0000,-0.8727 0.3465,-1.6170 0.3465 -1.6170c 0.3465,-0.7444 0.9882,-1.2577 0.9882 -1.2577c 0.6417,-0.5133 1.5400,-0.8085 1.5400 -0.8085c 0.8984,-0.2952 2.0021,-0.2952 2.0021 -0.2952c 1.4630,0.0000 2.5667,0.5005 2.5667 0.5005c 1.1037,0.5005 1.9251,1.1165 1.9251 1.1165l -1.6940,2.2587 c -0.6930,-0.5133 -1.3604,-0.7957 -1.3604 -0.7957c -0.6674,-0.2823 -1.3347,-0.2823 -1.3347 -0.2823c -1.4374,-0.0000 -1.4374,1.0010 -1.4374 1.0010c 0.0000,0.3080 0.2053,0.5262 0.2053 0.5262c 0.2053,0.2182 0.5518,0.3978 0.5518 0.3978c 0.3465,0.1797 0.7957,0.3465 0.7957 0.3465c 0.4492,0.1668 0.9369,0.3465 0.9369 0.3465c 0.6160,0.2310 1.2192,0.5262 1.2192 0.5262c 0.6032,0.2952 1.1037,0.7315 1.1037 0.7315c 0.5005,0.4363 0.8085,1.0652 0.8085 1.0652c 0.3080,0.6289 0.3080,1.5015 0.3080 1.5015c 0.0000,0.8727 -0.3337,1.6170 -0.3337 1.6170c -0.3337,0.7444 -1.0010,1.2962 -1.0010 1.2962c -0.6674,0.5518 -1.6427,0.8727 -1.6427 0.8727c -0.9754,0.3208 -2.2587,0.3208 -2.2587 0.3208c -1.2577,-0.0000 -2.5796,-0.4877 -2.5796 -0.4877c -1.3219,-0.4877 -2.2972,-1.2834 -2.2972 -1.2834ZM 312.5513,20.1694 ZM 314.7331,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 322.3819,20.1694 ZM 324.4610,5.9754 l -0.1283,-3.4138 h 3.7988 l -0.1283,3.4138 l -0.7444,5.1078 h -2.0534 ZM 335.4209,20.1694 ZM 336.6273,16.6273 c 0.0000,-2.0021 1.6940,-3.1314 1.6940 -3.1314c 1.6940,-1.1294 5.4671,-1.5144 5.4671 -1.5144c -0.0513,-0.8470 -0.5133,-1.3475 -0.5133 -1.3475c -0.4620,-0.5005 -1.4887,-0.5005 -1.4887 -0.5005c -0.8214,-0.0000 -1.6427,0.3080 -1.6427 0.3080c -0.8214,0.3080 -1.7454,0.8470 -1.7454 0.8470l -1.3347,-2.4897 c 1.2320,-0.7444 2.5796,-1.2064 2.5796 -1.2064c 1.3475,-0.4620 2.8619,-0.4620 2.8619 -0.4620c 2.4641,0.0000 3.7603,1.3989 3.7603 1.3989c 1.2962,1.3989 1.2962,4.3506 1.2962 4.3506v 7.2895 h -3.0801 l -0.2823,-1.3090 h -0.0770 c -0.8214,0.7187 -1.7325,1.1679 -1.7325 1.1679c -0.9112,0.4492 -1.9892,0.4492 -1.9892 0.4492c -0.8727,-0.0000 -1.5657,-0.2952 -1.5657 -0.2952c -0.6930,-0.2952 -1.1807,-0.8214 -1.1807 -0.8214c -0.4877,-0.5262 -0.7572,-1.2192 -0.7572 -1.2192c -0.2695,-0.6930 -0.2695,-1.5144 -0.2695 -1.5144ZM 336.6273,16.6273 ZM 340.2207,16.3450 c 0.0000,0.6160 0.3978,0.9112 0.3978 0.9112c 0.3978,0.2952 1.0652,0.2952 1.0652 0.2952c 0.6674,0.0000 1.1294,-0.2823 1.1294 -0.2823c 0.4620,-0.2823 0.9754,-0.7957 0.9754 -0.7957v -2.2331 c -2.0277,0.2823 -2.7977,0.8214 -2.7977 0.8214c -0.7700,0.5390 -0.7700,1.2834 -0.7700 1.2834ZM 349.1273,20.1694 ZM 351.3604,16.3450 c 0.8727,0.6674 1.6684,1.0010 1.6684 1.0010c 0.7957,0.3337 1.6170,0.3337 1.6170 0.3337c 0.8470,0.0000 1.2320,-0.2823 1.2320 -0.2823c 0.3850,-0.2823 0.3850,-0.7957 0.3850 -0.7957c 0.0000,-0.3080 -0.2182,-0.5518 -0.2182 -0.5518c -0.2182,-0.2438 -0.5903,-0.4492 -0.5903 -0.4492c -0.3722,-0.2053 -0.8342,-0.3722 -0.8342 -0.3722c -0.4620,-0.1668 -0.9497,-0.3722 -0.9497 -0.3722c -0.5903,-0.2310 -1.1807,-0.5390 -1.1807 -0.5390c -0.5903,-0.3080 -1.0780,-0.7572 -1.0780 -0.7572c -0.4877,-0.4492 -0.7957,-1.0524 -0.7957 -1.0524c -0.3080,-0.6032 -0.3080,-1.3989 -0.3080 -1.3989c 0.0000,-0.8727 0.3465,-1.6170 0.3465 -1.6170c 0.3465,-0.7444 0.9882,-1.2577 0.9882 -1.2577c 0.6417,-0.5133 1.5400,-0.8085 1.5400 -0.8085c 0.8984,-0.2952 2.0021,-0.2952 2.0021 -0.2952c 1.4630,0.0000 2.5667,0.5005 2.5667 0.5005c 1.1037,0.5005 1.9251,1.1165 1.9251 1.1165l -1.6940,2.2587 c -0.6930,-0.5133 -1.3604,-0.7957 -1.3604 -0.7957c -0.6674,-0.2823 -1.3347,-0.2823 -1.3347 -0.2823c -1.4374,-0.0000 -1.4374,1.0010 -1.4374 1.0010c 0.0000,0.3080 0.2053,0.5262 0.2053 0.5262c 0.2053,0.2182 0.5518,0.3978 0.5518 0.3978c 0.3465,0.1797 0.7957,0.3465 0.7957 0.3465c 0.4492,0.1668 0.9369,0.3465 0.9369 0.3465c 0.6160,0.2310 1.2192,0.5262 1.2192 0.5262c 0.6032,0.2952 1.1037,0.7315 1.1037 0.7315c 0.5005,0.4363 0.8085,1.0652 0.8085 1.0652c 0.3080,0.6289 0.3080,1.5015 0.3080 1.5015c 0.0000,0.8727 -0.3337,1.6170 -0.3337 1.6170c -0.3337,0.7444 -1.0010,1.2962 -1.0010 1.2962c -0.6674,0.5518 -1.6427,0.8727 -1.6427 0.8727c -0.9754,0.3208 -2.2587,0.3208 -2.2587 0.3208c -1.2577,-0.0000 -2.5796,-0.4877 -2.5796 -0.4877c -1.3219,-0.4877 -2.2972,-1.2834 -2.2972 -1.2834ZM 365.8368,20.1694 ZM 367.5051,7.4384 h 3.0801 l 0.2567,1.6427 h 0.1027 c 0.7957,-0.7957 1.6940,-1.3732 1.6940 -1.3732c 0.8984,-0.5775 2.1561,-0.5775 2.1561 -0.5775c 1.3604,0.0000 2.1946,0.5518 2.1946 0.5518c 0.8342,0.5518 1.3219,1.5785 1.3219 1.5785c 0.8470,-0.8727 1.7839,-1.5015 1.7839 -1.5015c 0.9369,-0.6289 2.2202,-0.6289 2.2202 -0.6289c 2.0534,0.0000 3.0159,1.3732 3.0159 1.3732c 0.9625,1.3732 0.9625,3.7603 0.9625 3.7603v 7.9055 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9497,-0.0000 -2.1817,1.2320 -2.1817 1.2320v 8.5986 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9754,-0.0000 -2.1561,1.2320 -2.1561 1.2320v 8.5986 h -3.7731 v -12.7310 ZM 387.8337,20.1694 ZM 389.3737,7.4384 h 3.7731 v 7.4179 c 0.0000,1.3860 0.3850,1.8994 0.3850 1.8994c 0.3850,0.5133 1.2064,0.5133 1.2064 0.5133c 0.7187,0.0000 1.2064,-0.3337 1.2064 -0.3337c 0.4877,-0.3337 1.0524,-1.0780 1.0524 -1.0780v -8.4189 h 3.7731 v 12.7310 h -3.0801 l -0.2823,-1.7710 h -0.0770 c -0.8214,0.9754 -1.7582,1.5272 -1.7582 1.5272c -0.9369,0.5518 -2.2459,0.5518 -2.2459 0.5518c -2.0791,-0.0000 -3.0159,-1.3604 -3.0159 -1.3604c -0.9369,-1.3604 -0.9369,-3.7731 -0.9369 -3.7731v -7.9055 ZM 402.4127,20.1694 ZM 404.0811,2.1766 h 3.7731 v 14.1940 c 0.0000,0.5903 0.2182,0.8214 0.2182 0.8214c 0.2182,0.2310 0.4492,0.2310 0.4492 0.2310h 0.2182 c 0.0000,0.0000 0.2438,-0.0513 0.2438 -0.0513l 0.4620,2.7977 c -0.3080,0.1283 -0.7829,0.2182 -0.7829 0.2182c -0.4748,0.0898 -1.1165,0.0898 -1.1165 0.0898c -0.9754,-0.0000 -1.6427,-0.3080 -1.6427 -0.3080c -0.6674,-0.3080 -1.0652,-0.8599 -1.0652 -0.8599c -0.3978,-0.5518 -0.5775,-1.3347 -0.5775 -1.3347c -0.1797,-0.7829 -0.1797,-1.7582 -0.1797 -1.7582v -14.0400 ZM 409.7536,20.1694 ZM 411.9353,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 419.5842,20.1694 ZM 423.1263,5.5647 c -0.9497,-0.0000 -1.5657,-0.5518 -1.5657 -0.5518c -0.6160,-0.5518 -0.6160,-1.4245 -0.6160 -1.4245c 0.0000,-0.8727 0.6160,-1.4117 0.6160 -1.4117c 0.6160,-0.5390 1.5657,-0.5390 1.5657 -0.5390c 0.9754,0.0000 1.5785,0.5390 1.5785 0.5390c 0.6032,0.5390 0.6032,1.4117 0.6032 1.4117c 0.0000,0.8727 -0.6032,1.4245 -0.6032 1.4245c -0.6032,0.5518 -1.5785,0.5518 -1.5785 0.5518ZM 423.1263,5.5647 ZM 421.2526,7.4384 h 3.7731 v 12.7310 h -3.7731 v -12.7310 ZM 426.6684,20.1694 ZM 432.1099,21.1704 v 3.7218 h -3.7731 v -17.4538 h 3.0801 l 0.2567,1.2577 h 0.1027 c 0.7444,-0.6674 1.6812,-1.1165 1.6812 -1.1165c 0.9369,-0.4492 1.9379,-0.4492 1.9379 -0.4492c 1.1550,0.0000 2.0791,0.4620 2.0791 0.4620c 0.9240,0.4620 1.5657,1.3090 1.5657 1.3090c 0.6417,0.8470 0.9882,2.0406 0.9882 2.0406c 0.3465,1.1935 0.3465,2.6566 0.3465 2.6566c 0.0000,1.6427 -0.4492,2.9132 -0.4492 2.9132c -0.4492,1.2705 -1.2064,2.1561 -1.2064 2.1561c -0.7572,0.8855 -1.7197,1.3475 -1.7197 1.3475c -0.9625,0.4620 -1.9892,0.4620 -1.9892 0.4620c -0.8214,-0.0000 -1.5914,-0.3465 -1.5914 -0.3465c -0.7700,-0.3465 -1.4374,-0.9882 -1.4374 -0.9882ZM 432.1099,21.1704 ZM 432.1099,16.5760 c 0.5133,0.4620 1.0267,0.6417 1.0267 0.6417c 0.5133,0.1797 1.0010,0.1797 1.0010 0.1797c 0.9754,0.0000 1.6684,-0.8855 1.6684 -0.8855c 0.6930,-0.8855 0.6930,-2.8619 0.6930 -2.8619c 0.0000,-3.4394 -2.2074,-3.4394 -2.2074 -3.4394c -1.1037,-0.0000 -2.1817,1.1550 -2.1817 1.1550v 5.2105 ZM 441.3758,20.1694 ZM 443.0441,2.1766 h 3.7731 v 14.1940 c 0.0000,0.5903 0.2182,0.8214 0.2182 0.8214c 0.2182,0.2310 0.4492,0.2310 0.4492 0.2310h 0.2182 c 0.0000,0.0000 0.2438,-0.0513 0.2438 -0.0513l 0.4620,2.7977 c -0.3080,0.1283 -0.7829,0.2182 -0.7829 0.2182c -0.4748,0.0898 -1.1165,0.0898 -1.1165 0.0898c -0.9754,-0.0000 -1.6427,-0.3080 -1.6427 -0.3080c -0.6674,-0.3080 -1.0652,-0.8599 -1.0652 -0.8599c -0.3978,-0.5518 -0.5775,-1.3347 -0.5775 -1.3347c -0.1797,-0.7829 -0.1797,-1.7582 -0.1797 -1.7582v -14.0400 ZM 448.7166,20.1694 ZM 449.6407,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 449.6407,13.8039 ZM 457.8542,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 462.0123,20.1694 ZM 464.2454,16.3450 c 0.8727,0.6674 1.6684,1.0010 1.6684 1.0010c 0.7957,0.3337 1.6170,0.3337 1.6170 0.3337c 0.8470,0.0000 1.2320,-0.2823 1.2320 -0.2823c 0.3850,-0.2823 0.3850,-0.7957 0.3850 -0.7957c 0.0000,-0.3080 -0.2182,-0.5518 -0.2182 -0.5518c -0.2182,-0.2438 -0.5903,-0.4492 -0.5903 -0.4492c -0.3722,-0.2053 -0.8342,-0.3722 -0.8342 -0.3722c -0.4620,-0.1668 -0.9497,-0.3722 -0.9497 -0.3722c -0.5903,-0.2310 -1.1807,-0.5390 -1.1807 -0.5390c -0.5903,-0.3080 -1.0780,-0.7572 -1.0780 -0.7572c -0.4877,-0.4492 -0.7957,-1.0524 -0.7957 -1.0524c -0.3080,-0.6032 -0.3080,-1.3989 -0.3080 -1.3989c 0.0000,-0.8727 0.3465,-1.6170 0.3465 -1.6170c 0.3465,-0.7444 0.9882,-1.2577 0.9882 -1.2577c 0.6417,-0.5133 1.5400,-0.8085 1.5400 -0.8085c 0.8984,-0.2952 2.0021,-0.2952 2.0021 -0.2952c 1.4630,0.0000 2.5667,0.5005 2.5667 0.5005c 1.1037,0.5005 1.9251,1.1165 1.9251 1.1165l -1.6940,2.2587 c -0.6930,-0.5133 -1.3604,-0.7957 -1.3604 -0.7957c -0.6674,-0.2823 -1.3347,-0.2823 -1.3347 -0.2823c -1.4374,-0.0000 -1.4374,1.0010 -1.4374 1.0010c 0.0000,0.3080 0.2053,0.5262 0.2053 0.5262c 0.2053,0.2182 0.5518,0.3978 0.5518 0.3978c 0.3465,0.1797 0.7957,0.3465 0.7957 0.3465c 0.4492,0.1668 0.9369,0.3465 0.9369 0.3465c 0.6160,0.2310 1.2192,0.5262 1.2192 0.5262c 0.6032,0.2952 1.1037,0.7315 1.1037 0.7315c 0.5005,0.4363 0.8085,1.0652 0.8085 1.0652c 0.3080,0.6289 0.3080,1.5015 0.3080 1.5015c 0.0000,0.8727 -0.3337,1.6170 -0.3337 1.6170c -0.3337,0.7444 -1.0010,1.2962 -1.0010 1.2962c -0.6674,0.5518 -1.6427,0.8727 -1.6427 0.8727c -0.9754,0.3208 -2.2587,0.3208 -2.2587 0.3208c -1.2577,-0.0000 -2.5796,-0.4877 -2.5796 -0.4877c -1.3219,-0.4877 -2.2972,-1.2834 -2.2972 -1.2834ZM 478.7218,20.1694 ZM 479.6458,13.8039 c 0.0000,-1.5914 0.5133,-2.8362 0.5133 -2.8362c 0.5133,-1.2449 1.3732,-2.0919 1.3732 -2.0919c 0.8599,-0.8470 1.9892,-1.2962 1.9892 -1.2962c 1.1294,-0.4492 2.3357,-0.4492 2.3357 -0.4492c 1.2064,0.0000 2.3229,0.4492 2.3229 0.4492c 1.1165,0.4492 1.9764,1.2962 1.9764 1.2962c 0.8599,0.8470 1.3732,2.0919 1.3732 2.0919c 0.5133,1.2449 0.5133,2.8362 0.5133 2.8362c 0.0000,1.5914 -0.5133,2.8362 -0.5133 2.8362c -0.5133,1.2449 -1.3732,2.0919 -1.3732 2.0919c -0.8599,0.8470 -1.9764,1.2962 -1.9764 1.2962c -1.1165,0.4492 -2.3229,0.4492 -2.3229 0.4492c -1.2064,-0.0000 -2.3357,-0.4492 -2.3357 -0.4492c -1.1294,-0.4492 -1.9892,-1.2962 -1.9892 -1.2962c -0.8599,-0.8470 -1.3732,-2.0919 -1.3732 -2.0919c -0.5133,-1.2449 -0.5133,-2.8362 -0.5133 -2.8362ZM 479.6458,13.8039 ZM 483.5216,13.8039 c 0.0000,1.6684 0.5775,2.6437 0.5775 2.6437c 0.5775,0.9754 1.7582,0.9754 1.7582 0.9754c 1.1550,0.0000 1.7454,-0.9754 1.7454 -0.9754c 0.5903,-0.9754 0.5903,-2.6437 0.5903 -2.6437c 0.0000,-1.6684 -0.5903,-2.6437 -0.5903 -2.6437c -0.5903,-0.9754 -1.7454,-0.9754 -1.7454 -0.9754c -1.1807,-0.0000 -1.7582,0.9754 -1.7582 0.9754c -0.5775,0.9754 -0.5775,2.6437 -0.5775 2.6437ZM 492.8388,20.1694 ZM 501.6940,5.1027 c -0.7187,-0.2567 -1.3090,-0.2567 -1.3090 -0.2567c -0.6930,-0.0000 -1.0780,0.4235 -1.0780 0.4235c -0.3850,0.4235 -0.3850,1.3989 -0.3850 1.3989v 0.7700 h 2.2844 v 2.9517 h -2.2844 v 9.7793 h -3.7731 v -9.7793 h -1.6940 v -2.7977 l 1.6940,-0.1283 v -0.6930 c 0.0000,-1.0010 0.2438,-1.8994 0.2438 -1.8994c 0.2438,-0.8984 0.8085,-1.5657 0.8085 -1.5657c 0.5647,-0.6674 1.4630,-1.0524 1.4630 -1.0524c 0.8984,-0.3850 2.1817,-0.3850 2.1817 -0.3850c 0.7957,0.0000 1.4502,0.1540 1.4502 0.1540c 0.6545,0.1540 1.0909,0.3080 1.0909 0.3080ZM 506.9302,20.1694 ZM 509.0092,5.9754 l -0.1283,-3.4138 h 3.7988 l -0.1283,3.4138 l -0.7444,5.1078 h -2.0534 ZM 514.6304,20.1694 ZM 520.0719,21.1704 v 3.7218 h -3.7731 v -17.4538 h 3.0801 l 0.2567,1.2577 h 0.1027 c 0.7444,-0.6674 1.6812,-1.1165 1.6812 -1.1165c 0.9369,-0.4492 1.9379,-0.4492 1.9379 -0.4492c 1.1550,0.0000 2.0791,0.4620 2.0791 0.4620c 0.9240,0.4620 1.5657,1.3090 1.5657 1.3090c 0.6417,0.8470 0.9882,2.0406 0.9882 2.0406c 0.3465,1.1935 0.3465,2.6566 0.3465 2.6566c 0.0000,1.6427 -0.4492,2.9132 -0.4492 2.9132c -0.4492,1.2705 -1.2064,2.1561 -1.2064 2.1561c -0.7572,0.8855 -1.7197,1.3475 -1.7197 1.3475c -0.9625,0.4620 -1.9892,0.4620 -1.9892 0.4620c -0.8214,-0.0000 -1.5914,-0.3465 -1.5914 -0.3465c -0.7700,-0.3465 -1.4374,-0.9882 -1.4374 -0.9882ZM 520.0719,21.1704 ZM 520.0719,16.5760 c 0.5133,0.4620 1.0267,0.6417 1.0267 0.6417c 0.5133,0.1797 1.0010,0.1797 1.0010 0.1797c 0.9754,0.0000 1.6684,-0.8855 1.6684 -0.8855c 0.6930,-0.8855 0.6930,-2.8619 0.6930 -2.8619c 0.0000,-3.4394 -2.2074,-3.4394 -2.2074 -3.4394c -1.1037,-0.0000 -2.1817,1.1550 -2.1817 1.1550v 5.2105 ZM 529.3378,20.1694 ZM 530.8778,7.4384 h 3.7731 v 7.4179 c 0.0000,1.3860 0.3850,1.8994 0.3850 1.8994c 0.3850,0.5133 1.2064,0.5133 1.2064 0.5133c 0.7187,0.0000 1.2064,-0.3337 1.2064 -0.3337c 0.4877,-0.3337 1.0524,-1.0780 1.0524 -1.0780v -8.4189 h 3.7731 v 12.7310 h -3.0801 l -0.2823,-1.7710 h -0.0770 c -0.8214,0.9754 -1.7582,1.5272 -1.7582 1.5272c -0.9369,0.5518 -2.2459,0.5518 -2.2459 0.5518c -2.0791,-0.0000 -3.0159,-1.3604 -3.0159 -1.3604c -0.9369,-1.3604 -0.9369,-3.7731 -0.9369 -3.7731v -7.9055 ZM 543.9168,20.1694 ZM 545.5852,7.4384 h 3.0801 l 0.2567,2.2331 h 0.1027 c 0.6930,-1.3090 1.6684,-1.9251 1.6684 -1.9251c 0.9754,-0.6160 1.9507,-0.6160 1.9507 -0.6160c 0.5390,0.0000 0.8855,0.0642 0.8855 0.0642c 0.3465,0.0642 0.6289,0.1925 0.6289 0.1925l -0.6160,3.2598 c -0.3593,-0.1027 -0.6674,-0.1540 -0.6674 -0.1540c -0.3080,-0.0513 -0.7187,-0.0513 -0.7187 -0.0513c -0.7187,-0.0000 -1.5015,0.5133 -1.5015 0.5133c -0.7829,0.5133 -1.2962,1.8224 -1.2962 1.8224v 7.3922 h -3.7731 v -12.7310 ZM 553.8758,20.1694 ZM 554.7998,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 554.7998,13.8039 ZM 563.0133,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 567.1715,20.1694 ZM 568.2752,12.3409 h 6.3142 v 2.6694 h -6.3142 v -2.6694 ZM 575.6930,20.1694 ZM 577.9261,16.3450 c 0.8727,0.6674 1.6684,1.0010 1.6684 1.0010c 0.7957,0.3337 1.6170,0.3337 1.6170 0.3337c 0.8470,0.0000 1.2320,-0.2823 1.2320 -0.2823c 0.3850,-0.2823 0.3850,-0.7957 0.3850 -0.7957c 0.0000,-0.3080 -0.2182,-0.5518 -0.2182 -0.5518c -0.2182,-0.2438 -0.5903,-0.4492 -0.5903 -0.4492c -0.3722,-0.2053 -0.8342,-0.3722 -0.8342 -0.3722c -0.4620,-0.1668 -0.9497,-0.3722 -0.9497 -0.3722c -0.5903,-0.2310 -1.1807,-0.5390 -1.1807 -0.5390c -0.5903,-0.3080 -1.0780,-0.7572 -1.0780 -0.7572c -0.4877,-0.4492 -0.7957,-1.0524 -0.7957 -1.0524c -0.3080,-0.6032 -0.3080,-1.3989 -0.3080 -1.3989c 0.0000,-0.8727 0.3465,-1.6170 0.3465 -1.6170c 0.3465,-0.7444 0.9882,-1.2577 0.9882 -1.2577c 0.6417,-0.5133 1.5400,-0.8085 1.5400 -0.8085c 0.8984,-0.2952 2.0021,-0.2952 2.0021 -0.2952c 1.4630,0.0000 2.5667,0.5005 2.5667 0.5005c 1.1037,0.5005 1.9251,1.1165 1.9251 1.1165l -1.6940,2.2587 c -0.6930,-0.5133 -1.3604,-0.7957 -1.3604 -0.7957c -0.6674,-0.2823 -1.3347,-0.2823 -1.3347 -0.2823c -1.4374,-0.0000 -1.4374,1.0010 -1.4374 1.0010c 0.0000,0.3080 0.2053,0.5262 0.2053 0.5262c 0.2053,0.2182 0.5518,0.3978 0.5518 0.3978c 0.3465,0.1797 0.7957,0.3465 0.7957 0.3465c 0.4492,0.1668 0.9369,0.3465 0.9369 0.3465c 0.6160,0.2310 1.2192,0.5262 1.2192 0.5262c 0.6032,0.2952 1.1037,0.7315 1.1037 0.7315c 0.5005,0.4363 0.8085,1.0652 0.8085 1.0652c 0.3080,0.6289 0.3080,1.5015 0.3080 1.5015c 0.0000,0.8727 -0.3337,1.6170 -0.3337 1.6170c -0.3337,0.7444 -1.0010,1.2962 -1.0010 1.2962c -0.6674,0.5518 -1.6427,0.8727 -1.6427 0.8727c -0.9754,0.3208 -2.2587,0.3208 -2.2587 0.3208c -1.2577,-0.0000 -2.5796,-0.4877 -2.5796 -0.4877c -1.3219,-0.4877 -2.2972,-1.2834 -2.2972 -1.2834ZM 587.0637,20.1694 ZM 589.2454,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 596.8943,20.1694 ZM 598.5626,7.4384 h 3.0801 l 0.2567,2.2331 h 0.1027 c 0.6930,-1.3090 1.6684,-1.9251 1.6684 -1.9251c 0.9754,-0.6160 1.9507,-0.6160 1.9507 -0.6160c 0.5390,0.0000 0.8855,0.0642 0.8855 0.0642c 0.3465,0.0642 0.6289,0.1925 0.6289 0.1925l -0.6160,3.2598 c -0.3593,-0.1027 -0.6674,-0.1540 -0.6674 -0.1540c -0.3080,-0.0513 -0.7187,-0.0513 -0.7187 -0.0513c -0.7187,-0.0000 -1.5015,0.5133 -1.5015 0.5133c -0.7829,0.5133 -1.2962,1.8224 -1.2962 1.8224v 7.3922 h -3.7731 v -12.7310 ZM 606.8532,20.1694 ZM 607.7772,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 607.7772,13.8039 ZM 615.9908,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 619.8665,20.1694 ZM 621.0729,16.6273 c 0.0000,-2.0021 1.6940,-3.1314 1.6940 -3.1314c 1.6940,-1.1294 5.4671,-1.5144 5.4671 -1.5144c -0.0513,-0.8470 -0.5133,-1.3475 -0.5133 -1.3475c -0.4620,-0.5005 -1.4887,-0.5005 -1.4887 -0.5005c -0.8214,-0.0000 -1.6427,0.3080 -1.6427 0.3080c -0.8214,0.3080 -1.7454,0.8470 -1.7454 0.8470l -1.3347,-2.4897 c 1.2320,-0.7444 2.5796,-1.2064 2.5796 -1.2064c 1.3475,-0.4620 2.8619,-0.4620 2.8619 -0.4620c 2.4641,0.0000 3.7603,1.3989 3.7603 1.3989c 1.2962,1.3989 1.2962,4.3506 1.2962 4.3506v 7.2895 h -3.0801 l -0.2823,-1.3090 h -0.0770 c -0.8214,0.7187 -1.7325,1.1679 -1.7325 1.1679c -0.9112,0.4492 -1.9892,0.4492 -1.9892 0.4492c -0.8727,-0.0000 -1.5657,-0.2952 -1.5657 -0.2952c -0.6930,-0.2952 -1.1807,-0.8214 -1.1807 -0.8214c -0.4877,-0.5262 -0.7572,-1.2192 -0.7572 -1.2192c -0.2695,-0.6930 -0.2695,-1.5144 -0.2695 -1.5144ZM 621.0729,16.6273 ZM 624.6663,16.3450 c 0.0000,0.6160 0.3978,0.9112 0.3978 0.9112c 0.3978,0.2952 1.0652,0.2952 1.0652 0.2952c 0.6674,0.0000 1.1294,-0.2823 1.1294 -0.2823c 0.4620,-0.2823 0.9754,-0.7957 0.9754 -0.7957v -2.2331 c -2.0277,0.2823 -2.7977,0.8214 -2.7977 0.8214c -0.7700,0.5390 -0.7700,1.2834 -0.7700 1.2834ZM 633.5729,20.1694 ZM 635.2413,7.4384 h 3.0801 l 0.2567,1.6427 h 0.1027 c 0.7957,-0.7957 1.6940,-1.3732 1.6940 -1.3732c 0.8984,-0.5775 2.1561,-0.5775 2.1561 -0.5775c 1.3604,0.0000 2.1946,0.5518 2.1946 0.5518c 0.8342,0.5518 1.3219,1.5785 1.3219 1.5785c 0.8470,-0.8727 1.7839,-1.5015 1.7839 -1.5015c 0.9369,-0.6289 2.2202,-0.6289 2.2202 -0.6289c 2.0534,0.0000 3.0159,1.3732 3.0159 1.3732c 0.9625,1.3732 0.9625,3.7603 0.9625 3.7603v 7.9055 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9497,-0.0000 -2.1817,1.2320 -2.1817 1.2320v 8.5986 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9754,-0.0000 -2.1561,1.2320 -2.1561 1.2320v 8.5986 h -3.7731 v -12.7310 ZM 655.5698,20.1694 ZM 657.2382,2.1766 h 3.7731 v 14.1940 c 0.0000,0.5903 0.2182,0.8214 0.2182 0.8214c 0.2182,0.2310 0.4492,0.2310 0.4492 0.2310h 0.2182 c 0.0000,0.0000 0.2438,-0.0513 0.2438 -0.0513l 0.4620,2.7977 c -0.3080,0.1283 -0.7829,0.2182 -0.7829 0.2182c -0.4748,0.0898 -1.1165,0.0898 -1.1165 0.0898c -0.9754,-0.0000 -1.6427,-0.3080 -1.6427 -0.3080c -0.6674,-0.3080 -1.0652,-0.8599 -1.0652 -0.8599c -0.3978,-0.5518 -0.5775,-1.3347 -0.5775 -1.3347c -0.1797,-0.7829 -0.1797,-1.7582 -0.1797 -1.7582v -14.0400 ZM 662.9107,20.1694 ZM 664.8614,22.0175 c 0.1797,0.0513 0.4107,0.1027 0.4107 0.1027c 0.2310,0.0513 0.4363,0.0513 0.4363 0.0513c 0.9497,0.0000 1.4630,-0.4620 1.4630 -0.4620c 0.5133,-0.4620 0.7700,-1.2064 0.7700 -1.2064l 0.1797,-0.6674 l -4.9025,-12.3973 h 3.7988 l 1.8224,5.4671 c 0.2823,0.8727 0.5133,1.7710 0.5133 1.7710c 0.2310,0.8984 0.4877,1.8480 0.4877 1.8480h 0.1027 c 0.2053,-0.8984 0.4235,-1.8095 0.4235 -1.8095c 0.2182,-0.9112 0.4492,-1.8095 0.4492 -1.8095l 1.5400,-5.4671 h 3.6191 l -4.4148,12.8593 c -0.4620,1.2064 -0.9625,2.1176 -0.9625 2.1176c -0.5005,0.9112 -1.1550,1.5144 -1.1550 1.5144c -0.6545,0.6032 -1.4887,0.9112 -1.4887 0.9112c -0.8342,0.3080 -1.9636,0.3080 -1.9636 0.3080c -0.5903,-0.0000 -1.0010,-0.0642 -1.0010 -0.0642c -0.4107,-0.0642 -0.7957,-0.1925 -0.7957 -0.1925l 0.6674,-2.8747 h 0.0000 ZM 676.2834,20.1694 ZM 678.3624,5.9754 l -0.1283,-3.4138 h 3.7988 l -0.1283,3.4138 l -0.7444,5.1078 h -2.0534 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,444.0000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,364.6000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,285.2000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,205.8000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,126.4000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,47.0000 h 709.5966 "/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip1"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip1)"><path d="M 95.4034,364.6000 v -306.3549 h 17.0946 v 306.3549 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip2"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip2)"><path d="M 112.4980,364.6000 v -219.0632 h 17.0946 v 219.0632 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip3"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip3)"><path d="M 129.5927,364.6000 v -80.0608 h 17.0946 v 80.0608 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip4"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip4)"><path d="M 146.6873,364.6000 v -60.1654 h 17.0946 v 60.1654 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip5"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip5)"><path d="M 163.7820,364.6000 v -53.0481 h 17.0946 v 53.0481 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip6"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip6)"><path d="M 180.8766,364.6000 v -48.1404 h 17.0946 v 48.1404 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip7"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip7)"><path d="M 197.9713,364.6000 v -42.4556 h 17.0946 v 42.4556 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip8"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip8)"><path d="M 215.0659,364.6000 v -38.4431 h 17.0946 v 38.4431 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip9"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip9)"><path d="M 232.1605,364.6000 v -32.7179 h 17.0946 v 32.7179 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip10"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip10)"><path d="M 249.2552,364.6000 v -32.6952 h 17.0946 v 32.6952 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip11"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip11)"><path d="M 266.3498,364.6000 v -32.2955 h 17.0946 v 32.2955 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip12"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip12)"><path d="M 283.4445,364.6000 v -31.8824 h 17.0946 v 31.8824 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip13"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip13)"><path d="M 300.5391,364.6000 v -27.0567 h 17.0946 v 27.0567 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip14"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip14)"><path d="M 317.6338,364.6000 v -20.1385 h 17.0946 v 20.1385 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip15"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip15)"><path d="M 334.7284,364.6000 v -12.6729 h 17.0946 v 12.6729 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip16"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip16)"><path d="M 351.8231,364.6000 v -4.1066 h 17.0946 v 4.1066 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip17"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip17)"><path d="M 368.9177,364.6000 v -1.3991 h 17.0946 v 1.3991 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip18"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip18)"><path d="M 386.0124,364.6000 v 2.7767 h 17.0946 v -2.7767 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip19"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip19)"><path d="M 403.1070,364.6000 v 7.7712 h 17.0946 v -7.7712 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip20"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip20)"><path d="M 95.4034,364.6000 v -306.3549 h 17.0946 v 306.3549 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip21"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip21)"><path d="M 112.4980,364.6000 v -219.0632 h 17.0946 v 219.0632 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip22"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip22)"><path d="M 129.5927,364.6000 v -80.0608 h 17.0946 v 80.0608 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip23"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip23)"><path d="M 146.6873,364.6000 v -60.1654 h 17.0946 v 60.1654 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip24"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip24)"><path d="M 163.7820,364.6000 v -53.0481 h 17.0946 v 53.0481 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip25"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip25)"><path d="M 180.8766,364.6000 v -48.1404 h 17.0946 v 48.1404 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip26"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip26)"><path d="M 197.9713,364.6000 v -42.4556 h 17.0946 v 42.4556 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip27"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip27)"><path d="M 215.0659,364.6000 v -38.4431 h 17.0946 v 38.4431 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip28"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip28)"><path d="M 232.1605,364.6000 v -32.7179 h 17.0946 v 32.7179 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip29"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip29)"><path d="M 249.2552,364.6000 v -32.6952 h 17.0946 v 32.6952 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip30"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip30)"><path d="M 266.3498,364.6000 v -32.2955 h 17.0946 v 32.2955 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip31"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip31)"><path d="M 283.4445,364.6000 v -31.8824 h 17.0946 v 31.8824 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip32"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip32)"><path d="M 300.5391,364.6000 v -27.0567 h 17.0946 v 27.0567 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip33"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip33)"><path d="M 317.6338,364.6000 v -20.1385 h 17.0946 v 20.1385 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip34"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip34)"><path d="M 334.7284,364.6000 v -12.6729 h 17.0946 v 12.6729 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip35"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip35)"><path d="M 351.8231,364.6000 v -4.1066 h 17.0946 v 4.1066 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip36"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip36)"><path d="M 368.9177,364.6000 v -1.3991 h 17.0946 v 1.3991 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip37"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip37)"><path d="M 386.0124,364.6000 v 2.7767 h 17.0946 v -2.7767 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip38"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip38)"><path d="M 403.1070,364.6000 v 7.7712 h 17.0946 v -7.7712 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="square" stroke-miterlimit="10.0"><path d="M 80.4034,444.0000 v -397.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,444.0000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,436.0600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,428.1200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,420.1800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,412.2400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,404.3000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,396.3600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,388.4200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,380.4800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,372.5400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,364.6000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,356.6600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,348.7200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,340.7800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,332.8400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,324.9000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,316.9600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,309.0200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,301.0800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,293.1400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,285.2000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,277.2600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,269.3200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,261.3800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,253.4400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,245.5000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,237.5600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,229.6200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,221.6800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,213.7400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,205.8000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,197.8600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,189.9200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,181.9800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,174.0400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,166.1000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,158.1600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,150.2200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,142.2800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,134.3400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,126.4000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,118.4600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,110.5200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,102.5800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,94.6400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,86.7000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,78.7600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,70.8200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,62.8800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,54.9400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,47.0000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,444.0000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,364.6000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,285.2000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,205.8000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,126.4000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,47.0000 h 5.0000 "/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 35.1681,448.8235 ZM 36.3298,447.8235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 42.4769,448.8235 ZM 46.5504,438.3824 h 0.8824 l -3.9265,12.7941 h -0.8824 ZM 47.6239,448.8235 ZM 48.5798,446.9265 c 0.4118,0.4265 0.9779,0.7500 0.9779 0.7500c 0.5662,0.3235 1.3897,0.3235 1.3897 0.3235c 0.4265,0.0000 0.8015,-0.1544 0.8015 -0.1544c 0.3750,-0.1544 0.6544,-0.4338 0.6544 -0.4338c 0.2794,-0.2794 0.4412,-0.6765 0.4412 -0.6765c 0.1618,-0.3971 0.1618,-0.8824 0.1618 -0.8824c 0.0000,-0.9706 -0.5441,-1.5147 -0.5441 -1.5147c -0.5441,-0.5441 -1.4559,-0.5441 -1.4559 -0.5441c -0.4853,-0.0000 -0.8309,0.1471 -0.8309 0.1471c -0.3456,0.1471 -0.7721,0.4265 -0.7721 0.4265l -0.6471,-0.4118 l 0.3088,-4.5147 h 4.6912 v 1.0441 h -3.6324 l -0.2500,2.7794 c 0.3382,-0.1765 0.6765,-0.2794 0.6765 -0.2794c 0.3382,-0.1029 0.7647,-0.1029 0.7647 -0.1029c 0.6029,0.0000 1.1324,0.1765 1.1324 0.1765c 0.5294,0.1765 0.9265,0.5368 0.9265 0.5368c 0.3971,0.3603 0.6250,0.9118 0.6250 0.9118c 0.2279,0.5515 0.2279,1.3162 0.2279 1.3162c 0.0000,0.7647 -0.2647,1.3529 -0.2647 1.3529c -0.2647,0.5882 -0.7059,0.9926 -0.7059 0.9926c -0.4412,0.4044 -1.0074,0.6176 -1.0074 0.6176c -0.5662,0.2132 -1.1838,0.2132 -1.1838 0.2132c -0.5588,-0.0000 -1.0221,-0.1103 -1.0221 -0.1103c -0.4632,-0.1103 -0.8382,-0.2868 -0.8382 -0.2868c -0.3750,-0.1765 -0.6765,-0.4044 -0.6765 -0.4044c -0.3015,-0.2279 -0.5368,-0.4779 -0.5368 -0.4779ZM 54.9328,448.8235 ZM 56.0945,447.8235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 65.2122,448.8235 ZM 67.7563,445.0882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.9328,369.4235 ZM 56.0945,368.4235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 65.2122,369.4235 ZM 67.7563,365.6882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 46.8298,290.0235 ZM 47.7857,288.1265 c 0.4118,0.4265 0.9779,0.7500 0.9779 0.7500c 0.5662,0.3235 1.3897,0.3235 1.3897 0.3235c 0.4265,0.0000 0.8015,-0.1544 0.8015 -0.1544c 0.3750,-0.1544 0.6544,-0.4338 0.6544 -0.4338c 0.2794,-0.2794 0.4412,-0.6765 0.4412 -0.6765c 0.1618,-0.3971 0.1618,-0.8824 0.1618 -0.8824c 0.0000,-0.9706 -0.5441,-1.5147 -0.5441 -1.5147c -0.5441,-0.5441 -1.4559,-0.5441 -1.4559 -0.5441c -0.4853,-0.0000 -0.8309,0.1471 -0.8309 0.1471c -0.3456,0.1471 -0.7721,0.4265 -0.7721 0.4265l -0.6471,-0.4118 l 0.3088,-4.5147 h 4.6912 v 1.0441 h -3.6324 l -0.2500,2.7794 c 0.3382,-0.1765 0.6765,-0.2794 0.6765 -0.2794c 0.3382,-0.1029 0.7647,-0.1029 0.7647 -0.1029c 0.6029,0.0000 1.1324,0.1765 1.1324 0.1765c 0.5294,0.1765 0.9265,0.5368 0.9265 0.5368c 0.3971,0.3603 0.6250,0.9118 0.6250 0.9118c 0.2279,0.5515 0.2279,1.3162 0.2279 1.3162c 0.0000,0.7647 -0.2647,1.3529 -0.2647 1.3529c -0.2647,0.5882 -0.7059,0.9926 -0.7059 0.9926c -0.4412,0.4044 -1.0074,0.6176 -1.0074 0.6176c -0.5662,0.2132 -1.1838,0.2132 -1.1838 0.2132c -0.5588,-0.0000 -1.0221,-0.1103 -1.0221 -0.1103c -0.4632,-0.1103 -0.8382,-0.2868 -0.8382 -0.2868c -0.3750,-0.1765 -0.6765,-0.4044 -0.6765 -0.4044c -0.3015,-0.2279 -0.5368,-0.4779 -0.5368 -0.4779ZM 54.1387,290.0235 ZM 55.3004,289.0235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 64.4181,290.0235 ZM 66.9622,286.2882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 40.3151,210.6235 ZM 41.4769,209.6235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 47.6239,210.6235 ZM 51.2857,210.8000 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 51.2857,210.8000 ZM 51.2857,209.8294 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 54.9328,210.6235 ZM 56.0945,209.6235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 65.2122,210.6235 ZM 67.7563,206.8882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 40.3151,131.2235 ZM 41.4769,130.2235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 47.6239,131.2235 ZM 48.5798,129.3265 c 0.4118,0.4265 0.9779,0.7500 0.9779 0.7500c 0.5662,0.3235 1.3897,0.3235 1.3897 0.3235c 0.4265,0.0000 0.8015,-0.1544 0.8015 -0.1544c 0.3750,-0.1544 0.6544,-0.4338 0.6544 -0.4338c 0.2794,-0.2794 0.4412,-0.6765 0.4412 -0.6765c 0.1618,-0.3971 0.1618,-0.8824 0.1618 -0.8824c 0.0000,-0.9706 -0.5441,-1.5147 -0.5441 -1.5147c -0.5441,-0.5441 -1.4559,-0.5441 -1.4559 -0.5441c -0.4853,-0.0000 -0.8309,0.1471 -0.8309 0.1471c -0.3456,0.1471 -0.7721,0.4265 -0.7721 0.4265l -0.6471,-0.4118 l 0.3088,-4.5147 h 4.6912 v 1.0441 h -3.6324 l -0.2500,2.7794 c 0.3382,-0.1765 0.6765,-0.2794 0.6765 -0.2794c 0.3382,-0.1029 0.7647,-0.1029 0.7647 -0.1029c 0.6029,0.0000 1.1324,0.1765 1.1324 0.1765c 0.5294,0.1765 0.9265,0.5368 0.9265 0.5368c 0.3971,0.3603 0.6250,0.9118 0.6250 0.9118c 0.2279,0.5515 0.2279,1.3162 0.2279 1.3162c 0.0000,0.7647 -0.2647,1.3529 -0.2647 1.3529c -0.2647,0.5882 -0.7059,0.9926 -0.7059 0.9926c -0.4412,0.4044 -1.0074,0.6176 -1.0074 0.6176c -0.5662,0.2132 -1.1838,0.2132 -1.1838 0.2132c -0.5588,-0.0000 -1.0221,-0.1103 -1.0221 -0.1103c -0.4632,-0.1103 -0.8382,-0.2868 -0.8382 -0.2868c -0.3750,-0.1765 -0.6765,-0.4044 -0.6765 -0.4044c -0.3015,-0.2279 -0.5368,-0.4779 -0.5368 -0.4779ZM 54.9328,131.2235 ZM 56.0945,130.2235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 65.2122,131.2235 ZM 67.7563,127.4882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.6828,51.8235 ZM 40.2710,51.1029 c 1.0588,-1.0588 1.8824,-1.9118 1.8824 -1.9118c 0.8235,-0.8529 1.3824,-1.5809 1.3824 -1.5809c 0.5588,-0.7279 0.8529,-1.3382 0.8529 -1.3382c 0.2941,-0.6103 0.2941,-1.1838 0.2941 -1.1838c 0.0000,-0.8088 -0.4412,-1.3235 -0.4412 -1.3235c -0.4412,-0.5147 -1.3382,-0.5147 -1.3382 -0.5147c -0.5882,-0.0000 -1.0882,0.3309 -1.0882 0.3309c -0.5000,0.3309 -0.9118,0.8015 -0.9118 0.8015l -0.6912,-0.6912 c 0.5882,-0.6471 1.2500,-1.0368 1.2500 -1.0368c 0.6618,-0.3897 1.5882,-0.3897 1.5882 -0.3897c 1.3088,0.0000 2.0588,0.7574 2.0588 0.7574c 0.7500,0.7574 0.7500,2.0074 0.7500 2.0074c 0.0000,0.6618 -0.2868,1.3309 -0.2868 1.3309c -0.2868,0.6691 -0.7941,1.3824 -0.7941 1.3824c -0.5074,0.7132 -1.2059,1.4853 -1.2059 1.4853c -0.6985,0.7721 -1.5368,1.6397 -1.5368 1.6397c 0.3824,-0.0294 0.7941,-0.0588 0.7941 -0.0588c 0.4118,-0.0294 0.7794,-0.0294 0.7794 -0.0294h 2.7206 v 1.0441 h -6.0588 v -0.7206 ZM 46.9916,51.8235 ZM 50.6534,52.0000 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 50.6534,52.0000 ZM 50.6534,51.0294 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 54.3004,51.8235 ZM 55.4622,50.8235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 64.5798,51.8235 ZM 67.1239,48.0882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="square" stroke-miterlimit="10.0"><path d="M 80.4034,444.0000 h 709.5966 "/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 187.3992,470.0000 ZM 188.7773,458.0336 h 1.3782 v 10.4202 c 0.0000,0.3361 0.1176,0.4706 0.1176 0.4706c 0.1176,0.1345 0.2689,0.1345 0.2689 0.1345h 0.1261 c 0.0000,0.0000 0.1765,-0.0336 0.1765 -0.0336l 0.1849,1.0420 c -0.1345,0.0672 -0.3193,0.1008 -0.3193 0.1008c -0.1849,0.0336 -0.4706,0.0336 -0.4706 0.0336c -0.7899,-0.0000 -1.1261,-0.4706 -1.1261 -0.4706c -0.3361,-0.4706 -0.3361,-1.3782 -0.3361 -1.3782v -10.3193 ZM 191.6849,470.0000 ZM 193.7689,460.1513 c -0.4034,-0.0000 -0.6807,-0.2521 -0.6807 -0.2521c -0.2773,-0.2521 -0.2773,-0.6387 -0.2773 -0.6387c 0.0000,-0.4034 0.2773,-0.6471 0.2773 -0.6471c 0.2773,-0.2437 0.6807,-0.2437 0.6807 -0.2437c 0.4034,0.0000 0.6807,0.2437 0.6807 0.2437c 0.2773,0.2437 0.2773,0.6471 0.2773 0.6471c 0.0000,0.3866 -0.2773,0.6387 -0.2773 0.6387c -0.2773,0.2521 -0.6807,0.2521 -0.6807 0.2521ZM 193.7689,460.1513 ZM 193.0630,461.8319 h 1.3782 v 8.1681 h -1.3782 v -8.1681 ZM 195.8193,470.0000 ZM 196.9790,468.1513 c 0.5378,0.4370 1.1008,0.7059 1.1008 0.7059c 0.5630,0.2689 1.3025,0.2689 1.3025 0.2689c 0.8067,0.0000 1.2101,-0.3697 1.2101 -0.3697c 0.4034,-0.3697 0.4034,-0.9076 0.4034 -0.9076c 0.0000,-0.3193 -0.1681,-0.5546 -0.1681 -0.5546c -0.1681,-0.2353 -0.4286,-0.4118 -0.4286 -0.4118c -0.2605,-0.1765 -0.5966,-0.3109 -0.5966 -0.3109l -0.6723,-0.2689 c -0.4370,-0.1513 -0.8739,-0.3445 -0.8739 -0.3445c -0.4370,-0.1933 -0.7815,-0.4706 -0.7815 -0.4706c -0.3445,-0.2773 -0.5630,-0.6471 -0.5630 -0.6471c -0.2185,-0.3697 -0.2185,-0.8908 -0.2185 -0.8908c 0.0000,-0.4874 0.1933,-0.9160 0.1933 -0.9160c 0.1933,-0.4286 0.5546,-0.7395 0.5546 -0.7395c 0.3613,-0.3109 0.8824,-0.4874 0.8824 -0.4874c 0.5210,-0.1765 1.1765,-0.1765 1.1765 -0.1765c 0.7731,0.0000 1.4202,0.2689 1.4202 0.2689c 0.6471,0.2689 1.1176,0.6555 1.1176 0.6555l -0.6555,0.8739 c -0.4202,-0.3193 -0.8739,-0.5210 -0.8739 -0.5210c -0.4538,-0.2017 -0.9916,-0.2017 -0.9916 -0.2017c -0.7731,-0.0000 -1.1345,0.3529 -1.1345 0.3529c -0.3613,0.3529 -0.3613,0.8235 -0.3613 0.8235c 0.0000,0.2857 0.1513,0.4958 0.1513 0.4958c 0.1513,0.2101 0.4034,0.3697 0.4034 0.3697c 0.2521,0.1597 0.5798,0.2857 0.5798 0.2857c 0.3277,0.1261 0.6807,0.2605 0.6807 0.2605c 0.4370,0.1681 0.8824,0.3529 0.8824 0.3529c 0.4454,0.1849 0.7983,0.4622 0.7983 0.4622c 0.3529,0.2773 0.5798,0.6807 0.5798 0.6807c 0.2269,0.4034 0.2269,0.9748 0.2269 0.9748c 0.0000,0.5042 -0.1933,0.9412 -0.1933 0.9412c -0.1933,0.4370 -0.5714,0.7731 -0.5714 0.7731c -0.3782,0.3361 -0.9412,0.5294 -0.9412 0.5294c -0.5630,0.1933 -1.2857,0.1933 -1.2857 0.1933c -0.8739,-0.0000 -1.6639,-0.3193 -1.6639 -0.3193c -0.7899,-0.3193 -1.3782,-0.8067 -1.3782 -0.8067ZM 202.8613,470.0000 ZM 204.4748,462.9580 h -1.2101 v -1.0420 l 1.2773,-0.0840 l 0.1681,-2.2857 h 1.1597 v 2.2857 h 2.2017 v 1.1261 h -2.2017 v 4.5378 c 0.0000,0.7563 0.2773,1.1681 0.2773 1.1681c 0.2773,0.4118 0.9832,0.4118 0.9832 0.4118c 0.2185,0.0000 0.4706,-0.0672 0.4706 -0.0672c 0.2521,-0.0672 0.4538,-0.1513 0.4538 -0.1513l 0.2689,1.0420 c -0.3361,0.1176 -0.7311,0.2101 -0.7311 0.2101c -0.3950,0.0924 -0.7815,0.0924 -0.7815 0.0924c -0.6555,-0.0000 -1.1008,-0.2017 -1.1008 -0.2017c -0.4454,-0.2017 -0.7227,-0.5546 -0.7227 -0.5546c -0.2773,-0.3529 -0.3950,-0.8571 -0.3950 -0.8571c -0.1176,-0.5042 -0.1176,-1.1092 -0.1176 -1.1092v -4.5210 ZM 208.5420,470.0000 ZM 213.1975,458.0672 h 1.0084 l -4.4874,14.6218 h -1.0084 ZM 214.4244,470.0000 ZM 217.1807,470.6891 v 2.7563 h -1.3782 v -11.6134 h 1.1429 l 0.1176,0.9412 h 0.0504 c 0.5546,-0.4706 1.2185,-0.8067 1.2185 -0.8067c 0.6639,-0.3361 1.3866,-0.3361 1.3866 -0.3361c 0.7899,0.0000 1.3950,0.2941 1.3950 0.2941c 0.6050,0.2941 1.0084,0.8403 1.0084 0.8403c 0.4034,0.5462 0.6134,1.3109 0.6134 1.3109c 0.2101,0.7647 0.2101,1.7227 0.2101 1.7227c 0.0000,1.0420 -0.2857,1.8571 -0.2857 1.8571c -0.2857,0.8151 -0.7731,1.3866 -0.7731 1.3866c -0.4874,0.5714 -1.1261,0.8655 -1.1261 0.8655c -0.6387,0.2941 -1.3445,0.2941 -1.3445 0.2941c -0.5714,-0.0000 -1.1345,-0.2521 -1.1345 -0.2521c -0.5630,-0.2521 -1.1345,-0.6891 -1.1345 -0.6891ZM 217.1807,470.6891 ZM 217.1807,468.1849 c 0.5546,0.4706 1.0756,0.6639 1.0756 0.6639c 0.5210,0.1933 0.9244,0.1933 0.9244 0.1933c 0.5042,0.0000 0.9328,-0.2269 0.9328 -0.2269c 0.4286,-0.2269 0.7395,-0.6387 0.7395 -0.6387c 0.3109,-0.4118 0.4874,-1.0168 0.4874 -1.0168c 0.1765,-0.6050 0.1765,-1.3613 0.1765 -1.3613c 0.0000,-0.6723 -0.1176,-1.2269 -0.1176 -1.2269c -0.1176,-0.5546 -0.3782,-0.9496 -0.3782 -0.9496c -0.2605,-0.3950 -0.6723,-0.6134 -0.6723 -0.6134c -0.4118,-0.2185 -0.9832,-0.2185 -0.9832 -0.2185c -0.5210,-0.0000 -1.0504,0.2857 -1.0504 0.2857c -0.5294,0.2857 -1.1345,0.8235 -1.1345 0.8235v 4.2857 ZM 223.7521,470.0000 ZM 225.0126,461.8319 h 1.3950 v 4.9916 c 0.0000,1.1597 0.3613,1.6723 0.3613 1.6723c 0.3613,0.5126 1.1681,0.5126 1.1681 0.5126c 0.6387,0.0000 1.1261,-0.3277 1.1261 -0.3277c 0.4874,-0.3277 1.0756,-1.0504 1.0756 -1.0504v -5.7983 h 1.3782 v 8.1681 h -1.1429 l -0.1176,-1.2773 h -0.0504 c -0.5714,0.6723 -1.2017,1.0756 -1.2017 1.0756c -0.6303,0.4034 -1.4874,0.4034 -1.4874 0.4034c -1.3109,-0.0000 -1.9076,-0.8067 -1.9076 -0.8067c -0.5966,-0.8067 -0.5966,-2.3866 -0.5966 -2.3866v -5.1765 ZM 232.8950,470.0000 ZM 234.2731,461.8319 h 1.1429 l 0.1176,1.4790 h 0.0504 c 0.4202,-0.7731 1.0168,-1.2269 1.0168 -1.2269c 0.5966,-0.4538 1.3025,-0.4538 1.3025 -0.4538c 0.4874,0.0000 0.8739,0.1681 0.8739 0.1681l -0.2689,1.2101 c -0.2017,-0.0672 -0.3697,-0.1008 -0.3697 -0.1008c -0.1681,-0.0336 -0.4202,-0.0336 -0.4202 -0.0336c -0.5210,-0.0000 -1.0840,0.4202 -1.0840 0.4202c -0.5630,0.4202 -0.9832,1.4622 -0.9832 1.4622v 5.2437 h -1.3782 v -8.1681 ZM 238.5588,470.0000 ZM 239.3319,465.9328 c 0.0000,-1.0084 0.3109,-1.8067 0.3109 -1.8067c 0.3109,-0.7983 0.8235,-1.3529 0.8235 -1.3529c 0.5126,-0.5546 1.1681,-0.8487 1.1681 -0.8487c 0.6555,-0.2941 1.3613,-0.2941 1.3613 -0.2941c 0.7731,0.0000 1.3866,0.2689 1.3866 0.2689c 0.6134,0.2689 1.0252,0.7731 1.0252 0.7731c 0.4118,0.5042 0.6303,1.2101 0.6303 1.2101c 0.2185,0.7059 0.2185,1.5798 0.2185 1.5798c 0.0000,0.4538 -0.0504,0.7563 -0.0504 0.7563h -5.5126 c 0.0840,1.3277 0.8151,2.1008 0.8151 2.1008c 0.7311,0.7731 1.9076,0.7731 1.9076 0.7731c 0.5882,0.0000 1.0840,-0.1765 1.0840 -0.1765c 0.4958,-0.1765 0.9496,-0.4622 0.9496 -0.4622l 0.4874,0.9076 c -0.5378,0.3361 -1.1933,0.5882 -1.1933 0.5882c -0.6555,0.2521 -1.4958,0.2521 -1.4958 0.2521c -0.8235,-0.0000 -1.5378,-0.2941 -1.5378 -0.2941c -0.7143,-0.2941 -1.2437,-0.8403 -1.2437 -0.8403c -0.5294,-0.5462 -0.8319,-1.3361 -0.8319 -1.3361c -0.3025,-0.7899 -0.3025,-1.7983 -0.3025 -1.7983ZM 239.3319,465.9328 ZM 245.0462,465.3109 c 0.0000,-1.2605 -0.5294,-1.9244 -0.5294 -1.9244c -0.5294,-0.6639 -1.4874,-0.6639 -1.4874 -0.6639c -0.4370,-0.0000 -0.8319,0.1765 -0.8319 0.1765c -0.3950,0.1765 -0.7143,0.5042 -0.7143 0.5042c -0.3193,0.3277 -0.5294,0.8067 -0.5294 0.8067c -0.2101,0.4790 -0.2773,1.1008 -0.2773 1.1008h 4.3697 ZM 246.8950,470.0000 ZM 247.5840,465.2605 h 3.8655 v 1.0588 h -3.8655 v -1.0588 ZM 252.1218,470.0000 ZM 253.2815,468.1513 c 0.5378,0.4370 1.1008,0.7059 1.1008 0.7059c 0.5630,0.2689 1.3025,0.2689 1.3025 0.2689c 0.8067,0.0000 1.2101,-0.3697 1.2101 -0.3697c 0.4034,-0.3697 0.4034,-0.9076 0.4034 -0.9076c 0.0000,-0.3193 -0.1681,-0.5546 -0.1681 -0.5546c -0.1681,-0.2353 -0.4286,-0.4118 -0.4286 -0.4118c -0.2605,-0.1765 -0.5966,-0.3109 -0.5966 -0.3109l -0.6723,-0.2689 c -0.4370,-0.1513 -0.8739,-0.3445 -0.8739 -0.3445c -0.4370,-0.1933 -0.7815,-0.4706 -0.7815 -0.4706c -0.3445,-0.2773 -0.5630,-0.6471 -0.5630 -0.6471c -0.2185,-0.3697 -0.2185,-0.8908 -0.2185 -0.8908c 0.0000,-0.4874 0.1933,-0.9160 0.1933 -0.9160c 0.1933,-0.4286 0.5546,-0.7395 0.5546 -0.7395c 0.3613,-0.3109 0.8824,-0.4874 0.8824 -0.4874c 0.5210,-0.1765 1.1765,-0.1765 1.1765 -0.1765c 0.7731,0.0000 1.4202,0.2689 1.4202 0.2689c 0.6471,0.2689 1.1176,0.6555 1.1176 0.6555l -0.6555,0.8739 c -0.4202,-0.3193 -0.8739,-0.5210 -0.8739 -0.5210c -0.4538,-0.2017 -0.9916,-0.2017 -0.9916 -0.2017c -0.7731,-0.0000 -1.1345,0.3529 -1.1345 0.3529c -0.3613,0.3529 -0.3613,0.8235 -0.3613 0.8235c 0.0000,0.2857 0.1513,0.4958 0.1513 0.4958c 0.1513,0.2101 0.4034,0.3697 0.4034 0.3697c 0.2521,0.1597 0.5798,0.2857 0.5798 0.2857c 0.3277,0.1261 0.6807,0.2605 0.6807 0.2605c 0.4370,0.1681 0.8824,0.3529 0.8824 0.3529c 0.4454,0.1849 0.7983,0.4622 0.7983 0.4622c 0.3529,0.2773 0.5798,0.6807 0.5798 0.6807c 0.2269,0.4034 0.2269,0.9748 0.2269 0.9748c 0.0000,0.5042 -0.1933,0.9412 -0.1933 0.9412c -0.1933,0.4370 -0.5714,0.7731 -0.5714 0.7731c -0.3782,0.3361 -0.9412,0.5294 -0.9412 0.5294c -0.5630,0.1933 -1.2857,0.1933 -1.2857 0.1933c -0.8739,-0.0000 -1.6639,-0.3193 -1.6639 -0.3193c -0.7899,-0.3193 -1.3782,-0.8067 -1.3782 -0.8067ZM 259.1639,470.0000 ZM 260.7773,462.9580 h -1.2101 v -1.0420 l 1.2773,-0.0840 l 0.1681,-2.2857 h 1.1597 v 2.2857 h 2.2017 v 1.1261 h -2.2017 v 4.5378 c 0.0000,0.7563 0.2773,1.1681 0.2773 1.1681c 0.2773,0.4118 0.9832,0.4118 0.9832 0.4118c 0.2185,0.0000 0.4706,-0.0672 0.4706 -0.0672c 0.2521,-0.0672 0.4538,-0.1513 0.4538 -0.1513l 0.2689,1.0420 c -0.3361,0.1176 -0.7311,0.2101 -0.7311 0.2101c -0.3950,0.0924 -0.7815,0.0924 -0.7815 0.0924c -0.6555,-0.0000 -1.1008,-0.2017 -1.1008 -0.2017c -0.4454,-0.2017 -0.7227,-0.5546 -0.7227 -0.5546c -0.2773,-0.3529 -0.3950,-0.8571 -0.3950 -0.8571c -0.1176,-0.5042 -0.1176,-1.1092 -0.1176 -1.1092v -4.5210 ZM 264.8445,470.0000 ZM 266.2227,461.8319 h 1.1429 l 0.1176,1.4790 h 0.0504 c 0.4202,-0.7731 1.0168,-1.2269 1.0168 -1.2269c 0.5966,-0.4538 1.3025,-0.4538 1.3025 -0.4538c 0.4874,0.0000 0.8739,0.1681 0.8739 0.1681l -0.2689,1.2101 c -0.2017,-0.0672 -0.3697,-0.1008 -0.3697 -0.1008c -0.1681,-0.0336 -0.4202,-0.0336 -0.4202 -0.0336c -0.5210,-0.0000 -1.0840,0.4202 -1.0840 0.4202c -0.5630,0.4202 -0.9832,1.4622 -0.9832 1.4622v 5.2437 h -1.3782 v -8.1681 ZM 270.5084,470.0000 ZM 271.2815,465.9328 c 0.0000,-1.0084 0.3109,-1.8067 0.3109 -1.8067c 0.3109,-0.7983 0.8235,-1.3529 0.8235 -1.3529c 0.5126,-0.5546 1.1681,-0.8487 1.1681 -0.8487c 0.6555,-0.2941 1.3613,-0.2941 1.3613 -0.2941c 0.7731,0.0000 1.3866,0.2689 1.3866 0.2689c 0.6134,0.2689 1.0252,0.7731 1.0252 0.7731c 0.4118,0.5042 0.6303,1.2101 0.6303 1.2101c 0.2185,0.7059 0.2185,1.5798 0.2185 1.5798c 0.0000,0.4538 -0.0504,0.7563 -0.0504 0.7563h -5.5126 c 0.0840,1.3277 0.8151,2.1008 0.8151 2.1008c 0.7311,0.7731 1.9076,0.7731 1.9076 0.7731c 0.5882,0.0000 1.0840,-0.1765 1.0840 -0.1765c 0.4958,-0.1765 0.9496,-0.4622 0.9496 -0.4622l 0.4874,0.9076 c -0.5378,0.3361 -1.1933,0.5882 -1.1933 0.5882c -0.6555,0.2521 -1.4958,0.2521 -1.4958 0.2521c -0.8235,-0.0000 -1.5378,-0.2941 -1.5378 -0.2941c -0.7143,-0.2941 -1.2437,-0.8403 -1.2437 -0.8403c -0.5294,-0.5462 -0.8319,-1.3361 -0.8319 -1.3361c -0.3025,-0.7899 -0.3025,-1.7983 -0.3025 -1.7983ZM 271.2815,465.9328 ZM 276.9958,465.3109 c 0.0000,-1.2605 -0.5294,-1.9244 -0.5294 -1.9244c -0.5294,-0.6639 -1.4874,-0.6639 -1.4874 -0.6639c -0.4370,-0.0000 -0.8319,0.1765 -0.8319 0.1765c -0.3950,0.1765 -0.7143,0.5042 -0.7143 0.5042c -0.3193,0.3277 -0.5294,0.8067 -0.5294 0.8067c -0.2101,0.4790 -0.2773,1.1008 -0.2773 1.1008h 4.3697 ZM 278.6092,470.0000 ZM 279.5840,467.8824 c 0.0000,-1.3445 1.2017,-2.0588 1.2017 -2.0588c 1.2017,-0.7143 3.8235,-1.0000 3.8235 -1.0000c 0.0000,-0.3866 -0.0756,-0.7563 -0.0756 -0.7563c -0.0756,-0.3697 -0.2689,-0.6555 -0.2689 -0.6555c -0.1933,-0.2857 -0.5126,-0.4622 -0.5126 -0.4622c -0.3193,-0.1765 -0.8235,-0.1765 -0.8235 -0.1765c -0.7227,-0.0000 -1.3361,0.2689 -1.3361 0.2689c -0.6134,0.2689 -1.1008,0.6050 -1.1008 0.6050l -0.5546,-0.9580 c 0.5714,-0.3697 1.3950,-0.7143 1.3950 -0.7143c 0.8235,-0.3445 1.8151,-0.3445 1.8151 -0.3445c 1.4958,0.0000 2.1681,0.9160 2.1681 0.9160c 0.6723,0.9160 0.6723,2.4454 0.6723 2.4454v 5.0084 h -1.1429 l -0.1176,-0.9748 h -0.0336 c -0.5882,0.4874 -1.2689,0.8319 -1.2689 0.8319c -0.6807,0.3445 -1.4370,0.3445 -1.4370 0.3445c -1.0420,-0.0000 -1.7227,-0.6050 -1.7227 -0.6050c -0.6807,-0.6050 -0.6807,-1.7143 -0.6807 -1.7143ZM 279.5840,467.8824 ZM 280.9454,467.7815 c 0.0000,0.7059 0.4118,1.0084 0.4118 1.0084c 0.4118,0.3025 1.0168,0.3025 1.0168 0.3025c 0.5882,0.0000 1.1176,-0.2773 1.1176 -0.2773c 0.5294,-0.2773 1.1176,-0.8151 1.1176 -0.8151v -2.2689 c -1.0252,0.1345 -1.7311,0.3193 -1.7311 0.3193c -0.7059,0.1849 -1.1345,0.4370 -1.1345 0.4370c -0.4286,0.2521 -0.6134,0.5798 -0.6134 0.5798c -0.1849,0.3277 -0.1849,0.7143 -0.1849 0.7143ZM 287.2143,470.0000 ZM 288.5924,461.8319 h 1.1429 l 0.1176,1.1765 h 0.0504 c 0.5378,-0.5882 1.1681,-0.9832 1.1681 -0.9832c 0.6303,-0.3950 1.3697,-0.3950 1.3697 -0.3950c 0.9412,0.0000 1.4706,0.4118 1.4706 0.4118c 0.5294,0.4118 0.7815,1.1513 0.7815 1.1513c 0.6387,-0.7059 1.2857,-1.1345 1.2857 -1.1345c 0.6471,-0.4286 1.4034,-0.4286 1.4034 -0.4286c 1.2605,0.0000 1.8739,0.8067 1.8739 0.8067c 0.6134,0.8067 0.6134,2.3866 0.6134 2.3866v 5.1765 h -1.3782 v -4.9916 c 0.0000,-1.1597 -0.3697,-1.6723 -0.3697 -1.6723c -0.3697,-0.5126 -1.1429,-0.5126 -1.1429 -0.5126c -0.9244,-0.0000 -2.0504,1.2605 -2.0504 1.2605v 5.9160 h -1.3782 v -4.9916 c 0.0000,-1.1597 -0.3697,-1.6723 -0.3697 -1.6723c -0.3697,-0.5126 -1.1597,-0.5126 -1.1597 -0.5126c -0.9244,-0.0000 -2.0504,1.2605 -2.0504 1.2605v 5.9160 h -1.3782 v -8.1681 ZM 301.1471,470.0000 ZM 302.5252,458.0336 h 1.3782 v 10.4202 c 0.0000,0.3361 0.1176,0.4706 0.1176 0.4706c 0.1176,0.1345 0.2689,0.1345 0.2689 0.1345h 0.1261 c 0.0000,0.0000 0.1765,-0.0336 0.1765 -0.0336l 0.1849,1.0420 c -0.1345,0.0672 -0.3193,0.1008 -0.3193 0.1008c -0.1849,0.0336 -0.4706,0.0336 -0.4706 0.0336c -0.7899,-0.0000 -1.1261,-0.4706 -1.1261 -0.4706c -0.3361,-0.4706 -0.3361,-1.3782 -0.3361 -1.3782v -10.3193 ZM 305.4328,470.0000 ZM 306.2563,472.2521 l 0.3025,0.0756 c 0.0000,0.0000 0.3193,0.0420 0.3193 0.0420c 0.7059,0.0000 1.1513,-0.4958 1.1513 -0.4958c 0.4454,-0.4958 0.6975,-1.2521 0.6975 -1.2521l 0.1849,-0.6050 l -3.2773,-8.1849 h 1.4286 l 1.6639,4.5210 c 0.1849,0.5378 0.3950,1.1345 0.3950 1.1345c 0.2101,0.5966 0.3950,1.1681 0.3950 1.1681h 0.0672 c 0.1849,-0.5546 0.3529,-1.1597 0.3529 -1.1597c 0.1681,-0.6050 0.3361,-1.1429 0.3361 -1.1429l 1.4622,-4.5210 h 1.3445 l -3.0756,8.8403 c -0.2185,0.6050 -0.4874,1.1261 -0.4874 1.1261c -0.2689,0.5210 -0.6387,0.8992 -0.6387 0.8992c -0.3697,0.3782 -0.8403,0.5966 -0.8403 0.5966c -0.4706,0.2185 -1.0924,0.2185 -1.0924 0.2185c -0.2857,-0.0000 -0.5210,-0.0420 -0.5210 -0.0420c -0.2353,-0.0420 -0.4370,-0.1261 -0.4370 -0.1261l 0.2689,-1.0924 h 0.0000 ZM 313.2815,470.0000 ZM 316.8782,472.9580 c -1.0420,-1.6807 -1.6303,-3.5462 -1.6303 -3.5462c -0.5882,-1.8655 -0.5882,-4.0840 -0.5882 -4.0840c 0.0000,-2.2185 0.5882,-4.0756 0.5882 -4.0756c 0.5882,-1.8571 1.6303,-3.5546 1.6303 -3.5546l 0.8571,0.4034 c -0.9748,1.6134 -1.4538,3.4538 -1.4538 3.4538c -0.4790,1.8403 -0.4790,3.7731 -0.4790 3.7731c 0.0000,1.9328 0.4790,3.7731 0.4790 3.7731c 0.4790,1.8403 1.4538,3.4538 1.4538 3.4538l -0.8571,0.4034 h 0.0000 ZM 318.3739,470.0000 ZM 321.2815,465.7311 l -2.4706,-3.8992 h 1.4958 l 1.0924,1.7983 c 0.1849,0.3361 0.3866,0.6807 0.3866 0.6807c 0.2017,0.3445 0.4202,0.6807 0.4202 0.6807h 0.0672 c 0.1849,-0.3361 0.3697,-0.6807 0.3697 -0.6807c 0.1849,-0.3445 0.3697,-0.6807 0.3697 -0.6807l 0.9916,-1.7983 h 1.4454 l -2.4706,4.0504 l 2.6555,4.1176 h -1.4958 l -1.1933,-1.8992 l -0.4370,-0.7395 c 0.0000,0.0000 -0.4538,-0.7227 -0.4538 -0.7227h -0.0672 c -0.2185,0.3529 -0.4202,0.7143 -0.4202 0.7143c -0.2017,0.3613 -0.4034,0.7479 -0.4034 0.7479l -1.1092,1.8992 h -1.4454 ZM 325.8697,470.0000 ZM 326.5084,472.5546 c 0.9748,-1.6134 1.4538,-3.4538 1.4538 -3.4538c 0.4790,-1.8403 0.4790,-3.7731 0.4790 -3.7731c 0.0000,-1.9328 -0.4790,-3.7731 -0.4790 -3.7731c -0.4790,-1.8403 -1.4538,-3.4538 -1.4538 -3.4538l 0.8571,-0.4034 c 1.0420,1.6975 1.6303,3.5546 1.6303 3.5546c 0.5882,1.8571 0.5882,4.0756 0.5882 4.0756c 0.0000,2.2185 -0.5882,4.0840 -0.5882 4.0840c -0.5882,1.8655 -1.6303,3.5462 -1.6303 3.5462l -0.8571,-0.4034 h 0.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,480.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,489.2500 ZM 39.7941,485.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 39.7941,485.6912 ZM 41.0441,485.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 47.2647,489.2500 ZM 48.4706,482.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 52.2206,489.2500 ZM 52.8971,485.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 52.8971,485.6912 ZM 54.1471,485.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 60.1912,489.2500 ZM 62.6029,489.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 62.6029,489.8529 ZM 62.6029,487.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 68.3529,489.2500 ZM 68.9559,485.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 72.9265,489.2500 ZM 74.1324,482.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.4706,-0.5147 1.0221,-0.8603 1.0221 -0.8603c 0.5515,-0.3456 1.1985,-0.3456 1.1985 -0.3456c 0.8235,0.0000 1.2868,0.3603 1.2868 0.3603c 0.4632,0.3603 0.6838,1.0074 0.6838 1.0074c 0.5588,-0.6176 1.1250,-0.9926 1.1250 -0.9926c 0.5662,-0.3750 1.2279,-0.3750 1.2279 -0.3750c 1.1029,0.0000 1.6397,0.7059 1.6397 0.7059c 0.5368,0.7059 0.5368,2.0882 0.5368 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0000,-0.4485 -1.0000 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0147,-0.4485 -1.0147 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -7.1471 ZM 85.1176,489.2500 ZM 85.9706,487.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 85.9706,487.3971 ZM 87.1618,487.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 92.6471,489.2500 ZM 95.0588,489.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 95.0588,489.8529 ZM 95.0588,487.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 103.7794,489.2500 ZM 106.3235,485.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 113.3088,489.2500 ZM 117.7794,485.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 117.7794,485.6912 ZM 120.2059,486.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,480.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,489.2500 ZM 173.4559,479.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 173.3235,489.2500 ZM 175.1471,480.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 175.1471,480.6324 ZM 174.5294,482.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 176.9412,489.2500 ZM 178.1471,478.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 180.6912,489.2500 ZM 182.1029,483.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 185.5147,489.2500 ZM 186.1912,485.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 186.1912,485.6912 ZM 191.1912,485.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 192.8088,489.2500 ZM 194.0147,482.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 197.9118,489.2500 ZM 198.5147,485.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 202.4853,489.2500 ZM 203.1765,485.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 203.1765,485.6912 ZM 204.4265,485.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 210.6471,489.2500 ZM 211.8529,482.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 215.6029,489.2500 ZM 216.2794,485.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 216.2794,485.6912 ZM 217.5294,485.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 223.5735,489.2500 ZM 225.9853,489.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 225.9853,489.8529 ZM 225.9853,487.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 234.7059,489.2500 ZM 237.2500,485.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 244.2353,489.2500 ZM 248.7059,485.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 248.7059,485.6912 ZM 251.1324,486.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,480.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,489.2500 ZM 321.6765,479.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 321.5441,489.2500 ZM 323.3676,480.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 323.3676,480.6324 ZM 322.7500,482.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 325.1618,489.2500 ZM 326.3676,478.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 328.9118,489.2500 ZM 330.3235,483.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 333.7353,489.2500 ZM 334.4118,485.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 334.4118,485.6912 ZM 339.4118,485.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 341.0294,489.2500 ZM 342.2353,482.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 346.1324,489.2500 ZM 346.7353,485.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 350.7059,489.2500 ZM 351.7206,487.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 356.8676,489.2500 ZM 357.5441,485.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 363.4265,489.2500 ZM 364.2794,487.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 364.2794,487.3971 ZM 365.4706,487.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 370.9559,489.2500 ZM 372.1618,482.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 381.9706,489.2500 ZM 384.5147,485.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 391.5000,489.2500 ZM 395.9706,485.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 395.9706,485.6912 ZM 398.3971,486.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 417.9559,480.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 447.0588,489.2500 ZM 448.4706,483.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 451.7647,489.2500 ZM 452.6176,487.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 452.6176,487.3971 ZM 453.8088,487.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 459.2941,489.2500 ZM 460.5000,478.7794 h 1.1912 v 7.0882 h 0.0441 l 3.0441,-3.7647 h 1.3382 l -2.3971,2.8676 l 2.7206,4.2794 h -1.3235 l -2.0882,-3.4412 l -1.3382,1.5588 v 1.8824 h -1.1912 v -10.4706 ZM 466.3088,489.2500 ZM 466.9853,485.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 466.9853,485.6912 ZM 471.9853,485.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 473.6029,489.2500 ZM 474.2059,485.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 478.1765,489.2500 ZM 479.3824,482.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.4706,-0.5147 1.0221,-0.8603 1.0221 -0.8603c 0.5515,-0.3456 1.1985,-0.3456 1.1985 -0.3456c 0.8235,0.0000 1.2868,0.3603 1.2868 0.3603c 0.4632,0.3603 0.6838,1.0074 0.6838 1.0074c 0.5588,-0.6176 1.1250,-0.9926 1.1250 -0.9926c 0.5662,-0.3750 1.2279,-0.3750 1.2279 -0.3750c 1.1029,0.0000 1.6397,0.7059 1.6397 0.7059c 0.5368,0.7059 0.5368,2.0882 0.5368 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0000,-0.4485 -1.0000 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0147,-0.4485 -1.0147 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -7.1471 ZM 490.3676,489.2500 ZM 491.2206,487.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 491.2206,487.3971 ZM 492.4118,487.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 497.8971,489.2500 ZM 500.3088,489.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 500.3088,489.8529 ZM 500.3088,487.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 509.0294,489.2500 ZM 511.5735,485.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 518.5588,489.2500 ZM 523.0294,485.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 523.0294,485.6912 ZM 525.4559,486.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,504.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,513.2500 ZM 40.1176,511.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 45.2647,513.2500 ZM 45.9412,509.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 51.8235,513.2500 ZM 52.6765,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 52.6765,511.3971 ZM 53.8676,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 59.3529,513.2500 ZM 60.5588,506.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 67.3971,513.2500 ZM 68.0000,509.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 71.9706,513.2500 ZM 73.1765,506.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.4706,-0.5147 1.0221,-0.8603 1.0221 -0.8603c 0.5515,-0.3456 1.1985,-0.3456 1.1985 -0.3456c 0.8235,0.0000 1.2868,0.3603 1.2868 0.3603c 0.4632,0.3603 0.6838,1.0074 0.6838 1.0074c 0.5588,-0.6176 1.1250,-0.9926 1.1250 -0.9926c 0.5662,-0.3750 1.2279,-0.3750 1.2279 -0.3750c 1.1029,0.0000 1.6397,0.7059 1.6397 0.7059c 0.5368,0.7059 0.5368,2.0882 0.5368 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0000,-0.4485 -1.0000 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0147,-0.4485 -1.0147 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -7.1471 ZM 84.1618,513.2500 ZM 85.0147,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 85.0147,511.3971 ZM 86.2059,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 91.6912,513.2500 ZM 94.1029,513.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 94.1029,513.8529 ZM 94.1029,511.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 102.8235,513.2500 ZM 105.3676,509.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 112.3529,513.2500 ZM 116.8235,509.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 116.8235,509.6912 ZM 119.2500,510.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,504.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,513.2500 ZM 169.4853,512.6029 l 3.7647,-5.5147 h -3.3529 v -0.9853 h 4.8824 v 0.6471 l -3.7647,5.5147 h 3.8824 v 0.9853 h -5.4118 v -0.6471 ZM 175.2794,513.2500 ZM 177.1029,504.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 177.1029,504.6324 ZM 176.4853,506.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 178.8971,513.2500 ZM 181.3088,513.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 181.3088,513.8529 ZM 181.3088,511.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,504.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,513.2500 ZM 321.6765,503.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 321.5441,513.2500 ZM 323.3676,504.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 323.3676,504.6324 ZM 322.7500,506.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 325.1618,513.2500 ZM 326.3676,502.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 328.9118,513.2500 ZM 330.3235,507.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 333.7353,513.2500 ZM 334.4118,509.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 334.4118,509.6912 ZM 339.4118,509.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 341.0294,513.2500 ZM 342.2353,506.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 346.1324,513.2500 ZM 346.7353,509.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 350.7059,513.2500 ZM 352.1176,507.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 355.4118,513.2500 ZM 356.2647,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 356.2647,511.3971 ZM 357.4559,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 362.9412,513.2500 ZM 364.1471,502.7794 h 1.1912 v 7.0882 h 0.0441 l 3.0441,-3.7647 h 1.3382 l -2.3971,2.8676 l 2.7206,4.2794 h -1.3235 l -2.0882,-3.4412 l -1.3382,1.5588 v 1.8824 h -1.1912 v -10.4706 ZM 369.9559,513.2500 ZM 370.6324,509.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 370.6324,509.6912 ZM 375.6324,509.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 380.2206,513.2500 ZM 382.7647,509.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 389.7500,513.2500 ZM 394.2206,509.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 394.2206,509.6912 ZM 396.6471,510.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 417.9559,504.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 447.0588,513.2500 ZM 448.4706,507.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 451.7647,513.2500 ZM 452.6176,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 452.6176,511.3971 ZM 453.8088,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 459.2941,513.2500 ZM 460.5000,502.7794 h 1.1912 v 7.0882 h 0.0441 l 3.0441,-3.7647 h 1.3382 l -2.3971,2.8676 l 2.7206,4.2794 h -1.3235 l -2.0882,-3.4412 l -1.3382,1.5588 v 1.8824 h -1.1912 v -10.4706 ZM 466.3088,513.2500 ZM 466.9853,509.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 466.9853,509.6912 ZM 471.9853,509.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 473.6029,513.2500 ZM 474.2059,509.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 478.1765,513.2500 ZM 479.1912,511.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 484.3382,513.2500 ZM 485.0147,509.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 490.8971,513.2500 ZM 491.7500,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 491.7500,511.3971 ZM 492.9412,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 498.4265,513.2500 ZM 499.6324,506.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 509.4412,513.2500 ZM 511.9853,509.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 518.9706,513.2500 ZM 523.4412,509.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 523.4412,509.6912 ZM 525.8676,510.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,528.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,537.2500 ZM 39.7941,533.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 39.7941,533.6912 ZM 41.0441,533.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 47.2647,537.2500 ZM 48.4706,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 52.2206,537.2500 ZM 52.8971,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 52.8971,533.6912 ZM 54.1471,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 60.1912,537.2500 ZM 62.6029,537.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 62.6029,537.8529 ZM 62.6029,535.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 68.3529,537.2500 ZM 68.9559,533.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 72.9265,537.2500 ZM 73.6029,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 73.6029,533.6912 ZM 74.8529,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 80.8971,537.2500 ZM 82.1029,530.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 88.9412,537.2500 ZM 89.6176,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 89.6176,533.6912 ZM 94.6176,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,528.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,537.2500 ZM 169.7206,533.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 169.7206,533.6912 ZM 170.9706,533.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 177.1912,537.2500 ZM 178.3971,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 182.1471,537.2500 ZM 182.8235,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 182.8235,533.6912 ZM 184.0735,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 190.1176,537.2500 ZM 192.5294,537.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 192.5294,537.8529 ZM 192.5294,535.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 198.2794,537.2500 ZM 198.6176,527.6029 h 1.2647 l 1.0147,5.2500 c 0.1324,0.7941 0.2794,1.5588 0.2794 1.5588c 0.1471,0.7647 0.2794,1.5588 0.2794 1.5588h 0.0588 c 0.1618,-0.7941 0.3382,-1.5662 0.3382 -1.5662c 0.1765,-0.7721 0.3382,-1.5515 0.3382 -1.5515l 1.3382,-5.2500 h 1.1176 l 1.3382,5.2500 c 0.1765,0.7647 0.3529,1.5441 0.3529 1.5441c 0.1765,0.7794 0.3529,1.5735 0.3529 1.5735h 0.0588 c 0.1324,-0.7941 0.2647,-1.5662 0.2647 -1.5662c 0.1324,-0.7721 0.2794,-1.5515 0.2794 -1.5515l 1.0147,-5.2500 h 1.1765 l -2.0000,9.6471 h -1.4706 l -1.4559,-5.8088 c -0.1324,-0.5588 -0.2426,-1.0956 -0.2426 -1.0956c -0.1103,-0.5368 -0.2279,-1.0956 -0.2279 -1.0956h -0.0588 c -0.1176,0.5588 -0.2426,1.0956 -0.2426 1.0956c -0.1250,0.5368 -0.2426,1.0956 -0.2426 1.0956l -1.4265,5.8088 h -1.4559 ZM 209.8382,537.2500 ZM 211.0441,526.7794 h 1.2059 v 2.8529 l -0.0441,1.4706 c 0.5147,-0.4853 1.0735,-0.8309 1.0735 -0.8309c 0.5588,-0.3456 1.3088,-0.3456 1.3088 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -10.4706 ZM 217.8382,537.2500 ZM 219.6618,528.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 219.6618,528.6324 ZM 219.0441,530.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 221.4559,537.2500 ZM 222.6618,526.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 225.2059,537.2500 ZM 225.8824,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 225.8824,533.6912 ZM 230.8824,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 232.5000,537.2500 ZM 233.1029,533.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 237.0735,537.2500 ZM 241.5000,527.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 241.0735,537.2500 ZM 241.9265,535.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 241.9265,535.3971 ZM 243.1176,535.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 248.6029,537.2500 ZM 249.8088,526.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 252.3529,537.2500 ZM 253.3676,535.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 258.5147,537.2500 ZM 259.1912,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 259.1912,533.6912 ZM 264.1912,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,528.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,537.2500 ZM 317.9412,533.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 317.9412,533.6912 ZM 319.1912,533.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 325.4118,537.2500 ZM 326.6176,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 330.3676,537.2500 ZM 331.0441,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 331.0441,533.6912 ZM 332.2941,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 338.3382,537.2500 ZM 340.7500,537.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 340.7500,537.8529 ZM 340.7500,535.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 346.5000,537.2500 ZM 347.1029,533.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 351.0735,537.2500 ZM 351.7500,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 351.7500,533.6912 ZM 353.0000,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 359.0441,537.2500 ZM 360.2500,530.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 367.0882,537.2500 ZM 367.7647,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 367.7647,533.6912 ZM 372.7647,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 377.3529,537.2500 ZM 379.8971,533.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 386.8824,537.2500 ZM 391.3529,533.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 391.3529,533.6912 ZM 393.7794,534.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 417.9559,528.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 447.0588,537.2500 ZM 447.7500,533.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 447.7500,533.6912 ZM 449.0000,533.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 455.2206,537.2500 ZM 456.4265,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 460.1765,537.2500 ZM 460.8529,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 460.8529,533.6912 ZM 462.1029,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 468.1471,537.2500 ZM 470.5588,537.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 470.5588,537.8529 ZM 470.5588,535.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 476.3088,537.2500 ZM 476.6471,527.6029 h 1.2647 l 1.0147,5.2500 c 0.1324,0.7941 0.2794,1.5588 0.2794 1.5588c 0.1471,0.7647 0.2794,1.5588 0.2794 1.5588h 0.0588 c 0.1618,-0.7941 0.3382,-1.5662 0.3382 -1.5662c 0.1765,-0.7721 0.3382,-1.5515 0.3382 -1.5515l 1.3382,-5.2500 h 1.1176 l 1.3382,5.2500 c 0.1765,0.7647 0.3529,1.5441 0.3529 1.5441c 0.1765,0.7794 0.3529,1.5735 0.3529 1.5735h 0.0588 c 0.1324,-0.7941 0.2647,-1.5662 0.2647 -1.5662c 0.1324,-0.7721 0.2794,-1.5515 0.2794 -1.5515l 1.0147,-5.2500 h 1.1765 l -2.0000,9.6471 h -1.4706 l -1.4559,-5.8088 c -0.1324,-0.5588 -0.2426,-1.0956 -0.2426 -1.0956c -0.1103,-0.5368 -0.2279,-1.0956 -0.2279 -1.0956h -0.0588 c -0.1176,0.5588 -0.2426,1.0956 -0.2426 1.0956c -0.1250,0.5368 -0.2426,1.0956 -0.2426 1.0956l -1.4265,5.8088 h -1.4559 ZM 487.8676,537.2500 ZM 489.0735,526.7794 h 1.2059 v 2.8529 l -0.0441,1.4706 c 0.5147,-0.4853 1.0735,-0.8309 1.0735 -0.8309c 0.5588,-0.3456 1.3088,-0.3456 1.3088 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -10.4706 ZM 495.8676,537.2500 ZM 497.6912,528.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 497.6912,528.6324 ZM 497.0735,530.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 499.4853,537.2500 ZM 500.6912,526.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 503.2353,537.2500 ZM 503.9118,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 503.9118,533.6912 ZM 508.9118,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 510.5294,537.2500 ZM 511.1324,533.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 515.1029,537.2500 ZM 516.5147,531.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 520.0735,537.2500 ZM 521.2794,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 525.1765,537.2500 ZM 526.2794,530.1029 h 1.2206 v 4.3676 c 0.0000,1.0147 0.3162,1.4632 0.3162 1.4632c 0.3162,0.4485 1.0221,0.4485 1.0221 0.4485c 0.5588,0.0000 0.9853,-0.2868 0.9853 -0.2868c 0.4265,-0.2868 0.9412,-0.9191 0.9412 -0.9191v -5.0735 h 1.2059 v 7.1471 h -1.0000 l -0.1029,-1.1176 h -0.0441 c -0.5000,0.5882 -1.0515,0.9412 -1.0515 0.9412c -0.5515,0.3529 -1.3015,0.3529 -1.3015 0.3529c -1.1471,-0.0000 -1.6691,-0.7059 -1.6691 -0.7059c -0.5221,-0.7059 -0.5221,-2.0882 -0.5221 -2.0882v -4.5294 ZM 533.1765,537.2500 ZM 533.8529,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 533.8529,533.6912 ZM 538.8529,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,552.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,561.2500 ZM 39.7941,557.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 39.7941,557.6912 ZM 41.0441,557.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 47.2647,561.2500 ZM 48.4706,554.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 52.2206,561.2500 ZM 52.8971,557.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 52.8971,557.6912 ZM 54.1471,557.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 60.1912,561.2500 ZM 62.6029,561.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 62.6029,561.8529 ZM 62.6029,559.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 68.3529,561.2500 ZM 68.9559,557.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 72.9265,561.2500 ZM 73.9412,559.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 79.0882,561.2500 ZM 79.7647,557.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 85.6471,561.2500 ZM 86.5000,559.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 86.5000,559.3971 ZM 87.6912,559.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 93.1765,561.2500 ZM 94.3824,554.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 104.1912,561.2500 ZM 106.7353,557.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 113.7206,561.2500 ZM 118.1912,557.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 118.1912,557.6912 ZM 120.6176,558.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,552.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,561.2500 ZM 169.7206,557.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 169.7206,557.6912 ZM 170.9706,557.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 177.1912,561.2500 ZM 178.3971,554.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 182.1471,561.2500 ZM 182.8235,557.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 182.8235,557.6912 ZM 184.0735,557.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 190.1176,561.2500 ZM 192.5294,561.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 192.5294,561.8529 ZM 192.5294,559.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 198.2794,561.2500 ZM 198.8824,557.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 202.8529,561.2500 ZM 203.7059,559.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 203.7059,559.3971 ZM 204.8971,559.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 210.3824,561.2500 ZM 211.5882,550.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 214.1324,561.2500 ZM 215.3382,550.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,552.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,561.2500 ZM 318.6618,555.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 321.9559,561.2500 ZM 322.8088,559.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 322.8088,559.3971 ZM 324.0000,559.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 329.4853,561.2500 ZM 330.6912,550.7794 h 1.1912 v 7.0882 h 0.0441 l 3.0441,-3.7647 h 1.3382 l -2.3971,2.8676 l 2.7206,4.2794 h -1.3235 l -2.0882,-3.4412 l -1.3382,1.5588 v 1.8824 h -1.1912 v -10.4706 ZM 336.5000,561.2500 ZM 337.1765,557.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 337.1765,557.6912 ZM 342.1765,557.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 343.7941,561.2500 ZM 344.3971,557.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 348.3676,561.2500 ZM 349.0588,557.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 349.0588,557.6912 ZM 350.3088,557.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 356.5294,561.2500 ZM 357.7353,554.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 361.4853,561.2500 ZM 362.1618,557.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 362.1618,557.6912 ZM 363.4118,557.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 369.4559,561.2500 ZM 371.8676,561.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 371.8676,561.8529 ZM 371.8676,559.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 380.5882,561.2500 ZM 383.1324,557.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 390.1176,561.2500 ZM 394.5882,557.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 394.5882,557.6912 ZM 397.0147,558.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 417.9559,552.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 447.0588,561.2500 ZM 447.7500,557.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 447.7500,557.6912 ZM 449.0000,557.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 455.2206,561.2500 ZM 456.4265,554.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 460.1765,561.2500 ZM 460.8529,557.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 460.8529,557.6912 ZM 462.1029,557.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 468.1471,561.2500 ZM 470.5588,561.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 470.5588,561.8529 ZM 470.5588,559.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 476.3088,561.2500 ZM 476.6471,551.6029 h 1.2647 l 1.0147,5.2500 c 0.1324,0.7941 0.2794,1.5588 0.2794 1.5588c 0.1471,0.7647 0.2794,1.5588 0.2794 1.5588h 0.0588 c 0.1618,-0.7941 0.3382,-1.5662 0.3382 -1.5662c 0.1765,-0.7721 0.3382,-1.5515 0.3382 -1.5515l 1.3382,-5.2500 h 1.1176 l 1.3382,5.2500 c 0.1765,0.7647 0.3529,1.5441 0.3529 1.5441c 0.1765,0.7794 0.3529,1.5735 0.3529 1.5735h 0.0588 c 0.1324,-0.7941 0.2647,-1.5662 0.2647 -1.5662c 0.1324,-0.7721 0.2794,-1.5515 0.2794 -1.5515l 1.0147,-5.2500 h 1.1765 l -2.0000,9.6471 h -1.4706 l -1.4559,-5.8088 c -0.1324,-0.5588 -0.2426,-1.0956 -0.2426 -1.0956c -0.1103,-0.5368 -0.2279,-1.0956 -0.2279 -1.0956h -0.0588 c -0.1176,0.5588 -0.2426,1.0956 -0.2426 1.0956c -0.1250,0.5368 -0.2426,1.0956 -0.2426 1.0956l -1.4265,5.8088 h -1.4559 ZM 487.8676,561.2500 ZM 489.0735,550.7794 h 1.2059 v 2.8529 l -0.0441,1.4706 c 0.5147,-0.4853 1.0735,-0.8309 1.0735 -0.8309c 0.5588,-0.3456 1.3088,-0.3456 1.3088 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -10.4706 ZM 495.8676,561.2500 ZM 497.6912,552.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 497.6912,552.6324 ZM 497.0735,554.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 499.4853,561.2500 ZM 500.6912,550.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 503.2353,561.2500 ZM 503.9118,557.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 503.9118,557.6912 ZM 508.9118,557.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 510.5294,561.2500 ZM 511.1324,557.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 515.1029,561.2500 ZM 519.5294,551.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 519.1029,561.2500 ZM 519.9559,559.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 519.9559,559.3971 ZM 521.1471,559.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 526.6324,561.2500 ZM 527.8382,550.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 530.3824,561.2500 ZM 531.3971,559.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 536.5441,561.2500 ZM 537.2206,557.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 537.2206,557.6912 ZM 542.2206,557.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 546.8088,561.2500 ZM 549.3529,557.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 556.3382,561.2500 ZM 560.8088,557.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 560.8088,557.6912 ZM 563.2353,558.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,576.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,585.2500 ZM 40.3088,574.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 42.8529,585.2500 ZM 43.7059,583.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 43.7059,583.3971 ZM 44.8971,583.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 50.3824,585.2500 ZM 51.3971,583.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 56.5441,585.2500 ZM 57.9559,579.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,576.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,585.2500 ZM 169.8824,583.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 169.8824,583.3971 ZM 171.0735,583.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 176.5588,585.2500 ZM 178.9706,585.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 178.9706,585.8529 ZM 178.9706,583.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 184.7206,585.2500 ZM 187.1324,585.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 187.1324,585.8529 ZM 187.1324,583.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 192.8824,585.2500 ZM 193.5588,581.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 193.5588,581.6912 ZM 198.5588,581.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 200.1765,585.2500 ZM 201.3824,578.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 208.2206,585.2500 ZM 208.9118,581.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 208.9118,581.6912 ZM 210.1618,581.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 216.3824,585.2500 ZM 218.9265,580.1765 h 1.6176 c 1.1324,0.0000 1.7353,-0.4632 1.7353 -0.4632c 0.6029,-0.4632 0.6029,-1.4044 0.6029 -1.4044c 0.0000,-0.9559 -0.6029,-1.3382 -0.6029 -1.3382c -0.6029,-0.3824 -1.7353,-0.3824 -1.7353 -0.3824h -1.6176 v 3.5882 ZM 218.9265,580.1765 ZM 223.0000,585.2500 l -2.3235,-4.0735 h -1.7500 v 4.0735 h -1.2206 v -9.6471 h 3.0147 c 0.7353,0.0000 1.3603,0.1397 1.3603 0.1397c 0.6250,0.1397 1.0735,0.4632 1.0735 0.4632c 0.4485,0.3235 0.6985,0.8382 0.6985 0.8382c 0.2500,0.5147 0.2500,1.2647 0.2500 1.2647c 0.0000,1.1324 -0.5882,1.8088 -0.5882 1.8088c -0.5882,0.6765 -1.5735,0.9265 -1.5735 0.9265l 2.4412,4.2059 h -1.3824 ZM 224.9265,585.2500 ZM 226.3088,574.8382 h 2.6324 v 0.6912 h -1.7206 v 11.2647 h 1.7206 v 0.6912 h -2.6324 v -12.6471 ZM 229.3824,585.2500 ZM 230.5441,584.2500 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 236.6912,585.2500 ZM 240.3529,585.4265 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 240.3529,585.4265 ZM 240.3529,584.4559 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 244.0000,585.2500 ZM 247.6618,585.4265 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 247.6618,585.4265 ZM 247.6618,584.4559 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 251.3088,585.2500 ZM 254.9706,585.4265 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 254.9706,585.4265 ZM 254.9706,584.4559 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 258.6176,585.2500 ZM 262.2794,585.4265 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 262.2794,585.4265 ZM 262.2794,584.4559 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 265.9265,585.2500 ZM 268.0882,586.7941 v -11.2647 h -1.7059 v -0.6912 h 2.6176 v 12.6471 h -2.6176 v -0.6912 h 1.7059 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,576.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,585.2500 ZM 317.9265,581.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 323.6471,585.2500 ZM 324.3235,581.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 324.3235,581.6912 ZM 325.5735,581.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 331.6176,585.2500 ZM 332.8235,578.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 339.6618,585.2500 ZM 340.3382,581.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 346.2206,585.2500 ZM 347.0735,583.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 347.0735,583.3971 ZM 348.2647,583.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 353.7500,585.2500 ZM 355.1618,579.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 358.7206,585.2500 ZM 360.0441,575.6029 h 1.4412 l 1.8676,5.1765 l 0.7059,1.9706 h 0.0588 l 0.6765,-1.9706 l 1.8529,-5.1765 h 1.4412 v 9.6471 h -1.1618 v -5.3088 c 0.0000,-0.6471 0.0515,-1.4265 0.0515 -1.4265c 0.0515,-0.7794 0.1103,-1.4265 0.1103 -1.4265h -0.0588 l -0.7794,2.1471 l -1.8529,5.0441 h -0.6912 l -1.8676,-5.0441 l -0.7647,-2.1471 h -0.0588 c 0.0441,0.6471 0.1029,1.4265 0.1029 1.4265c 0.0588,0.7794 0.0588,1.4265 0.0588 1.4265v 5.3088 h -1.1324 v -9.6471 ZM 369.4118,585.2500 ZM 370.2647,583.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 370.2647,583.3971 ZM 371.4559,583.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 376.9412,585.2500 ZM 379.3529,585.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 379.3529,585.8529 ZM 379.3529,583.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 Z"/></g></svg>
+ docs/User/HowTo/streamly-vs-lists.md view
@@ -0,0 +1,292 @@+# Streams are concurrent monadic lists++THIS TUTORIAL IS OBSOLETE.++Streamly streams are a generalization of Haskell lists with a similar API with+two crucial additions:++* A list is a _pure sequence_ of values whereas a stream is a _monadic+  sequence_ of values i.e. a sequence of values generated by monadic actions.+* The monadic actions producing the sequence can be executed concurrently.+  Concurrency is declarative and can be switched on or off using an appropriate+  combinator.++## Pure Streams vs Monadic Streams++A list is a sequence of pure values or pure steps that produce a value on+evaluation.  Ideally, we want to process each element in the sequence through a+pipeline of processing stages without first accumulating all the elements in+the sequence. This style of processing is known as "streaming" and it runs in+constant memory because we do not accumulate elements in memory, data gets+consumed as soon as it is produced.  If all the processing stages are pure,+lists can be used in a streaming style processing. For example, this is+streaming style processing:++```haskell docspec+>>> import Data.Function ((&))+>>> :{+replicate 10 1+    & zipWith (+) [1..10]+    & map (+1)+    & filter odd+    & sum+:}+35+```++However, if a list is generated in a strict monad (e.g. IO) it cannot be+consumed in a streaming fashion as described above. In that case the full list+first gets accumulated and then processed. This means we will consume memory+proportional to the size of the list and therefore it becomes unusable for+large lists. For example, the following code accumulates `xs` before it+processes it:++```haskell docspec+>>> import Control.Monad (replicateM)+>>> xs <- replicateM 10 (return 1)+>>> :{+zipWith (+) [1..10] xs+    & map (+1)+    & filter odd+    & sum+:}+35+```++Monadic streams solve this problem. To be able to consume elements from+`replicateM` as it produces them we need a monadic representation of the stream+and stream processing operations that can consume the stream elements lazily+one at a time. Streamly provides a monadic representation for lists with the+same API.  So we can represent the previous example in a streaming fashion by+replacing the list combinators with corresponding streamly combinators:++```haskell docspec+>>> import qualified Streamly.Data.Stream as S+>>> import qualified Streamly.Data.Fold as F+>>> :{+S.replicateM 10 (return 1)+    & S.zipWith (+) (S.fromList [1..10])+    & fmap (+1)+    & S.filter odd+    & S.fold F.sum+:}+35+```++Streamly's monadic streams are a generalization of pure streams (aka lists) and+therefore can represent pure streams just as easily, making lists a special+case.++## Streamly as lists++`Stream Identity a` can be used in place of `[a]` with equivalent or better+performance and almost identical interface except a few differences. Use of+`OverloadedLists` extension can make the difference even less significant.+++### Construction++Lists are constructed using `[]` and `:`.++```haskell docspec+>>> "hello" : "world" : []+["hello","world"]+```++Pure streams are constructed using `S.nil` (corresponds to `[]`) and `S.cons`+or `.:` (corresponds to `:`):++```haskell docspec+>>> import Data.Functor.Identity (Identity)+>>> import Streamly.Data.StreamK (StreamK)+>>> import qualified Streamly.Data.StreamK as StreamK+>>> "hello" `StreamK.cons` "world" `StreamK.cons` StreamK.nil :: StreamK Identity String+fromList ["hello","world"]+```++### Pattern Matching++The crucial difference is that lists are built using constructors whereas+streams are built using functions. `S.nil` and `S.cons` are functions.+Therefore, you cannot directly pattern match on streams.  However, the yet+unexposed `Streamly.Internal.Data.List` module also provides `Nil` and `Cons`+pattern synonyms corresponding to the list `[]` and `:` constructors for pattern+matches.++### Pure Operations++`Stream Identity a` is an instance of `Show`, `Read`, `Eq`, `Ord`, `IsList`,+`Foldable` and `Traversable` type classes. Furthermore, `Stream Identity Char`+is an instance of `IsString`. Use of `OverloadedLists` and `OverloadedStrings`+can make the use of streams in place of lists quite convenient.++Along with these we can use combinators from `Streamly.Data.Stream` to perform+all list operations on pure streams.++Lists:++```haskell docspec+>>> replicate 10 1+[1,1,1,1,1,1,1,1,1,1]++>>> map (+1) $ replicate 10 1+[2,2,2,2,2,2,2,2,2,2]++>>> length $ replicate 10 1+10+```++Pure streams are almost identical:++```+>>> S.replicate 10 1 :: S.Stream Identity Int+fromList [1,1,1,1,1,1,1,1,1,1]++>>> S.map (+1) $ S.replicate 10 1 :: S.Stream Identity Int+fromList [2,2,2,2,2,2,2,2,2,2]++>>> S.fold F.length (S.replicate 10 1 :: S.Stream Identity Int)+10+```++## Monadic Operations++Lists have great performance as long as we perform only pure operations on+them. When monadic operations are performed on lists, they may accumulate+potentially unbounded or large lists in memory degrading performance massively.++Such "unsafe" list operations exist in `Control.Monad`, `Data.Traversable`, and+`Data.Foldable` in `base`. They are typically found with an `M` suffix.++Streamly provides monadic streams and the equivalents of the above mentioned+monadic list operations work on streams without any issues.++Unsafe monadic operations involving lists, run these example with `+RTS -s`+options:++```haskell unshared+import Control.Monad++main = do+  xs <- replicateM 10000000 (pure 1)+  ys <- mapM (\x -> return $ x + 1) xs+  print $ length ys+```++Streams:++```haskell unshared+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.Fold as F++main = do+  n <- S.fold F.length+      $ S.mapM (\x -> return $ x + 1)+      $ S.replicateM 10000000 (pure 1)+  print n+```++## Splitting Operations++Another unsafe category of operations for lists is stream splitting operations+e.g. `lines`, `splitAt` and `group`. Such operations may also accumulate+unbounded data in memory.++Stream splitting operations in streamly are streaming in nature and can work+without accumulating any data in memory.++### Monadic Lists++Monadic streams are nothing but lists made monadic. We can construct streams+using monadic actions, just the way pure lists are constructed:++<!-- We are not type checking this -->+```+>>> import qualified Streamly.Data.StreamK as StreamK+>>> StreamK.toList $ getLine `StreamK.cons` getLine `StreamK.cons` StreamK.nil+hello+world+["hello","world"]+```++The monadic action `getLine` is executed twice in a sequence, the first one+gets "hello" and second one gets "world" from the terminal and a stream+consisting of those strings is produced.++## Concurrent Monadic Lists++Streamly streams are not just monadic lists but they are concurrent monadic+lists. All the monadic streaming operations provided by streamly are inherently+concurrent.  Concurrent behavior can be enabled by just using an appropriate+modifying combinator, without any other change to the code.++The following code prints one element every second:++```haskell docspec+>>> import Control.Concurrent+>>> import qualified Streamly.Data.Stream.Prelude as S+>>> import qualified Streamly.Data.Fold as F++>>> func = S.mapM (\x -> threadDelay 1000000 >> print x) $ S.replicate 10 1+>>> main = S.fold F.drain func+```++To run it concurrently, depending on what you want to make concurrent, you can+use `parMapM` or `parBuffered`.++```haskell docspec+>>> func = S.parMapM id (\x -> threadDelay 1000000 >> print x) $ S.replicate 10 1+>>> main = S.fold F.drain func+```++The `parMapM` combinator now maps the monadic delay action concurrently on all+the stream elements.  It prints all the 10 elements after one second because all+the delay actions run concurrently. Alternatively we can write:++```haskell docspec+>>> func = S.parReplicateM id 10 (threadDelay 1000000 >> print 1)+>>> main = S.fold F.drain func+```++Here, the `parReplicateM` operation replicates the action concurrently.  In real+applications this could be a request to a web server that you may want to+perform multiple times concurrently.++## Performance: Streamly vs Lists++The following figures show the ratio of time and memory consumed by `[Int]`+(`base-4.12`) vs `Stream Identity Int`+([streamly@00c7613](https://github.com/composewell/streamly)) for exactly the+same operation. `5x` on the y axis means lists take 5 times more resources+compared to streamly. Whereas a `1/5x` means that lists take 5 times less+resources compared to streamly. We only show those operations that are at least+10% better or worse in one library compared to the other. The operations are+shown in a sorted order, from list's worst performing ones on the left to its+best ones on the right.++![Streamly vs Lists (time) comparison](/docs/User/HowTo/streamly-vs-list-time.svg)++## Why use streams instead of lists?++By using monadic streams instead of lists you get the following benefits:++* Use just one library for pure or monadic lists. There is no difference in+  pure or monadic code, its all the same.+* You can use a monadic action anywhere in the code e.g. printing a warning or+  error message or any other effectful operations. This is not possible in pure+  list code.+* You can make the code concurrent whenever you want without having to modify+  it.+* You do not have the risk of using unsafe/accumulating list operations+  degrading performance massively and resulting in space leaks.+* Streamly provides safe versions of partial list functions like `head`, `tail`+  etc.+* You get better fusion and therefore better performance for many operations,+  the only operation which is significantly faster for lists is `concatMap`.++## References++* [Data.List](https://hackage.haskell.org/package/base/docs/Data-List.html)+* [Control.Monad](http://hackage.haskell.org/package/base/docs/Control-Monad.html)+* [Data.Foldable](http://hackage.haskell.org/package/base/docs/Data-Foldable.html)+* [Data.Traversable](http://hackage.haskell.org/package/base/docs/Data-Traversable.html)
+ docs/User/Project/ApiChangelogs/0.10.1-0.11.0.txt view
@@ -0,0 +1,261 @@+---------------------------------+API Annotations+---------------------------------++[A] : Added+[R] : Removed+[C] : Changed+[O] : Old definition+[N] : New definition+[D] : Deprecated++---------------------------------+API diff+---------------------------------++[C] Streamly.Data.Stream.Prelude+    [A] useAcquire :: AcquireIO -> Config -> Config+    [D] parEval :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [A] parCrossApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] parBuffered :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [D] parApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] clearAcquire :: Config -> Config+[A] Streamly.Data.Scanl.Prelude+    [A] Config+    [A] parTeeWith :: MonadAsync m => (Config -> Config) -> (a -> b -> c) -> Scanl m x a -> Scanl m x b -> Scanl m x c+    [A] parDistributeScanM :: MonadAsync m => (Config -> Config) -> m [Scanl m a b] -> Stream m a -> Stream m [b]+    [A] parDistributeScan :: MonadAsync m => (Config -> Config) -> [Scanl m a b] -> Stream m a -> Stream m [b]+    [A] parDemuxScanM :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> m (Scanl m a b)) -> Stream m a -> Stream m [(k, b)]+    [A] parDemuxScan :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> Scanl m a b) -> Stream m a -> Stream m [(k, b)]+    [A] maxBuffer :: Int -> Config -> Config+    [A] inspect :: Bool -> Config -> Config+    [A] boundThreads :: Bool -> Config -> Config+[C] Streamly.Data.Fold.Prelude+    [C] toHashMapIO+        [O] toHashMapIO :: (MonadIO m, Hashable k, Ord k) => (a -> k) -> Fold m a b -> Fold m a (HashMap k b)+        [N] toHashMapIO :: (MonadIO m, Hashable k) => (a -> k) -> Fold m a b -> Fold m a (HashMap k b)+    [A] parUnzip :: MonadAsync m => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (b, c) (x, y)+    [A] parTee :: MonadAsync m => (Config -> Config) -> Fold m x a -> Fold m x b -> Fold m x (a, b)+    [A] parPartition :: MonadAsync m => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)+    [D] parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+    [A] parDistributeScan :: MonadAsync m => (Config -> Config) -> m [Fold m a b] -> Stream m a -> Stream m [b]+    [A] parDistribute :: MonadAsync m => (Config -> Config) -> [Fold m a b] -> Fold m a [b]+    [A] parDemuxScan :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> m (Fold m a b)) -> Stream m a -> Stream m [(k, b)]+    [A] parBuffered :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b++---------------------------------+Internal API diff+---------------------------------++[C] Streamly.Internal.Network.Inet.TCP+    [A] pipeChunks :: (MonadAsync m, MonadCatch m) => (Word8, Word8, Word8, Word8) -> PortNumber -> Stream m (Array Word8) -> Stream m (Array Word8)+[D] Streamly.Internal.FileSystem.Event.Linux+[D] Streamly.Internal.FileSystem.Event+[C] Streamly.Internal.Data.Stream.Prelude+    [C] Channel+        [C] [enqueue]+            [O] [enqueue] :: Channel m a -> Bool -> (RunInIO m, StreamK m a) -> IO ()+            [N] [enqueue] :: Channel m a -> (RunInIO m, StreamK m a) -> IO ()+        [A] [channelStopping] :: Channel m a -> IORef Bool+        [A] [channelStopped] :: Channel m a -> MVar Bool+        [C] Channel+            [O] Channel :: RunInIO m -> IORef ([ChildEvent a], Int) -> MVar () -> m [ChildEvent a] -> m Bool -> Limit -> Limit -> Maybe (IORef Count) -> Maybe YieldRateInfo -> (Bool -> (RunInIO m, StreamK m a) -> IO ()) -> m () -> IO Bool -> IO Bool -> IORef Bool -> (Maybe WorkerInfo -> m ()) -> IORef (Set ThreadId) -> IORef Int -> (ThreadId -> m ()) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a+            [N] Channel :: RunInIO m -> Limit -> IORef ([ChildEvent a], Int) -> MVar () -> m [ChildEvent a] -> m Bool -> Maybe (IORef Count) -> IO Bool -> Maybe YieldRateInfo -> IORef Bool -> m () -> ((RunInIO m, StreamK m a) -> IO ()) -> IO Bool -> (Maybe WorkerInfo -> m ()) -> IORef Bool -> MVar Bool -> Limit -> IORef (Set ThreadId) -> IORef Int -> (ThreadId -> m ()) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a+    [A] yieldWith :: Maybe WorkerInfo -> Channel m a -> a -> IO Bool+    [R] yield :: Channel m a -> Maybe WorkerInfo -> a -> IO Bool+    [A] useAcquire :: AcquireIO -> Config -> Config+    [A] timedGroupsOf :: MonadAsync m => Double -> Int -> Fold m a b -> Stream m a -> Stream m b+    [A] timedChunksOf' :: (MonadAsync m, Unbox a) => Double -> Int -> Stream m a -> Stream m (Array a)+    [A] timedChunksOf :: (MonadAsync m, Unbox a) => Double -> Int -> Stream m a -> Stream m (Array a)+    [A] stopWith :: Maybe WorkerInfo -> Channel m a -> IO ()+    [R] stopChannel :: MonadIO m => Channel m a -> m ()+    [R] stop :: Channel m a -> Maybe WorkerInfo -> IO ()+    [C] startChannel+        [O] startChannel :: MonadRunInIO m => Channel m a -> m ()+        [N] startChannel :: MonadIO m => Channel m a -> m ()+    [A] shutdown :: MonadIO m => Channel m a -> m ()+    [R] sendWorkerWait :: MonadIO m => Bool -> (Channel m a -> IO ()) -> (Channel m a -> m Bool) -> Channel m a -> m ()+    [C] readOutputQPaced+        [O] readOutputQPaced :: MonadRunInIO m => Channel m a -> m [ChildEvent a]+        [N] readOutputQPaced :: MonadIO m => Channel m a -> m [ChildEvent a]+    [C] readOutputQBounded+        [O] readOutputQBounded :: MonadRunInIO m => Bool -> Channel m a -> m [ChildEvent a]+        [N] readOutputQBounded :: MonadIO m => Bool -> Channel m a -> m [ChildEvent a]+    [R] pushWorker :: MonadRunInIO m => Count -> Channel m a -> m ()+    [C] postProcessPaced+        [O] postProcessPaced :: MonadRunInIO m => Channel m a -> m Bool+        [N] postProcessPaced :: MonadIO m => Channel m a -> m Bool+    [C] postProcessBounded+        [O] postProcessBounded :: MonadRunInIO m => Channel m a -> m Bool+        [N] postProcessBounded :: MonadIO m => Channel m a -> m Bool+    [A] parYieldWith :: (Config -> Config) -> ((a -> m b) -> m c) -> Stream m a+    [A] parMergeMap :: (Config -> Config) -> (a -> Stream m b) -> Stream m a -> Stream m b+    [A] parMergeIterate :: (Config -> Config) -> (a -> Stream m a) -> Stream m a -> Stream m a+    [D] parEval :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [A] parCrossApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] parBuffered :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [D] parApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] newStreamAndCallback :: MonadAsync m => m (a -> m (), Stream m a)+    [A] newRateInfo :: Config -> IO (Maybe YieldRateInfo)+    [A] maxYields :: Maybe Int64 -> Config -> Config+    [D] groupsOfTimeout :: MonadAsync m => Int -> Double -> Fold m a b -> Stream m a -> Stream m b+    [A] getYieldLimit :: Config -> Maybe Count+    [A] getStreamRate :: Config -> Maybe Rate+    [A] getOrdered :: Config -> Bool+    [A] getMaxThreads :: Config -> Limit+    [A] getMaxBuffer :: Config -> Limit+    [A] getInterleaved :: Config -> Bool+    [A] getInspectMode :: Config -> Bool+    [A] getEagerDispatch :: Config -> Bool+    [A] getCleanup :: Config -> Maybe (IO () -> IO ())+    [C] fromChannelK+        [O] fromChannelK :: MonadAsync m => Channel m a -> StreamK m a+        [N] fromChannelK :: MonadAsync m => Maybe (IO () -> IO ()) -> Channel m a -> StreamK m a+    [A] forkWorker :: MonadIO m => Count -> Channel m a -> m ()+    [A] exceptionWith :: Maybe WorkerInfo -> Channel m a -> SomeException -> IO ()+    [R] dumpSVar :: Channel m a -> IO String+    [A] dumpChannel :: Channel m a -> IO String+    [C] dispatchWorkerPaced+        [O] dispatchWorkerPaced :: MonadRunInIO m => Channel m a -> m Bool+        [N] dispatchWorkerPaced :: MonadIO m => Channel m a -> m Bool+    [C] dispatchWorker+        [O] dispatchWorker :: MonadRunInIO m => Count -> Channel m a -> m Bool+        [N] dispatchWorker :: MonadIO m => Count -> Channel m a -> m Bool+    [A] dispatchAllWait :: MonadIO m => Bool -> (Channel m a -> IO ()) -> (Channel m a -> m Bool) -> Channel m a -> m ()+    [A] clearAcquire :: Config -> Config+    [A] cleanupChan :: Channel m a -> String -> IO ()+    [A] channelDone :: Channel m a -> String -> IO ()+    [A] chanConcatMapK :: MonadAsync m => (Config -> Config) -> Channel m b -> (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] boundedIntervalsOf :: Int -> Double -> Int -> Fold m a b -> Stream m a -> Stream m b+    [A] boundThreads :: Bool -> Config -> Config+[A] Streamly.Internal.Data.Scanl.Prelude+    [A] OutEvent+        [A] FoldPartial :: b -> OutEvent b+        [A] FoldException :: ThreadId -> SomeException -> OutEvent b+        [A] FoldEOF :: ThreadId -> OutEvent b+        [A] FoldDone :: ThreadId -> b -> OutEvent b+    [A] Config+    [A] Channel+        [A] [svarStats] :: Channel m a b -> SVarStats+        [A] [svarRef] :: Channel m a b -> Maybe (IORef ())+        [A] [svarInspectMode] :: Channel m a b -> Bool+        [A] [svarCreator] :: Channel m a b -> ThreadId+        [A] [readInputQ] :: Channel m a b -> m [ChildEvent a]+        [A] [outputQueue] :: Channel m a b -> IORef ([OutEvent b], Int)+        [A] [outputDoorBell] :: Channel m a b -> MVar ()+        [A] [maxInputBuffer] :: Channel m a b -> Limit+        [A] [inputSpaceDoorBell] :: Channel m a b -> MVar ()+        [A] [inputQueue] :: Channel m a b -> IORef ([ChildEvent a], Int)+        [A] [inputItemDoorBell] :: Channel m a b -> MVar ()+        [A] [closedForInput] :: Channel m a b -> IORef Bool+        [A] Channel :: IORef ([ChildEvent a], Int) -> Limit -> MVar () -> IORef Bool -> MVar () -> m [ChildEvent a] -> IORef ([OutEvent b], Int) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a b+    [A] sendToWorker_ :: MonadAsync m => Channel m a b -> a -> m ()+    [A] sendToWorker :: MonadAsync m => Channel m a b -> a -> m (Maybe b)+    [A] parTeeWith :: MonadAsync m => (Config -> Config) -> (a -> b -> c) -> Scanl m x a -> Scanl m x b -> Scanl m x c+    [A] parDistributeScanM :: MonadAsync m => (Config -> Config) -> m [Scanl m a b] -> Stream m a -> Stream m [b]+    [A] parDistributeScan :: MonadAsync m => (Config -> Config) -> [Scanl m a b] -> Stream m a -> Stream m [b]+    [A] parDemuxScanM :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> m (Scanl m a b)) -> Stream m a -> Stream m [(k, b)]+    [A] parDemuxScan :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> Scanl m a b) -> Stream m a -> Stream m [(k, b)]+    [A] newScanChannel :: MonadRunInIO m => (Config -> Config) -> Scanl m a b -> m (Channel m a b)+    [A] newChannelWithScan :: MonadRunInIO m => IORef ([OutEvent b], Int) -> MVar () -> (Config -> Config) -> Scanl m a b -> m (Channel m a b, ThreadId)+    [A] newChannelWith :: MonadRunInIO m => IORef ([OutEvent b], Int) -> MVar () -> (Config -> Config) -> Fold m a b -> m (Channel m a b, ThreadId)+    [A] newChannel :: MonadRunInIO m => (Config -> Config) -> Fold m a b -> m (Channel m a b)+    [A] maxBuffer :: Int -> Config -> Config+    [A] inspect :: Bool -> Config -> Config+    [A] finalize :: MonadIO m => Channel m a b -> m ()+    [A] dumpChannel :: Channel m a b -> IO String+    [A] defaultConfig :: Config+    [A] cleanup :: MonadIO m => Channel m a b -> m ()+    [A] checkFoldStatus :: MonadAsync m => Channel m a b -> m (Maybe b)+    [A] boundThreads :: Bool -> Config -> Config+[C] Streamly.Internal.Data.Fold.Prelude+    [A] OutEvent+        [A] FoldPartial :: b -> OutEvent b+        [A] FoldException :: ThreadId -> SomeException -> OutEvent b+        [A] FoldEOF :: ThreadId -> OutEvent b+        [A] FoldDone :: ThreadId -> b -> OutEvent b+    [C] Channel+        [R] [readOutputQ] :: Channel m a b -> m [ChildEvent a]+        [A] [readInputQ] :: Channel m a b -> m [ChildEvent a]+        [C] [outputQueue]+            [O] [outputQueue] :: Channel m a b -> IORef ([ChildEvent a], Int)+            [N] [outputQueue] :: Channel m a b -> IORef ([OutEvent b], Int)+        [R] [outputQueueFromConsumer] :: Channel m a b -> IORef ([ChildEvent b], Int)+        [R] [outputDoorBellFromConsumer] :: Channel m a b -> MVar ()+        [A] [maxInputBuffer] :: Channel m a b -> Limit+        [R] [maxBufferLimit] :: Channel m a b -> Limit+        [A] [inputSpaceDoorBell] :: Channel m a b -> MVar ()+        [A] [inputQueue] :: Channel m a b -> IORef ([ChildEvent a], Int)+        [A] [inputItemDoorBell] :: Channel m a b -> MVar ()+        [A] [closedForInput] :: Channel m a b -> IORef Bool+        [R] [bufferSpaceDoorBell] :: Channel m a b -> MVar ()+        [C] Channel+            [O] Channel :: IORef ([ChildEvent a], Int) -> Limit -> MVar () -> m [ChildEvent a] -> IORef ([ChildEvent b], Int) -> MVar () -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a b+            [N] Channel :: IORef ([ChildEvent a], Int) -> Limit -> MVar () -> IORef Bool -> MVar () -> m [ChildEvent a] -> IORef ([OutEvent b], Int) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a b+    [A] sendToWorker_ :: MonadAsync m => Channel m a b -> a -> m ()+    [A] parUnzipWithM :: MonadAsync m => (Config -> Config) -> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+    [A] parUnzip :: MonadAsync m => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (b, c) (x, y)+    [A] parTeeWith :: MonadAsync m => (Config -> Config) -> (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+    [A] parTee :: MonadAsync m => (Config -> Config) -> Fold m x a -> Fold m x b -> Fold m x (a, b)+    [A] parPartition :: MonadAsync m => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)+    [A] parLmapM :: (Config -> Config) -> (a -> m b) -> Fold m b r -> Fold m a r+    [D] parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+    [A] parDistributeScan :: MonadAsync m => (Config -> Config) -> m [Fold m a b] -> Stream m a -> Stream m [b]+    [A] parDistribute :: MonadAsync m => (Config -> Config) -> [Fold m a b] -> Fold m a [b]+    [A] parDemuxScan :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> m (Fold m a b)) -> Stream m a -> Stream m [(k, b)]+    [A] parBuffered :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+    [A] newScanChannel :: MonadRunInIO m => (Config -> Config) -> Scanl m a b -> m (Channel m a b)+    [A] newChannelWithScan :: MonadRunInIO m => IORef ([OutEvent b], Int) -> MVar () -> (Config -> Config) -> Scanl m a b -> m (Channel m a b, ThreadId)+    [A] newChannelWith :: MonadRunInIO m => IORef ([OutEvent b], Int) -> MVar () -> (Config -> Config) -> Fold m a b -> m (Channel m a b, ThreadId)+    [A] finalize :: MonadIO m => Channel m a b -> m ()+    [R] dumpSVar :: Channel m a b -> IO String+    [A] dumpChannel :: Channel m a b -> IO String+    [A] defaultConfig :: Config+    [A] cleanup :: MonadIO m => Channel m a b -> m ()+[C] Streamly.Internal.Data.Channel+    [C] YieldRateInfo+    [R] Config+    [R] workerRateControl :: Limit -> IORef Int -> YieldRateInfo -> WorkerInfo -> IO Bool+    [R] stopWhen :: StopWhen -> Config -> Config+    [R] setStreamLatency :: Int -> Config -> Config+    [C] sendYield+        [O] sendYield :: Limit -> Limit -> IORef Int -> Maybe WorkerInfo -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> ChildEvent a -> IO Bool+        [N] sendYield :: Limit -> Limit -> IORef Int -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> Maybe WorkerInfo -> a -> IO Bool+    [R] sendWithDoorBell :: IORef ([ChildEvent a], Int) -> MVar () -> ChildEvent a -> IO Int+    [C] sendStop+        [O] sendStop :: IORef Int -> Maybe WorkerInfo -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> IO ()+        [N] sendStop :: IORef Int -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> Maybe WorkerInfo -> IO ()+    [A] sendException :: IORef Int -> IORef ([ChildEvent a], Int) -> MVar () -> SomeException -> IO ()+    [A] sendEvent :: IORef ([a], Int) -> MVar () -> a -> IO Int+    [C] readOutputQBasic+        [O] readOutputQBasic :: IORef ([ChildEvent a], Int) -> IO ([ChildEvent a], Int)+        [N] readOutputQBasic :: IORef ([a], Int) -> IO ([a], Int)+    [R] rate :: Maybe Rate -> Config -> Config+    [R] ordered :: Bool -> Config -> Config+    [R] newRateInfo :: Config -> IO (Maybe YieldRateInfo)+    [R] minRate :: Double -> Config -> Config+    [R] maxYields :: Maybe Int64 -> Config -> Config+    [R] maxThreads :: Int -> Config -> Config+    [R] maxRate :: Double -> Config -> Config+    [R] maxBuffer :: Int -> Config -> Config+    [R] interleaved :: Bool -> Config -> Config+    [R] inspect :: Bool -> Config -> Config+    [A] incrWorkerYieldCount :: Limit -> IORef Int -> YieldRateInfo -> WorkerInfo -> IO Bool+    [R] handleChildException :: IORef ([ChildEvent a], Int) -> MVar () -> SomeException -> IO ()+    [R] getYieldLimit :: Config -> Maybe Count+    [R] getStreamRate :: Config -> Maybe Rate+    [R] getStreamLatency :: Config -> Maybe NanoSecond64+    [R] getStopWhen :: Config -> StopWhen+    [R] getOrdered :: Config -> Bool+    [R] getMaxThreads :: Config -> Limit+    [R] getMaxBuffer :: Config -> Limit+    [R] getInterleaved :: Config -> Bool+    [R] getInspectMode :: Config -> Bool+    [R] getEagerDispatch :: Config -> Bool+    [R] getBound :: Config -> Bool+    [R] eager :: Bool -> Config -> Config+    [R] defaultConfig :: Config+    [R] constRate :: Double -> Config -> Config+    [R] cleanupSVar :: IORef (Set ThreadId) -> IO ()+    [R] boundThreads :: Bool -> Config -> Config+    [R] avgRate :: Double -> Config -> Config
+ docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt view
@@ -0,0 +1,253 @@+# API diff as generated by cabal-diff with minor edits.+# ~~~ means deprecated module+# ~~ means deprecated symbol++#----------------------------+# Changes from 0.7.3 to 0.8.0+#----------------------------++# Deprecated, merged into Streamly.Prelude+~~~ Streamly+# Fixity changes+++ infixr 6 `ahead`+++ infixr 6 `async`+++ infixr 6 `parallel`+++ infixr 6 `serial`+++ infixr 6 `wAsync`+++ infixr 6 `wSerial`++# Added+@@@ Streamly.Console.Stdio++# Deprecated, renamed+~~~ Streamly.Memory.Array+@@@ Streamly.Data.Array.Foreign++# Moved from Streamly.Memory.Array+++ data Array a+++ fromList :: Storable a => [a] -> Array a+++ fromListN :: Storable a => Int -> [a] -> Array a+++ length :: forall a. Storable a => Array a -> Int+++ read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a+++ toList :: Storable a => Array a -> [a]+++ write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)+++ writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)++# Added+++ asBytes :: Array a -> Array Word8+++ cast :: forall a b. Storable b => Array a -> Maybe (Array b)+++ getIndex :: Storable a => Array a -> Int -> Maybe a+++ readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a+++ writeLastN :: (Storable a, MonadIO m) => Int -> Fold m a (Array a)++@@@ Streamly.Data.Fold+# Signature changed+ - product :: (Monad m, Num a) => Fold m a a+ + product :: (Monad m, Num a, Eq a) => Fold m a a++# Removed (Moved to the Streamly.Data.Fold.Tee module)+-- instance (Monad m, Floating b) => Floating (Fold m a b)+-- instance (Monad m, GHC.Num.Num b) => GHC.Num.Num (Fold m a b)+-- instance (Monad m, GHC.Real.Fractional b) => GHC.Real.Fractional (Fold m a b)+-- instance (Semigroup b, Monad m) => Semigroup (Fold m a b)+-- instance (Semigroup b, Monoid b, Monad m) => Monoid (Fold m a b)+-- instance Applicative m => Applicative (Fold m a)++# Renamed+~~ mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c+++ rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c++# Deprecated+~~ sequence :: Monad m => Fold m a (m b) -> Fold m a b++# Added+++ catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b+++ chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c+++ concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c+++ filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r+++ filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r+++ foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b+++ foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b+++ foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b+++ lmap :: (a -> b) -> Fold m b r -> Fold m a r+++ lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r+++ many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+++ mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r+++ rollingHash :: (Monad m, Enum a) => Fold m a Int64+++ rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64+++ sconcat :: (Monad m, Semigroup a) => a -> Fold m a a+++ serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+++ take :: Monad m => Int -> Fold m a b -> Fold m a b+++ takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+++ takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+++ teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+++ toListRev :: Monad m => Fold m a [a]++# Added+@@@ Streamly.Data.Fold.Tee++@@@ Streamly.Data.Unfold+# Added+++ crossWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+++ drop :: Applicative m => Int -> Unfold m a b -> Unfold m a b+++ dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+++ dropWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+++ filter :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+++ filterM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+++ fromList :: Applicative m => Unfold m [a] a+++ fromListM :: Applicative m => Unfold m [m a] a+++ fromStream :: (IsStream t, Applicative m) => Unfold m (t m a) a+++ function :: Applicative m => (a -> b) -> Unfold m a b+++ functionM :: Applicative m => (a -> m b) -> Unfold m a b+++ iterateM :: Monad m => (a -> m a) -> Unfold m (m a) a+++ lmap :: (a -> c) -> Unfold m c b -> Unfold m a b+++ lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b+++ many :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c+++ mapM :: Monad m => (b -> m c) -> Unfold m a b -> Unfold m a c+++ repeatM :: Monad m => Unfold m (m a) a+++ replicateM :: Monad m => Int -> Unfold m (m a) a+++ take :: Monad m => Int -> Unfold m a b -> Unfold m a b+++ takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+++ takeWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+++ unfoldr :: Applicative m => (a -> Maybe (b, a)) -> Unfold m a b+++ unfoldrM :: Applicative m => (a -> m (Maybe (b, a))) -> Unfold m a b+++ zipWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d++# Deprecated, renamed to Streamly.Unicode.Stream+~~~ Streamly.Data.Unicode.Stream++@@@ Streamly.Network.Socket+# Added+++ forSocketM :: (MonadMask m, MonadIO m) => (Socket -> m ()) -> Socket -> m ()+++ readChunk :: Int -> Socket -> IO (Array Word8)+++ writeChunk :: Storable a => Socket -> Array a -> IO ()+++ writeChunksWithBufferOf :: (MonadIO m, Storable a) => Int -> Socket -> Fold m (Array a) ()++@@@ Streamly.Prelude+# Signature changed+ - after :: (IsStream t, Monad m) => m b -> t m a -> t m a+ + after :: (IsStream t, MonadIO m, MonadBaseControl IO m) => m b -> t m a -> t m a+ - bracket :: (IsStream t, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a+ + bracket :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a+ - concatMapWith :: IsStream t => (forall c. t m c -> t m c -> t m c) -> (a -> t m b) -> t m a -> t m b+ + concatMapWith :: IsStream t => (t m b -> t m b -> t m b) -> (a -> t m b) -> t m a -> t m b+ - finally :: (IsStream t, MonadCatch m) => m b -> t m a -> t m a+ + finally :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> t m a -> t m a+ - foldlM' :: Monad m => (b -> a -> m b) -> b -> SerialT m a -> m b+ + foldlM' :: Monad m => (b -> a -> m b) -> m b -> SerialT m a -> m b+ - postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b+ + postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b+ - scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b+ + scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b++# Renamed+~~ yieldM :: (Monad m, IsStream t) => m a -> t m a+++ fromEffect :: (Monad m, IsStream t) => m a -> t m a+~~ yield :: IsStream t => a -> t m a+++ fromPure :: IsStream t => a -> t m a+~~ concatUnfold :: (IsStream t, Monad m) => Unfold m a b -> t m a -> t m b+++ unfoldMany :: (IsStream t, Monad m) => Unfold m a b -> t m a -> t m b++# Moved from "Streamly" module+## Fixity change+++ infixr 6 `ahead`+++ infixr 6 `async`+++ infixr 6 `parallel`+++ infixr 6 `serial`+++ infixr 6 `wAsync`+++ infixr 6 `wSerial`+## Renamed+~~ foldWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a+++ concatFoldableWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a+~~ forEachWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b+++ concatForFoldableWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b+~~ foldMapWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b+++ concatMapFoldableWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b+~~ aheadly :: IsStream t => AheadT m a -> t m a+++ fromAhead :: IsStream t => AheadT m a -> t m a+~~ asyncly :: IsStream t => AsyncT m a -> t m a+++ fromAsync :: IsStream t => AsyncT m a -> t m a+~~ parallely :: IsStream t => ParallelT m a -> t m a+++ fromParallel :: IsStream t => ParallelT m a -> t m a+~~ serially :: IsStream t => SerialT m a -> t m a+++ fromSerial :: IsStream t => SerialT m a -> t m a+~~ wAsyncly :: IsStream t => WAsyncT m a -> t m a+++ fromWAsync :: IsStream t => WAsyncT m a -> t m a+~~ wSerially :: IsStream t => WSerialT m a -> t m a+++ fromWSerial :: IsStream t => WSerialT m a -> t m a+~~ zipAsyncly :: IsStream t => ZipAsyncM m a -> t m a+++ fromZipAsync :: IsStream t => ZipAsyncM m a -> t m a+~~ zipSerially :: IsStream t => ZipSerialM m a -> t m a+++ fromZipSerial :: IsStream t => ZipSerialM m a -> t m a+## unchanged+++ class (forall m a. MonadAsync m => Semigroup (t m a), forall m a. MonadAsync m => Monoid (t m a), forall m. Monad m => Functor (t m), forall m. MonadAsync m => Applicative (t m)) => IsStream t+++ data AheadT m a+++ data AsyncT m a+++ data ParallelT m a+++ data Rate Rate :: Double -> Double -> Double -> Int -> Rate+++ data SerialT m a+++ data WAsyncT m a+++ data WSerialT m a+++ data ZipAsyncM m a+++ data ZipSerialM m a+++ type Ahead = AheadT IO+++ type Async = AsyncT IO+++ type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)+++ type Parallel = ParallelT IO+++ type Serial = SerialT IO+++ type WAsync = WAsyncT IO+++ type WSerial = WSerialT IO+++ type ZipAsync = ZipAsyncM IO+++ type ZipSerial = ZipSerialM IO+++ (|$) :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> t m a -> t m b+++ (|$.) :: (IsStream t, MonadAsync m) => (t m a -> m b) -> t m a -> m b+++ (|&) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> t m b) -> t m b+++ (|&.) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> m b) -> m b+++ [rateBuffer] :: Rate -> Int+++ [rateGoal] :: Rate -> Double+++ [rateHigh] :: Rate -> Double+++ [rateLow] :: Rate -> Double+++ adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a+++ ahead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+++ async :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+++ avgRate :: IsStream t => Double -> t m a -> t m a+++ constRate :: IsStream t => Double -> t m a -> t m a+++ maxBuffer :: IsStream t => Int -> t m a -> t m a+++ maxRate :: IsStream t => Double -> t m a -> t m a+++ maxThreads :: IsStream t => Int -> t m a -> t m a+++ minRate :: IsStream t => Double -> t m a -> t m a+++ mkAsync :: (IsStream t, MonadAsync m) => t m a -> t m a+++ parallel :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+++ rate :: IsStream t => Maybe Rate -> t m a -> t m a+++ serial :: IsStream t => t m a -> t m a -> t m a+++ wAsync :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+++ wSerial :: IsStream t => t m a -> t m a -> t m a++# Added+++ delay :: (IsStream t, MonadIO m) => Double -> t m a -> t m a+++ foldMany :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b+++ intercalate :: (IsStream t, Monad m) => Unfold m b c -> b -> t m b -> t m c+++ intercalateSuffix :: (IsStream t, Monad m) => Unfold m b c -> b -> t m b -> t m c+++ liftInner :: (Monad m, IsStream t, MonadTrans tr, Monad (tr m)) => t m a -> t (tr m) a+++ runReaderT :: (IsStream t, Monad m) => m s -> t (ReaderT s m) a -> t m a+++ runStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m (s, a)++# Removed: documentation moved to streamly-docs module in docs dir+@@@ Streamly.Tutorial++# Deprecated, renamed+~~~ Streamly.Data.Unicode.Stream+@@@ Streamly.Unicode.Stream+# Moved from Streamly.Data.Unicode.Stream+## Behavior changed+++ decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char+++ encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8+++ encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8+## Unchanged+++ decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char++# Added+++ decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char+++ encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8+++ encodeStrings :: (MonadIO m, IsStream t) => (SerialT m Char -> SerialT m Word8) -> t m String -> t m (Array Word8)+++ encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8
+ docs/User/Project/ApiChangelogs/0.8.0-0.8.1.txt view
@@ -0,0 +1,11 @@+# API diff as generated by cabal-diff with minor edits.+# ~~~ means deprecated module+# ~~ means deprecated symbol++#----------------------------+# Changes from 0.8.0 to 0.8.1+#----------------------------++@@@ Streamly.FileSystem.Handle+++ getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)+++ putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()
+ docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt view
@@ -0,0 +1,175 @@+---------------------------------+Terminology+---------------------------------++[A]: Added+[R]: Removed+[C]: Changed+[D]: Deprecated+[O]: Old+[N]: New++---------------------------------+Difference+---------------------------------++[R] Streamly.Unicode.Stream+[D] Streamly.Prelude+    [A] toStreamK :: IsStream t => t m a -> StreamK m a+    [A] toStream :: (IsStream t, Monad m) => t m a -> Stream m a+    [C] mergeBy+        [O] mergeBy :: (IsStream t, Monad m) => (a -> a -> Ordering) -> t m a -> t m a -> t m a+        [N] mergeBy :: IsStream t => (a -> a -> Ordering) -> t m a -> t m a -> t m a+    [A] fromStreamK :: IsStream t => StreamK m a -> t m a+    [A] fromStream :: (IsStream t, Monad m) => Stream m a -> t m a+[C] Streamly.Network.Socket+    [D] writeWithBufferOf :: MonadIO m => Int -> Socket -> Fold m Word8 ()+    [A] writeWith :: MonadIO m => Int -> Socket -> Fold m Word8 ()+    [D] writeChunksWithBufferOf :: (MonadIO m, Unbox a) => Int -> Socket -> Fold m (Array a) ()+    [A] writeChunksWith :: (MonadIO m, Unbox a) => Int -> Socket -> Fold m (Array a) ()+    [C] writeChunks+        [O] writeChunks :: (MonadIO m, Storable a) => Socket -> Fold m (Array a) ()+        [N] writeChunks :: (MonadIO m, Unbox a) => Socket -> Fold m (Array a) ()+    [D] writeChunk :: Unbox a => Socket -> Array a -> IO ()+    [A] readerWith :: MonadIO m => Unfold m (Int, Socket) Word8+    [A] reader :: MonadIO m => Unfold m Socket Word8+    [D] readWithBufferOf :: MonadIO m => Unfold m (Int, Socket) Word8+    [D] readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Socket) (Array Word8)+    [D] readChunks :: MonadIO m => Unfold m Socket (Array Word8)+    [D] readChunk :: Int -> Socket -> IO (Array Word8)+    [D] read :: MonadIO m => Unfold m Socket Word8+    [A] putChunk :: Unbox a => Socket -> Array a -> IO ()+    [A] getChunk :: Int -> Socket -> IO (Array Word8)+    [A] chunkReaderWith :: MonadIO m => Unfold m (Int, Socket) (Array Word8)+    [A] chunkReader :: MonadIO m => Unfold m Socket (Array Word8)+    [A] acceptor :: MonadIO m => Unfold m (Int, SockSpec, SockAddr) Socket+    [D] accept :: MonadIO m => Unfold m (Int, SockSpec, SockAddr) Socket+[C] Streamly.Network.Inet.TCP+    [A] acceptorOnPortLocal :: MonadIO m => Unfold m PortNumber Socket+    [A] acceptorOnPort :: MonadIO m => Unfold m PortNumber Socket+    [A] acceptorOnAddr :: MonadIO m => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket+    [D] acceptOnPortLocal :: MonadIO m => Unfold m PortNumber Socket+    [D] acceptOnPort :: MonadIO m => Unfold m PortNumber Socket+    [D] acceptOnAddr :: MonadIO m => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket+[R] Streamly.FileSystem.Handle+[R] Streamly.Data.Unfold+[A] Streamly.Data.Stream.Prelude+    [A] StopWhen+        [A] FirstStops :: StopWhen+        [A] AnyStops :: StopWhen+        [A] AllStop :: StopWhen+    [A] Rate+        [A] [rateLow] :: Rate -> Double+        [A] [rateHigh] :: Rate -> Double+        [A] [rateGoal] :: Rate -> Double+        [A] [rateBuffer] :: Rate -> Int+        [A] Rate :: Double -> Double -> Double -> Int -> Rate+    [A] Config+    [A] type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)+    [A] tapCount :: MonadAsync m => (a -> Bool) -> (Stream m Int -> m b) -> Stream m a -> Stream m a+    [A] takeInterval :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] stopWhen :: StopWhen -> Config -> Config+    [A] sampleIntervalStart :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] sampleIntervalEnd :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] sampleBurstStart :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] sampleBurstEnd :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] rate :: Maybe Rate -> Config -> Config+    [A] parZipWithM :: MonadAsync m => (Config -> Config) -> (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+    [A] parZipWith :: MonadAsync m => (Config -> Config) -> (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+    [A] parSequence :: MonadAsync m => (Config -> Config) -> Stream m (m a) -> Stream m a+    [A] parReplicateM :: MonadAsync m => (Config -> Config) -> Int -> m a -> Stream m a+    [A] parRepeatM :: MonadAsync m => (Config -> Config) -> m a -> Stream m a+    [A] parMergeByM :: MonadAsync m => (Config -> Config) -> (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] parMergeBy :: MonadAsync m => (Config -> Config) -> (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] parMapM :: MonadAsync m => (Config -> Config) -> (a -> m b) -> Stream m a -> Stream m b+    [A] parList :: MonadAsync m => (Config -> Config) -> [Stream m a] -> Stream m a+    [A] parEval :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [A] parConcatMap :: MonadAsync m => (Config -> Config) -> (a -> Stream m b) -> Stream m a -> Stream m b+    [A] parConcatIterate :: MonadAsync m => (Config -> Config) -> (a -> Stream m a) -> Stream m a -> Stream m a+    [A] parConcat :: MonadAsync m => (Config -> Config) -> Stream m (Stream m a) -> Stream m a+    [A] parApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] ordered :: Bool -> Config -> Config+    [A] minRate :: Double -> Config -> Config+    [A] maxThreads :: Int -> Config -> Config+    [A] maxRate :: Double -> Config -> Config+    [A] maxBuffer :: Int -> Config -> Config+    [A] intervalsOf :: MonadAsync m => Double -> Fold m a b -> Stream m a -> Stream m b+    [A] interleaved :: Bool -> Config -> Config+    [A] interject :: MonadAsync m => m a -> Double -> Stream m a -> Stream m a+    [A] inspect :: Bool -> Config -> Config+    [A] fromCallback :: MonadAsync m => ((a -> m ()) -> m ()) -> Stream m a+    [A] finally :: (MonadAsync m, MonadCatch m) => m b -> Stream m a -> Stream m a+    [A] eager :: Bool -> Config -> Config+    [A] dropInterval :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] constRate :: Double -> Config -> Config+    [A] bracket :: (MonadAsync m, MonadCatch m) => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a+    [A] avgRate :: Double -> Config -> Config+    [A] after :: (MonadIO m, MonadBaseControl IO m) => m b -> Stream m a -> Stream m a+[A] Streamly.Data.Stream.MkType+    [A] class Monad m => MonadReader r (m :: Type -> Type) | m -> r+    [A] class MonadTrans (t :: Type -> Type -> Type -> Type)+    [A] class Read a+    [A] class IsString a+    [A] class IsList l+    [A] Identity+    [A] throwM :: (MonadThrow m, Exception e) => e -> m a+    [A] readsPrec :: Read a => Int -> ReadS a+    [A] reader :: MonadReader r m => (r -> a) -> m a+    [A] readPrec :: Read a => ReadPrec a+    [A] readListPrec :: Read a => ReadPrec [a]+    [A] readList :: Read a => ReadS [a]+    [A] mkZipType :: String -> String -> Bool -> Q [Dec]+    [A] mkCrossType :: String -> String -> Bool -> Q [Dec]+    [A] local :: MonadReader r m => (r -> r) -> m a -> m a+    [A] liftIO :: MonadIO m => IO a -> m a+    [A] lift :: (MonadTrans t, Monad m) => m a -> t m a+    [A] ask :: MonadReader r m => m r+    [A] ap :: Monad m => m (a -> b) -> m a -> m b+[D] Streamly.Data.Fold.Tee+    [C] Tee+        [A] [unTee] :: Tee (m :: Type -> Type) a b -> Fold m a b+        [R] [toFold] :: Tee m a b -> Fold m a b+        [C] Tee+            [O] Tee :: Fold m a b -> Tee m a b+            [N] Tee :: Fold m a b -> Tee (m :: Type -> Type) a b+    [A] toFold :: forall (m :: Type -> Type) a b. Tee m a b -> Fold m a b+[R] Streamly.Data.Fold+[D] Streamly.Data.Array.Foreign+    [A] Control.DeepSeq.NFData1+        [A] instance Control.DeepSeq.NFData1 Streamly.Internal.Data.Array.Type.Array+    [A] Control.DeepSeq.NFData+        [A] instance Control.DeepSeq.NFData (Streamly.Internal.Data.Array.Type.Array a)+    [C] writeN+        [O] writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)+        [N] writeN :: forall (m :: Type -> Type) a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [C] writeLastN+        [O] writeLastN :: (Storable a, MonadIO m) => Int -> Fold m a (Array a)+        [N] writeLastN :: forall a (m :: Type -> Type). (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a)+    [C] write+        [O] write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)+        [N] write :: forall (m :: Type -> Type) a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [C] toList+        [O] toList :: Storable a => Array a -> [a]+        [N] toList :: Unbox a => Array a -> [a]+    [C] readRev+        [O] readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a+        [N] readRev :: forall (m :: Type -> Type) a. (Monad m, Unbox a) => Array a -> Stream m a+    [C] read+        [O] read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a+        [N] read :: forall (m :: Type -> Type) a. (Monad m, Unbox a) => Array a -> Stream m a+    [C] length+        [O] length :: forall a. Storable a => Array a -> Int+        [N] length :: Unbox a => Array a -> Int+    [C] getIndex+        [O] getIndex :: forall a. Storable a => Array a -> Int -> Maybe a+        [N] getIndex :: Unbox a => Int -> Array a -> Maybe a+    [C] fromListN+        [O] fromListN :: Storable a => Int -> [a] -> Array a+        [N] fromListN :: Unbox a => Int -> [a] -> Array a+    [C] fromList+        [O] fromList :: Storable a => [a] -> Array a+        [N] fromList :: Unbox a => [a] -> Array a+    [C] cast+        [O] cast :: forall a b. Storable b => Array a -> Maybe (Array b)+        [N] cast :: forall a b. Unbox b => Array a -> Maybe (Array b)+[R] Streamly.Console.Stdio
+ docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txt view
@@ -0,0 +1,424 @@+---------------------------------+API Annotations+---------------------------------++[A] : Added+[R] : Removed+[C] : Changed+[O] : Old definition+[N] : New definition+[D] : Deprecated++---------------------------------+API diff+---------------------------------++[C] Streamly.Network.Socket+    [A] readWith :: MonadIO m => Int -> Socket -> Stream m Word8+    [A] readChunksWith :: MonadIO m => Int -> Socket -> Stream m (Array Word8)+[C] Streamly.Network.Inet.TCP+    [D] acceptorOnPortLocal :: MonadIO m => Unfold m PortNumber Socket+    [D] acceptorOnPort :: MonadIO m => Unfold m PortNumber Socket+    [A] acceptorLocal :: MonadIO m => Unfold m PortNumber Socket+    [A] acceptor :: MonadIO m => Unfold m PortNumber Socket+    [A] acceptOnAddrWith :: MonadIO m => [(SocketOption, Int)] -> (Word8, Word8, Word8, Word8) -> PortNumber -> Stream m Socket+    [A] acceptLocal :: MonadIO m => PortNumber -> Stream m Socket+    [A] accept :: MonadIO m => PortNumber -> Stream m Socket+[C] Streamly.Data.Stream.Prelude+    [D] tapCount :: MonadAsync m => (a -> Bool) -> (Stream m Int -> m b) -> Stream m a -> Stream m a+    [A] parTapCount :: MonadAsync m => (a -> Bool) -> (Stream m Int -> m b) -> Stream m a -> Stream m a+[A] Streamly.Data.Fold.Prelude+    [A] Config+    [A] toHashMapIO :: (MonadIO m, Hashable k, Ord k) => (a -> k) -> Fold m a b -> Fold m a (HashMap k b)+    [A] parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+    [A] maxBuffer :: Int -> Config -> Config+    [A] inspect :: Bool -> Config -> Config+    [A] boundThreads :: Bool -> Config -> Config++---------------------------------+Internal API diff+---------------------------------++[C] Streamly.Internal.Network.Inet.TCP+    [A] acceptorWith :: MonadIO m => [(SocketOption, Int)] -> Unfold m PortNumber Socket+    [R] acceptorOnPortWith :: MonadIO m => [(SocketOption, Int)] -> Unfold m PortNumber Socket+    [D] acceptorOnPortLocal :: MonadIO m => Unfold m PortNumber Socket+    [D] acceptorOnPort :: MonadIO m => Unfold m PortNumber Socket+    [A] acceptorLocal :: MonadIO m => Unfold m PortNumber Socket+    [A] acceptor :: MonadIO m => Unfold m PortNumber Socket+    [R] acceptOnPortLocal :: MonadIO m => PortNumber -> Stream m Socket+    [R] acceptOnPort :: MonadIO m => PortNumber -> Stream m Socket+    [A] acceptLocal :: MonadIO m => PortNumber -> Stream m Socket+    [A] accept :: MonadIO m => PortNumber -> Stream m Socket+[R] Streamly.Internal.Data.Unfold.SVar+[A] Streamly.Internal.Data.Unfold.Prelude+    [A] gbracket :: MonadRunInIO m => (a -> m c) -> (c -> m d) -> Unfold m (c, e) b -> (forall s. m s -> m (Either e s)) -> Unfold m c b -> Unfold m a b+    [A] fromSVar :: MonadAsync m => Unfold m (SVar t m a) a+    [A] fromProducer :: MonadAsync m => Unfold m (SVar t m a) a+    [A] finally :: (MonadAsync m, MonadCatch m) => (a -> m c) -> Unfold m a b -> Unfold m a b+    [A] bracket :: (MonadAsync m, MonadCatch m) => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b+    [A] after :: MonadRunInIO m => (a -> m c) -> Unfold m a b -> Unfold m a b+[R] Streamly.Internal.Data.Unfold.Exception+[R] Streamly.Internal.Data.Stream.Zip.Concurrent+[D] Streamly.Internal.Data.Stream.Zip+    [C] GHC.Base.Functor+        [A] instance GHC.Base.Monad m => GHC.Base.Functor (Streamly.Internal.Data.Stream.Zip.ZipConcurrent m)+    [C] GHC.Base.Applicative+        [A] instance Streamly.Internal.Control.Concurrent.MonadAsync m => GHC.Base.Applicative (Streamly.Internal.Data.Stream.Zip.ZipConcurrent m)+    [A] ZipConcurrent+        [A] [getZipConcurrent] :: ZipConcurrent m a -> Stream m a+        [A] ZipConcurrent :: Stream m a -> ZipConcurrent m a+[R] Streamly.Internal.Data.Stream.Time+[R] Streamly.Internal.Data.Stream.SVar.Generate+[R] Streamly.Internal.Data.Stream.SVar.Eliminate+[A] Streamly.Internal.Data.Stream.Prelude+    [A] StopWhen+        [A] FirstStops :: StopWhen+        [A] AnyStops :: StopWhen+        [A] AllStop :: StopWhen+    [A] Rate+        [A] [rateLow] :: Rate -> Double+        [A] [rateHigh] :: Rate -> Double+        [A] [rateGoal] :: Rate -> Double+        [A] [rateBuffer] :: Rate -> Int+        [A] Rate :: Double -> Double -> Double -> Int -> Rate+    [A] Config+    [A] Channel+        [A] [yieldRateInfo] :: Channel m a -> Maybe YieldRateInfo+        [A] [workerThreads] :: Channel m a -> IORef (Set ThreadId)+        [A] [workerStopMVar] :: Channel m a -> MVar ()+        [A] [workerCount] :: Channel m a -> IORef Int+        [A] [workLoop] :: Channel m a -> Maybe WorkerInfo -> m ()+        [A] [svarStats] :: Channel m a -> SVarStats+        [A] [svarRef] :: Channel m a -> Maybe (IORef ())+        [A] [svarMrun] :: Channel m a -> RunInIO m+        [A] [svarInspectMode] :: Channel m a -> Bool+        [A] [svarCreator] :: Channel m a -> ThreadId+        [A] [remainingWork] :: Channel m a -> Maybe (IORef Count)+        [A] [readOutputQ] :: Channel m a -> m [ChildEvent a]+        [A] [postProcess] :: Channel m a -> m Bool+        [A] [outputQueue] :: Channel m a -> IORef ([ChildEvent a], Int)+        [A] [outputDoorBell] :: Channel m a -> MVar ()+        [A] [maxWorkerLimit] :: Channel m a -> Limit+        [A] [maxBufferLimit] :: Channel m a -> Limit+        [A] [isWorkDone] :: Channel m a -> IO Bool+        [A] [isQueueDone] :: Channel m a -> IO Bool+        [A] [enqueue] :: Channel m a -> Bool -> (RunInIO m, StreamK m a) -> IO ()+        [A] [eagerDispatch] :: Channel m a -> m ()+        [A] [doorBellOnWorkQ] :: Channel m a -> IORef Bool+        [A] [accountThread] :: Channel m a -> ThreadId -> m ()+        [A] Channel :: RunInIO m -> IORef ([ChildEvent a], Int) -> MVar () -> m [ChildEvent a] -> m Bool -> Limit -> Limit -> Maybe (IORef Count) -> Maybe YieldRateInfo -> (Bool -> (RunInIO m, StreamK m a) -> IO ()) -> m () -> IO Bool -> IO Bool -> IORef Bool -> (Maybe WorkerInfo -> m ()) -> IORef (Set ThreadId) -> IORef Int -> (ThreadId -> m ()) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a+    [A] type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)+    [A] yield :: Channel m a -> Maybe WorkerInfo -> a -> IO Bool+    [A] withChannelK :: MonadAsync m => (Config -> Config) -> StreamK m a -> (Channel m b -> StreamK m a -> StreamK m b) -> StreamK m b+    [A] withChannel :: MonadAsync m => (Config -> Config) -> Stream m a -> (Channel m b -> Stream m a -> Stream m b) -> Stream m b+    [A] toChannelK :: MonadRunInIO m => Channel m a -> StreamK m a -> m ()+    [A] toChannel :: MonadRunInIO m => Channel m a -> Stream m a -> m ()+    [A] ticksRate :: MonadAsync m => Rate -> Stream m ()+    [A] ticks :: MonadIO m => Double -> Stream m ()+    [A] takeLastInterval :: Double -> Stream m a -> Stream m a+    [A] takeInterval :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] stopWhen :: StopWhen -> Config -> Config+    [A] stopChannel :: MonadIO m => Channel m a -> m ()+    [A] stop :: Channel m a -> Maybe WorkerInfo -> IO ()+    [A] startChannel :: MonadRunInIO m => Channel m a -> m ()+    [A] sendWorkerWait :: MonadIO m => Bool -> (Channel m a -> IO ()) -> (Channel m a -> m Bool) -> Channel m a -> m ()+    [A] sendWorkerDelayPaced :: Channel m a -> IO ()+    [A] sendWorkerDelay :: Channel m a -> IO ()+    [A] sampleIntervalStart :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] sampleIntervalEnd :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] sampleBurstStart :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] sampleBurstEnd :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] sampleBurst :: MonadAsync m => Bool -> Double -> Stream m a -> Stream m a+    [A] retryD :: forall e m a. (Exception e, Ord e, MonadCatch m) => Map e Int -> (e -> Stream m a) -> Stream m a -> Stream m a+    [A] retry :: (MonadCatch m, Exception e, Ord e) => Map e Int -> (e -> Stream m a) -> Stream m a -> Stream m a+    [A] readOutputQPaced :: MonadRunInIO m => Channel m a -> m [ChildEvent a]+    [A] readOutputQBounded :: MonadRunInIO m => Bool -> Channel m a -> m [ChildEvent a]+    [A] rate :: Maybe Rate -> Config -> Config+    [A] pushWorker :: MonadRunInIO m => Count -> Channel m a -> m ()+    [A] postProcessPaced :: MonadRunInIO m => Channel m a -> m Bool+    [A] postProcessBounded :: MonadRunInIO m => Channel m a -> m Bool+    [A] periodic :: MonadIO m => m a -> Double -> Stream m a+    [A] parZipWithM :: MonadAsync m => (Config -> Config) -> (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+    [A] parZipWith :: MonadAsync m => (Config -> Config) -> (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+    [A] parTwo :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a -> Stream m a+    [A] parTapCount :: MonadAsync m => (a -> Bool) -> (Stream m Int -> m b) -> Stream m a -> Stream m a+    [A] parSequence :: MonadAsync m => (Config -> Config) -> Stream m (m a) -> Stream m a+    [A] parReplicateM :: MonadAsync m => (Config -> Config) -> Int -> m a -> Stream m a+    [A] parRepeatM :: MonadAsync m => (Config -> Config) -> m a -> Stream m a+    [A] parMergeByM :: MonadAsync m => (Config -> Config) -> (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] parMergeBy :: MonadAsync m => (Config -> Config) -> (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] parMapM :: MonadAsync m => (Config -> Config) -> (a -> m b) -> Stream m a -> Stream m b+    [A] parListOrdered :: MonadAsync m => [Stream m a] -> Stream m a+    [A] parListLazy :: MonadAsync m => [Stream m a] -> Stream m a+    [A] parListInterleaved :: MonadAsync m => [Stream m a] -> Stream m a+    [A] parListEagerMin :: MonadAsync m => [Stream m a] -> Stream m a+    [A] parListEagerFst :: MonadAsync m => [Stream m a] -> Stream m a+    [A] parListEager :: MonadAsync m => [Stream m a] -> Stream m a+    [A] parList :: MonadAsync m => (Config -> Config) -> [Stream m a] -> Stream m a+    [A] parEval :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [A] parConcatMap :: MonadAsync m => (Config -> Config) -> (a -> Stream m b) -> Stream m a -> Stream m b+    [A] parConcatIterate :: MonadAsync m => (Config -> Config) -> (a -> Stream m a) -> Stream m a -> Stream m a+    [A] parConcat :: MonadAsync m => (Config -> Config) -> Stream m (Stream m a) -> Stream m a+    [A] parApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] ordered :: Bool -> Config -> Config+    [A] newInterleaveChannel :: MonadAsync m => (Config -> Config) -> m (Channel m a)+    [A] newChannel :: MonadAsync m => (Config -> Config) -> m (Channel m a)+    [A] newAppendChannel :: MonadRunInIO m => (Config -> Config) -> m (Channel m a)+    [A] minRate :: Double -> Config -> Config+    [A] maxThreads :: Int -> Config -> Config+    [A] maxRate :: Double -> Config -> Config+    [A] maxBuffer :: Int -> Config -> Config+    [A] intervalsOf :: MonadAsync m => Double -> Fold m a b -> Stream m a -> Stream m b+    [A] interleaved :: Bool -> Config -> Config+    [A] interject :: MonadAsync m => m a -> Double -> Stream m a -> Stream m a+    [A] inspect :: Bool -> Config -> Config+    [A] groupsOfTimeout :: MonadAsync m => Int -> Double -> Fold m a b -> Stream m a -> Stream m b+    [A] getStopWhen :: Config -> StopWhen+    [A] fromChannelK :: MonadAsync m => Channel m a -> StreamK m a+    [A] fromChannel :: MonadAsync m => Channel m a -> Stream m a+    [A] fromCallback :: MonadAsync m => ((a -> m ()) -> m ()) -> Stream m a+    [A] finally :: (MonadAsync m, MonadCatch m) => m b -> Stream m a -> Stream m a+    [A] eager :: Bool -> Config -> Config+    [A] dumpSVar :: Channel m a -> IO String+    [A] dropLastInterval :: Int -> Stream m a -> Stream m a+    [A] dropInterval :: MonadAsync m => Double -> Stream m a -> Stream m a+    [A] dispatchWorkerPaced :: MonadRunInIO m => Channel m a -> m Bool+    [A] dispatchWorker :: MonadRunInIO m => Count -> Channel m a -> m Bool+    [A] defaultConfig :: Config+    [A] constRate :: Double -> Config -> Config+    [A] classifySessionsOf :: (MonadAsync m, Ord k) => (Int -> m Bool) -> Double -> Fold m a b -> Stream m (AbsTime, (k, a)) -> Stream m (k, b)+    [A] classifySessionsByGeneric :: forall m f a b. (MonadAsync m, IsMap f) => Proxy (f :: Type -> Type) -> Double -> Bool -> (Int -> m Bool) -> Double -> Fold m a b -> Stream m (AbsTime, (Key f, a)) -> Stream m (Key f, b)+    [A] classifySessionsBy :: (MonadAsync m, Ord k) => Double -> Bool -> (Int -> m Bool) -> Double -> Fold m a b -> Stream m (AbsTime, (k, a)) -> Stream m (k, b)+    [A] classifyKeepAliveSessions :: (MonadAsync m, Ord k) => (Int -> m Bool) -> Double -> Fold m a b -> Stream m (AbsTime, (k, a)) -> Stream m (k, b)+    [A] bufferOldestN :: Int -> Stream m a -> Stream m a+    [A] bufferLatestN :: Int -> Stream m a -> Stream m a+    [A] bufferLatest :: Stream m a -> Stream m (Maybe a)+    [A] bracket3D :: (MonadAsync m, MonadCatch m) => m b -> (b -> m c) -> (b -> m d) -> (b -> m e) -> (b -> Stream m a) -> Stream m a+    [A] bracket3 :: (MonadAsync m, MonadCatch m) => m b -> (b -> m c) -> (b -> m d) -> (b -> m e) -> (b -> Stream m a) -> Stream m a+    [A] bracket :: (MonadAsync m, MonadCatch m) => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a+    [A] avgRate :: Double -> Config -> Config+    [A] afterD :: MonadRunInIO m => m b -> Stream m a -> Stream m a+    [A] after :: (MonadIO m, MonadBaseControl IO m) => m b -> Stream m a -> Stream m a+[R] Streamly.Internal.Data.Stream.Exception.Lifted+[R] Streamly.Internal.Data.Stream.Concurrent.Channel.Type+[R] Streamly.Internal.Data.Stream.Concurrent.Channel.Operations+[R] Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave+[R] Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher+[R] Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer+[R] Streamly.Internal.Data.Stream.Concurrent.Channel.Append+[R] Streamly.Internal.Data.Stream.Concurrent.Channel+[R] Streamly.Internal.Data.Stream.Concurrent+[R] Streamly.Internal.Data.Stream.Channel.Worker+[R] Streamly.Internal.Data.Stream.Channel.Types+[R] Streamly.Internal.Data.Stream.Channel.Dispatcher+[R] Streamly.Internal.Data.SVar.Worker+[R] Streamly.Internal.Data.SVar.Pull+[R] Streamly.Internal.Data.SVar.Dispatch+[D] Streamly.Internal.Data.SVar+    [A] Work+        [A] PartialWorker :: Count -> Work+        [A] ManyWorkers :: Int -> Count -> Work+        [A] BlockWait :: NanoSecond64 -> Work+    [A] workerUpdateLatency :: YieldRateInfo -> WorkerInfo -> IO ()+    [A] workerRateControl :: SVar t m a -> YieldRateInfo -> WorkerInfo -> IO Bool+    [A] withDiagMVar :: SVar t m a -> String -> IO () -> IO ()+    [A] updateYieldCount :: WorkerInfo -> IO Count+    [A] sendYield :: SVar t m a -> Maybe WorkerInfo -> ChildEvent a -> IO Bool+    [A] sendWorkerWait :: MonadAsync m => (SVar t m a -> IO ()) -> (SVar t m a -> m Bool) -> SVar t m a -> m ()+    [A] sendWorkerDelayPaced :: SVar t m a -> IO ()+    [A] sendWorkerDelay :: SVar t m a -> IO ()+    [A] sendToProducer :: SVar t m a -> ChildEvent a -> IO Int+    [A] sendStopToProducer :: MonadIO m => SVar t m a -> m ()+    [A] sendStop :: SVar t m a -> Maybe WorkerInfo -> IO ()+    [A] sendFirstWorker :: MonadAsync m => SVar t m a -> t m a -> m (SVar t m a)+    [A] send :: SVar t m a -> ChildEvent a -> IO Int+    [A] ringDoorBell :: SVar t m a -> IO ()+    [A] resetBufferLimit :: SVar t m a -> IO ()+    [A] recordMaxWorkers :: MonadIO m => SVar t m a -> m ()+    [A] readOutputQRaw :: SVar t m a -> IO ([ChildEvent a], Int)+    [A] readOutputQPaced :: MonadAsync m => SVar t m a -> m [ChildEvent a]+    [A] readOutputQBounded :: MonadAsync m => SVar t m a -> m [ChildEvent a]+    [A] readOutputQBasic :: IORef ([ChildEvent a], Int) -> IO ([ChildEvent a], Int)+    [A] pushWorkerPar :: MonadAsync m => SVar t m a -> (Maybe WorkerInfo -> m ()) -> m ()+    [A] pushWorker :: MonadAsync m => Count -> SVar t m a -> m ()+    [A] printSVar :: SVar t m a -> String -> IO ()+    [A] postProcessPaced :: MonadAsync m => SVar t m a -> m Bool+    [A] postProcessBounded :: MonadAsync m => SVar t m a -> m Bool+    [A] modifyThread :: MonadIO m => SVar t m a -> ThreadId -> m ()+    [A] minThreadDelay :: NanoSecond64+    [A] isBeyondMaxRate :: SVar t m a -> YieldRateInfo -> IO Bool+    [A] incrementYieldLimit :: SVar t m a -> IO ()+    [A] incrementBufferLimit :: SVar t m a -> IO ()+    [A] handleFoldException :: SVar t m a -> SomeException -> IO ()+    [A] handleChildException :: SVar t m a -> SomeException -> IO ()+    [A] estimateWorkers :: Limit -> Count -> Count -> NanoSecond64 -> NanoSecond64 -> NanoSecond64 -> LatencyRange -> Work+    [A] dumpSVar :: SVar t m a -> IO String+    [A] dispatchWorkerPaced :: MonadAsync m => SVar t m a -> m Bool+    [A] dispatchWorker :: MonadAsync m => Count -> SVar t m a -> m Bool+    [A] delThread :: MonadIO m => SVar t m a -> ThreadId -> m ()+    [A] decrementYieldLimit :: SVar t m a -> IO Bool+    [A] decrementBufferLimit :: SVar t m a -> IO ()+    [A] collectLatency :: SVar t m a -> YieldRateInfo -> Bool -> IO (Count, AbsTime, NanoSecond64)+    [A] cleanupSVarFromWorker :: SVar t m a -> IO ()+    [A] cleanupSVar :: SVar t m a -> IO ()+    [A] allThreadsDone :: MonadIO m => SVar t m a -> m Bool+[C] Streamly.Internal.Data.IsMap.HashMap+    [C] Streamly.Internal.Data.IsMap.IsMap+        [C] (Data.HashMap.Internal.HashMap k)+            [O] instance (Data.Hashable.Class.Hashable k, GHC.Classes.Eq k) => Streamly.Internal.Data.IsMap.IsMap (Data.HashMap.Internal.HashMap k)+            [N] instance Data.Hashable.Class.Hashable k => Streamly.Internal.Data.IsMap.IsMap (Data.HashMap.Internal.HashMap k)+[C] Streamly.Internal.Data.IOFinalizer.Lifted+    [C] IOFinalizer+[R] Streamly.Internal.Data.Fold.SVar+[A] Streamly.Internal.Data.Fold.Prelude+    [A] Config+    [A] Channel+        [A] [svarStats] :: Channel m a b -> SVarStats+        [A] [svarRef] :: Channel m a b -> Maybe (IORef ())+        [A] [svarInspectMode] :: Channel m a b -> Bool+        [A] [svarCreator] :: Channel m a b -> ThreadId+        [A] [readOutputQ] :: Channel m a b -> m [ChildEvent a]+        [A] [outputQueue] :: Channel m a b -> IORef ([ChildEvent a], Int)+        [A] [outputQueueFromConsumer] :: Channel m a b -> IORef ([ChildEvent b], Int)+        [A] [outputDoorBell] :: Channel m a b -> MVar ()+        [A] [outputDoorBellFromConsumer] :: Channel m a b -> MVar ()+        [A] [maxBufferLimit] :: Channel m a b -> Limit+        [A] [bufferSpaceDoorBell] :: Channel m a b -> MVar ()+        [A] Channel :: IORef ([ChildEvent a], Int) -> Limit -> MVar () -> m [ChildEvent a] -> IORef ([ChildEvent b], Int) -> MVar () -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a b+    [A] writeLimited :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()+    [A] write :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()+    [A] takeInterval :: MonadAsync m => Double -> Fold m a b -> Fold m a b+    [A] sendToWorker :: MonadAsync m => Channel m a b -> a -> m (Maybe b)+    [A] parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+    [A] newChannel :: MonadRunInIO m => (Config -> Config) -> Fold m a b -> m (Channel m a b)+    [A] maxBuffer :: Int -> Config -> Config+    [A] intervalsOf :: MonadAsync m => Double -> Fold m a b -> Fold m b c -> Fold m a c+    [A] inspect :: Bool -> Config -> Config+    [A] dumpSVar :: Channel m a b -> IO String+    [A] checkFoldStatus :: MonadAsync m => Channel m a b -> m (Maybe b)+    [A] boundThreads :: Bool -> Config -> Config+[R] Streamly.Internal.Data.Fold.Concurrent.Channel.Type+[R] Streamly.Internal.Data.Fold.Concurrent.Channel+[R] Streamly.Internal.Data.Fold.Concurrent+[R] Streamly.Internal.Data.Fold.Async+[A] Streamly.Internal.Data.Channel+    [A] YieldRateInfo+        [A] [workerPollingInterval] :: YieldRateInfo -> IORef Count+        [A] [workerPendingLatency] :: YieldRateInfo -> IORef (Count, Count, NanoSecond64)+        [A] [workerMeasuredLatency] :: YieldRateInfo -> IORef NanoSecond64+        [A] [workerCollectedLatency] :: YieldRateInfo -> IORef (Count, Count, NanoSecond64)+        [A] [workerBootstrapLatency] :: YieldRateInfo -> Maybe NanoSecond64+        [A] [svarRateBuffer] :: YieldRateInfo -> Int+        [A] [svarLatencyTarget] :: YieldRateInfo -> NanoSecond64+        [A] [svarLatencyRange] :: YieldRateInfo -> LatencyRange+        [A] [svarGainedLostYields] :: YieldRateInfo -> IORef Count+        [A] [svarAllTimeLatency] :: YieldRateInfo -> IORef (Count, AbsTime)+        [A] YieldRateInfo :: NanoSecond64 -> LatencyRange -> Int -> IORef Count -> IORef (Count, AbsTime) -> Maybe NanoSecond64 -> IORef Count -> IORef (Count, Count, NanoSecond64) -> IORef (Count, Count, NanoSecond64) -> IORef NanoSecond64 -> YieldRateInfo+    [A] WorkerInfo+        [A] [workerYieldMax] :: WorkerInfo -> Count+        [A] [workerYieldCount] :: WorkerInfo -> IORef Count+        [A] [workerLatencyStart] :: WorkerInfo -> IORef (Count, AbsTime)+        [A] WorkerInfo :: Count -> IORef Count -> IORef (Count, AbsTime) -> WorkerInfo+    [A] Work+        [A] PartialWorker :: Count -> Work+        [A] ManyWorkers :: Int -> Count -> Work+        [A] BlockWait :: NanoSecond64 -> Work+    [A] ThreadAbort+        [A] ThreadAbort :: ThreadAbort+    [A] StopWhen+        [A] FirstStops :: StopWhen+        [A] AnyStops :: StopWhen+        [A] AllStop :: StopWhen+    [A] SVarStats+        [A] [totalDispatches] :: SVarStats -> IORef Int+        [A] [svarStopTime] :: SVarStats -> IORef (Maybe AbsTime)+        [A] [minWorkerLatency] :: SVarStats -> IORef NanoSecond64+        [A] [maxWorkers] :: SVarStats -> IORef Int+        [A] [maxWorkerLatency] :: SVarStats -> IORef NanoSecond64+        [A] [maxWorkQSize] :: SVarStats -> IORef Int+        [A] [maxOutQSize] :: SVarStats -> IORef Int+        [A] [maxHeapSize] :: SVarStats -> IORef Int+        [A] [avgWorkerLatency] :: SVarStats -> IORef (Count, NanoSecond64)+        [A] SVarStats :: IORef Int -> IORef Int -> IORef Int -> IORef Int -> IORef Int -> IORef (Count, NanoSecond64) -> IORef NanoSecond64 -> IORef NanoSecond64 -> IORef (Maybe AbsTime) -> SVarStats+    [A] Rate+        [A] [rateLow] :: Rate -> Double+        [A] [rateHigh] :: Rate -> Double+        [A] [rateGoal] :: Rate -> Double+        [A] [rateBuffer] :: Rate -> Int+        [A] Rate :: Double -> Double -> Double -> Int -> Rate+    [A] Limit+        [A] Unlimited :: Limit+        [A] Limited :: Word -> Limit+    [A] LatencyRange+        [A] [minLatency] :: LatencyRange -> NanoSecond64+        [A] [maxLatency] :: LatencyRange -> NanoSecond64+        [A] LatencyRange :: NanoSecond64 -> NanoSecond64 -> LatencyRange+    [A] Config+    [A] ChildEvent+        [A] ChildYield :: a -> ChildEvent a+        [A] ChildStopChannel :: ChildEvent a+        [A] ChildStop :: ThreadId -> Maybe SomeException -> ChildEvent a+    [A] Count+        [A] Count :: Int64 -> Count+    [A] workerRateControl :: Limit -> IORef Int -> YieldRateInfo -> WorkerInfo -> IO Bool+    [A] withDiagMVar :: Bool -> IO String -> String -> IO () -> IO ()+    [A] stopWhen :: StopWhen -> Config -> Config+    [A] setStreamLatency :: Int -> Config -> Config+    [A] sendYield :: Limit -> Limit -> IORef Int -> Maybe WorkerInfo -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> ChildEvent a -> IO Bool+    [A] sendWithDoorBell :: IORef ([ChildEvent a], Int) -> MVar () -> ChildEvent a -> IO Int+    [A] sendStop :: IORef Int -> Maybe WorkerInfo -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> IO ()+    [A] ringDoorBell :: IORef Bool -> MVar () -> IO ()+    [A] recordMaxWorkers :: MonadIO m => IORef Int -> SVarStats -> m ()+    [A] readOutputQRaw :: IORef ([ChildEvent a], Int) -> Maybe SVarStats -> IO ([ChildEvent a], Int)+    [A] readOutputQBasic :: IORef ([ChildEvent a], Int) -> IO ([ChildEvent a], Int)+    [A] rate :: Maybe Rate -> Config -> Config+    [A] printSVar :: IO String -> String -> IO ()+    [A] ordered :: Bool -> Config -> Config+    [A] newSVarStats :: IO SVarStats+    [A] newRateInfo :: Config -> IO (Maybe YieldRateInfo)+    [A] modifyThread :: MonadIO m => IORef (Set ThreadId) -> MVar () -> ThreadId -> m ()+    [A] minThreadDelay :: NanoSecond64+    [A] minRate :: Double -> Config -> Config+    [A] maxYields :: Maybe Int64 -> Config -> Config+    [A] maxThreads :: Int -> Config -> Config+    [A] maxRate :: Double -> Config -> Config+    [A] maxBuffer :: Int -> Config -> Config+    [A] magicMaxBuffer :: Word+    [A] isBeyondMaxRate :: Limit -> IORef Int -> YieldRateInfo -> IO Bool+    [A] interleaved :: Bool -> Config -> Config+    [A] inspect :: Bool -> Config -> Config+    [A] incrementYieldLimit :: Maybe (IORef Count) -> IO ()+    [A] handleChildException :: IORef ([ChildEvent a], Int) -> MVar () -> SomeException -> IO ()+    [A] getYieldLimit :: Config -> Maybe Count+    [A] getStreamRate :: Config -> Maybe Rate+    [A] getStreamLatency :: Config -> Maybe NanoSecond64+    [A] getStopWhen :: Config -> StopWhen+    [A] getOrdered :: Config -> Bool+    [A] getMaxThreads :: Config -> Limit+    [A] getMaxBuffer :: Config -> Limit+    [A] getInterleaved :: Config -> Bool+    [A] getInspectMode :: Config -> Bool+    [A] getEagerDispatch :: Config -> Bool+    [A] getBound :: Config -> Bool+    [A] estimateWorkers :: Limit -> Count -> Count -> NanoSecond64 -> NanoSecond64 -> NanoSecond64 -> LatencyRange -> Work+    [A] eager :: Bool -> Config -> Config+    [A] dumpWorkerCount :: Show a => IORef a -> IO String+    [A] dumpSVarStats :: Bool -> Maybe YieldRateInfo -> SVarStats -> IO String+    [A] dumpRunningThreads :: Show a => IORef a -> IO String+    [A] dumpOutputQ :: (Foldable t, Show a1) => IORef (t a2, a1) -> IO String+    [A] dumpNeedDoorBell :: Show a => IORef a -> IO String+    [A] dumpDoorBell :: Show a => MVar a -> IO String+    [A] dumpCreator :: Show a => a -> String+    [A] delThread :: MonadIO m => IORef (Set ThreadId) -> ThreadId -> m ()+    [A] defaultConfig :: Config+    [A] decrementYieldLimit :: Maybe (IORef Count) -> IO Bool+    [A] constRate :: Double -> Config -> Config+    [A] collectLatency :: Bool -> SVarStats -> YieldRateInfo -> Bool -> IO (Count, AbsTime, NanoSecond64)+    [A] cleanupSVar :: IORef (Set ThreadId) -> IO ()+    [A] boundThreads :: Bool -> Config -> Config+    [A] avgRate :: Double -> Config -> Config+    [A] allThreadsDone :: MonadIO m => IORef (Set ThreadId) -> m Bool+    [A] addThread :: MonadIO m => IORef (Set ThreadId) -> ThreadId -> m ()+[C] Streamly.Internal.Control.ForkLifted+    [A] doForkWith :: MonadRunInIO m => Bool -> m () -> RunInIO m -> (SomeException -> IO ()) -> m ThreadId
+ docs/User/Project/CONTRIBUTORS.md view
@@ -0,0 +1,178 @@+This is a list of code contributors to this library. For issue contributors+please see https://github.com/composewell/streamly/issues.++Use `git shortlog -sn tag1...tag2` on the git repository to get a list of+contributors between two repository tags.++## 0.11.1++* Harendra Kumar+* John Hampton++## 0.11.0++* Harendra Kumar+* Adithya Kumar+* Alice Rixte+* Domen Kožar+* He Zhenxing+* ericpashman++## 0.10.0++* Adithya Kumar+* Harendra Kumar+* Ranjeet Kumar Ranjan+* Shlok Datye+* Bodigrim++## 0.9.0++* Harendra Kumar+* Ranjeet Kumar Ranjan+* Adithya Kumar+* Francesco Gazzetta+* Ishan Bhanuka++## 0.8.2++* Adithya Kumar+* Harendra Kumar+* Ranjeet Kumar Ranjan+* Anurag Hooda+* andremarianiello++## 0.8.1.1++* Harendra Kumar+* Julian Ospald++## 0.8.1++* Harendra Kumar+* Adithya Kumar+* Ranjeet Kumar Ranjan+* Julian Ospald+* Sanchayan Maity++## 0.8.0++* Harendra Kumar+* Adithya Kumar+* Pranay Sashank+* Ranjeet Kumar Ranjan+* Anurag Hooda+* Ahmed Zaheer Dadarkar+* Shruti Umat+* Joseph Koshy (Google LLC.)+* Sanchayan Maity+* Kirill Elagin+* Shlok Datye+* Julian Ospald+* George Thomas+* endgame++## 0.7.3++* Pranay Sashank+* Adithya Kumar+* Julian Ospald++## 0.7.2++* Harendra Kumar+* Pranay Sashank+* Adithya Kumar+* Sanchayan Maity+* Julian Ospald+* Shlok Datye++## 0.7.1++* Harendra Kumar+* Pranay Sashank+* Adithya Kumar+* Sanchayan Maity+* Brian Wignall+* Julian Ospald+* Lucian Ursu++## 0.7.0++* Harendra Kumar+* Pranay Sashank+* Artyom Kazak+* David Feuer+* Adithya Kumar+* Aravind Gopal++## 0.6.1++* Harendra Kumar+* Mariusz Ryndzionek+* Luke Clifton+* Nicolas Henin++## 0.6.0++* Harendra Kumar+* Pranay Sashank+* Abhiroop Sarkar+* Michael Sloan++## 0.5.2++* Harendra Kumar+* Keith++## 0.5.1++* Harendra Kumar++## 0.5.0++* Harendra Kumar+* Veladus+* Tim Buckley++## 0.4.1++* Harendra Kumar++## 0.4.0++* Harendra Kumar++## 0.3.0++* Harendra Kumar+* Xiaokui Shu+* k0ral++## 0.2.1++* Harendra Kumar++## 0.2.0++* Harendra Kumar+* Abhiroop Sarkar+* Hussein Ait Lahcen++## 0.1.2++* Harendra Kumar+* Abhiroop Sarkar+* Hussein Ait Lahcen++## 0.1.1++* Harendra Kumar+* Veladus+* Abhiroop Sarkar+* Sibi Prabakaran++## 0.1.0++* Harendra Kumar+* Sibi Prabakaran
+ docs/User/Project/Changelog.md view
@@ -0,0 +1,694 @@+# Changelog++<!-- See rendered changelog at https://streamly.composewell.com -->++## 0.11.1 (May 2026)++* Fix `parDemuxScan` deadlock when a worker throws an exception while the+  driver is blocked on a full input buffer.++## 0.11.0 (Sep 2025)++See+[0.10.1-0.11.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.11.0/docs/User/Project/ApiChangelogs/0.10.1-0.11.0.txt)+for detailed API changes in this release.++### Breaking Changes++* Concurrent streams and folds now use separate concurrency config types. If you+  were importing `Config` from the wrong module, you will need to update it.++### Enhancements++* Support for prompt cleanup of concurrent threads, allowing guaranteed+  cleanup as an alternative to GC-based cleanup.+* Introduced `Streamly.Data.Scanl.Prelude` for using concurrent+  operations with the new `Scanl` type. Scans can split a stream into+  multiple streams, process them concurrently, and merge the results.+* Added new concurrent fold combinators in `Streamly.Data.Fold.Prelude`.+* Fixed rate control for ordered streams.++### Internal++* Internal `FileSystem.Event.*` modules are deprecated; use the+  [streamly-fsevents](https://github.com/composewell/streamly-fsevents) package.+  instead.++## 0.10.1 (Jan 2024)++* Fix TH macros in `Streamly.Data.Stream.MkType` for GHC 9.6 and above.++## 0.10.0 (Nov 2023)++See+[0.9.0-0.10.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txt)+for a full list of API changes in this release. Only a few significant+changes are mentioned here.  For changes to the core functionality+please see the changelog of the `streamly-core` package.++### Breaking Changes++* `MonadTrans` and `MonadBase` instances have been removed for `AsyncT`,+  `ParallelT`, `AheadT` for GHC versions 9.6 onwards. This is due to a+  breaking change in `transformers` 0.6. You can replace `lift` with+  `fromEffect` when using these as top level monads in a monad stack.++### Enhancements++* __Concurrent Folds__: `Streamly.Data.Fold.Prelude` module added with+  concurrent fold APIs and a container fold API to fold a key value+  stream to a HashMap.++## 0.9.0 (Mar 2023)++Also see the following:++* [streamly-0.9.0 Upgrade Guide](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md) or+  https://hackage.haskell.org/package/streamly-0.9.0/docs/docs/User/ProjectRelated/Upgrading.md+* [streamly-0.9.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt) or+  https://hackage.haskell.org/package/streamly-0.9.0/docs/docs/User/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt+* [streamly-core-0.1.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0.txt) or+  https://hackage.haskell.org/package/streamly-core-0.1.0/docs/docs/ApiChangelogs/0.1.0.txt++### Package split++`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. Make sure you add a dependency on `streamly-core` to keep old+code working.++* 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++### Breaking Changes++* Unboxed arrays now require `Unbox` constraint instead of `Storable`.+  The `Unbox` typeclass can be imported from `Streamly.Data.Array`. You+  can use generic deriving to derive Unbox instances.+* Stream type in all modules has been changed to the new `Stream` type+  replacing the existing `IsStream t` or `SerialT` types. Use `fromStream`,+  `toStream` from `Streamly.Prelude` module to adapt the types.+* Signatures changed in `Streamly.Data.Unfold`:+  * `fromStream`+  * `replicateM`++### Major Changes++`Streamly.Prelude` module has been deprecated, equivalent+functionality is covered by the `Streamly.Data.Stream`,+`Streamly.Data.Stream.Prelude`, and `Streamly.Data.Fold` modules. The+new modules use a monomorphic `Stream` type instead of the polymorphic+`IsStream t` type.++`Streamly.Data.Stream` module and the `Stream` type are meant for+writing high-performance fused pipelines not involving explicit+recursion. For writing code that may require recursive function calls,+`Streamly.Data.Stream.StreamK` module and the `StreamK` type have been+added which provide a CPS based stream implementation. `Stream` and+`StreamK` types can be easily interconverted.++The old code can be adapted to use the new modules with some changes.+See the+[streamly-0.9.0 Upgrade Guide](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md)+for more details on how to adapt your existing code to the new release.++### Enhancements++* Added the following new modules to the `streamly` package:+  * Streamly.Data.Stream.MkType+  * Streamly.Data.Stream.Prelude+* Added the following new modules to the `streamly-core` package:+  * 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++### Deprecations++* Remove support for GHC 8.4.*++Several modules and functions have been deprecated, equivalent modules or+functions are suggested in the deprecation warning messages by the compiler.++### Internal module changes++If you cannot find an internal module that you were using, it may have+been moved to the `streamly-core` package or may have been renamed.++Following modules are moved to `streamly-core` package and renamed:+  * Streamly.Internal.Data.Array.Stream.Foreign -> Streamly.Internal.Data.Stream.Chunked+  * Streamly.Internal.Data.Array.Stream.Mut.Foreign -> Streamly.Internal.Data.Array.Mut.Stream++## 0.8.3 (September 2022)++* Fix build with GHC 9.4++## 0.8.2 (Mar 2022)++* Fix performance issues for GHC-9. These changes coupled with GHC changes+  expected to land in 9.2.2 will bring the performance back to the same levels+  as before.++## 0.8.1.1 (Dec 2021)++* Disable building FileSystem.Events where FS Events isn't supported.++## 0.8.1 (Nov 2021)++See ApiChangelogs/0.8.0-0.8.1.txt for new APIs introduced.++### Bug Fixes++* Several bug fixes in the Array module:+    * Fix writeN fold eating away one element when applied multiple times+      [#1258](https://github.com/composewell/streamly/issues/1258).+    * Fix potentially writing beyond allocated memory when shrinking. Likely+      cause of [#944](https://github.com/composewell/streamly/issues/944).+    * Fix potentially writing beyond allocated memory when writing the last+      element. Likely cause of+      [#944](https://github.com/composewell/streamly/issues/944).+    * Fix missing pointer touch could potentially cause use of freed memory.+    * Fix unnecessary additional allocation due to a bug+* Fix a bug in classifySessionsBy, see+  [PR #1311](https://github.com/composewell/streamly/pull/1311). The bug+  could cause premature ejection of a session when input events with the+  same key are split into multiple sessions.++### Notable Internal API Changes++* `tapAsync` from `Streamly.Internal.Data.Stream.Parallel` has been moved to+  `Streamly.Internal.Data.Stream.IsStream` and renamed to `tapAsyncK`.+* `Fold2` has now been renamed to `Refold` and the corresponding `Fold2`+  combinators have been either renamed or removed.++## 0.8.0 (Jun 2021)++See [API Changelog](/docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt) for a complete list of signature+changes and new APIs introduced.++### Breaking changes++* `Streamly.Prelude`+    * `fold`: this function may now terminate early without consuming+      the entire stream. For example, `fold Fold.head stream` would+      now terminate immediately after consuming the head element from+      `stream`. This may result in change of behavior in existing programs+      if the program relies on the evaluation of the full stream.+* `Streamly.Data.Unicode.Stream`+    * The following APIs no longer throw errors on invalid input, use new+      APIs suffixed with a prime for strict behavior:+        * decodeUtf8+        * encodeLatin1+        * encodeUtf8+* `Streamly.Data.Fold`:+    * Several instances have been moved to the `Streamly.Data.Fold.Tee`+      module, please use the `Tee` type to adapt to the changes.++### Bug Fixes++* Concurrent Streams: The monadic state for the stream is now propagated across+  threads. Please refer to+  [#369](https://github.com/composewell/streamly/issues/369) for more info.+* `Streamly.Prelude`:+    * `bracket`, `handle`, and `finally` now also work correctly on streams+      that aren't fully drained. Also, the resource acquisition and release is+      atomic with respect to async exceptions.+    * `iterate`, `iterateM` now consume O(1) space instead of O(n).+    * `fromFoldableM` is fixed to be concurrent.+* `Streamly.Network.Inet.TCP`: `accept` and `connect` APIs now close the socket+  if an exception is thrown.+* `Streamly.Network.Socket`: `accept` now closes the socket if an exception is+  thrown.++### Enhancements++* See [API Changelog](/docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt) for a complete list of new+  modules and APIs introduced.+* The Fold type is now more powerful, the new termination behavior allows+  to express basic parsing of streams using folds.+* Many new Fold and Unfold APIs are added.+* A new module for console IO APIs is added.+* Experimental modules for the following are added:+    * Parsing+    * Deserialization+    * File system event handling (fsnotify/inotify)+    * Folds for streams of arrays+* Experimental `use-c-malloc` build flag to use the c library `malloc` for+  array allocations. This could be useful to avoid pinned memory fragmentation.+++### Notable Internal/Pre-release API Changes++Breaking changes:++* The `Fold` type has changed to accommodate terminating folds.+* Rename: `Streamly.Internal.Prelude` => `Streamly.Internal.Data.Stream.IsStream`+* Several other internal modules have been renamed and re-factored.++Bug fixes:++* A bug was fixed in the conversion of `MicroSecond64` and `MilliSecond64`+  (commit e5119626)+* Bug fix: `classifySessionsBy` now flushes sessions at the end and terminates.++### Miscellaneous++* Drop support for GHC 7.10.3.+* The examples in this package are moved to a new github repo+  [streamly-examples](https://github.com/composewell/streamly-examples)++## 0.7.3 (February 2021)++### Build Issues++* Fix build issues with primitive package version >= 0.7.1.+* Fix build issues on armv7.++## 0.7.2 (April 2020)++### Bug Fixes++* Fix a bug in the `Applicative` and `Functor` instances of the `Fold`+  data type.++### Build Issues++* Fix a bug that occasionally caused a build failure on windows when+  used with `stack` or `stack ghci`.+* Now builds on 32-bit machines.+* Now builds with `primitive` package version >= 0.5.4 && <= 0.6.4.0+* Now builds with newer `QuickCheck` package version >= 2.14 && < 2.15.+* Now builds with GHC 8.10.++## 0.7.1 (February 2020)++### Bug Fixes++* Fix a bug that caused `findIndices` to return wrong indices in some+  cases.+* Fix a bug in `tap`, `chunksOf` that caused memory consumption to+  increase in some cases.+* Fix a space leak in concurrent streams (`async`, `wAsync`, and `ahead`) that+  caused memory consumption to increase with the number of elements in the+  stream, especially when built with `-threaded` and used with `-N` RTS option.+  The issue occurs only in cases when a worker thread happens to be used+  continuously for a long time.+* Fix scheduling of WAsyncT stream style to be in round-robin fashion.+* Now builds with `containers` package version < 0.5.8.+* Now builds with `network` package version >= 3.0.0.0 && < 3.1.0.0.++### Behavior change++* Combinators in `Streamly.Network.Inet.TCP` no longer use TCP `NoDelay` and+  `ReuseAddr` socket options by default. These options can now be specified+  using appropriate combinators.++### Performance++* Now uses `fusion-plugin` package for predictable stream fusion optimizations+* Significant improvement in performance of concurrent stream operations.+* Improved space and time performance of `Foldable` instance.++## 0.7.0 (November 2019)++### Breaking changes++* Change the signature of `foldrM` to ensure that it is lazy+* Change the signature of `iterateM` to ensure that it is lazy.+* `scanx` would now require an additional `Monad m` constraint.++### Behavior change++* Earlier `ParallelT` was unaffected by `maxBuffer` directive, now `maxBuffer`+  can limit the buffer of a `ParallelT` stream as well. When the buffer becomes+  full, the producer threads block.+* `ParallelT` streams no longer have an unlimited buffer by default. Now the+  buffer for parallel streams is limited to 1500 by default, the same as other+  concurrent stream types.++### Deprecations++* In `Streamly.Prelude`:+    * `runStream` has been replaced by `drain`+    * `runN` has been replaced by `drainN`+    * `runWhile` has been replaced by `drainWhile`+    * `fromHandle` has been deprecated. Please use+      `Streamly.FileSystem.Handle.read`, `Streamly.Data.Unicode.Stream.decodeUtf8` and+      `splitOnSuffix` with `Streamly.Data.Fold.toList` to split the+       stream to a stream of `String` separated by a newline.+    * `toHandle` has been deprecated. Please use `intersperse` and `concatUnfold` to+      add newlines to a stream, `Streamly.Data.Unicode.Stream.encodeUtf8` for encoding and+      `Streamly.FileSystem.Handle.write` for writing to a file handle.+    * Deprecate `scanx`, `foldx`, `foldxM`, `foldr1`+    * Remove deprecated APIs `foldl`, `foldlM`+    * Replace deprecated API `scan` with a new signature, to scan using Fold.++* In `Streamly` module:+    * `runStream` has been deprecated, please use `Streamly.Prelude.drain`++* Remove deprecated module `Streamly.Time` (moved to Streamly.Internal.Data.Time)+* Remove module `Streamly.Internal` (functionality moved to the Internal hierarchy)++### Bug Fixes++* Fix a bug that caused `uniq` function to yield the same element twice.+* Fix a bug that caused "thread blocked indefinitely in an MVar operation"+  exception in a parallel stream.+* Fix unbounded memory usage (leak) in `parallel` combinator. The bug manifests+  when large streams are combined using `parallel`.++### Major Enhancements++This release contains a lot of new features and major enhancements.  For more+details on the new features described below please see the haddock docs of the+modules on hackage.++#### Exception Handling++See `Streamly.Prelude` for new exception handling combinators like `before`,+`after`, `bracket`, `onException`, `finally`, `handle` etc.++#### Composable Folds++`Streamly.Data.Fold` module provides composable folds (stream consumers). Folds+allow splitting, grouping, partitioning, unzipping and nesting a stream onto+multiple folds without breaking the stream. Combinators are provided for+temporal and spatial window based fold operations, for example, to support+folding and aggregating data for timeout or inactivity based sessions.++#### Composable Unfolds++`Streamly.Data.Unfold` module provides composable stream generators. Unfolds allow+high performance merging/flattening/combining of stream generators.++#### Streaming File IO++`Streamly.FileSystem.Handle` provides handle based streaming file IO+operations.++#### Streaming Network IO++* `Streamly.Network.Socket` provides socket based streaming network IO+operations.++* `Streamly.Network.Inet.TCP` provides combinators to build Inet/TCP+clients and servers.++#### Concurrent concatMap++The new `concatMapWith` in `Streamly.Prelude` combinator performs a+`concatMap` using a supplied merge/concat strategy. This is a very+powerful combinator as you can, for example, concat streams+concurrently using this.++### Other Enhancements++* Add the following new features/modules:+  * _Unicode Strings_: `Streamly.Data.Unicode.Stream` module provides+    encoding/decoding of character streams and other character stream+    operations.+  * _Arrays_: `Streamly.Memory.Array` module provides arrays for efficient+    in-memory buffering and efficient interfacing with IO.++* Add the following to `Streamly.Prelude`:+    * `unfold`, `fold`, `scan` and `postscan`+    * `concatUnfold` to concat a stream after unfolding each element+    * `intervalsOf` and `chunksOf`+    * `splitOn`, `splitOnSuffix`, `splitWithSuffix`, and `wordsBy`+    * `groups`, `groupsBy` and `groupsByRolling`+    * `postscanl'` and `postscanlM'`+    * `intersperse` intersperse an element in between consecutive elements in+      stream+    * `trace` combinator maps a monadic function on a stream just for side+      effects+    * `tap` redirects a copy of the stream to a `Fold`++## 0.6.1 (March 2019)++### Bug Fixes++* Fix a bug that caused `maxThreads` directive to be ignored when rate control+  was not used.++### Enhancements++* Add GHCJS support+* Remove dependency on "clock" package++## 0.6.0 (December 2018)++### Breaking changes++* `Monad` constraint may be needed on some of the existing APIs (`findIndices`+  and `elemIndices`).++### Enhancements++* Add the following functions to Streamly.Prelude:+    * Generation: `replicate`, `fromIndices`, `fromIndicesM`+    * Enumeration: `Enumerable` type class, `enumerateFrom`, `enumerateFromTo`,+      `enumerateFromThen`, `enumerateFromThenTo`, `enumerate`, `enumerateTo`+    * Running: `runN`, `runWhile`+    * Folds: `(!!)`, `maximumBy`, `minimumBy`, `the`+    * Scans: `scanl1'`, `scanl1M'+    * Filters: `uniq`, `insertBy`, `deleteBy`, `findM`+    * Multi-stream: `eqBy`, `cmpBy`, `mergeBy`, `mergeByM`, `mergeAsyncBy`,+      `mergeAsyncByM`, `isPrefixOf`, `isSubsequenceOf`, `stripPrefix`,+      `concatMap`, `concatMapM`, `indexed`, `indexedR`+* Following instances were added for `SerialT m`, `WSerialT m` and+  `ZipSerialM m`:+  * When `m` ~ `Identity`: IsList, Eq, Ord, Show, Read, IsString, NFData,+    NFData1, Traversable+  * When `m` is `Foldable`: Foldable+* Performance improvements+* Add benchmarks to measure composed and iterated operations++## 0.5.2 (October 2018)++### Bug Fixes++* Cleanup any pending threads when an exception occurs.+* Fixed a livelock in ahead style streams. The problem manifests sometimes when+  multiple streams are merged together in ahead style and one of them is a nil+  stream.+* As per expected concurrency semantics each forked concurrent task must run+  with the monadic state captured at the fork point.  This release fixes a bug,+  which, in some cases caused an incorrect monadic state to be used for a+  concurrent action, leading to unexpected behavior when concurrent streams are+  used in a stateful monad e.g. `StateT`. Particularly, this bug cannot affect+  `ReaderT`.++## 0.5.1 (September 2018)++* Performance improvements, especially space consumption, for concurrent+  streams++## 0.5.0 (September 2018)++### Bug Fixes++* Leftover threads are now cleaned up as soon as the consumer is garbage+  collected.+* Fix a bug in concurrent function application that in certain cases would+  unnecessarily share the concurrency state resulting in incorrect output+  stream.+* Fix passing of state across `parallel`, `async`, `wAsync`, `ahead`, `serial`,+  `wSerial` combinators. Without this fix combinators that rely on state+  passing e.g.  `maxThreads` and `maxBuffer` won't work across these+  combinators.++### Enhancements++* Added rate limiting combinators `rate`, `avgRate`, `minRate`, `maxRate` and+  `constRate` to control the yield rate of a stream.+* Add `foldl1'`, `foldr1`, `intersperseM`, `find`, `lookup`, `and`, `or`,+  `findIndices`, `findIndex`, `elemIndices`, `elemIndex`, `init` to Prelude++### Deprecations++* The `Streamly.Time` module is now deprecated, its functionality is subsumed+  by the new rate limiting combinators.++## 0.4.1 (July 2018)++### Bug Fixes++* foldxM was not fully strict, fixed.++## 0.4.0 (July 2018)++### Breaking changes++* Signatures of `zipWithM` and `zipAsyncWithM` have changed+* Some functions in prelude now require an additional `Monad` constraint on+  the underlying type of the stream.++### Deprecations++* `once` has been deprecated and renamed to `yieldM`++### Enhancements++* Add concurrency control primitives `maxThreads` and `maxBuffer`.+* Concurrency of a stream with bounded concurrency when used with `take` is now+  limited by the number of elements demanded by `take`.+* Significant performance improvements utilizing stream fusion optimizations.+* Add `yield` to construct a singleton stream from a pure value+* Add `repeat` to generate an infinite stream by repeating a pure value+* Add `fromList` and `fromListM` to generate streams from lists, faster than+  `fromFoldable` and `fromFoldableM`+* Add `map` as a synonym of fmap+* Add `scanlM'`, the monadic version of scanl'+* Add `takeWhileM` and `dropWhileM`+* Add `filterM`++## 0.3.0 (June 2018)++### Breaking changes++* Some prelude functions, to whom concurrency capability has been added, will+  now require a `MonadAsync` constraint.++### Bug Fixes++* Fixed a race due to which, in a rare case, we might block indefinitely on+  an MVar due to a lost wakeup.+* Fixed an issue in adaptive concurrency. The issue caused us to stop creating+  more worker threads in some cases due to a race. This bug would not cause any+  functional issue but may reduce concurrency in some cases.++### Enhancements+* Added a concurrent lookahead stream type `Ahead`+* Added `fromFoldableM` API that creates a stream from a container of monadic+  actions+* Monadic stream generation functions `consM`, `|:`, `unfoldrM`, `replicateM`,+  `repeatM`, `iterateM` and `fromFoldableM` can now generate streams+  concurrently when used with concurrent stream types.+* Monad transformation functions `mapM` and `sequence` can now map actions+  concurrently when used at appropriate stream types.+* Added concurrent function application operators to run stages of a+  stream processing function application pipeline concurrently.+* Added `mapMaybe` and `mapMaybeM`.++## 0.2.1 (June 2018)++### Bug Fixes+* Fixed a bug that caused some transformation ops to return incorrect results+  when used with concurrent streams. The affected ops are `take`, `filter`,+  `takeWhile`, `drop`, `dropWhile`, and `reverse`.++## 0.2.0 (May 2018)++### Breaking changes+* Changed the semantics of the Semigroup instance for `InterleavedT`, `AsyncT`+  and `ParallelT`. The new semantics are as follows:+  * For `InterleavedT`, `<>` operation interleaves two streams+  * For `AsyncT`, `<>` now concurrently merges two streams in a left biased+    manner using demand based concurrency.+  * For `ParallelT`, the `<>` operation now concurrently meges the two streams+    in a fairly parallel manner.++  To adapt to the new changes, replace `<>` with `serial` wherever it is used+  for stream types other than `StreamT`.++* Remove the `Alternative` instance.  To adapt to this change replace any usage+  of `<|>` with `parallel` and `empty` with `nil`.+* Stream type now defaults to the `SerialT` type unless explicitly specified+  using a type combinator or a monomorphic type.  This change reduces puzzling+  type errors for beginners. It includes the following two changes:+  * Change the type of all stream elimination functions to use `SerialT`+    instead of a polymorphic type. This makes sure that the stream type is+    always fixed at all exits.+  * Change the type combinators (e.g. `parallely`) to only fix the argument+    stream type and the output stream type remains polymorphic.++  Stream types may have to be changed or type combinators may have to be added+  or removed to adapt to this change.+* Change the type of `foldrM` to make it consistent with `foldrM` in base.+* `async` is renamed to `mkAsync` and `async` is now a new API with a different+  meaning.+* `ZipAsync` is renamed to `ZipAsyncM` and `ZipAsync` is now ZipAsyncM+  specialized to the IO Monad.+* Remove the `MonadError` instance as it was not working correctly for+  parallel compositions. Use `MonadThrow` instead for error propagation.+* Remove Num/Fractional/Floating instances as they are not very useful. Use+  `fmap` and `liftA2` instead.++### Deprecations+* Deprecate and rename the following symbols:+    * `Streaming` to `IsStream`+    * `runStreaming` to `runStream`+    * `StreamT` to `SerialT`+    * `InterleavedT` to `WSerialT`+    * `ZipStream` to `ZipSerialM`+    * `ZipAsync` to `ZipAsyncM`+    * `interleaving` to `wSerially`+    * `zipping` to `zipSerially`+    * `zippingAsync` to `zipAsyncly`+    * `<=>` to `wSerial`+    * `<|` to `async`+    * `each` to `fromFoldable`+    * `scan` to `scanx`+    * `foldl` to `foldx`+    * `foldlM` to `foldxM`+* Deprecate the following symbols for future removal:+    * `runStreamT`+    * `runInterleavedT`+    * `runAsyncT`+    * `runParallelT`+    * `runZipStream`+    * `runZipAsync`++### Enhancements+* Add the following functions:+    * `consM` and `|:` operator to construct streams from monadic actions+    * `once` to create a singleton stream from a monadic action+    * `repeatM` to construct a stream by repeating a monadic action+    * `scanl'` strict left scan+    * `foldl'` strict left fold+    * `foldlM'` strict left fold with a monadic fold function+    * `serial` run two streams serially one after the other+    * `async` run two streams asynchronously+    * `parallel` run two streams in parallel (replaces `<|>`)+    * `WAsyncT` stream type for BFS version of `AsyncT` composition+* Add simpler stream types that are specialized to the IO monad+* Put a bound (1500) on the output buffer used for asynchronous tasks+* Put a limit (1500) on the number of threads used for Async and WAsync types++## 0.1.2 (March 2018)++### Enhancements+* Add `iterate`, `iterateM` stream operations++### Bug Fixes+* Fixed a bug that caused unexpected behavior when `pure` was used to inject+  values in Applicative composition of `ZipStream` and `ZipAsync` types.++## 0.1.1 (March 2018)++### Enhancements+* Make `cons` right associative and provide an operator form `.:` for it+* Add `null`, `tail`, `reverse`, `replicateM`, `scan` stream operations+* Improve performance of some stream operations (`foldl`, `dropWhile`)++### Bug Fixes+* Fix the `product` operation. Earlier, it always returned 0 due to a bug+* Fix the `last` operation, which returned `Nothing` for singleton streams++## 0.1.0 (December 2017)++* Initial release
+ docs/User/Project/Credits.md view
@@ -0,0 +1,43 @@+# Credits and Contributions++This library builds upon many good ideas from the existing body of Haskell+work.  We would like to thank all the Haskellers whose work might have+influenced this library. It is not possible to quantify that contribution and+give proper credits for it. Below, we have listed the copyright attributions+and contributions to this library.  We do due diligence in giving credit where+its due, if something got missed please do point out by [raising an issue on+github](https://github.com/composewell/streamly/issues) or [sending an email to+the maintainers](mailto:streamly@composewell.com).++## Attributions++See LICENSE for parts of other works included in this package.++## Contributions++See CONTRIBUTORS.md for a release wise list of contributors to this library.++## References++Some (among many others) of the Haskell packages that we looked at and might+have taken some ideas or inspiration from include:++* http://hackage.haskell.org/package/base++* https://hackage.haskell.org/package/logict+* https://hackage.haskell.org/package/list-transformer+* http://hackage.haskell.org/package/transient++* http://hackage.haskell.org/package/streaming+* http://hackage.haskell.org/package/machines+* https://hackage.haskell.org/package/simple-conduit+* http://hackage.haskell.org/package/pipes+* http://hackage.haskell.org/package/conduit++* http://hackage.haskell.org/package/vector+* http://hackage.haskell.org/package/bytestring+* http://hackage.haskell.org/package/text++* http://hackage.haskell.org/package/split+* https://hackage.haskell.org/package/foldl+* https://github.com/effectfully/prefolds
@@ -0,0 +1,1 @@+https://github.com/composewell/streamly
+ docs/User/Project/README.md view
@@ -0,0 +1,139 @@+# [Streamly][]: Idiomatic Haskell with C-Like Performance++[![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)+[![Hackage](https://img.shields.io/hackage/v/streamly-core.svg?style=flat)](https://hackage.haskell.org/package/streamly-core)+[![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly)++## Upgrading to 0.9.0+++Please read the [Streamly 0.9.0 Upgrade Guide](/docs/User/Project/Upgrading-0.8-to-0.9.md).++## Overview++Streamly is a powerful Haskell library that provides developers with+the essential building blocks to create safe, scalable, modular, and+high-performance software. With Streamly, developers can enjoy the+benefits of Haskell's type safety while leveraging C-like program+performance.  Streamly offers a comprehensive range of features,+comprising:++* Haskell's strong type safety.+* C-program-like performance capabilities.+* Flexible, modular building blocks.+* Idiomatic functional programming.+* Fearless, declarative concurrency for seamless parallel execution.+* A collection of ecosystem libraries for fast and efficient development.++Check out the [Learn By Examples](/docs/User/Tutorials/learn-by-examples.md)+page for an introduction to the library. For more detailed documentation, visit+the [Haskell Streamly website][Streamly].++## Blazing Fast++Streamly delivers C-like speed in Haskell by fusing stream pipelines+using the stream-fusion technique, resulting in compiled code that is+equivalent to handwritten C code, eliminating intermediate allocations+and function calls.++For a comprehensive comparison of Streamly to other Haskell streaming+libraries, check out our [streaming benchmarks][streaming-benchmarks]+page. In fact, Streamly's fused loops can be up to 100 times faster than+those of libraries without stream fusion.++## Declarative Concurrency++Streamly introduces declarative concurrency to standard functional+streaming abstractions.  Declarative concurrency abstracts away the+low-level details of concurrency management, such as locks and threads,+and allows for easier and safer parallelization of code.  For example,+with Streamly you can do things like repeat actions concurrently to+generate a stream of results, map functions concurrently on a stream,+and combine multiple streams concurrently to create a single output+stream.++## Unified API++Streamly provides a comprehensive and unified API for basic programming+needs, covering a wide range of areas including streaming, concurrency,+logic programming, reactive programming, pinned and unpinned arrays,+serialization, builders, parsers, unicode processing, file-io, file+system events, and network-io. By unifying functionality from disparate+Haskell libraries, Streamly simplifies development while delivering+equivalent or improved performance. Additionally, the complexity+of handling combinations of lazy, strict, bytestring, and text is+eliminated by using streams for lazy evaluation, and by generalizing+bytestring and text to arrays.++Check out [Streamly's documentation][Streamly] for more information+about Streamly's features.++## Batteries Included++In addition to the fundamental programming constructs, Streamly also+provides higher-level functionality through supporting packages such as+[streamly-process][], [streamly-shell][], and [streamly-coreutils][]+that are essential for general programming tasks. Check out the+[streamly-examples][] repository for some program snippets.++## Highly Modular++Traditionally, you must choose between modularity and performance when+writing code. However, with [Haskell Streamly][Streamly], you can have+the best of both worlds. By taking advantage of GHC's stream fusion+optimizations (such as `case-of-case` and `spec-constr`), Streamly achieves+performance comparable to an equivalent C program while still allowing+for highly modular code.++## Credits++The following authors/libraries have influenced or inspired this library in a+significant way:++  * Roman Leshchinskiy ([vector](http://hackage.haskell.org/package/vector))+  * Gabriella Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))+  * Alberto G. Corona ([transient](https://hackage.haskell.org/package/transient))++Please see the [`credits`](/docs/User/Project/Credits.md) directory for a full+list of contributors, credits and licenses.++## Licensing++Streamly is an [open source](https://github.com/composewell/streamly)+project available under a liberal [BSD-3-Clause license][LICENSE]++## Contributing to Streamly++As an open project we welcome contributions:++* [Streamly Contributor's Guide][CONTRIBUTING.md]+* [Contact the streamly development team](mailto:streamly@composewell.com)++## Getting Support++Professional support is available for [Streamly][]: please contact+[support@composewell.com](mailto:support@composewell.com).++You can also join our [community chat+channel](https://gitter.im/composewell/streamly) on Gitter.++<!--+Link References.+-->++[Streamly]: https://streamly.composewell.com/+[streaming-benchmarks]: https://github.com/composewell/streaming-benchmarks+[concurrency-benchmarks]: https://github.com/composewell/concurrency-benchmarks+[streamly-examples]: https://github.com/composewell/streamly-examples+[streamly-process]: https://github.com/composewell/streamly-process+[streamly-shell]: https://github.com/composewell/streamly-shell+[streamly-coreutils]: https://github.com/composewell/streamly-coreutils++<!--+Keep all the unstable links here so that they can be updated to stable+links (for online docs) before we release.+-->++<!-- local files -->+[LICENSE]: /LICENSE+[CONTRIBUTING.md]: /docs/Developer/Contributing.md+[docs]: docs/
@@ -0,0 +1,1 @@+https://github.com/composewell/streamly/issues/1046
+ docs/User/Project/Upgrading-0.8-to-0.9.md view
@@ -0,0 +1,392 @@+# Upgrading to streamly 0.9.0++```haskell docspec+>>> :set -Wno-deprecations+```++Also see the detailed changelog describing all the changes in the release:++* [0.9.0 API Changelog](/docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt) or+* [0.9.0 API Changelog](https://hackage.haskell.org/package/streamly-0.9.0/docs/docs/User/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt)++`Streamly.Prelude` module has been deprecated, equivalent+functionality is covered by the `Streamly.Data.Stream`,+`Streamly.Data.Stream.Prelude`, and `Streamly.Data.Fold` modules. The+new modules use a monomorphic `Stream` type instead of the polymorphic+`IsStream t` type.++`Streamly.Data.Stream` module and the `Stream` type are designed+for writing high-performance fused pipelines not involving explicit+recursion. For writing code that may require recursive function calls,+`Streamly.Data.Stream.StreamK` module and the `StreamK` type have been+introduced which provide a CPS based stream implementation. `Stream` and+`StreamK` types can be easily interconverted. These changes have been made to+make performance robust and not rely on GHC rewrite rules which could be+fragile. For example, GHC 9.0.x had broken the rewrite rule which was+not fixed until GHC-9.2.2. This split also gives more power and+transparency of the performance behavior to the programmer.++Instead of using separate stream types for concurrent code, now+you have to use explicit concurrent combinators with appropriate+concurrency parameters. These combinators are available in the+`Streamly.Data.Stream.Prelude` module. This change has been made to allow+programmers to control concurrent behavior in a more robust way and+reduce pitfalls.++The old code can be adapted to use the new modules with some+changes. More details about this is supplied in the following sections.+Please open an issue if you cannot find a way to adapt the code to the new+release.++Assume the following imports in the code snippets below:++```haskell docspec+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.StreamK as StreamK+>>> import qualified Streamly.Data.Stream.Prelude as Stream+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Parser as Parser+```++## Dependencies in cabal file++If you allow streamly < 0.9 in version bounds in your package then you+may not be able to build if any of the following is true:++* there is a dependency on `streamly-core` (module name conflicts)+* there is a dependency on `streamly-bytestring` >= 0.2 (type conflict)++You can define and use a build flag in your package to allow older+streamly versions:++```+flag old-streamly+  description: Allow streamly versions lower than 0.9+  manual: True+  default: False+```++```+  if flag(old-streamly)+    build-depends:+      streamly >=0.8.3 && < 0.9+  else+    build-depends:+      streamly-core >= 0.1.0 && < 0.2,+      streamly >=0.9.0 && < 0.10+```++## The `Stream` and `StreamK` types++The following types are removed:++* `IsStream`+* `ZipSerialM`+* `ZipAsyncM`+* `WSerialT`+* `WAsyncT`+* `SerialT`+* `ParallelT`+* `AsyncT`+* `AheadT`++In the new release, the `Stream` type is the primary stream type that+you will use most of the time. You can think of it as a replacement for+the `SerialT` type. However, it does not provide an Applicative or Monad+instance.++The `CrossStream` type in `Streamly.Internal.Data.Stream` is a+wrapper over `Stream` type supplying the Monad instance. However, see+the "Stream Fusion" section in the `Streamly.Data.Stream` module for+limitations of the `Stream` type. The `StreamK` type and `CrossStreamK`+(in Streamly.Internal.Data.Stream.StreamK) could be used to overcome the+limitations of `Stream` type.++If required, you can use the template-haskell functions in+`Streamly.Data.Stream.MkType` to create stream type wrappers (like+ZipSerialM or WSerialT) with custom Applicative or Monadic properties.+But in general, try to avoid specific types and use explicit functions+from the stream module.++Here are the TH macro based recipes to define types equivalent to all the older+types:++```+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++import Streamly.Data.Stream.MkType+import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Internal.Data.StreamK as StreamK+import Language.Haskell.TH+```++`SerialT`: Use `CrossStreamK` from `Streamly.Internal.Data.StreamK` equivalent+Monad and other instances.++For `WSerialT`, create a newtype wrapper using the following monad bind+operation:++```+bind = StreamK.bindWith StreamK.interleave+```++`WSerialT` requires `StreamK`, therefore you can not generate the code directly+using TH macros. However, you can print the code generated by the TH macro.+Then you can tweak that code, replacing `Stream` type with `StreamK`.++```+expr <- runQ (mkCrossType "WSerialT" "bind" True)+putStrLn $ pprint expr+```++For `AsyncT`:++```+bind = flip (Stream.parConcatMap id)+$(mkCrossType "AsyncT" "bind" True)+```++For `WAsyncT`:++```+bind = flip (Stream.parConcatMap (Stream.interleaved True))+$(mkCrossType "WAsyncT" "bind" True)+```++For `AheadT`:++```+bind = flip (Stream.parConcatMap (Stream.ordered True))+$(mkCrossType "AheadT" "bind" True)+```++For `ParallelT`:++```+bind = flip (Stream.parConcatMap (Stream.eager True))+$(mkCrossType "ParallelT" "bind" True)+```++For `ZipSerialM`:++```+apply = Stream.zipWith ($)+$(mkZipType "ZipSerialM" "apply" False)+```++For `ZipAsync`:++```+apply = Stream.parApply id+$(mkZipType "ZipAsync" "apply" False)+```++`adapt` is not needed anymore.++```haskell docspec+>>> (.:) = StreamK.cons+>>> cons = StreamK.cons+>>> wSerial = StreamK.interleave+>>> serial = StreamK.append+>>> fromIndicesM f = Stream.mapM f $ Stream.enumerateFrom 0+>>> fromIndices f = fmap f $ Stream.enumerateFrom 0+>>> fromListM = Stream.sequence . Stream.fromList+>>> fromFoldable = StreamK.toStream . StreamK.fromFoldable+>>> fromFoldableM = Stream.sequence . fromFoldable+```++## Stream folding functions++Explicit stream fold functions have been omitted from the new stream+module. You can use the following equivalent definitions:++```haskell docspec+>>> the = Stream.fold Fold.the+>>> sum = Stream.fold Fold.sum+>>> product = Stream.fold Fold.product+>>> or = Stream.fold Fold.or+>>> null = Stream.fold Fold.null+>>> elemIndex a = Stream.fold (Fold.elemIndex a)+>>> elem a = Stream.fold (Fold.elem a)+>>> notElem a = Stream.fold (Fold.notElem a)+>>> minimumBy ordering = Stream.fold (Fold.minimumBy ordering)+>>> minimum = Stream.fold Fold.minimum+>>> maximumBy ordering = Stream.fold (Fold.maximumBy ordering)+>>> maximum = Stream.fold Fold.maximum+>>> mapM_ f = Stream.fold (Fold.drainMapM f)+>>> lookup a = Stream.fold (Fold.lookup a)+>>> length = Stream.fold Fold.length+>>> last = Stream.fold Fold.latest+>>> head = Stream.fold Fold.one+>>> foldlM' f a = Stream.fold (Fold.foldlM' f a)+>>> foldl1 f = Stream.fold (Fold.foldl1' f)+>>> foldl' f a = Stream.fold (Fold.foldl' f a)+>>> findIndex eq = Stream.fold (Fold.findIndex eq)+>>> find eq = Stream.fold (Fold.find eq)+>>> findM eq = Stream.fold (Fold.findM eq)+>>> drainWhile p = Stream.fold Fold.drain . Stream.takeWhile p+>>> drainN i = Stream.fold Fold.drain . Stream.take i+>>> drain = Stream.fold Fold.drain+>>> any p = Stream.fold (Fold.any p)+>>> and = Stream.fold Fold.and+>>> all p = Stream.fold (Fold.all p)+>>> (!!) i = Stream.fold (Fold.index i)+>>> tail = Streamly.Internal.Data.StreamK.tail+>>> init = Streamly.Internal.Data.StreamK.init+```++Mapping functions:++```haskell docspec+>>> map = fmap+```++Similarly for scanning use `Stream.scan` or `Stream.postscan`+with an appropriate fold.++```haskell docspec+>>> scanl' f z = Stream.scan (Fold.foldl' f z)+>>> scanlM' f z = Stream.scan (Fold.foldlM' f z)+>>> postscanl' f z = Stream.postscan (Fold.foldl' f z)+>>> postscanlM' f z = Stream.postscan (Fold.foldlM' f z)+>>> scanl1' f = Stream.catMaybes . Stream.scan (Fold.foldl1' f)+>>> scanl1M' f = Stream.catMaybes . Stream.scan (Fold.foldlM1' f)+>>> concatMapWith = StreamK.concatMapWith+>>> concatFoldableWith f = Prelude.foldr f StreamK.nil+>>> concatMapFoldableWith f g = Prelude.foldr (f . g) StreamK.nil+>>> concatForFoldableWith f xs g = Prelude.foldr (f . g) StreamK.nil xs+```++Filters:++```haskell docspec+>>> deleteBy cmp x = Stream.scanMaybe (Fold.deleteBy cmp x)+>>> findIndices p = Stream.scanMaybe (Fold.findIndices p)+>>> elemIndices a = findIndices (== a)+```++Custom implementations of most of these folds, scans and filters are also+available in the `Streamly.Internal.Data.Stream` module.++## Stream splitting and grouping functions++Stream splitting and grouping functions like `splitOn`, `wordsBy`, and+`groupsBy` have been omitted from the new stream module as these can+now be implemented using `foldMany` and an appropriate fold from the+`Streamly.Data.Fold` module, or using `parseMany` and an appropriate+parser from the `Streamly.Data.Parser` module.++```haskell docspec+>>> uniq = Stream.scanMaybe (Fold.uniqBy (==))+>>> splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)+>>> splitOn = Streamly.Internal.Data.Stream.splitOn+>>> splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)+>>> indexedR = Streamly.Internal.Data.Stream.indexedR+>>> groupsBy eq fld = Stream.parseMany (Parser.groupBy (flip eq) fld)+>>> groups = groupsBy (==)+>>> groupsByRolling = Streamly.Internal.Data.Stream.groupsRollingBy+>>> wordsBy p f = Stream.parseMany (Parser.wordBy p f)+>>> chunksOf n f = Stream.foldMany (Fold.take n f)+```++**Caution**: In `streamly-0.8`, The `groupsBy` comparison function took the new+element as the first argument and the previous element as the second.  The order+is flipped in the newer versions of streamly.++Direct implementation of these are also available in+`Streamly.Internal.Data.Stream`.++## Concurrency++Earlier, concurrent and non-concurrent code used the same+combinators. The code was made concurrent by using different concurrent+stream types such as `AsyncT`, `ParallelT` etc. Now you use the same+stream type everywhere, you have to choose a concurrent combinator+for concurrent behavior.  For example, use `mapM` for serial behavior+and `parMapM` for concurrent behavior. Concurrent combinators can+be imported from `Streamly.Data.Stream.Prelude` module. Concurrent+combinators are prefixed with `par`.++Parallel combinators take a concurrency config argument to specify the+concurrency control parameters.  The following combinators have the same+meaning as before except that they are used to set the config parameters+instead of being applied on the stream:++* `rate`+* `maxRate`+* `constRate`+* `avgRate`+* `minRate`+* `maxThreads`+* `maxBuffer`++A stream is evaluated asynchronously using `parEval`:++```haskell docspec+>>> :set -XFlexibleContexts+>>> mkAsync = Stream.parEval id+```++Earlier `consM` was used to create an implicitly concurrent stream of+actions. In the new release, an equivalent effect is achieved by using+a serial `consM` to create a stream of actions and then explicitly using+`Stream.parEval` on it to evaluate it concurrently.++```haskell docspec+>>> consM = StreamK.consM+>>> (|:) = consM+```++Note that you will have to use `StreamK.toStream` to covert it to `Stream`+before using `parEval` on it.++Existing generation combinators that can be implemented using new primitives:++```haskell docspec+>>> repeatM = Stream.parRepeatM+>>> replicateM = Stream.parReplicateM+>>> unfoldrM step = Stream.parEval id . Stream.unfoldrM step+>>> iterateM step = Stream.parEval id . Stream.iterateM step+>>> fromIndicesM f = Stream.parEval id . fromIndicesM f+>>> fromListM = Stream.parSequence id . Stream.fromList+>>> fromFoldableM = Stream.parSequence id . StreamK.toStream . StreamK.fromFoldable+```++Existing transformation combinators that can be implemented using `parEval`:++```haskell docspec+>>> (|$.) f = f . Stream.parEval id+>>> (|&.) = flip (|$.)+>>> (|$) f = f . Stream.parEval id+>>> (|&) = flip (|$)+>>> sequence = Stream.parSequence+>>> mapM = Stream.parMapM+```++`parList` is used to evaluate multiple streams concurrently and combine the+outputs. Existing combinators that can be implemented using `parList`:++```haskell docspec+>>> async x y = Stream.parList id [x, y]+>>> wAsync x y = Stream.parList (Stream.interleaved True) [x, y]+>>> parallel x y = Stream.parList (Stream.eager True) [x, y]+>>> ahead x y = Stream.parList (Stream.ordered True) [x, y]+```++Concurrent zipping and merging combinators:++```haskell docspec+>>> zipAsyncWithM = Stream.parZipWith id+>>> zipAsyncWith = Stream.parZipWith id+>>> mergeAsyncByM = Stream.parMergeByM id+>>> mergeAsyncBy = Stream.parMergeBy id+```++The equivalent of `concatMapWith` using a concurrent combining operation in the+new release is `parConcatMap`. The config argument in `parConcatMap` can+specify an equivalent of the combining operation. Similarly, concurrent+`concatFoldableWith`, `concatMapFoldableWith`, `concatForFoldableWith` can also+be expressed using `parConcatMap`.
+ docs/User/Tutorials/all-your-base.jpg view

binary file changed (absent → 147629 bytes)

@@ -0,0 +1,1 @@+https://github.com/composewell/streamly-examples/blob/master/README.md
+ docs/User/Tutorials/functionality-overview.md view
@@ -0,0 +1,135 @@+# Functionality At a Glance++Streamly allows the programmer to write high-performance code+concisely and idiomatically using high level constructs, and with high+expressivity.++## Streams++**Streaming**: Streamly is a general purpose computing framework+based on data flow programming paradigm also known as the streaming+paradigm.  Streaming enables writing modular and composable applications+declaratively.++**High Performance**: Streamly focuses on high performance in all+areas comparable to low programming languages like C. To achieve that+streamly uses a GHC optimization popularly known as stream fusion. All+abstractions in streamly are designed for stream fusion. It makes sure+that stream fusion works reliably. The abstractions in streamly also+allow nested stream fusion, for example, the `Unfold` abstraction is+specifically designed for nested fusion (an alternative to `concatMap`)+which does not fuse.++**Unified Abstractions**: Furthermore, streamly provides a range+of unified streaming abstractions for representing real life+applications. In general, it includes stream producers and consumers. In+particular, streaming abstractions include `Stream` representing the+stream producers, `Scan` the stream transformers, `Fold` representing+the stream consumers, `Parser` representing the stream consumers with+failure and backtracking. All these abstractions are unified, interwork+with each other, they are all designed based on the same underlying+principles. All other functionality in streamly and applications based+on streamly are designed based on these fundamental abstractions.++**Concise**: The functionality of lists, list-transformer,+logic-programming, streaming, streaming folds, parsers which is covered+by numerous library in the Haskell ecosystem are all represented+efficiently, with the highest possible performance with just these few+abstractions.++**Interworking**: Streamly streams can be converted to and from other streaming+types in the Haskell ecosystem. See the [interop+examples](https://github.com/composewell/streamly-examples/tree/master/examples/Interop)+in the [streamly-examples](https://github.com/composewell/streamly-examples)+repository.++## Arrays++**Arrays**: Arrays complement streams. While streams are used for+in-flight data processing, arrays are used for storing data-at-rest+and for random access. If you look carefully, the core functionality+in streamly is _only_ streams and arrays, the remaining part is just+high level functionality built on these two. All you need to build+any application is streams and arrays. Streamly unifies these two+fundamental concepts, they are intertwined, some stream functionality+requires arrays and some array functionality requires streams. That is+also the reason why we cannot separate these two cleanly in different+packages.++**High Performance**: Similar to streams, arrays are designed for high+performance. While arrays also provide native and high-performance+operations utilizing the random and chunked access nature of arrays,+in most cases they can be processed and transformed efficiently using+streams. Thus, providing a concise API utilizing streams. Unboxed arrays+provide the highest performance.++**Unified Abstractions**: Streamly provides a wide range of abstractions+using arrays to express all types of applications. Unboxed arrays+provide the highest performance whereas boxed arrays provide more+flexibility. Immutable arrays (the `Array` type) guarantee that the data+does not change whereas mutable arrays (the `MutArray` type) provide+in-place mutation for performance where needed. Pinned arrays provide+interfacing with the OS whereas unpinned arrays provide freedom from+fragmentation of memory. The `Unbox` and `Serialize` type classes assist+in high-performance serialization of Haskell data to and from arrays.++**Concise**: The functionality of array processing and serialization+which is covered by numerous library in the Haskell ecosystem are all+represented efficiently, well-integrated with streams, with the highest+possible performance, and in a concise and unified way. Especially, the+functionality of `bytestring`, `text` and `vector` packages can all be+represented by the single `Array` type in streamly and `MutArray` if you+want them to be mutable.++**Interworking**: Streamly arrays can be converted to and from+other popular array types (e.g. bytestring, text and vector) in+the Haskell ecosystem at zero cost i.e. without copying. See the+[streamly-bytestring](https://github.com/psibi/streamly-bytestring)+repository.+<!-- TODO add streamly-text and streamly-vector repos -->++## Declarative Concurrency++Streamly introduces concurrency to the streaming paradigm preserving+the modularity and composability of serial composition. It enables the+programmer to write concurrent programs in a high-level declarative+manner, without using low level concurrency primitives like threads+and synchronization. No explicit thread pools are needed. The degree+of concurrency can be automatically adjusted dynamically based on the+demand by the consumer.++Arrays are processed using streams and streams are concurrent,+therefore, arrays can be processed concurrently.++## Reactive Programming++Streaming and concurrency together enable expressing reactive+applications conveniently.  See the `AcidRain` game in [Streamly+Examples](https://github.com/composewell/streamly-examples) for a simple+reactive programming example.  See the `CirclingSquare` example in+[Streamly Examples](https://github.com/composewell/streamly-examples)+for a simple SDL based reactive programming example. To summarize,+streamly provides a unified computing framework for streaming,+non-determinism and functional reactive programming in an elegant and+simple API that is a natural extension of pure lists to monadic streams.++<!--+## Why data flow programming?++If you need some convincing for using streaming or data flow programming+paradigm itself then try to answer this question - why do we use lists in+Haskell? It boils down to why we use functional programming in the first place.+Haskell is successful in enforcing the functional data flow paradigm for pure+computations using lists, but not for monadic computations. In the absence of a+standard and easy to use data flow programming paradigm for monadic+computations, and the IO monad providing an escape hatch to an imperative+model, we just love to fall into the imperative trap, and start asking the same+fundamental question again - why do we have to use the streaming data model?+-->++## Batteries Included++As we discussed above the core abstractions in streamly are streams+and arrays. For basic programming needs we also need console IO, file+IO, network IO and unicode text processing. All this functionality is+provided by streamly using the core streaming and array abstractions.
+ docs/User/Tutorials/installing-haskell.md view
@@ -0,0 +1,30 @@+<!--+(c) 2022, Composewell Technologies.+SPDX-License-Identifer: BSD-3-Clause+-->++# Installing Haskell++In this tutorial, we assume basic knowledge of Haskell syntax, constructs and+lazy evaluation. The [Haskell wikibook](https://en.wikibooks.org/wiki/Haskell)+may be a good place to start and get familiar with Haskell.++If you wish to follow along and run the examples in this tutorial, you will+need to have Haskell tool chain installed.++You can choose one of the following options.++## Haskell Toolchain++To get started, you will need a fairly recent version (latest three major+versions will work) of the Haskell compiler `ghc` and the build tool+`cabal` installed on your system.  Please see the install instructions+at https://www.haskell.org/downloads/ .++## Development Environment using Nix++If you use the nix package manager, a nix shell for complete Haskell+development environment - including a consistent set of latest streamly+ecosystem packages, hoogle documentation, vim and vscode editors,+Haskell language server (HLS) and other tools - is available at+[streamly-packages](https://github.com/composewell/streamly-packages).
+ docs/User/Tutorials/learn-by-examples.md view
@@ -0,0 +1,741 @@+<!--+(c) 2017, Composewell Technologies and Contributors+SPDX-License-Identifer: BSD-3-Clause+-->++# [Streamly][] Quick Tutorial+## About This Document++This guide introduces programming with [Streamly][] using a few practical+examples:++*  We will start with a simple program that [counts the number of words+   in a text](#modular-word-counting). We will then transform this program+   into a [concurrent](#concurrent-word-counting) program that can efficiently+   use multiprocessing hardware.+*  Next, we will create a [concurrent network+   server](#a-concurrent-network-server). We then show+   how to write a network server that [merges multiple+   streams](#merging-incoming-streams) concurrently.+*  Our third example shows how to list a directory tree concurrently,+   by reading [multiple directories in+   parallel](#listing-directories-recursivelyconcurrently).+*  Finally, we will look at how to [rate limit](#rate-limiting) stream+   processing.++It [concludes](#further-reading) with suggestions for further reading.++## Getting Started++### Installing Streamly++If you wish to follow along and run examples in this guide, please see+the [Using Streamly](/docs/User/Tutorials/using-streamly.md) guide+for instructions on how to use the `streamly` package interactively or+in a project.++Additionally, see [Installing+Haskell](/docs/User/Tutorials/installing-haskell.md) for instructions on how to+install haskell.++### An overview of the types used in these examples++As an expository device, we have indicated the types at the intermediate+stages of stream computations as comments in the examples below.+The meaning of these types are:++* A `Stream IO a` is a representation of a sequence of values of type+  `a` in the IO Monad.+* A `Fold IO a b` is a representation of a function that converts a stream of+  type `a` to a final accumulator of type `b` in the IO Monad.++## The Examples++The code snippets below should work in GHCi if all of those are typed+in sequence.  For brevity, imports that are already used in earlier+snippets are omitted from the latter ones.++### Modular Word Counting++A `Fold` in Streamly is a composable stream consumer.  For our first+example, we will use `Fold`s to count the number of bytes, words and lines+present in a file.  We will then compose individual `Fold`s together to+count words, bytes and lines at the same time.++Please see the file [WordCountModular.hs][] for the complete example+program.++#### Count Bytes (wc -c)++We start with a code fragment that counts the number of bytes in a file:++```haskell docspec+>>> import Data.Function ((&))+>>> import Streamly.FileSystem.Path (Path)+>>> import qualified Streamly.FileSystem.Path as Path+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.FileSystem.FileIO as File++>>> :{+wcb :: Path -> IO Int+wcb file = do+  File.read file               -- Stream IO Word8+    & Stream.fold Fold.length  -- IO Int+:}+```++### Count Lines (wc -l)++The next code fragment shows how to count the number of lines in a file:++```haskell docspec+>>> import Data.Word (Word8)+>>> import Streamly.Data.Fold (Fold)+>>> :{+-- ASCII character 10 is a newline.+countl :: Int -> Word8 -> Int+countl n ch = if ch == 10 then n + 1 else n+:}+>>> :{+-- The `nlines` fold accepts a stream of `Word8` and returns a line count (`Int`).+nlines :: Monad m => Fold m Word8 Int+nlines = Fold.foldl' countl 0+:}+>>> :{+wcl :: Path -> IO Int+wcl file =+    File.read file     -- Stream IO Word8+  & Stream.fold nlines -- IO Int+:}+```++### Count Words (wc -w)++Our final code fragment counts the number of whitespace-separated words+in a stream:++```haskell docspec+>>> import Data.Char (chr, isSpace)+>>> :{+countw :: (Int, Bool) -> Word8 -> (Int, Bool)+countw (n, wasSpace) ch =+    if isSpace $ chr $ fromIntegral ch+    then (n, True)+    else (if wasSpace then n + 1 else n, False)+:}+>>> :{+-- The `nwords` fold accepts a stream of `Word8` and returns a word count (`Int`).+nwords :: Monad m => Fold m Word8 Int+nwords = fst <$> Fold.foldl' countw (0, True)+:}+>>> :{+wcw :: Path -> IO Int+wcw file =+    File.read file      -- Stream IO Word8+  & Stream.fold nwords  -- IO Int+:}+```++### Counting Bytes, Words and Lines Together++By using the `Tee` combinator we can compose the three folds that count+bytes, lines and words individually into a single fold that counts all+three at once.  The applicative instance of `Tee` distributes its input+to all the supplied folds (`Fold.length`, `nlines`, and `nwords`) and+then combines the outputs from the folds using the supplied combiner+function (`(,,)`).++```haskell docspec+>>> import Streamly.Data.Fold (Tee(..))+>>> :{+-- The fold accepts a stream of `Word8` and returns the three counts.+countAll :: Fold IO Word8 (Int, Int, Int)+countAll = unTee $ (,,) <$> Tee Fold.length <*> Tee nlines <*> Tee nwords+:}+>>> :{+wc :: Path -> IO (Int, Int, Int)+wc file =+    File.read file       -- Stream IO Word8+  & Stream.fold countAll -- IO (Int, Int, Int)+:}+```++This example demonstrates the excellent modularity offered by+[Streamly][]'s simple and concise API.++### The Performance of Word Counting++We compare two equivalent implementations: one using [Streamly][],+and the other using C.++The performance of the [Streamly word counting+implementation][WordCount.hs] (using ghc-9.4.4 and fusion-plugin) is:++```+$ time WordCount-hs gutenberg-500MB.txt+11242220 97050938 574714449 gutenberg-500MB.txt++real    0m2.033s+user    0m1.821s+sys     0m0.209s+```++The performance of an equivalent [wc implementation in C][WordCount.c] is:++```+$ time WordCount-c gutenberg-500MB.txt+11242220 97050938 574714449 gutenberg-500MB.txt++real    0m2.113s+user    0m1.928s+sys     0m0.185s+```++### Concurrent Word Counting++In our next example we show how the task of counting words, lines,+and bytes could be done in parallel on multiprocessor hardware.++To count words in parallel we first divide the stream into chunks+(arrays), do the counting within each chunk, and then add all the+counts across chunks.  We use the same code as above except that we use+arrays for our input data.++Please see the file [WordCountParallel.hs][] for the complete working+code for this example, including the imports that we have omitted below.++First we create a new data type `Counts` that holds all the context.++```haskell docspec+>>> :{+-- Counts lines words chars lastCharWasSpace+data Counts = Counts !Int !Int !Int !Bool deriving Show+:}+>>> :{+{-# INLINE count #-}+count :: Counts -> Char -> Counts+count (Counts l w c wasSpace) ch =+    let l1 = if ch == '\n' then l + 1 else l+        (w1, wasSpace1) =+            if isSpace ch+            then (w, True)+            else (if wasSpace then w + 1 else w, False)+    in Counts l1 w1 (c + 1) wasSpace1+:}+```++The `countArray` function counts the line, word, char counts in one chunk:++```haskell docspec+>>> import Streamly.Data.Array (Array)++>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Unicode.Stream as Unicode++>>> :{+countArray :: Array Word8 -> IO Counts+countArray arr =+      Array.read arr                                      -- Stream IO Word8+    & Unicode.decodeLatin1                                -- Stream IO Char+    & Stream.fold (Fold.foldl' count (Counts 0 0 0 True)) -- IO Counts+:}+```++Here the function `count` and the `Counts` data type are defined in the+`WordCount` helper module defined in [WordCount.hs][].++When combining the counts in two contiguous chunks, we need to check+whether the first element of the next chunk is a whitespace character+in order to determine if the same word continues in the next chunk or+whether the chunk starts with a new word. The `partialCounts` function+adds a `Bool` flag to `Counts` returned by `countArray` to indicate+whether the first character in the chunk is a space.++```haskell docspec+>>> :{+partialCounts :: Array Word8 -> IO (Bool, Counts)+partialCounts arr = do+    let r = Array.getIndex 0 arr+    case r of+        Just x -> do+            counts <- countArray arr+            return (isSpace (chr (fromIntegral x)), counts)+        Nothing -> return (False, Counts 0 0 0 True)+:}+```++`addCounts` then adds the counts from two consecutive chunks:++```haskell docspec+>>> :{+addCounts :: (Bool, Counts) -> (Bool, Counts) -> (Bool, Counts)+addCounts (sp1, Counts l1 w1 c1 ws1) (sp2, Counts l2 w2 c2 ws2) =+    let wcount =+            if not ws1 && not sp2 -- No space between two chunks.+            then w1 + w2 - 1+            else w1 + w2+     in (sp1, Counts (l1 + l2) wcount (c1 + c2) ws2)+:}+```++To count in parallel we now only need to divide the stream into arrays,+apply our counting function to each array, and then combine the counts+from each chunk.++```haskell docspec+>>> :set -XFlexibleContexts+>>> import GHC.Conc (numCapabilities)+>>> import qualified Streamly.Data.Stream.Prelude as Stream++>>> :{+wc :: Path -> IO (Bool, Counts)+wc file = do+      File.readChunks file             -- Stream IO (Array Word8)+    & Stream.parMapM cfg partialCounts -- Stream IO (Bool, Counts)+    & Stream.fold add                  -- IO (Bool, Counts)++    where++    cfg = Stream.maxThreads numCapabilities . Stream.ordered True+    add = Fold.foldl' addCounts (False, Counts 0 0 0 True)+:}+```++We can replace `parMapM` with `mapM` to get a serial version of the program.++A benchmark with 2 CPUs:++```+$ time WordCount-hs-parallel gutenberg-500MB.txt+11242220 97050938 574714449 gutenberg-500MB.txt++real    0m1.443s+user    0m2.095s+sys     0m0.202s+```++These example programs have assumed ASCII encoded input data.  For UTF-8+streams, we have a [concurrent wc implementation][WordCountParallelUTF8.hs]+with UTF-8 decoding.  This concurrent implementation performs as well+as the standard `wc` program in serial benchmarks. In concurrent mode+[Streamly][]'s implementation can utilise multiple processing cores if+these are present, and can thereby run much faster than the standard+binary.++Streamly provides concurrency facilities similar+to [OpenMP](https://en.wikipedia.org/wiki/OpenMP) and+[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative+style of expression.  With Streamly you can write concurrent programs+with ease, with support for different types of concurrent scheduling.++### A Concurrent Network Server++We now move to a slightly more complicated example: we simulate a+dictionary lookup server which can serve word meanings to multiple+clients concurrently.++Please see the file [WordServer.hs][] for the complete code for this+example.++```haskell docspec+>>> import Control.Concurrent (threadDelay)+>>> import Control.Exception (finally)+>>> import Network.Socket (Socket, close)++>>> import qualified Streamly.Data.Parser as Parser+>>> import qualified Streamly.Network.Inet.TCP as TCP+>>> import qualified Streamly.Network.Socket as Socket+>>> import qualified Streamly.Unicode.Stream as Unicode++>>> :{+-- Simulate network/db query by adding a delay.+fetch :: String -> IO (String, String)+fetch w = threadDelay 1000000 >> return (w,w)+:}++>>> :{+-- Read lines of whitespace separated list of words from a socket, fetch the+-- meanings of each word concurrently and return the meanings separated by+-- newlines, in same order as the words were received. Repeat until the+-- connection is closed.+lookupWords :: Socket -> IO ()+lookupWords sk =+      Socket.read sk                             -- Stream IO Word8+    & Unicode.decodeLatin1                       -- Stream IO Char+    & Stream.wordsBy isSpace Fold.toList         -- Stream IO String+    & Stream.parMapM cfg fetch                   -- Stream IO (String, String)+    & fmap show                                  -- Stream IO String+    & Stream.intersperse "\n"                    -- Stream IO String+    & Unicode.encodeStrings Unicode.encodeLatin1 -- Stream IO (Array Word8)+    & Stream.fold (Socket.writeChunks sk)++    where++    cfg = Stream.ordered True+:}++>>> :{+serve :: Socket -> IO ()+serve sk = finally (lookupWords sk) (close sk)+:}++>>> :{+-- | Run a server on port 8091. Accept and handle connections concurrently. The+-- connection handler is "serve" (i.e. lookupWords).  You can use "telnet" or+-- "nc" as a client to try it out.+main :: IO ()+main =+      TCP.accept 8091         -- Stream IO Socket+    & Stream.parMapM id serve -- Stream IO ()+    & Stream.fold Fold.drain  -- IO ()+:}+```++### Merging Incoming Streams++In the next example, we show how to merge logs coming from multiple+nodes in your network.  These logs are merged at line boundaries and+the merged logs are written to a file or to a network destination.+This example uses the `concatMapWith` combinator to merge multiple+streams concurrently.++Please see the file [MergeServer.hs][] for the complete working code,+including the imports that we have omitted below.++<!--+Docspec bug: For some reason if we add the signature of the function the+definition is not registered and goes out of scope. This behaviour is consistent+but I'm unable to figure out the pattern yet.+-->+```haskell docspec+>>> import Streamly.Data.Stream (Stream)+>>> import System.IO (IOMode(AppendMode), Handle, withFile)++>>> import qualified Streamly.Network.Socket as Socket+>>> import qualified Streamly.FileSystem.Handle as Handle++>>> :{+-- | Read a line stream from a socket.+-- Note: lines are buffered, and we could add a limit to the+-- buffering for safety.+-- readLines :: Socket -> Stream IO (Array Char)+readLines sk =+    Socket.read sk       -- Stream IO Word8+  & Unicode.decodeLatin1 -- Stream IO Char+  & Stream.foldMany line -- Stream IO (Array Char)++  where++  line = Fold.takeEndBy (== '\n') Array.create+:}++>>> :{+-- recv :: Socket -> Stream IO (Array Char)+recv sk = Stream.finallyIO (close sk) (readLines sk)+:}++>>> :{+-- | Starts a server at port 8091 listening for lines with space separated+-- words. Multiple clients can connect to the server and send streams of lines.+-- The server handles all the connections concurrently, merges the incoming+-- streams at line boundaries and writes the merged stream to a file.+-- server :: Handle -> IO ()+server file =+      TCP.accept 8090                              -- Stream IO Socket+    & Stream.parConcatMap (Stream.eager True) recv -- Stream IO (Array Char)+    & Stream.unfoldEach Array.reader               -- Stream IO Char+    & Unicode.encodeLatin1                         -- Stream IO Word8+    & Stream.fold (Handle.write file)              -- IO ()+:}++>>> :{+main :: IO ()+main = withFile "output.txt" AppendMode server+:}+```++### Listing Directories Recursively/Concurrently++Our next example lists a directory tree recursively, and concurrently.++This example uses the tree traversing combinator `parConcatIterate`.  This+combinator maps a stream generator function on the input stream and then+recursively on the generated stream as well and flattens the results. We map a+directory to a stream generating its children and a file to a nil stream. This+results in a concurrent recursive depth first traversal of the directory tree.++Please see [ListDir.hs][] for the complete working code.++```haskell docspec+>>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))+>>> import qualified Streamly.Internal.FileSystem.DirIO as Dir (readEitherPaths)++>>> :set -XQuasiQuotes+>>> import Streamly.FileSystem.Path (path)+>>> import qualified Streamly.FileSystem.Path as Path+>>> import Data.Bifunctor(bimap)++>>> :{+main :: IO ()+main = do+    hSetBuffering stdout LineBuffering+    let start = Stream.fromPure (Left [path|.|])+        f = either (Dir.readEitherPaths id) (const Stream.nil)+        ls = Stream.parConcatIterate id f start+     in Stream.fold (Fold.drainMapM (print . bimap Path.toString Path.toString)) ls+:}+```++### Rate Limiting++For concurrent streams, a stream evaluation rate can be specified.  For+example, to print "tick" once every second you can simply write:++```haskell docspec+>>> import qualified Streamly.Internal.Data.Stream as Stream (timestamped)++>>> :{+main :: IO ()+main =+      Stream.parRepeatM (Stream.avgRate 1) (pure "tick") -- Stream IO String+    & Stream.timestamped                                 -- Stream IO (AbsTime, String)+    & Stream.fold (Fold.drainMapM print)                 -- IO ()+:}+```++Please see the file [Rate.hs][] for the complete working code.++The concurrency of the stream is automatically controlled to match the+specified rate. [Streamly][]'s rate control works precisely even at+throughputs as high as millions of yields per second.++For more sophisticated rate control needs please see the Streamly [reference+documentation][Streamly].++## Reactive Programming: Acid Rain Game++### Objective of the Game++The game starts with a certain measure of health of the player. As time+passes the health of the player keeps on deteriorating because acid rain is+going on. If the health reaches 0 the player dies and the game is over. If the+player types "potion" on the CLI, the health is improved, the game continues if+the player keeps typing potion rapidly enough. If the player types "harm"+instead the health of the player deteriorates and the player dies sooner. If+the player types "quit" then the game ends.++### Importing Required Modules++Let's first import the required modules from `streamly` and `base`.++```haskell+{-# LANGUAGE FlexibleContexts #-}+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.State (MonadState, get, modify)+import Data.Function ((&))+import Streamly.Data.Stream.Prelude (MonadAsync, Stream)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream.Prelude as Stream+```++### Events++The possible events in the system are represented by the `Event` data type.+Acid rain generates the `Harm` event, typing "potion" on the CLI generates the+`Heal` event, typing "harm" generates the `Harm` event, and typing "quit"+generates the `Quit` event. Harm and Heal events have an integer associated+which represents the degree of harm or healing.++```haskell+data Event = Quit | Harm Int | Heal Int deriving (Eq, Show)+```++This application has two independent and concurrent sources of event+streams, `acidRain` and `userAction`.++### Acid Rain Stream++Now let's simulate acid rain. The acidRain function below generates a stream of+`Harm 1` events, one event is generated per second.++```haskell+acidRain :: MonadAsync m => Stream m Event+acidRain = Stream.parRepeatM (Stream.constRate 1) (return $ Harm 1)+```++### User Event Stream++The second stream is the stream of events generated by the user by typing+commands on the CI. The `userAction` function reads the standard input,+interprets the command typed and generates the appropriate event. It keeps+doing this forever, this is an infinite stream.++```haskell+userAction :: MonadAsync m => Stream m Event+userAction = Stream.repeatM $ liftIO askUser++    where++    askUser = do+        command <- getLine+        case command of+            "potion" -> return (Heal 10)+            "harm"   -> return (Harm 10)+            "quit"   -> return Quit+            _        -> putStrLn "Type potion or harm or quit" >> askUser+```++### Combined Stream++Now let's combine the streams generated by acid rain and the stream generated+by the CLI. Both the streams should be generated concurrently, therefore, we+use the `parList` function to combine them, this function combines a list of+streams concurrently. We use the `eager True` option to ensure that both the+streams are evaluated as soon as possible.++```haskell+parallel :: MonadAsync m => [Stream m a] -> Stream m a+parallel = Stream.parList (Stream.eager True)++eventStream :: MonadAsync m => Stream m Event+eventStream = parallel [userAction, acidRain]+```++### Process Health Events++The `runEvents` function below maintains the health of the player as an integer+value in the `State` monad. It maps the `processEvents` function on the event+stream. The `Harm` or `Heal` events decrement or increment the player health+value appropriately. If we encounter a `Quit` event the function returns `Done`+otherwise it returns `Continue`. The resulting stream is a stream of `Result`+values.++```haskell+data Result = Continue | Done++runEvents :: (MonadAsync m, MonadState Int m) => Stream m Result+runEvents = Stream.mapM processEvents eventStream++    where++    processEvents event =+        case event of+            Harm n -> modify (\h -> h - n) >> return Continue+            Heal n -> modify (\h -> h + n) >> return Continue+            Quit -> return Done+```++### Check the Player Status++The `runEvents` function above returns a stream of results after processing the+health events. The stream consists of results indicating whether the game+should continue or end, the `State` monad supplies the current health of the+player.++Now we map the `getStatus` function on the `Result` stream. If we encounter a+`Done` in the result stream then it means the user has quit the game, so we+return `GameOver`, if the health of the player is 0 or less then the player has+died and we return `GameOver`, otherwise we return `Alive`.++```haskell+data Status = Alive | GameOver deriving Eq++getStatus :: (MonadAsync m, MonadState Int m) => Result -> m Status+getStatus result =+    case result of+        Done  -> liftIO $ putStrLn "You quit!" >> return GameOver+        Continue -> do+            h <- get+            liftIO+                $ if (h <= 0)+                  then putStrLn "You die!" >> return GameOver+                  else putStrLn ("Health = " <> show h) >> return Alive+```++### Tying it all Together++We start with the `Result` stream using the `runEvents` function. Then we map+the `getStatus` function on this stream and turn it into a `Status` stream.+Then we run the `State` monad using `runStateT`, supplying the initial health+to be 60, the resulting stream is a tuple of (health, status) in the IO monad.+We then discard the health and just keep the status, resulting in a `Status`+stream. We then fold this `Status` stream using the `takeEndBy` fold, this fold+terminates as soon as a `GameOver` value is encountered in the stream.++```haskell+main :: IO ()+main = do+    putStrLn "Your health is deteriorating due to acid rain,\+             \ type \"potion\" or \"quit\""+    runEvents                        -- Stream (StateT Int IO) Result+        & Stream.mapM getStatus      -- Stream (StateT Int IO) Status+        & Stream.runStateT (pure 60) -- Stream IO (Int, Status)+        & fmap snd                   -- Stream IO Status+        & Stream.fold (Fold.takeEndBy (== GameOver) Fold.drain) -- IO ()+    return ()+```++### Complete Working Example++You can find a complete working source of this example in the+streamly-examples repo as+[AcidRain.hs](https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs).+The idea of this game example has been taken from Gabriella Gonzalez's+[pipes-concurrency](https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html)+package.++## Reactive Programming: Circling Square++For a simple graphical example where we generate an animation by+rendering a graphics frame periodically, see the SDL based circling+square example adapted from Yampa in+[CirclingSquare.hs](https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs).++### More Examples++If you would like to view more examples, please visit the [Streamly+Examples][streamly-examples] web page.++<!--+### Further Reading++* [Streaming Benchmarks][streaming-benchmarks]+* [Concurrency Benchmarks][concurrency-benchmarks]+* Functional Conf 2019 [Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)+* [Other Guides](/)+* [Streamly Homepage][Streamly]+-->++<!--+Link References.+-->++[Streamly]: https://streamly.composewell.com/+[streamly-examples]: https://github.com/composewell/streamly-examples+[streaming-benchmarks]: https://github.com/composewell/streaming-benchmarks+[concurrency-benchmarks]: https://github.com/composewell/concurrency-benchmarks++<!--+Keep all the unstable links here so that they can be updated to stable+links (for online docs) before we release.+-->++<!-- examples -->+[WordCountModular.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountModular.hs+[WordCount.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.hs+[WordCount.c]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.c+[WordCountParallel.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallel.hs+[WordCountParallelUTF8.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallelUTF8.hs+[WordServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordServer.hs+[MergeServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/MergeServer.hs+[ListDir.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/ListDir.hs+[Rate.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/Rate.hs+[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs+[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs++<!-- local files -->+[LICENSE]: /LICENSE+[CONTRIBUTING.md]: /CONTRIBUTING.md+[docs]: docs/
+ docs/User/Tutorials/performance-considerations.md view
@@ -0,0 +1,123 @@+# Performance Considerations++<!--+CPS-vs-Direct++# High performance code.++Use examples to illustrate.++## Direct encpasulated in CPS++Direct style modules provide the highest performance with static fusion. CPS+style modules provide dynamic composition and building/consuming of streams+with dependencies.++The basic principle is always compose using the fused modules as long as you+can. When we cannot we wrap them in cps. In general the outer structure of the+program is CPS and the inner structure is direct.++When using streams, we generally build/process small segments using the direct+style streams, we store the segments in chunks of arrays, wrap these arrays+into StreamK to build larger streams.++Similarly, we process larger CPS streams of arrays using CPS ParserK, process+the smaller segments within using direct style parser as much as we can. When+we need to express dependencies during processing i.e. we need monad then we+wrap the direct processing in CPS.++So we have the entire outline of the processing as CPS which encapsulates small+islands of direct style processing.++## Stream vs StreamK++The CPS overhead is per element, the smaller the elements, more in numbers, the+more is the overhead. Thus we want to minimize CPS and maximize direct style.+So we keep chunks in outer CPS StreamK and process those chunks using the inner+Stream. The direct processing is extermely efficient but it has to fuse+statically.++We we use fromStream (streamd), we are converting the stream to CPS and now+each element of the stream will pass through CPS, each elements will have a+constant CPS overhead. Thus it is better if we CPS a stream with fewer elements+of larger size rather than a large number of elements.++When we use toStream (streamk), we do not make the performance better, the+overhead remains the same as each element is passing through CPS anyway. We are+just processing the elements vis non-cps stream functions.++Therefore once we made a stream CPS, it does not make any difference if we make+it direct again or not. From performance perspective it is a one-way street.++The same arguments apply to Parser vs ParserK.+-->++## Streams++From performance behavior perspective, the stream operations can be divided+into three categories:++* Byte level loops: Fused streams as the lowest level building blocks.+* Chunk level loops: CPS streams as scalable wrappers to wrap fused streams.+* Thread level loops: Byte or chunk level loops evaluated in multiple threads.++| Fused  | CPS     | Concurrent Combinators       |+|--------|---------|------------------------------|+| Stream | StreamK | Streamly.Data.Stream.Prelude |+| Fold   | ParserK | Streamly.Data.Fold.Prelude   |+| Parser | ParserK |                              |+<!-- | Scan   | PipeK   | Streamly.Data.Scan.Prelude   | -->++## Fused Streams++The fused stream types provide the statically optimized loops giving the+highest performance with no function calls, thus no memory allocations for+wrapping constructors. Such loops provide C like performance.++## CPS Streams++In many cases you cannot determine the loops statically, in which case a+function call overhead or constructor allocation cannot be avoided. Note+this is not Haskell specific, even in C such cases would require a+function call overhead.  For such cases we have stream types which use+function composition rather than constructor fusion. In general we use+such streams to generate large chunks of data which is then processed by+fused streams loops embedded in CPS streams. Because of larger chunks+the number of function calls, therefore, the function call overhead due+to CPS streams is reduced.++## Concurrent Combinators++Concurrent streams use concurrency channels to evaluate streams+concurrently.  Concurrent combinators are provided corresponding to most+serial stream combinator for concurrent evaluation.  These combinators+consume fused or CPS streams, process them in a multithreaded manner and+generate a fused or CPS stream where the output is a stream.++## Arrays++Streams are for processing data, therefore, performance of streams+mostly involves CPU optimization.  Arrays are for storing data,+therefore, performance of arrays mostly involves memory aspects e.g.+boxed or unboxed, pinned or unpinned.++For highest performance we recommend the use of unboxed arrays. Unboxed+arrays store data without an additional heap pointer wrapper+(boxing). The arrays in the following modules are unboxed arrays:++* Streamly.Data.Array+* Streamly.Data.MutArray+* Streamly.Data.RingArray++For storing boxed heap objects, boxed arrays are provided in the following+modules:++* Streamly.Data.Array.Generic+* Streamly.Data.MutArray.Generic++Unboxed arrays can be pinned (cannot be moved by GC) or+unpinned. However, pinned or unpinned nature of the memory is not+statically typed in the array type. The same array may be created in+pinned or unpinned memory, an unpinned array can be dynamically moved+to pinned memory or vice-versa. For this purpose pinned or unpinned+versions of functions are provided in the unboxed array modules.
+ docs/User/Tutorials/streamly-core.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0.0 0.0 700.0 699.9999999999998" height="700.0000" font-size="1" stroke-opacity="1" width="700.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,456.0606 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,456.0606 l -0.0000,-70.7071 h -212.1212 l -0.0000,70.7071 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,456.0606 l -0.0000,-44.1919 h -212.1212 l -0.0000,44.1919 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,433.9646)" dominant-baseline="middle" text-anchor="middle" stroke="none">Control.Exception</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,398.6111)" dominant-baseline="middle" text-anchor="middle" stroke="none">Resource Management</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,385.3535 l -0.0000,-141.4141 h -212.1212 l -0.0000,141.4141 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,385.3535 l -0.0000,-114.8990 h -212.1212 l -0.0000,114.8990 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,365.0253)" dominant-baseline="middle" text-anchor="middle" stroke="none">String</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,327.9040)" dominant-baseline="middle" text-anchor="middle" stroke="none">Stream</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,290.7828)" dominant-baseline="middle" text-anchor="middle" stroke="none">Parser</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,257.1970)" dominant-baseline="middle" text-anchor="middle" stroke="none">Unicode</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,456.0606 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,456.0606 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,456.0606 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,437.5000)" dominant-baseline="middle" text-anchor="middle" stroke="none">Path</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,400.3788)" dominant-baseline="middle" text-anchor="middle" stroke="none">Handle</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,363.2576)" dominant-baseline="middle" text-anchor="middle" stroke="none">DirIO</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,326.1364)" dominant-baseline="middle" text-anchor="middle" stroke="none">FileIO</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,289.0152)" dominant-baseline="middle" text-anchor="middle" stroke="none">Console.Stdio</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,257.1970)" dominant-baseline="middle" text-anchor="middle" stroke="none">File System</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,668.1818 l -0.0000,-212.1212 h -636.3636 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,668.1818 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,668.1818 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,625.7576)" dominant-baseline="middle" text-anchor="middle" stroke="none">Serialize</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,588.6364)" dominant-baseline="middle" text-anchor="middle" stroke="none">Unbox</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,551.5152)" dominant-baseline="middle" text-anchor="middle" stroke="none">MutByteArray</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,495.8333)" dominant-baseline="middle" text-anchor="middle" stroke="none">Serialization</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,625.7576)" dominant-baseline="middle" text-anchor="middle" stroke="none">RingArray</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,588.6364)" dominant-baseline="middle" text-anchor="middle" stroke="none">MutArray.Generic</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,551.5152)" dominant-baseline="middle" text-anchor="middle" stroke="none">MutArray</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,495.8333)" dominant-baseline="middle" text-anchor="middle" stroke="none">Mutable</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,668.1818 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,668.1818 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,607.1970)" dominant-baseline="middle" text-anchor="middle" stroke="none">Array.Generic</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,570.0758)" dominant-baseline="middle" text-anchor="middle" stroke="none">Array</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,495.8333)" dominant-baseline="middle" text-anchor="middle" stroke="none">Immutable</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,469.3182)" dominant-baseline="middle" text-anchor="middle" stroke="none">Arrays</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-212.1212 h -636.3636 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,201.5152)" dominant-baseline="middle" text-anchor="middle" stroke="none">ParserK</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Parser</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,127.2727)" dominant-baseline="middle" text-anchor="middle" stroke="none">Fold</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Consumption</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Scanl</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Transformation</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,201.5152)" dominant-baseline="middle" text-anchor="middle" stroke="none">Unfold</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">StreamK</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,127.2727)" dominant-baseline="middle" text-anchor="middle" stroke="none">Stream</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Generation</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,45.0758)" dominant-baseline="middle" text-anchor="middle" stroke="none">Streams</text></g><g stroke-linecap="butt" fill="rgb(173,216,230)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 429.5455,350.0000 c 0.0000,-21.9659 -35.6137,-39.7727 -79.5455 -39.7727c -43.9317,-0.0000 -79.5455,17.8069 -79.5455 39.7727c -0.0000,21.9659 35.6137,39.7727 79.5455 39.7727c 43.9317,0.0000 79.5455,-17.8069 79.5455 -39.7727Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,357.9545)" dominant-baseline="middle" text-anchor="middle" stroke="none">(types and modules)</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,342.0455)" dominant-baseline="middle" text-anchor="middle" stroke="none">streamly-core</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 429.5455,350.0000 h 15.9091 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,350.0000 l -10.6061,-6.1234 v 12.2468 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 270.4545,350.0000 l -15.9091,0.0000 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,350.0000 l 10.6061,6.1234 l -0.0000,-12.2468 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,389.7727 l 0.0000,55.6818 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,456.0606 l 6.1234,-10.6061 l -12.2468,0.0000 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,310.2273 l 0.0000,-55.6818 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,243.9394 l -6.1234,10.6061 l 12.2468,0.0000 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g></svg>
+ docs/User/Tutorials/streamly-ecosystem.md view
@@ -0,0 +1,111 @@+# Streamly Ecosystem++The Streamly ecosystem is a collection of packages built on top of+Streamly, extending its core with higher-level functionality for+real-world programming.++For a combined view of the reference documentation across all ecosystem+packages, visit:+👉 [Streamly Module Listing](https://streamly.composewell.com/module-listing.html)++## streamly-process++**`streamly-process`** lets you use operating system (OS) commands in+Haskell programs as if they were native functions, by treating their+inputs and outputs as Haskell streams. This makes it easy to write+high-level Haskell scripts that perform tasks similar to shell pipelines+but with **C-like performance, strong safety guarantees, modularity, and+refactorability**.++For example, the shell command:++```bash+echo "hello world" | tr [a-z] [A-Z]+```++can be expressed in Haskell as:++<!--+Not exactly sure what the clean way is to import packages. We need to launch the+ghci session with the required packages.+-->+```+>>> :{+   Command.toBytes [str|echo "hello world"|] -- Stream IO Word8+ & Command.pipeBytes [str|tr [a-z] [A-Z]|]   -- Stream IO Word8+ & Stream.fold Stdio.write                   -- IO ()+:}+HELLO WORLD+```++👉 [streamly-process on GitHub](https://github.com/composewell/streamly-process)++## streamly-coreutils++**`streamly-coreutils`** reimplements GNU coreutils utilities as+composable Haskell functions—concurrent where possible. Examples include+`test`, `cp`, `ls`, `ln`, `mv`, `rm`, `touch`, `mkdir`, `pwd`, `cd`,+`stat`, `readlink`, `which`, `sleep`, and more.++This allows you to use familiar Unix-style tools directly within+streaming Haskell programs, combining the convenience of shell scripting+with the safety, modularity, and performance of Haskell.++👉 [streamly-coreutils on GitHub](https://github.com/composewell/streamly-coreutils)++## streamly-statistics++**`streamly-statistics`** offers functionality similar to the Haskell+`statistics` package, but with streaming APIs. Its unique strength is+support for **incremental statistical analysis on sliding windows of+data**, seamlessly integrated into streaming pipelines. This makes it+ideal for real-time analytics, monitoring systems, or any application+that processes continuous data streams.++👉 [streamly-statistics on GitHub](https://github.com/composewell/streamly-statistics)++## streamly-fsevents++**`streamly-fsevents`** provides a streaming interface to file system+events. It allows you to **watch files or directories for changes**—+such as creation, modification, deletion, or renaming—and consume those+events as Haskell streams. Internally, it uses efficient system+facilities like `inotify` on Linux for scalable event monitoring.++This makes it well-suited for building **real-time file watchers,+synchronization tools, live-reload servers, or monitoring pipelines**.++👉 [streamly-fsevents on GitHub](https://github.com/composewell/streamly-fsevents)++<!--+## streamly-lz4++Streaming APIs for lz4 compression and decompression.+-->++## Compatibility Packages++Streamly can interwork with other packages in the Haskell ecosystem+providing similar functionality. These packages enable the+interconversion.++### streamly-bytestring++Package for converting streamly `Array` type to the bytestring package's+`ByteString` type and vice-versa.++👉 [streamly-bytestring on GitHub](https://github.com/psibi/streamly-bytestring)++### streamly-text++Package for converting streamly `Array` type to the `text` package's+`Text` type and vice-versa.++👉 [streamly-text on GitHub](https://github.com/composewell/streamly-text)++### streamly-filepath++Package for converting streamly `Path` type to the `filepath` package's+`OsPath` type and vice-versa.++👉 [streamly-filepath on GitHub](https://github.com/composewell/streamly-filepath)
+ docs/User/Tutorials/streamly.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0.0 0.0 700.0 699.9999999999998" height="700.0000" font-size="1" stroke-opacity="1" width="700.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,593.9394)" dominant-baseline="middle" text-anchor="middle" stroke="none">Network.Inet.TCP</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,556.8182)" dominant-baseline="middle" text-anchor="middle" stroke="none">Network.Socket</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,469.3182)" dominant-baseline="middle" text-anchor="middle" stroke="none">Network</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-212.1212 h -636.3636 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Fold.Prelude</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Consumption</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Scanl.Prelude</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Transformation</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Stream.Prelude</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Generation</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,45.0758)" dominant-baseline="middle" text-anchor="middle" stroke="none">Concurrent Streams</text></g><g stroke-linecap="butt" fill="rgb(173,216,230)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 429.5455,350.0000 c 0.0000,-21.9659 -35.6137,-39.7727 -79.5455 -39.7727c -43.9317,-0.0000 -79.5455,17.8069 -79.5455 39.7727c -0.0000,21.9659 35.6137,39.7727 79.5455 39.7727c 43.9317,0.0000 79.5455,-17.8069 79.5455 -39.7727Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,350.0000)" dominant-baseline="middle" text-anchor="middle" stroke="none">streamly</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,389.7727 l 0.0000,55.6818 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,456.0606 l 6.1234,-10.6061 l -12.2468,0.0000 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,310.2273 l 0.0000,-55.6818 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,243.9394 l -6.1234,10.6061 l 12.2468,0.0000 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g></svg>
+ docs/User/Tutorials/streams-as-loops.md view
@@ -0,0 +1,190 @@+# Streaming Pipelines as Functional Loops++Streaming pipelines are the functional equivalent of loops in imperative+programming.  In imperative programming when we have to process a+sequence of data items we run a loop over all the items. Each iteration+of the loop examines a single element of data to change the state of the+program or produce an output.++<!-- Write a C loop equivalent to the stream code below -->++## Data as Stream++In the streaming paradigm, we represent the user data that we have to+loop over as a stream.  A stream is a representation of potentially+infinite sequence of data items.++A finite stream consisting of integer data elements 1,2,3:++```haskell docspec+>>> import Streamly.Data.Stream (Stream)+>>> import qualified Streamly.Data.Stream as Stream+>>> s1 = Stream.enumerateFromTo 1 3 :: Stream IO Int+```++An infinite stream consisting of integers from 1 to infinity:++```haskell docspec+>>> s2 = Stream.enumerateFrom 1 :: Stream IO Int+```++## Stream Transformation++We have represented data as stream, now we have to operate on it. To+operate on the data in the stream we use stream transformation+functions, for example, if we have to increment each element in the+stream by one we use the `fmap` function. After applying the `fmap (+1)`+function on the stream we get an output stream in which each element of+the input stream is incremented by 1. Stream `s3` consists of elements+2,3,4:++```haskell docspec+>>> import Data.Function ((&))+>>> :{+s3 =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & fmap (+1)              -- Stream IO Int+:}+```++Another example of a stream transformation operation is `take`, it trims+the stream to the specified number of elements. For example, the stream+`s4` in the code below consists of only two items 1,2:++```haskell docspec+>>> :{+s4 =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & Stream.take 2          -- Stream IO Int+:}+```++## Modular Streaming Operations++Similar to `fmap` and `take` there are many transformation operations+available in the library to perform different type of operations on the+stream. Each operation performs a specific job. We can combine multiple such+operations successively in a pipeline of operations to perform a desired+operation on the stream. For example, if we want to increment each element by 1+and want to take only first two items, then we can do it as follows. The+resulting stream `s5` consists of items 2,4.++```haskell docspec+>>> :{+s5 =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & fmap (+1)              -- Stream IO Int+      & Stream.take 2          -- Stream IO Int+:}+```++Each stream transformation operation maintains its own internal state+which is hidden from the programmer. In an imperative language loop we+will have to maintain the state explicitly in a monolithic loop, for+example if we have to stop after processing 2 elements we will have to+maintain a counter and check that counter in each iteration. Here we are+able to hide the state locally in each transformation operation and we+can build a larger processing loop by putting together smaller parts in+a modular fashion.++The programmer only needs to pick the operations required for the+job and put them together. The resulting code is highly modular,+maintainable and readable. You can add an operation in the pipeline+without worrying about breaking anything else as the state for each+operation is private and cannot be meddled with by the programmer.++## Stream Consumption++Previously, we looked at operations that transform a stream to another+stream. Now let us look at another class of operations that consume a+stream and produce a single value or a single structure from it. This is+known as consuming the stream or eliminating the stream. The entities+that consume the stream are called consumers or folds (they help fold a+stream into a single value).++The `sum` fold consumes a stream of integers and adds them all, when+done it returns the sum. The `Stream.fold` operation takes a stream+and a fold and connects them together, feeding the stream to the fold+and then returning the result. We refer to this operation as the fold+driver. The variable `total` contains the value `1+2+3` i.e. 6.++```haskell docspec+>>> import Streamly.Data.Fold as Fold+>>> :{+total <-+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & Stream.fold Fold.sum   -- IO Int+:}+```++## The Streaming Pipeline++Using all the operations described above we can create a data processing+pipeline that increments each data item one by 1, takes the first two+elements, adds them and prints the result:++```haskell docspec+>>> :{+main =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & fmap (+1)              -- Stream IO Int+      & Stream.take 2          -- Stream IO Int+      & Stream.fold Fold.sum   -- IO Int+      >>= print                -- IO ()+:}+```++The following snippet provides a simple stream composition example that reads+numbers from stdin, prints the squares of even numbers and exits if an even+number more than 9 is entered.++``` haskell ghci+>>> import qualified Streamly.Data.Stream as Stream++>>> :{+main = Stream.drain $+       Stream.repeatM getLine+     & fmap read+     & Stream.filter even+     & Stream.takeWhile (<= 9)+     & fmap (\x -> x * x)+     & Stream.mapM print+:}+```++## Data Flow Programming++We have demonstrated above how you can compose a pipeline of functions+or stream processors to process an input stream of data to produce an+output stream. We call it a form of dataflow programming as data flows+through the processing logic. In imperative programming there is no+clear separation of data and logic. The logic can arbitrarily examine+and mutate data which creates a problem due to complex interleaving of+state and logic in the program.++Imperative looping is a low level and monolithic concept, it is+difficult for programmers to implement and is error prone. Whereas+streams are high level, declarative, structured and modular way of+expressing what you usually do with low level loops. Streams allow+you to write different parts of the loop as modular combinators and+then compose them to create bigger loops. Streamly uses stream fusion+optimizations to ensure that the composed loop has the same performance+as a hand-written monolithic loop.++## Performance Optimizations++The streaming pipeline is translated into actual imperative loops by+the Haskell compiler GHC. The programmer writes a very high level+declarative code while the heavy lifting is done by the compiler to fuse+all that code together in a tight imperative loop.++You might think that the code above may not perform as well as a+handwritten code for the same job. But you will be surprised how+efficiently GHC optimizes this code using a technique called stream+fusion which is based on two important optimizations done by GHC namely,+case-of-case and spec-constructor. There are no intermediate streams,+no constructor allocations, all heap values are unboxed while being+processed in the loop, thus resulting in the same code as a C compiler+would generate from a handwritten C loop. Essentially, the imperative+loop is written by the compiler using the high level instructions+provided by the programmer.
+ docs/User/Tutorials/the-swiss-army-knife.md view
@@ -0,0 +1,335 @@+# Streamly: The Swiss Army Knife for Haskell+++<!--+![All your base are belong to us!](./all-your-base.jpg)+# All your package are belong to us!+Bring the docs from streamly-core/streamly cabal package description here.+-->++Streamly provides a comprehensive suite of functionality through+a **consistent, concise, and modular interface**, backed by+**high-performance APIs**. Designed from the ground up, it **minimizes+abstractions** while **maximizing functionality and efficiency**. By+unifying features from many disparate Haskell packages on Hackage—and+often outperforming them—**Streamly acts as a Swiss army knife for+Haskell programmers**.++Importantly, Streamly does **not** aim to replicate functionality that+already exists elsewhere. Instead, it focuses on creating **foundational+building blocks** that naturally deliver **broad, unified, and concise+capabilities** with **peak performance**. This approach embodies the+Haskell principle of **“don’t repeat yourself” (DRY)**, addressing+a gap often overlooked in the Haskell library ecosystem.++Below, we provide an overview of Streamly’s functionality and show+how its modular building blocks unify disparate features into a single,+coherent framework. Streamly offers a unified alternative to several+existing packages. For new projects, it can reduce dependency bloat,+enable concise and expressive solutions to domain-specific problems, and+often deliver better performance out of the box.++## Streaming++Streamly offers **high-performance, feature-rich streaming** and data+flow programming operations. We are briefly mentioning some of the+key capabilities here among many others.++### Three Core Abstractions++Streamly provides three types of streams, each one allows transformation and+stateful processing of sequential streams of data but they differ in how they+can be composed:++- **Producers (`Stream`)** – these are essentially generators or+  source of data streams, multiple sources can be combined to create+  a single source.+- **Transformers (`Scanl`)** – these are essentially pipes connecting sources+  to sources or sinks, multiple scans can be combined together such that+  a source stream can be split over multiple pipes and the resulting+  streams can be the combined back into a single source stream.+- **Consumers (`Fold`)** – these are essentially final consumers or sinks of+  data, multiple consumers can be combined together into a single+  consumer such that a source stream can be distributed to all consumers+  and the results can be combined.++**Parsers** are a specialization of folds that support backtracking+and errors handling.  Folds and parsers are **first-class building+blocks** for stateful data processing. Grouping, chunking and many other+operations over streams, scans and folds are implemented using folds and+parsers — making the library extremely versatile, modular, and yet+high-performing due to stream fusion.++### Nested and Structured Stream Processing++Streamly supports **nested stream processing** (the functional+equivalent of nested loops) in several styles:++- **Depth-first** – inner loops run to completion before the next+    outer loop iteration.+- **Breadth-first** – all outer loop iterations advance one step at a+    time.+- **Fair interleaving** – inner and outer loops advance fairly in+    parallel.++With `concatIterate`, the output of a stream can be fed back into+its input, allowing recursion and control flow at the stream level.+It can be used for traversing **trees and graphs breadth-first or+depth-first**. `mergeMapWith` merges streams pairwise to form balanced+merge trees, for example you can merge sorted data from many files using+this combinator.++### Sliding Windows and Sessions++**Sliding windows** are an integral part of scans and folds,+enabling incremental window based computations for use cases+such as **time-series analysis, statistical metrics, and trading+indicators**—without recomputing the results over the entire dataset.++Elements in streams can be **classified by keys** to route them to+different sessions, fold each substream differently in its own session,+and generate a stream of end results from these sessions.++### Expressiveness and Performance++These modular abstractions allow complex problems to be expressed in+**succinct and idiomatic way**. For example, merge sort in Streamly+is implemented in just a few lines of idiomatic code using only+general-purpose building blocks—yet the performance matches or exceeds+the highly optimized list implementation in base.++Streamly provides a unified, expressive, and high-level alternative to+stream processing packages like `streaming`, `conduit`, `pipes`, and+`foldl`, with unmatched performance.++## Concurrency++Streamly is built for concurrency, all abstractions are designed for+concurrency, it provides native concurrent evaluation of streams, scans+and folds. All the ways in which stream processing pipelines can be+composed with serial processing can also be composed with concurrent+processing.  For example, you can:++- Map a function over a stream concurrently.+- generate multiple streams in parallel and merge the results in a single+  stream.+- Split streams, scan each branch concurrently, and combine them back+  into a single stream.+- Distribute a stream to different concurrent folds and merge back the results.+- Traverse trees or graphs, feed output streams back to input for+  recursive processing, concurrently.+- Perform time-based operations such as sampling, throttling, or debouncing.+- Group items over time intervals or intersperse actions in a stream+  periodically.++Concurrent streaming with time based operations can be used to implement+programs based on functional reactive programming model.  The operations+you can perform with Streamly often overlap with what libraries like+**Apache Flink** provide, but in a **lightweight, unified, and purely+functional way**.++With all these facilities streamly allows you to express your domain+specific problems much more succinctly and effortlessly. For example,+the concurrent directory traversal written with streamly is just a+few lines of code, built from low level basic building blocks, and+outperforms rust based implementations.++Streamly is much more higher level alternative to low level packages like+async, pipes-concurrency, streamling-concurrency etc. Take a look at the+`Streamly.Data.Stream.Prelude`, `Streamly.Data.Scanl.Prelude`,+`Streamly.Data.Fold.Prelude` modules in the streamly package.++## Reactive Programming++Streamly supports reactive (time domain) programming because of its support for+declarative concurrency. Please see the `Streamly.Data.Stream.Prelude`+module for time-specific and time based sampling combinators.++Reactive programming is modeled beautifully using concurrent streaming in+streamly. It involves generation of streams of events, merging concurrent+streams and processing events concurrently.  Streamly provides native+high-level facilities to do all this easily.++The examples [AcidRain.hs][] and [CirclingSquare.hs][] demonstrate+reactive programming using [Streamly][].++[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs+[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs++## Parsing++Parsing in Streamly is first-class, high-performance, and integrated+with streams.  Streamly treats parsers as core building blocks for+data processing. Many tasks—such as **sorting, chunking, and+structured transformations**—are expressed naturally with folds and+parsers. Parsers are not restricted to byte streams, any type of streams+can be parsed. It provides full-fledged parsing functionality equivalent+to the standard parser combinator libraries like `parsec`. Performance+is equivalent or better than some of the best performing libraries like+`attoparsec`.++## Prompt Resource Cleanup++One of the many challenges in a concurrent environment is safe,+correct and timely resource cleanup in all cases and races. Streamly+provides built-in prompt resource cleanup operations in a concurrent+environment. It provides basic IO level building blocks as well as+stream based resource management combinators, everything that you can do+with `resourcet` is built into the library.++## Lists and Strings++Streamly modules `Streamly.Data.Stream` and `Streamly.Data.Fold` cover+the entire functionality of `Data.List` from the `base` package. While+lists are sufficient and easy to use for many cases, it can be+problematic when you need to **interleave IO effects** such as tracing+or debug prints. Streamly streams provide the same interface as lists+but allow you to **inject IO effects anywhere** without buffering the+entire dataset in memory.  Additionally, **Streamly streams often+outperform lists** when combining transformations.++By virtue of its modularity it is able to express the string (stream)+splitting operations similar to the `split` package without any custom+implementation. In the same manner it implements search operations+similar to the `stringsearch` package.  For string search, `splitOnSeq`+and `takeEndBySeq` in Streamly use the **Rabin-Karp algorithm** for+fast pattern matching. Benchmarks show performance comparable to the+Rust `ripgrep` tool.  `Streamly.Unicode.String` also provides string+interpolation.++## Non-determinism and List Transformers++Streamly provides full list transformer functionality (e.g. equivalent+to the `ListT` from list-t package) and more.  It does not provide a+Monad instance for streams, as there are many possible ways to define+the bind operation.  Instead, it offers bind-style operations such as+'concatFor', 'concatForM', and their variants (e.g. fair interleaving+and breadth-first nesting). These can be used for convenient ListT-style+stream composition. Additionally, it provides applicative-style cross+product operations like 'cross' and its variants which are many times+faster than the monad style operations.++## Logic Programming++Streamly does not provide a 'LogicT'-style Monad instance, but it+offers comprehensive logic programming functionality.  Operations like+'fairCross' and 'fairConcatFor' nest outer and inner streams fairly,+ensuring that no stream is starved when exploring cross products.++This enables balanced exploration across all dimensions in backtracking+problems, while also supporting infinite streams without starvation. It+effectively replaces the core functionality of 'LogicT' from the+@logict@ package, with significantly better performance. In particular,+it avoids the quadratic slowdown seen with @observeMany@, and the+applicative 'fairCross' runs many times faster, achieving loop nesting+performance comparable to C.++## Arrays++Streamly provides comprehensive array functionality. Arrays are equal+partners to streams in general purpose programming.  Arrays in streamly+can be mutable or immutable, boxed or unboxed, pinned or unpinned. Thus+they unify the functionality provided by the `bytestring`, `text` and+`vector` packages. The API is integrated with streams, it is concise and+modular because all the processing is done via streams.  There is no+need of thinking about lazy bytestring vs strict bytestring, bytestring+vs text, text vs lazy text. Lazy in streamly is equivalent to stream+processing or stream of arrays, and strict is equivalent to arrays.++The `streamly-bytestring` package provides interoperation of+streamly arrays with `bytestring`. `streamly-text` package provides+interoperability with `text`.++Streamly also implements ring arrays which are essentially mutable+circular buffers. Ring Arrays help in implementing sliding windows+efficiently and conveniently.++Streamly can potentially replace most array like package for example+`array`, `primitive`, `vector`, `vector-algorithms`, `ring-buffer`,+`bytestring`.++## Serialization++Binary serialization in streamly is built into arrays. Unboxed arrays+are in fact store data in binary serialized form. The `Unbox` and+`Serialize` type classes provide fast binary serialization and+deserialization. The `MutByteArray`, `MutArray` and `Array` modules+provide functions that can serialize Haskell data types using the+`Unbox` and `Serialize` type classes.++Thus arrays in streamly are high performance alternative to+serialization packages like `binary`, `cereal`, `store` etc.++<!--+## Builders++Streams, folds, parsers and arrays are natural builders in streamly.+Folds are natural stream builders, mutable arrays are natural array+builders.++The fastest way to encode and decode Haskell data types is via+the `Unbox` and `Serialize` type classes. However, if you require+custom ways to encode or decode the Haskell data types, the fastest+way is to directly encode to or decode from `MutArray` using the+`Streamly.Internal.Data.Binary.MutArray` module (yet to be written).+Also, using `Streamly.Internal.Data.Builder` and yet to be written+serialize and deserialize monads.++Less efficiently, for custom encoding, you can build a stream+of encoded streams or possibly a stream of arrays using+the `Streamly.Internal.Data.Binary.Stream` module and then+flatten it.  For custom decoding you can build a parser using+`Streamly.Internal.Data.Binary.Parser` module.++| Package        | Streamly Type          | Combinators                              |+|----------------|------------------------|------------------------------------------|+| dlist          | Stream, Fold           | Fold.toList, Fold.addOne, Fold.addStream |+| bytestring     | Stream, Fold, MutArray |                                          |+-->++<!-- vector-builder -->++## File System++Streamly provides native, high-performance streaming APIs for file+system operations.  There is also a module for file path representation+which leverages streamly arrays for high performance and safe path+operations. Path module is designed to allow gradual typing, you can+choose to use untyped path, absolute vs relative distinction, file vs+dir distinction or all four. The typed versions are not released yet but+available as internal modules.++Paths and directory modules in streamly can be used as an alternative+for `filepath`, `directory`, and `path` packages.++## Network++Streamly provides native streaming APIs for network operations as a higher+level alternative to the `network` package functionality.++## Clock and Time++Streamly provides clock, time and timer APIs for high-performance+streaming use. See the `Streamly.Internal.Data.Time.Clock`,+`Streamly.Internal.Data.Time.Units` modules. These are currently+internal but will be released in a future release.++## Compatibility++Streamly can interwork with other packages in the Haskell ecosystem+providing similar functionality. Following is a list of examples or+packages providing interconversion:++<!-- TODO foldl interworking -->+<!-- TODO vector interworking -->++| Interop with   | Example, package                                                      |+|----------------|-----------------------------------------------------------------------|+| streaming      | [streamly-examples](https://github.com/composewell/streamly-examples) |+| pipes          | [streamly-examples](https://github.com/composewell/streamly-examples) |+| conduit        | [streamly-examples](https://github.com/composewell/streamly-examples) |+| bytestring     | [streamly-bytestring](https://github.com/psibi/streamly-bytestring)   |+| text           | [streamly-text](https://github.com/composewell/streamly-text)         |+| filepath       | [streamly-filepath](https://github.com/composewell/streamly-filepath) |++See the `streamly-ecosystem` chapter for more details.
+ docs/User/Tutorials/types-and-modules(examples).md view
@@ -0,0 +1,515 @@+# Packages and Modules++Streamly is a self sufficient, batteries included library for general+purpose programming.  It has been designed for ease of use and high+performance.++Streamly consists of two packages: "streamly-core" and "streamly".+[streamly-core](https://hackage.haskell.org/package/streamly-core)+provides most of the core functionality, and depends only on GHC boot libraries, while+[streamly](https://hackage.haskell.org/package/streamly) provides+higher-level features like concurrency, time based streaming+combinators, lifted exceptions, and streaming network operations.++Streamly is built around two core data structures: streams and+arrays. They are computational duals—streams enable dataflow-style+processing, while arrays provide efficient data storage. Together, they+form a powerful foundation for general-purpose programming in+functional and dataflow paradigms.++The general data processing functionality in `streamly` can be divided+into following categories:++* Streams: for processing of in flight data+* Arrays: for in-memory storage of data at rest+* Serialization: for on-disk storage of data at rest+* Concurrency: for scaling your applications across CPUs++The essential domain specific functionality can be divided into the+following categories:++* Console IO: reading from and writing to stdin, stdout and stderr+* File system IO: for interfacing with the file system+* Network IO: for interfacing with the network+* Unicode: stream processing of Unicode text++## Streams++In functional programming, the **stream processing paradigm** offers+a higher-level alternative to the low-level looping constructs of+imperative programming. In Streamly, the `Stream` abstraction models+data as a sequence of items of the same type. Functional operations can+then be applied to process and transform each item, producing a new+stream of either the same or a different type.++### Stream Type++The following contrived example generates a stream of integers,+increments each element by 1, takes the first two elements, adds them+together, and prints the result:++```haskell+import Data.Function ((&))+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl++main1 =+    Stream.enumerateFromTo 1 3    -- Stream IO Int+      & fmap ((+1) :: Int -> Int) -- Stream IO Int+      & Stream.take 2             -- Stream IO Int+      & Stream.fold Fold.sum      -- IO Int+      >>= print                   -- IO ()+```++See "Streamly.Data.Stream" module.++### Fold Type++Just like the `Stream` type represents a producer of a sequence of+items, the `Fold` type represents a consumer of a sequence of items of+the same type. A fold consumes a stream and returns a single value as+output. The `Fold.sum` function above is a `Fold` which consumes an+integer stream as input and returns their sum as output. The fold is+driven using the `Stream.fold` combinator.++Folds can be composed using combinators. For example, the `teeWith`+combinator combines two folds so that the input stream is fed into both+the folds simultaneously.++```haskell+f :: Monad m => Fold.Fold m Int (Int, Int)+f = Fold.teeWith (,) Fold.sum (Fold.lmap (\x -> x * x) Fold.sum)+main2 =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & Stream.fold f          -- IO Int+      >>= print                -- IO ()+```++See "Streamly.Data.Fold" module.++### Scanl Type++The `Scanl` type represents a stateful transformation from a stream+to another stream. As a contrived example to demonstrate the basic+functionality of scans let us compute the expression `x^4 + 3x^2 + 4` for+each number in a stream.++```haskell+scan1 :: Monad m => Scanl.Scanl m Int Int+scan1 = Scanl.mkScanl (\_ x -> x * x) undefined++scan2 :: Monad m => Scanl.Scanl m Int Int+scan2 = Scanl.mkScanl (\_ x -> 3 * x) undefined++scan3 :: Monad m => Scanl.Scanl m Int Int+scan3 = Scanl.teeWith (+) scan1 scan2 -- Compute x^2 + 3x++scan4 :: Monad m => Scanl.Scanl m Int Int+scan4 = Scanl.postscanl scan1 scan3   -- compute x^2 then pass it to scan3++main3 =+    Stream.enumerateFromTo 1 3             -- Stream IO Int+      & Stream.scanl scan4                 -- Stream IO Int+      & fmap (+4)                          -- Stream IO Int+      & Stream.fold (Fold.drainMapM print) -- IO ()+```++`scan3` splits the computation into two parts, one part computes `x^2`+using `scan1` and the other part computes `3x` using `scan2` and then it+zips the two parts back into a single stream by summing them. `scan4`+first passes an element through `scan1` thus squaring it and then it+passes the result through `scan3`, the final result is+`x^4 + 3x^2`. Then we add 4 in the resulting stream and print each+element in the stream.++In general, using scans, we can split the stream into multiple streams+and perform different stateful computations in each branch and then+merge them back into a single stream.++See "Streamly.Data.Scanl" module.++### Parser Type++The `Parser` type represents a stream consumer just like the `Fold` type+but it adds failure handling and backtracking of input on failure.++For example, to parse a sequence of digits:++```haskell docspec+>>> import Data.Function ((&))+>>> import qualified Data.Char as Char+>>> import qualified Streamly.Data.Stream.Prelude as Stream+>>> import qualified Streamly.Data.Parser as Parser+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.Stream as Stream (parsePos)+>>> decimal = Parser.takeWhile1 Char.isDigit Fold.toList+>>> Stream.parsePos decimal $ Stream.fromList "1234 is the number"+Right "1234"+>>> Stream.parsePos decimal $ Stream.fromList "this is the number"+Left (ParseErrorPos 1 "takeWhile1: predicate failed on first element")+```++On failure we can return a default value:++```haskell docspec+>>> import Control.Applicative ((<|>))+>>> Stream.parse (decimal <|> pure "0") $ Stream.fromList "this is the number"+Right "0"+```++See "Streamly.Data.Parser" module.++## Arrays++<!-- TODO Add pinning and unpinning examples+See the+[streamly-bytestring](https://github.com/psibi/streamly-bytestring)+repository.+-->++While streams are meant for sequential processing of in-flight data, arrays+are meant for storing data in memory with serial or random access. Processing+of the data stored by arrays is done using streams.++### Immutable Arrays++The `Array` type is used to represent immutable arrays which cannot be+modified in-place.++```haskell docspec+>>> import qualified Streamly.Data.Array as Array+>>> arr = Array.fromList "hello"+>>> Array.length arr+5+>>> Array.getIndex 1 arr+Just 'e'+```++Arrays provide streaming interfaces. Like all other data in streamly, arrays+are transformed using stream transformations.++```haskell docspec+>>> arr <- Stream.fold Array.create $ Stream.enumerateFromTo 1 (5 :: Int)+>>> show arr+"fromList [1,2,3,4,5]"+>>> arr1 <- Stream.fold Array.create $ fmap (+1) $ Array.read arr+>>> show arr1+"fromList [2,3,4,5,6]"+```++See "Streamly.Data.Array" and "Streamly.Data.Array.Generic" modules.++### Mutable Arrays++The `MutArray` type is used to represent mutable arrays which can be+modified in-place.  Mutable arrays also have a reserved capacity to grow+without reallocation.++```haskell docspec+>>> import qualified Streamly.Data.MutArray as MutArray+>>> arr <- Stream.fold (MutArray.createOf 12) $ Stream.fromList "hello"+>>> arr1 <- MutArray.snoc arr ' '+>>> arr2 <- Stream.fold (MutArray.append2 arr1) $ Stream.fromList "world "+>>> MutArray.toList arr2+"hello world "+>>> MutArray.putIndex 11 arr2 '!'+>>> MutArray.toList arr2+"hello world!"+```++Since we allocated an array of 12 elements to begin with, `snoc` and+`append` operations do not reallocate the array, they just append to the+existing array.++See "Streamly.Data.MutArray" and "Streamly.Data.MutArray.Generic" modules.++## Serialization++### MutByteArray++The `MutByteArray` type is used to represent low level mutable byte+arrays which can be modified in-place. `Unbox` and `Serialize` type+classes use this data type to serialize Haskell data structures.++### Unbox++Unbox provides fast serialization of fixed size data types.+`deriveUnbox` can be used to automatically derive the instances of+`Unbox`. `Unbox` can also be derived using `Generic`.  `Unbox` type+class provides `pokeAt` and `peekAt` operations to serialize and+deserialize Haskell data types:++```haskell docspec+>>> import qualified Streamly.Data.MutByteArray as MutByteArray+>>> import Data.Proxy (Proxy(..))+>>> arr <- MutByteArray.new 10+>>> MutByteArray.pokeAt 0 arr 'h'+>>> offset = MutByteArray.sizeOf (Proxy :: Proxy Char)+>>> MutByteArray.pokeAt offset arr (1234 :: Int)+>>> r :: Char <- MutByteArray.peekAt 0 arr+>>> r+'h'+>>> r1 :: Int <- MutByteArray.peekAt offset arr+>>> r1+1234+```++The `Array` and MutArray types are unboxed arrays, they require an+`Unbox` instance. Writing to an `Array` or `MutArray` is in fact+exactly the same as serializing the type, and reading from them is+deserializing it.++### Serialize++`Serialize` provides fast serialization of any Haskell data types.+`deriveSerialize` can be used to automatically derive the instances+of `Serialize`.  `Serialize` type class provides `serializeAt` and+`deserializeAt` operations to serialize and deserialize Haskell data+types:++```haskell docspec+>>> import qualified Streamly.Data.MutByteArray as MutByteArray+>>> arr <- MutByteArray.new 10+>>> offset <- MutByteArray.serializeAt 0 arr 'h'+>>> offset1 <- MutByteArray.serializeAt offset arr (1234 :: Int)+>>> (next, r :: Char) <- MutByteArray.deserializeAt 0 arr offset1+>>> r+'h'+>>> (next1, r1 :: Int) <- MutByteArray.deserializeAt next arr offset1+>>> r1+1234+```++The Array module also provides operations to serialize and deserialize a+Haskell data type to an `Array Word8`, using the `Serialize` type class:++```haskell docspec+>>> import qualified Streamly.Data.Array as Array+>>> arr = Array.serialize' (1234 :: Int)+>>> fst (Array.deserialize arr) :: Int+1234+```++## Concurrency and Time++Concurrency and time operations can be found in the `streamly` package.+Stream operations can be performed concurrently by using the concurrent+combinators.++### Concurrent Streams++The following example uses `parMapM` which is a concurrent version of `mapM`,+consequently it prints a value every second even though there is a 2 second+serial delay for each element.++```haskell docspec+>>> import Control.Concurrent (threadDelay)+>>> let delay n = threadDelay (n * 1000000) >> return n+>>> :{+parMap =+      Stream.repeatM (delay 1)+    & Stream.parMapM (Stream.ordered True) (\x -> delay 1 >> print x)+    & Stream.fold Fold.drain+:}+```++See `Streamly.Data.Stream.Prelude` module.++### Concurrent Folds++The following example evaluates each fold in a separate thread, therefore, even+though each fold introduces a serial delay of 1 second, the total delay is+still only 1 second instead of 2 seconds.++```haskell docspec+>>> import qualified Streamly.Data.Fold.Prelude as Fold+>>> p x = delay 1 >> print x+>>> f1 = Fold.parBuffered id (Fold.drainMapM p)+>>> f2 = Fold.parBuffered id (Fold.lmap (\x -> x * x) (Fold.drainMapM p))+>>> f = Fold.teeWith (\_ _ -> pure ()) f1 f2+>>> :{+parFolds =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & Stream.fold f          -- IO ()+:}+```++See `Streamly.Data.Fold.Prelude` module.++### Time Domain Operations++Streamly provides time domain stream operations for reactive programming+including event sampling operations like throttle and debounce.++For example, the `intervalsOf` operation collapses stream elements within a+specified time interval.++```haskell docspec+>>> input = Stream.parBuffered (Stream.constRate 2) $ Stream.enumerateFrom 1+>>> intervals = Stream.intervalsOf 1 Fold.toList input+>>> Stream.fold Fold.toList $ Stream.take 2 intervals+[[1,2],[3,4]]+```++See `Streamly.Data.Fold.Prelude` module.++## Console IO++The `Streamly.Console.Stdio` module provides facilities to read a stream+from stdin and to write a stream to stdout and stderr.++Implementation of a console echo program:++```haskell unshared+import Data.Function ((&))+import qualified Streamly.Console.Stdio as Stdio++main =+  Stdio.readChunks    -- Stream IO (Array Word8)+    & Stdio.putChunks -- IO ()+```++An example to read two numbers from separate lines on stdin and sum them:++```haskell unshared+import Data.Function ((&))+import qualified Streamly.Internal.Console.Stdio as Stdio+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++main =+    Stdio.readChars                              -- Stream IO Char+      & Stream.splitSepBy_ (== '\n') Fold.toList -- Stream IO String+      & fmap read                                -- Stream IO Int+      & Stream.take 2                            -- Stream IO Int+      & Stream.fold Fold.sum                     -- IO Int+      >>= print                                  -- IO ()+```++## File IO++Implementation of the Unix `cp` utility to copy `input.txt` to `output.txt`:++```haskell unshared+{-# LANGUAGE QuasiQuotes #-}++import Data.Function ((&))+import Streamly.FileSystem.Path (path)+import qualified Streamly.FileSystem.FileIO as File+import qualified Streamly.FileSystem.Path as Path+import qualified Streamly.Data.Stream as Stream++main =+  File.readChunks [path|input.txt|]                     -- Stream IO (Array Word8)+    & Stream.fold (File.writeChunks [path|output.txt|]) -- IO ()++```++Implementation of the Unix `cat` utility to read all files from+the current directory on standard output.++```haskell unshared+{-# LANGUAGE QuasiQuotes #-}++import Data.Function ((&))+import Streamly.FileSystem.Path (path)+import qualified Streamly.FileSystem.DirIO as Dir+import qualified Streamly.FileSystem.Path as Path+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Console.Stdio as Console+import qualified Streamly.FileSystem.FileIO as File++main =+  Dir.read [path|.|]                   -- Stream IO Path+    & Stream.concatMap File.readChunks -- Stream IO (Array Word8)+    & Console.putChunks                -- IO ()+```++## Network IO++Streaming network operations can be found in `Streamly.Network.*` modules. Here+is a streaming implementation of a concurrent network server which echo's back+whatever it receives.++```haskell docspec+>>> import Control.Exception (finally)+>>> import Network.Socket (Socket)+>>> import qualified Network.Socket as Net+>>> import qualified Streamly.Network.Inet.TCP as TCP+>>> import qualified Streamly.Network.Socket as Socket+>>> :{+main :: IO ()+main =+      TCP.accept 8091                            -- Stream IO Socket+    & Stream.parMapM id (handleExceptions echo)  -- Stream IO ()+    & Stream.fold Fold.drain                     -- IO ()+    where+    echo :: Socket -> IO ()+    echo sk =+          Socket.readChunksWith 32768 sk      -- Stream IO (Array Word8)+        & Stream.fold (Socket.writeChunks sk) -- IO ()+    handleExceptions :: (Socket -> IO ()) -> Socket -> IO ()+    handleExceptions f sk = finally (f sk) (Net.close sk)+:}+```++## Unicode Operations++The `Streamly.Unicode.*` modules provide stream operations like UTF-8, UTF-16+encoding and decoding, splitting Unicode char streams into lines, words and+joining lines and words etc.++String quasiquoter:++```haskell docspec+>>> :set -XQuasiQuotes+>>> import Streamly.Unicode.String (str)+>>> [str|this is a string|]+"this is a string"+```++String interpolation:++```haskell docspec+>>> x = "interpolated"+>>> [str|this is an #{x} string|]+"this is an interpolated string"+```++Splitting a string into lines, each line is collected in a list fold and+all the lines are collected in a list fold.:++```haskell docspec+>>> import qualified Streamly.Internal.Unicode.Stream as Unicode+>>> Stream.fold Fold.toList $ Unicode.lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")+["lines","this","string","",""]+```++You could supply any fold to consume the lines in a different way, for example+use `Fold.length` to print the lengths of the lines:++```haskell docspec+>>> Stream.fold Fold.toList $ Unicode.lines Fold.length (Stream.fromList "lines\nthis\nstring\n\n\n")+[5,4,6,0,0]+```++Decoding the contents of a file into a stream of Unicode chars:++```haskell docspec+>>> import Streamly.FileSystem.FileIO as File+>>> import Streamly.FileSystem.Path as Path+>>> :{+countChars inpFilePath = do+   inp <- Path.fromString inpFilePath+   File.readChunks inp & Unicode.decodeUtf8Chunks & Stream.fold Fold.length+:}+```++Streamly.Unicode.Parser provides Unicode char and sequence parsers:++```haskell docspec+>>> import qualified Streamly.Unicode.Parser as Unicode+>>> Stream.parse Unicode.double $ Stream.fromList "3.14"+Right 3.14+```
+ docs/User/Tutorials/types-and-modules(summary).md view
@@ -0,0 +1,102 @@+# Streamly: Types & Modules Cheat Sheet++This guide gives you a quick overview of Streamly’s core modules,+types, and their typical use cases. Use it as a reference map when+navigating the library.++## streamly-core package++![Streamly Core Modules](./streamly-core.svg)++## streamly package++![Streamly Modules](./streamly.svg)++## Streams++### Sources+- `Stream m a` — statically fused, composable source streams<br>+  **Module:** `Streamly.Data.Stream`+- `Unfold m a b` — statically fused streams, for nested fusion<br>+  **Module:** `Streamly.Data.Unfold`+- `StreamK m a` — CPS based source streams for dynamic composition<br>+  **Module:** `Streamly.Data.StreamK`++### Transformations++- `Scanl m a b` — statically fused scans, for composable stateful transformation<br>+  **Module:** `Streamly.Data.Scanl`++### Consumers++- `Fold m a b` — statically fused, composable stream consumers<br>+  **Module:** `Streamly.Data.Fold`+- `Parser a m b` — statically fused, composable parsers<br>+  **Module:** `Streamly.Data.Parser`+- `ParserK a m b` — CPS based parsers for dynamic composition<br>+  **Module:** `Streamly.Data.ParserK`++---++## Arrays++### Immutable++- `Array a => Unbox a` — immutable, unboxed (pinned/unpinned)<br>+  **Module:** `Streamly.Data.Array`+- `Array a` — unconstrained type<br>+  **Module:** `Streamly.Data.Array.Generic`++### Mutable++- `MutArray a => Unbox a` — mutable, unboxed (pinned/unpinned)<br>+  **Module:** `Streamly.Data.MutArray`+- `MutArray a` — unconstrained type<br>+  **Module:** `Streamly.Data.MutArray.Generic`+- `RingArray a => Unbox a` — unboxed, circular buffer (pinned/unpinned)<br>+  **Module:** `Streamly.Data.RingArray`++### Serialization++- `Unbox a` — type class for fixed length binary serialization<br>+  **Module:** `Streamly.Data.MutByteArray`+- `Serialize a` — type class for variable length binary serialization<br>+  **Module:** `Streamly.Data.MutByteArray`+- `MutByteArray` — raw mutable byte arrays<br>+  **Module:** `Streamly.Data.MutByteArray`++---++## Unicode Operations++- `Streamly.Unicode.Stream` — encode/decode streams of text+- `Streamly.Unicode.Parser` — parsers for Unicode chars/strings+- `Streamly.Unicode.String` — string interpolation utilities++---++## Concurrent Operations++High-level concurrent, time-based, and lifted operations.++- `Streamly.Data.Stream.Prelude` — concurrent operations for `Stream` type+- `Streamly.Data.Scanl.Prelude` — concurrent operations for `Scanl` type+- `Streamly.Data.Fold.Prelude` — concurrent operations for `Fold` type+- `Streamly.Data.Stream.MkType` — define custom monad/applicative stream types  ++---++## File System++- `Streamly.Console.Stdio` — console (stdin/stdout/stderr) streams+- `Streamly.FileSystem.Handle` — handle-based I/O streams+- `Streamly.FileSystem.FileIO` — path-based file I/O streams+- `Streamly.FileSystem.DirIO` — directory read streams+- `Streamly.FileSystem.Path` — file path operations++---++## Network++- `Streamly.Network.Socket` — socket-level stream operations+- `Streamly.Network.Inet.TCP` — TCP accept streams/connect
+ docs/User/Tutorials/using-streamly.md view
@@ -0,0 +1,268 @@+<!--+(c) 2019, Composewell Technologies.+Portions (c) 2020, Google LLC.+SPDX-License-Identifer: BSD-3-Clause+-->++# Getting started with `Haskell Streamly`++This guide shows you how to use Streamly in the GHCi REPL, in a simple+program, or in a Haskell project.++<!-- TODO: Add instructions for `stack` and `nix`.++If you are using `stack` or `nix` please make sure to add the latest+version from Hackage to your tool configuration.  -->++No prior knowledge of Haskell is needed.  We do however assume that you+are using a command-line shell on a POSIX operating system.  If you are+running Windows&trade; then you may need to run a command-line shell+under `msys` and some of the commands below may also need to be changed+in small ways to make them work.++## Streamly Library Packages++Streamly comprises two packages, the+[streamly-core](https://hackage.haskell.org/package/streamly-core)+package provides functionality that depends only on boot libraries, and+the [streamly](https://hackage.haskell.org/package/streamly) package+provides additional functionality like concurrency, time, lifted+exceptions, and networking.++For high-level functionality built over streamly like streaming+system processes, shell programming, GNU coreutils, statistics,+and compression libraries please see the [streamly ecosystem+packages](https://streamly.composewell.com/module-listing.html).++## Released and Pre-release modules++Some of the examples in the tutorials may use modules from the+`Internal` Streamly module hierarchy.  These modules are not really+internal to the library.  We classify `Streamly` modules into two+categories:++* _Released modules and APIs_: These modules and APIs are+  stable. Significant changes to these modules and APIs will cause+  Streamly's version number to change according to the package versioning+  policy.+* _Pre-release modules and APIs_: These modules and APIs have not been+  formally released yet.  They may change in the near future, and such+  changes will not necessarily be reflected in Streamly's package+  version number.  As yet unreleased modules and APIs reside in the+  `Internal` namespace.++Please use a minor release upper bound to adhere to the Haskell PVP when+using a pre-release (internal) module.++<!--+Link References.+-->++## Using `streamly` Interactively in REPL++You can try out `streamly` using `GHCi`, the interactive Haskell+read-eval-print-loop (REPL).++Streamly consists of two packages, namely `streamly-core` and+`streamly`. The former package provides basic functionality and the+latter provides higher level functionality. To start up the GHCi REPL+using the latest released `streamly-core` package from Hackage, please+use:++```+$ cabal repl --build-depends streamly-core+... plenty of build messages, the first time around ...+GHCi, version 9.2.2: https://www.haskell.org/ghc/  :? for help+ghci>+```++This command may take a while to build the package first time around,+please be patient.++Once at the `ghci>` prompt, you can import Haskell modules from the+`streamly-core` package and use the available functions in the REPL:++```+ghci> import qualified Streamly.Data.Stream as Stream+ghci> import qualified Streamly.Data.Fold as Fold++ghci> Stream.fold Fold.drain $ Stream.mapM print $ Stream.fromList [1..3]+1+2+3+ghci>+```++For the curious, here is a high level overview of what these lines+do:++1. `import qualified Streamly.Data.Stream as Stream` imports the Streamly+   Stream module into GHCi, and makes it available under the name `Stream`.+2. `[1..3]` generates the Haskell list `[1, 2, 3]`.+3. `Stream.fromList` transforms that list into a stream of integers.+4. `Stream.mapM print` transforms the stream of integers into a stream of+   actions that would print those integers when executed.+5. `Stream.fold Fold.drain` folds that stream using the `drain` fold,+   transforming it into an IO action that evaluates the stream.++### Using a specific version of `streamly` in the REPL++You can also ask `cabal` to use a specific version of `streamly-core` by+adding a version number constraint to the `--build-depends` flag:++```+$ cabal repl --build-depends streamly-core==0.1.0+...+ghci>+```++## Using `streamly` in a Project++Create a project directory for our example project.++```+$ mkdir streamly-project+```++### Add `streamly` as project dependency++Run `cabal init` in the project directory to create an initial set of+project files:++```+$ cd streamly-project+$ cabal init --non-interactive --minimal --dependency base --dependency streamly-core++...+Generating app/Main.hs...+Generating streamly-project.cabal...+...+```++This invocation sets up a Haskell package named `streamly-project`+with two build dependencies, namely `base` (the Haskell standard+library) and `streamly-core`.  You can add additional dependencies+later, by editing the `build-depends` section of the generated+cabal file `streamly-project.cabal`.  Please see the [Cabal User+Guide](https://www.haskell.org/cabal/users-guide/) for more information+on `.cabal` files.++IMPORTANT: Because of a bug in cabal 3.8, which is fixed in cabal 3.10,+this does not generate a dependency on `base`, please edit the generated+cabal file and add `base` in the `build-depends` section:++```+    build-depends: base, streamly-core+```++This invocation also creates a skeletal `app/Main.hs`, therefore, we can+compile and run it right away:++```+$ cabal run+Hello, Haskell!+```++### Import `streamly` modules in the project code++Let us now turn the single-line stanza we used in the REPL into a+standalone program.++Edit `app/Main.hs` to contain the following:++```haskell+module Main where++import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++main :: IO ()+main = Stream.fold Fold.drain $ Stream.mapM print $ Stream.fromList [1..3]+```++Build and run this program using `cabal run`:++```+$ cabal run+... build messages ...+1+2+3+```++### Running GHCi REPL for the project code++To start up the GHCi REPL for your project, please use:++```+$ cabal repl+...+Ok, one module loaded.+ghci> main+1+2+3+ghci>+```++The repl will load all the dependencies and modules of the project. You can now+run your project code or any other code snippets as you desire.++### (Advanced) Using the development version of `streamly`++To use the development version of `streamly`, we need to configure+`cabal` to fetch it from Github.++Create a `cabal.project` file in the project directory with the+following content:++```+packages: .+-- fetch streamly-core dependency package from github+source-repository-package+  type: git+  location: https://github.com/composewell/streamly+  subdir: core+  tag: master+```++With this file present, `cabal` will fetch and build the current+version of `streamly-core` from Github.  For example:++```+$ cabal repl+Cloning into '/home/harendra/streamly-project/...+...+In order, the following will be built (use -v for more details):+ - streamly-core-0.1.0 (lib:streamly-core) (requires build)+ - streamly-project-0.1.0.0 (exe:streamly-project) (configuration changed)+ ...+ghci>+```++## Which version of `streamly` should you use?++If you are new to Streamly, we recommend using the latest [stable release+of streamly][streamly-hackage] on Hackage.++If you need access to cutting edge features (and do not mind the+occasional breakage), please use the [development version of+streamly][streamly-github] from Github.++## Building for Performance++If you wish to run benchmarks, please be sure to build your+application using the instructions in the [Build Guide](/docs/User/HowTo/Compiling.md).++## Next Steps++If you got this far successfully, congratulations!  For an overview+of the `streamly` package, please read the [Learn By+Examples](/docs/User/Tutorials/learn-by-examples.md) page.++<!-- Markdown Links -->++ [Streamly]: https://streamly.composewell.com/+ [streamly-hackage]: https://hackage.haskell.org/package/streamly+ [streamly-github]: https://github.com/composewell/streamly+ [streamly-packages]: https://github.com/composewell/streamly-packages
+ docs/User/Tutorials/why-haskell-streamly.md view
@@ -0,0 +1,152 @@+<!--+(c) 2022, Composewell Technologies.+SPDX-License-Identifer: BSD-3-Clause+-->++# Why Haskell and Streamly?++## Why Haskell?++Haskell provides a rock-solid foundation for building reliable,+maintainable, and efficient systems. It combines the rigor of a strongly+typed, purely functional language with the practicality of modern+tooling.++### Interactive Development (GHCi)++Haskell is compiled for performance, but it also ships with an+interpreter (GHCi). This gives you the convenience of interactive+exploration—like Python or Ruby—while still compiling to fast native+code when needed. Types are inferred automatically, so you often don’t+need to write them explicitly, but they are always there to guarantee+safety.++### Fearless Refactoring++Large systems inevitably evolve, and in many languages refactoring+introduces new bugs. In Haskell, immutability and a strong static type+system keep programs consistent, while the compiler catches errors early.+This makes refactoring safe and reliable—a quality that experienced+Haskell developers consistently vouch for in production systems.++### Correctness by Design++Many common bugs in other languages—null pointer exceptions, data+races, accidental mutation—simply don’t exist in Haskell. This frees+you to focus on business logic instead of defensive programming.++### Portability and Interoperability++Haskell is portable across Linux, macOS, Windows, and even the browser+(via JavaScript or WebAssembly). It can seamlessly interoperate with C,+Python, and many other languages, letting you reuse existing code and+libraries.++---++## Why Streamly?++Streamly builds on Haskell’s strengths to provide a single framework+for everything from quick automation scripts to high-performance+servers. It combines **Python’s ease of use, C’s performance,+Rust’s safety, and Go’s concurrency model**—all in one framework,+and goes even further.++### Performance Matching Low-Level Languages++High-level scripting languages like Python or Bash can be **10x–100x+slower** than optimized low-level languages such as C, Rust, or+Java. For tasks where efficiency matters—data pipelines, servers,+or numerical processing—this overhead is unacceptable.++Streamly leverages GHC’s advanced optimizations and stream fusion to+deliver performance on par with C, without sacrificing expressiveness.+It gives you the best of both worlds: the productivity of high-level+scripting languages like Python or Bash, with the performance of+low-level languages like C and Rust.++### More Expressive than Scripting Languages++For scripting, system management, data wrangling, or even spinning up+quick servers, Streamly offers high-level combinators that let you+compose programs declaratively. Its design philosophy emphasizes+**modularity**: a hierarchy of composable building blocks, where+higher-level constructs are built from lower-level ones. This degree+of modularity is possible in Haskell due to purity, which enables+the compiler to reason about and combine components safely, creating+higher-level functionality without compromising performance. The result+is much more power and expressiveness than Python or shell scripting—+while still compiling to efficient native code.++### Fearless Concurrency++Streamly is designed for concurrency, allowing you to write concurrent+code in a declarative style. Haskell’s purity lends itself+particularly well to concurrency, and Streamly leverages this unique+feature in Haskell. Its high-level abstractions free you from low-level+concerns such as threads, locks, and synchronization. There is little+distinction between concurrent and non-concurrent code—if your program+follows the streaming paradigm, it can be made concurrent effortlessly.++### Standard Library for Real-World Needs++The streaming model is the truest form of functional programming,+delivering the high composability that functional programming promises.+Streamly extends Haskell’s base library with unified, streaming-capable+APIs for everyday programming:++- Streams, folds, and parsers for data processing+- Arrays for random-access storage with streaming APIs+- Binary serialization and deserialization+- Streaming file and directory I/O+- Streaming Unicode text processing+- Streaming network APIs+- Time-based streaming APIs for FRP+- Concurrency built into all APIs++With these tools, you can move seamlessly from quick prototypes to+production-grade systems—without ever switching languages.++### Streamly Ecosystem++Beyond the core library, Streamly provides an ecosystem of packages:++- **`streamly-process`**: Launch and compose executables, connect their+  input and output streams, run shell commands, and integrate them+  seamlessly into Haskell streaming pipelines.+- **`streamly-coreutils`**: Replace shell or Python scripts with safe,+  modular, high-performance Haskell equivalents.+- **`streamly-statistics`**: Perform incremental statistical analysis on+  sliding windows of data within streaming pipelines.+- **`streamly-fsevents`**: Watch files or directories for file system+  events (inotify) and generate event streams.++More packages are continually evolving. Combined with the thousands of+Haskell libraries on [Hackage](https://hackage.haskell.org), Streamly+gives you a complete toolkit for building powerful applications.++---++## One Language for Everything++Modern software projects demand many different kinds of programs:  ++- Quick scripts for automation  +- High-performance data processing  +- Concurrent or parallel applications  +- Network servers and distributed systems  ++Traditionally, this forces programmers to juggle different tools: Python+or shell for scripting, C/C++/Rust for performance, Java/Go for servers,+and special frameworks for concurrency. This fragmentation leads to+duplicated effort, larger teams, and higher maintenance costs.++**Haskell Streamly provides a single framework for all of these+tasks.** You can write concise, high-level programs that are safe,+scalable, and easy to reason about—yet still achieve performance+competitive with C.++Haskell gives you correctness, safety, and interactive development.+Streamly adds performance, concurrency, modularity, and practical+libraries. Together, they remove the need to juggle multiple languages+for different tasks.
+ docs/User/Tutorials/why-not-lists.md view
@@ -0,0 +1,224 @@+<!--+(c) 2022, Composewell Technologies.+SPDX-License-Identifer: BSD-3-Clause+-->++# Why not lists?++This document explains some problems that you might face when using+Haskell lists and why using streams is better in those cases.++## Haskell Lazy Evaluation++Haskell is fundamentally different from other languages. In most+languages, a variable name refers to some concrete data in memory;  in+Haskell, a variable may refer to concrete data or it could refer to+a computation or expression which when evaluated would produce the+concrete data that the variable is referring to. When the value of the+variable is needed, the computation is evaluated and replaced by+the result.++When a Haskell program starts, the entire program is an unevaluated+expression which is evaluated on-demand as needed. The top level+expression is forced to produce data when a result is demanded from it+for IO.  Parts of the expression are reduced as needed, the reduction+process can be controlled by the programmer.++## Unevaluated Expressions++When we assign a value to a name, the name refers to the unevaluated+expression and not what it would produce when evaluated. For example:++```+>>> infiniteList = [1..]+```++The name `infiniteList` refers to an expression which when evaluated+would generate the list. `infiniteList` is not an actual physical list+but just an expression to generate the list `when needed`. Because we+are not storing the actual list in memory, we can represent an infinite+list without requiring infinite amount of memory.++Let's try to get the length of this list:++```+>>> len = length infiniteList+```++Like before, the name `len` refers to an expression that when evaluated+would give us the length of the list.  Till now Haskell has been saying+that I duly noted how to do what you want to do but I will do it only+when you need it. Let's ask it to do that now:++```+>>> len+...hangs forever+```++Now, Haskell has no choice but to start evaluating the expression but we+know it can never finish because the list is infinite.++All expressions in Haskell are unevaluated by default.  Haskell+evaluates the expressions only when it is absolutely required e.g. when+we have to print something, or write it to a file or to network.++## On-demand Expression Evaluation++Let us illustrate expression evaluation in Haskell with an example. Write+this little program in a file `example.hs`:++```haskell unshared+main =+    let largeList = [1..1000000::Int]+        n = length largeList+     in print n+```++The expression `largeList` is never evaluated to generate the entire+list at once. It is evaluated on-demand one element at a time by the+`length` function. The `length` function is in turn evaluated by the+`print` function when it evaluates its argument `n`. The `print`+function is evaluated by the top level program because it wants to print+`n` to the console.++We can verify that the whole list is not stored in memory by looking at+the memory usage of this program. Let's compile and run it:++```+$ ghc -O example.hs+$ ./example +RTS -s+1000000+          51,480 bytes allocated in the heap+              24 bytes copied during GC+          44,328 bytes maximum residency (1 sample(s))+```++`largeList` is an expression representing a million element list, but+the program takes only 44K maximum memory.  The `length` function+evaluates `largeList` one element at a time to count them, as soon as+an element is counted it can be garbage collected as there are no more+references to it in the entire program.++## Expressions Holding up Heap Memory++Let's try this program instead:++```haskell unshared+{-# OPTIONS_GHC -Wno-x-partial #-}++main = do+    let largeList = [1..1000000::Int]+        x1 = last largeList+        x2 = head largeList+     in print (x1, x2)+```++```+$ ghc -O example.hs+$ ./example +RTS -s+(1000000,1)+      64,051,552 bytes allocated in the heap+             400 bytes copied during GC+      26,233,360 bytes maximum residency (4 sample(s))+```++This program is showing 26MB maximum residency instead of 44K+earlier. Why is it so? To evaluate the first element of the tuple, `x1`,+we need to evaluate the entire list to get to the last element. However,+the head of the list is referenced by the element `x2` as well which+is yet to be evaluated and used. Therefore, we need to retain the head+until `x2` is printed and freed. But head of the list is referencing the+next element in the list which in turn is referring to the next element+and so on, therefore, the entire list is retained in memory between the+evaluation of `x1` and `x2`.++If we change the print statement to `(x2, x1)` then we do not need to+retain the entire list between the two evaluations.++When memory is unexpectedly retained in a program it is known as a+"space-leak" in the Haskell parlance.++## Forcing Expression Evaluation++Even if there is no explicit dependency in the program forcing+evaluation of an expression, the programmer can force the evaluation of+an expression using `seq`:++```haskell unshared+{-# OPTIONS_GHC -Wno-x-partial #-}++main = do+    let largeList = [1..1000000::Int]+        x1 = last largeList+        x2 = head largeList+     in print (x1 `seq` x2)+```++Similar to the example in previous section, this example also retains+the entire list in memory because `seq` forces `x1` to be evaluated+before `x2` and then returns `x2`, the evaluated list is held until `x2` is+returned.++## Avoiding Unnecessary Memory Retention++Memory retention can be avoided by changing the way we construct the+expression to process the data. We can use Streamly to avoid memory+retention in the above program.++Let's first write it using streamly and reproduce the same problem:++```haskell unshared+import Data.Functor.Identity (runIdentity)+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++main = do+    let largeList = Stream.fromList [1..1000000::Int]+        x1 = runIdentity $ Stream.fold Fold.latest largeList+        x2 = runIdentity $ Stream.fold Fold.one largeList+     in print (x1, x2)+```++This program has the same behavior as the list based program, and for+the same reasons.++```+$ ghc -O2 example.hs+$ ./example +RTS -s+(Just 1000000,Just 1)+      64,052,520 bytes allocated in the heap+             400 bytes copied during GC+      26,233,360 bytes maximum residency (4 sample(s))+```++However, we can compose the two folds using the `teeWith` combinator+such that we distribute a each element of the list to both the folds+simultaneously, thus avoiding the retainment of the entire list:++```haskell unshared+import Data.Functor.Identity (runIdentity)+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++main = do+    let largeList = Stream.fromList [1..1000000::Int]+        x = Fold.teeWith (,) Fold.latest Fold.one+     in print $ runIdentity $ Stream.fold x largeList+```++```+$ ghc -O2 example.hs+$ ./example +RTS -s+(Just 1000000,Just 1)+      64,052,736 bytes allocated in the heap+             280 bytes copied during GC+          44,328 bytes maximum residency (2 sample(s))+```++This program uses constant small memory footprint (44K) irrespective of+the order of the elements in the tuple. When an element is generated by+the list it is supplied to both the folds before generating the next+element, therefore, it can be immediately freed.++Streamly covers all the functionality of standard Haskell lists but in addition+provides powerful composition tools for better efficiency.
+ docs/User/resources.md view
@@ -0,0 +1,18 @@+# Related Resources++## Talks++* [Streamly: Declarative Concurrency And Dataflow Programming In Haskell](https://www.youtube.com/watch?v=uzsqgdMMgtk) by Harendra Kumar at FnConf19+* [High Performance Haskell](https://www.youtube.com/watch?v=aJvwORrBJ0o) by Harendra Kumar at FnConf18++## Related Papers++* [Faster Coroutine Pipelines: A Reconstruction by RUBEN P. PIETERS, TOM SCHRIJVERS](https://rubenpieters.github.io/assets/papers/JFP20-pipes.pdf)++## Ecosystem Packages++* [Search on Hackage](https://hackage.haskell.org/packages/search?terms=streamly)++## Commercial Users++* [Juspay Technologies](https://www.juspay.in/)
+ docs/diagrams/module-diagram.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE TypeFamilies              #-}++import Diagrams.Prelude+import Diagrams.Backend.SVG.CmdLine+import Data.List (isPrefixOf)++splitOn :: Eq a => [a] -> [a] -> [[a]]+splitOn delim str = go str+  where+    go [] = [[]]+    go s+      | delim `isPrefixOf` s = [] : go (drop (length delim) s)+      | otherwise =+          let (c:cs) = s+              (x:xs) = go cs+          in (c:x) : xs++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++title1 t =+  vsep 0.3 [ text line # fontSizeL 0.3 # bold | line <- splitOn "\n" t ]+title2 t = text t # fontSizeL 0.2 # bold++textBox x y t = t <> strutX x <> strutY y++item1 t = text t # fontSizeL 0.25+enumerate items = vsep 0.3 [ textBox 2.0 0.4 (item1 i) | i <- items ]++boxedXY :: Double -> Double -> Diagram B -> Diagram B+boxedXY w h content = content # centerXY  <> rect w h # lw thin++boxedEnum x y items =+    let list = enumerate items+    in boxedXY x y (list # centerXY)++titleW = 2.0+titleH = 0.5++boxedTitledEnum1 x y title items =+    let ttext = textBox titleW titleH (title1 title)+        list = enumerate items+    in boxedXY x y (vsep 0 [ttext, boxedXY x (y - titleH) (list # centerXY)])++connect1 = connectOutside' (with & arrowHead .~ tri & headLength .~ global 0.2)++coreOval :: String -> Diagram B+coreOval tag =+    textBox 2.0 0.5 (title1 tag # centerXY)+    <> ellipseXY 1.5 0.75 # fc lightblue # lw medium++-------------------------------------------------------------------------------+-- streamly-core diagram+-------------------------------------------------------------------------------++bigBoxW = 12+bigBoxH = 4+centerBoxW = bigBoxH+centerBoxH = bigBoxH++box1 = boxedXY bigBoxW bigBoxH+box2 = boxedXY centerBoxW centerBoxH++bigBoxSubContent = boxedTitledEnum1 (bigBoxW / 3) (bigBoxH - titleH)++streamsBox :: Diagram B+streamsBox =+    let prod    = bigBoxSubContent "Generation" ["Stream", "StreamK", "Unfold"]+        transf  = bigBoxSubContent "Transformation" ["Scanl"]+        cons    = bigBoxSubContent "Consumption" ["Fold", "Parser", "ParserK"]+        row     = hsep 0 [prod, transf, cons]+        title   = textBox titleW titleH (title1 "Streams")+        content = vsep 0 [title, row # centerXY]+    in box1 (content # centerXY)++arraysBox :: Diagram B+arraysBox =+    let immut  = bigBoxSubContent "Immutable" ["Array", "Array.Generic"]+        mut    = bigBoxSubContent "Mutable" ["MutArray", "MutArray.Generic", "RingArray"]+        ser    = bigBoxSubContent "Serialization" ["MutByteArray", "Unbox", "Serialize"]+        row    = hsep 0 [immut, mut, ser]+        title  = textBox titleW titleH (title1 "Arrays")+        content= vsep 0 [title, row # centerXY]+    in box1 (content # centerXY)++fileSystemBox :: Diagram B+fileSystemBox =+    let items = ["Console.Stdio", "FileIO", "DirIO", "Handle", "Path"]+        content = boxedTitledEnum1 centerBoxW centerBoxH "File System" items+    in box2 (content # centerXY)++otherModulesBox :: Diagram B+otherModulesBox =+    let unicode = boxedTitledEnum1 centerBoxW (centerBoxH * 2/3) "Unicode" ["Parser", "Stream", "String"]+        resmgmt = boxedTitledEnum1 centerBoxW (centerBoxH * 1/3) "Resource Management" ["Control.Exception"]+        content = vsep 0 [unicode, resmgmt]+    in box2 (content # centerXY)++streamlyCore :: Diagram B+streamlyCore =+    let center    = coreOval "streamly-core\n(types and modules)" # named "core"+        topBox    = streamsBox # named "streams"+        bottomBox = arraysBox # named "arrays"+        leftBox   = fileSystemBox # named "fs"+        rightBox  = otherModulesBox # named "others"++        placed = position+          [ (p2 (0,0), center)+          , (p2 (0,4), topBox)+          , (p2 (0,-4), bottomBox)+          , (p2 (-4,0), leftBox)+          , (p2 (4,0), rightBox)+          ]++        arrows = applyAll+          [ connect1 "core" "streams"+          , connect1 "core" "arrays"+          , connect1 "core" "fs"+          , connect1 "core" "others"+          ]+    in arrows placed++-------------------------------------------------------------------------------+-- streamly diagram+-------------------------------------------------------------------------------++concurrentStreamsBox :: Diagram B+concurrentStreamsBox =+    let prod    = bigBoxSubContent "Generation" ["Stream.Prelude"]+        transf  = bigBoxSubContent "Transformation" ["Scanl.Prelude"]+        cons    = bigBoxSubContent "Consumption" ["Fold.Prelude"]+        row     = hsep 0 [prod, transf, cons]+        title   = textBox titleW titleH (title1 "Concurrent Streams")+        content = vsep 0 [title, row # centerXY]+    in box1 (content # centerXY)++networkBox :: Diagram B+networkBox =+    let items = ["Network.Socket", "Network.Inet.TCP"]+        content = boxedTitledEnum1 centerBoxW centerBoxH "Network" items+    in box2 (content # centerXY)++streamly :: Diagram B+streamly =+    let center    = coreOval "streamly" # named "streamly"+        topBox    = concurrentStreamsBox # named "concurrent-streams"+        bottomBox = networkBox # named "network"++        placed = position+          [ (p2 (0,0), center)+          , (p2 (0,4), topBox)+          , (p2 (0,-4), bottomBox)+          ]++        arrows = applyAll+          [ connect1 "streamly" "concurrent-streams"+          , connect1 "streamly" "network"+          ]+    in arrows placed++main :: IO ()+main =+    mainWith+        [ ("streamly-core", (streamlyCore # centerXY # pad 1.1))+        , ("streamly", (streamly # centerXY # pad 1.1))+        ]
− docs/faq.md 
@@ -1,70 +0,0 @@-# Frequently Asked Questions--This document provides idioms or examples to solve common programming-problems using streamly. To start with please go through [Streamly Quick-Overview](/docs/Introduction.md) and [`Streamly examples repository`][streamly-examples].-This document provides additional examples.--## Distribute and Zip Concurrently--Say, you have an input stream, and each element of the input stream is to be-transformed in multiple ways using monadic functions. Then you want to zip the-results together and consume the resulting stream concurrently.--First, distribute an item to multiple effectful consumer concurrently, for-example:--```haskell-import Data.Function ((&))-import qualified Streamly.Prelude as Stream--f1 x =-      Prelude.map ($ x) [return . (+ 1), return . (+ 2)]-    & Stream.fromListM-    & Stream.fromAhead-    & Stream.toList-```--Alternatively, if you want to concurrently zip different types of outputs, you-can use `Applicative` composition:--```haskell-import Data.Maybe (fromJust)-f2 x =-    (,,)-      <$> Stream.fromEffect (return $ show x)-      <*> Stream.fromEffect (return $ x + 1)-      <*> Stream.fromEffect (return $ fromIntegral x / 2)-  & Stream.fromAsync-  & Stream.head-  & fmap fromJust-```--Then apply the function `f` concurrently to your input stream:--```haskell-g f xs =-  Stream.fromList xs-    & Stream.mapM f-    & Stream.fromAhead-    & Stream.toList-```--```->>> g f1 [1,2,3,4::Int]-[[2,3],[3,4],[4,5],[5,6]]-->>> g f2 [1,2,3,4::Int]-[("1",2,0.5),("2",3,1.0),("3",4,1.5),("4",5,2.0)]-```--## Sliding Window--```->>> :{-  Stream.fromList [1,2,3,4,5::Int]-& Stream.scan (Array.writeLastN 2)-& Stream.toList-:}-[[],[1],[1,2],[2,3],[3,4],[4,5]]-```
− docs/getting-started.md 
@@ -1,296 +0,0 @@-<!---Portions (c) 2020, Google LLC.-SPDX-License-Identifer: BSD-3-Clause--->--# Getting started with the `streamly` package--This guide will show you how to write a simple program that uses-[Streamly][], using the [`cabal`](https://www.haskell.org/cabal/) build-manager for Haskell.--<!-- TODO: Add instructions for `stack` and `nix`.--If you are using `stack` or `nix` please make sure to add the latest-version from Hackage to your tool configuration.  -->--No prior knowledge of either Haskell or of `cabal` is needed.  We do-however assume that you are using a command-line shell on a POSIX-operating system.  If you are running Windows&trade; then you may need-to run a command-line shell under `msys` and some of the commands-below may also need to be changed in small ways to make them work.--**Note**: If you are new to Haskell you may find the [Haskell Getting-Started Guide][haskell-getting-started] to be useful.--If you know your way around Haskell, and have an up to date toolchain-already installed, then you can jump straight to the section titled-"[_Prepare Your Build Directory_](#prepare-your-build-directory)".--## Getting started with `streamly` using `cabal`--To get started, you will need a recent `cabal` binary to be installed-on your system.--### Installing `cabal`--A pre-packaged `cabal` binary may already be available for your-operating system.--For example, on Debian GNU/Linux, you could install `cabal` using::--```-$ sudo apt install cabal-install-```--### Installing `ghc`--You would also need to install the Glasgow Haskell Compiler `ghc`.  In-most operating systems, using the system's package manager to install-`cabal` would also bring in a version of `ghc` as a dependency.--Please verify that `ghc` is present:--```-$ ghc --version-The Glorious Glasgow Haskell Compilation System, version 8.0.2-```--If `ghc` isn't present, please install it using your operating-system's package manager. For example, on Debian GNU/Linux, use:--```-$ sudo apt install ghc-```--### Update `cabal` if necessary--Many operating systems ship an old version of `cabal`; in order to use-`streamly` you should use `cabal` version 3.0 (or later).--You can check the installed version of `cabal` by using its-`--version` flag:--```-$ which cabal-/usr/bin/cabal-$ /usr/bin/cabal --version-cabal-install version 1.24.0.2-compiled using version 1.24.2.0 of the Cabal library-```--In this example, the installed `cabal` binary is too old for our-needs. It would need to be upgraded.--You can ask `cabal` to upgrade itself (please see-<https://www.haskell.org/cabal/>):--```-$ cabal install Cabal cabal-install-Resolving dependencies...-Downloading base16-bytestring-0.1.1.7...-... lots of build output ...-Building cabal-install-3.0.0.0...-Installed cabal-install-3.0.0.0-```--`cabal` will usually place its compiled binaries inside the directory-`$HOME/.cabal/bin`.--You can verify the version of your newly installed binary by using the-`--version` flag again:--```-$ $HOME/.cabal/bin/cabal --version-cabal-install version 3.0.0.0-compiled using version 3.0.2.0 of the Cabal library-```--If you have upgraded `cabal`, do be sure to specify `$HOME/.cabal/bin`-early in your `PATH` shell variable, so that the new binary gets used-instead of the older version on your system.--```-$ PATH=$HOME/.cabal/bin:$PATH-```--Once you have `cabal` version 3.0 (or later) successfully installed,-please refresh its package list by using `cabal update`.--```-$ cabal update-Downloading the latest package list from hackage.haskell.org-```--### Prepare Your Build Directory--Next, create a build directory, so that you can use `cabal`'s isolated-builds feature.--```-$ mkdir streamly-play-$ cd streamly-play-```--Run `cabal init` to create an initial set of project files:--```-$ cabal init --minimal --dependency base --dependency streamly--Generating LICENSE...-... other messages ...-Generating Main.hs...-Generating streamly-play.cabal...--Warning: no synopsis given. You should edit the .cabal file and add one.-You may want to edit the .cabal file and add a Description field.-```--This invocation will set up a build with two build dependencies,-namely `base` and `streamly`.  You can add additional dependencies-later, by editing the `build-depends` section of the generated cabal-file `streamly-play.cabal`.  Please see the [Cabal User-Guide](https://www.haskell.org/cabal/users-guide/) for more-information on how to configure `cabal`.--This invocation also creates a skeletal `Main.hs` program which we-will use later.--### Try `streamly` in the GHCi REPL--You can now try out `streamly` using the `GHCi` interpreter's-read-eval-print-loop (REPL) facility.--To start up the GHCi REPL using the released `streamly` version on-Hackage, please use:--```-$ cabal repl --build-depends streamly-... plenty of build messaages, the first time around ...-GHCi, version 8.8.3: https://www.haskell.org/ghc/  :? for help-[1 of 1] Compiling Main             ( Main.hs, interpreted )-Ok, one module loaded.-*Main>-```--Once at the `*Main>` prompt, you can import `streamly` and use it-directly:--```-*Main> import qualified Streamly.Prelude as Stream--*Main Stream> Stream.drain $ Stream.mapM print $ Stream.fromList [1..3]-1-2-3-*Main Stream>-```--For the curious, here is a high level overview of what these lines-do:--1. `import qualified Streamly.Prelude as Stream` imports the Streamly-   prelude into GHCi, and makes it available as module `Stream`.-2. `[1..3]` generates the Haskell list `[1, 2, 3]`.-3. `Stream.fromList` transforms that list into a stream of integers.-4. `Stream.mapM print` transforms the stream of integers into a stream of-   actions that would print those integers when executed.-5. `Stream.drain` transforms that stream of actions into an IO action that-   `main` or GHCi's REPL can execute.--#### Using a specific version of `streamly` in the REPL--You can also ask `cabal` to use a specific version of `streamly` by-adding a version number constraint to the `--build-depends` flag:--```-$ cabal repl --build-depends streamly==0.8.2-[1 of 1] Compiling Main             ( Main.hs, interpreted )-Ok, modules loaded: Main.-*Main>-```--#### (Advanced) Using the development version of `streamly` in the REPL--To use the development version of `streamly`, we need to configure-`cabal` to fetch it from Github.--Create a `cabal.project` file in the current directory with the-following content:--```-packages: .-source-repository-package-  type: git-  location: https://github.com/composewell/streamly-  tag: master-```--With this file present, `cabal` will fetch and build the current-version of `streamly` from Github every time it is run.  For example:--```-$ cabal repl-... fetches the 'master' branch of streamly from Github ...-... build messages ...-[1 of 1] Compiling Main     v        ( Main.hs, interpreted )-Ok, modules loaded: Main.-*Main>-```--### Using `streamly` in a standalone program--Let us now turn the single-line stanza above into a standalone program-that uses `streamly`.--Edit `Main.hs` to contain the following:--```haskell-module Main where--import qualified Streamly.Prelude as Stream--main :: IO ()-main = Stream.drain $ Stream.mapM print $ Stream.fromList [1..3]-```--Build and run this program using `cabal run`:--```-$ cabal run-... build messages ...-1-2-3-```--## Which version of `streamly` should you use?--If you are new to Streamly, we recommend using latest [stable release-of streamly][streamly-hackage] on Hackage.--If you need access to cutting edge features (and do not mind the-occasional breakage), please use the [development version of-streamly][streamly-github] on Github.---## Next Steps--If you got this far successfully, congratulations!--* For an overview of the `streamly` package, please read the-  [Streamly Quick Overview](/docs/Introduction.md).-* Please browse the code examples in the-  [`Streamly examples repository`][streamly-examples].-* If you would like to start on a real world project, please take a-  look at the [Streamly Build Guide](/docs/Compiling.md).-* For comprehensive documentation please visit the-  [Streamly Homepage][Streamly].--<!-- Markdown Links -->-- [Streamly]: https://streamly.composewell.com/- [streamly-hackage]: https://hackage.haskell.org/package/streamly- [streamly-github]: https://github.com/composewell/streamly- [streamly-examples]: https://github.com/composewell/streamly-examples- [haskell-getting-started]: https://github.com/composewell/haskell-dev/blob/master/getting-started.rst
− docs/interoperation.md 
@@ -1,11 +0,0 @@-# Interoperation with streaming libraries--We can use `unfoldr` and `uncons` operations to convert one streaming-type to another. See the following interoperation examples in the-[streamly-examples](https://github.com/composewell/streamly-examples)-repository.--* [Interoperation with `streaming`](https://github.com/composewell/streamly-examples/blob/master/examples/Interop/Streaming.hs)-* [Interoperation with `pipes`](https://github.com/composewell/streamly-examples/blob/master/examples/Interop/Pipes.hs)-* [Interoperation with `conduit`](https://github.com/composewell/streamly-examples/blob/master/examples/Interop/Conduit.hs)-* [Interoperation with `vector`](https://github.com/composewell/streamly-examples/blob/master/examples/Interop/Vector.hs)
− docs/monad-transformers.md 
@@ -1,65 +0,0 @@-# Monad Transformers--In the stream tutorials we mostly used streams in the IO monad.  In-general, the type `SerialT` is a monad transformer, @SerialT m a@-represents a stream of values of type 'a' in some underlying monad-'m'. For example, @SerialT IO Int@ is a stream of 'Int' in 'IO'-monad. Similarly, `SerialT Identity Int` would be a pure stream-equivalent to `[a]`.--Similarly we have monad transformer types for other stream types as well-viz.  'WSerialT', 'AsyncT', 'WAsyncT' and 'ParallelT'.--To lift a value from an underlying monad in a monad transformer stack into a-singleton stream use 'lift' and to lift from an IO action use 'liftIO'.--```->>> import Control.Monad.IO.Class (liftIO)->>> Stream.drain $ liftIO $ putStrLn "Hello world!"-Hello world!-->>> import Control.Monad.Trans.Class (MonadTrans(lift))->>> Stream.drain $ lift $ putStrLn "Hello world!"-Hello world!-```--## Using Monad Transformers--Common monad transformers can be used with streamly serial streams, without any-issues. `ReaderT` can be used with concurrent streams as well without any-issues.--The semantics of monads other than `ReaderT` with concurrent streams are-not yet finalized and will change in future, therefore, as of now they are not-recommended to be used with concurrent streams.--## Ordering of Monad Transformers--In most cases it is a good idea to keep streamly as the top level monad.-[This-example](https://github.com/composewell/streamly-examples/blob/master/examples/ControlFlow.hs)-demonstrates how various control flow modifying monads can be combined-with streamly stream monads.--## State Sharing-### Serial Applications--Read only global state can always be shared using the `Reader` monad.-Read-write global state can be shared either using an `IORef` in the `Reader`-monad or using the `State` monad.--See `AcidRain.hs` example for a usage of `StateT` in the serially executing-portion of the program.--### Concurrent Applications--The current recommended method for sharing modifiable global state across-concurrent tasks is to put the shared state inside an `IORef` in a `Reader`-monad or just share the `IORef` by passing it to the required functions. The-`IORef` can be updated atomically using `atomicModifyIORef`.--The `CirclingSquare.hs` example shares an `IORef` across parallel tasks.--## See also--* [Examples of control flow monads with Streamly](https://github.com/composewell/streamly-examples/blob/master/examples/ControlFlow.hs)
− docs/optimizing.md 
@@ -1,98 +0,0 @@-# Optimization Guide--## Performance Optimizations--A "closed loop" is any streamly code that generates a stream using-unfold (or conceptually any stream generation combinator) and ends-up eliminating it with a fold (conceptually any stream elimination-combinator). It is essentially a loop processing multiple elements in-a stream sequence, just like a `for` or `while` loop in imperative-programming.--Closed loops are generated in a modular fashion by stream generation,-transformation and elimination combinators in streamly. Combinators-transfer data to the next stream pipeline stage using data constructors.-These data constructors are eliminated by the compiler using `stream-fusion` optimizations, generating a very efficient loop.--However, stream fusion optimization depends on proper inlining of the-combinators involved. The fusion-plugin package mentioned earlier-fills gaps for several optimizations that GHC does not perform-automatically. It automatically inlines the internal definitions-that involve the constructors we want to eliminate. In some cases-fusion-plugin may not help and programmer may have to annotate the code-manually for complete fusion. In this section we mention some of the-cases where programmer annotation may help in stream fusion.--Remember, you need to worry about performance only where it matters, try-to optimize the fast path and not everything blindly.--### INLINE annotations--It may help to add INLINE annotations on any intermediate functions-involved in a closed loop. In some cases you may have to add an inline-phase as well as described below.--Usually GHC has three inline phases - the first phase is pahse-2, the-second phase is phase-1 and the last one is phase-0.--#### Early INLINE--Generally, you only have to inline the combinators or functions-participating in a loop and not the whole loop itself.  But sometimes-you may want to inline the whole loop itself inside a larger-function. In most cases you can just add an INLINE pragma on-the function containing the loop. But you may need some special-considerations in some (not common) cases.--In some cases you may have to use INLINE[2] instead of INLINE which-means inline the function early in phase-2.  This may sometimes be-needed on the because the performance of several combinators in streamly-depends on getting inlined in phase-2 and if you use a plain `INLINE`-annotation GHC may decide to delay the inlining in some cases. This is-not very common but may be needed sometimes. Perhaps GHC can be fixed or-we can resolve this using fusion-plugin in future.--#### Delayed INLINE--When a function is passed to a higher order function e.g. a function-passed to `concatMap` or `unfoldMany` then we want the function to be-inlined after the higher order is inlined so that proper fusion of the-higher order function can occur. For such cases we usually add INLINE[1]-on the function being passed to instruct GHC not to inline it too early.--### Strictness annotations--* Strictness annotations on data, specially the data used as accumulator in-  folds and scans, can help in improving performance.-* Strictness annotations on function arguments can help the compiler unbox-  constructors in certain cases, improving performance.-* Sometimes using `-XStrict` extension can help improve performance, if so you-  may be missing some strictness annotations. `-XStrict` can be used as an aid-  to detect missing annotations, using it blindly may regress performance.--### Use tail recursion--Do not use a strict `foldr` or lazy `foldl` unless you know what you are-doing.  Use lazy `foldr` for lazily transforming the stream and strict-`foldl` for reducing the stream.  If you are manually writing recursive-code, try to use tail recursion where possible.--## Build times and space considerations--Haskell, being a pure functional language, confers special powers on-GHC. It allows GHC to do whole program optimization. In a closed loop-all the components of the loop are inlined and GHC fuses them together,-performs many optimizing transformations and churns out an optimized-fused loop code. Let's call it whole-loop-optimization.--To be able to fuse the loop by whole-loop-optimization all the parts of the-loop must be operated on by GHC at the same time to fuse them together. The-amount of time and memory required to do so depends on the size of the loop.-Huge loops can take a lot of time and memory. We have seen GHC take 4-5 GB of-memory when a lot of combinators are used in a single module.--If a module takes too much time and space we can break it into multiple-modules moving some non-inlined parts in another module. There is-another advantage of breaking large modules, it can take advantage of-parallel compilation if they do not depend on each other.
− docs/performance.md 
@@ -1,7 +0,0 @@-# Performance--Streamly is highly optimized for performance, it is designed for-high performing, concurrent and scalable applications. Please see the-[streaming-benchmarks](https://github.com/composewell/streaming-benchmarks)-package for microbencmarks measuring the performance of streamly and comparing-it with other streaming libraries.
− docs/resources.md 
@@ -1,18 +0,0 @@-# Related Resources--## Talks--* [Streamly: Declarative Concurrency And Dataflow Programming In Haskell](https://www.youtube.com/watch?v=uzsqgdMMgtk) by Harendra Kumar at FnConf19-* [High Performance Haskell](https://www.youtube.com/watch?v=aJvwORrBJ0o) by Harendra Kumar at FnConf18--## Related Papers--* [Faster Coroutine Pipelines: A Reconstruction by RUBEN P. PIETERS, TOM SCHRIJVERS](https://rubenpieters.github.io/assets/papers/JFP20-pipes.pdf)--## Ecosystem Packages--* [Search on Hackage](https://hackage.haskell.org/packages/search?terms=streamly)--## Commercial Users--* [Juspay Technologies](https://www.juspay.in/)
− docs/streaming-pradigms.rst 
@@ -1,117 +0,0 @@-Streaming Paradigms----------------------There are two dual paradigms for stream processing in Haskell. In the first-paradigm we represent a stream as a data type and use functions to work on it.-In the second paradigm we represent *stream processors* as data types and-provide them individual data elements to process, there is no explicit-representation of the stream as a data type. In the first paradigm we work with-data representation and in the second paradigm we work with function-representations. Both of these paradigms have equal expressive power. The-latter uses the monadic composition for data flow whereas the former does not-need monadic composition for straight line stream processing and therefore can-use it for higher level composition e.g.  to compose streams in a product-style.--To see an example of the first paradigm, let us use the ``vector`` package to-represent a monadic stream of integers as ``Stream IO Int``. This data-representation of stream is passed explicitly to the stream processing-functions like ``filter`` and ``drop`` to manipulate it::--  import qualified Data.Vector.Fusion.Stream.Monadic as S--  stream :: S.Stream IO Int-  stream = S.fromList [1..100]--  main =  do-    let str = (S.filter even . S.drop 10) stream-    toList str >>= putStrLn . show--Pure lists and vectors are the most basic examples of streams in this paradigm.-The streaming IO libraries just extend the same paradigm to monadic streaming.-The API of these libraries is very much similar to lists with a monad parameter-added.--The second paradigm is direct opposite of the first one, there is no stream-representation in this paradigm, instead we represent *stream processors* as-data types. A stream processor represents a particular process rather than-data, and we compose them together to create composite processors. We can call-them stream transducers or simply pipes. Using the ``machines`` package::--  import qualified Data.Machine as S--  producer :: S.SourceT IO Int-  producer = S.enumerateFromTo 1 100--  main =  do-    let processor = producer S.~> S.dropping 10 S.~> S.filtered even-    S.runT processor >>= putStrLn . show--Both of these paradigms look almost the same, right? To see the difference-let's take a look at some types. In the first paradigm we have an explicit-stream type and the processing functions take the stream as input and produce-the transformed stream::--  stream :: S.Stream IO Int-  filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--In the second paradigm, there is no stream data type, there are stream-processors, let's call them boxes that represent a process.  We have a-*SourceT* box that represents a singled ended producer and a *Process* box or a-pipe that has two ends, an input end and an output end, a ``MachineT``-represents any kind of box. We put these boxes together using the ``~>``-operator and then run the resulting machine using ``runT``::--  producer :: S.SourceT IO Int-  filtered :: (a -> Bool) -> Process a a-  dropping :: Int -> Process a a-  (~>) :: Monad m => MachineT m k b -> ProcessT m b c -> MachineT m k c--Custom pipes can be created using a Monadic composition and primitives to-receive and send data usually called ``await`` and ``yield``.--.. |str| replace:: `streamly <https://github.com/composewell/streamly>`__--+-----------------------------------------------------------------------------+-| Streaming libraries using the direct paradigm.                              |-+------------------------+----------------------------------------------------+-| Library                | Remarks                                            |-+========================+====================================================+-| vector                 | The simplest in this category, provides            |-|                        | transformation and combining of monadic            |-|                        | streams but no monadic composition of streams.     |-|                        | Provides a very simple list like API.              |-+------------------------+----------------------------------------------------+-| streaming              | * Encodes a return value to be supplied when the   |-|                        |   stream ends. The monad instance passes on the    |-|                        |   streams and combines the return values.          |-|                        | * Functor general                                  |-|                        | * The API is more complicated than vector because  |-|                        |   of the return value and the functor layer.       |-+------------------------+----------------------------------------------------+-| list-t                 | Provides straight line composition of streams      |-|                        | as well as a list like monadic composition.        |-|                        | The API is simple, just like ``vector``.           |-+------------------------+----------------------------------------------------+-|                        | Like list-t, in addition to straight line          |-|                        | composition it provides a list like monadic        |-|                        | composition of streams, supports combining streams |-|                        | concurrently supports concurrent applicative and   |-|                        | monadic composition.                               |-| |str|                  | The basic API is very much like lists and          |-|                        | almost identical to ``vector`` streams.            |-+------------------------+----------------------------------------------------+--+-----------------------------------------------------------------------------+-| Streaming libraries using the pipes paradigm.                               |-+------------------------+----------------------------------------------------+-| Library                | Remarks                                            |-+========================+====================================================+-| conduit                | ``await`` and ``yield`` data to upstream or        |-|                        | downstream pipes; supports pushing leftovers back. |-+------------------------+----------------------------------------------------+-| pipes                  | ``await`` and ``yield`` data to upstream or        |-|                        | downstream pipes                                   |-+------------------------+----------------------------------------------------+-| machines               | Can await from two sources, left and right.        |-+------------------------+----------------------------------------------------+
− docs/streamly-docs.cabal 
@@ -1,34 +0,0 @@-cabal-version:      2.2--- Reasons for having a separate package for docs:--- * Leaner main package and better modularity--- * This package can be forked out as an independent package--- * We can have code examples in haddock with more dependencies--- * Documentation can be released independent of the library--- * We do not want too many doc modules in the main library-name:               streamly-docs-version:            0.0.0-synopsis:           Documentation for Streamly-description:        Documentation for Streamly-build-type:         Simple------------------------------------------------------------------------------------ Library----------------------------------------------------------------------------------extra-doc-files:-  Roadmap.link-  *.md--library-  default-language: Haskell2010-  ghc-options:      -Wall-  hs-source-dirs:    .-  exposed-modules:-    Tutorial-    ConcurrentStreams-    ReactiveProgramming--  build-depends:-      base              >= 4.9   &&  < 4.17-    , transformers      >= 0.4   && < 0.6-    , streamly
− docs/streamly-vs-async.md 
@@ -1,235 +0,0 @@-# Streamly--Streamly is a library to make concurrent programming a joy. The venerable-`async` package is the go to package for concurrent programming for most-Haskellers. Streamly is a higher level library than `async` and provides a lot-more power and functionality, using a simpler and concise expression of-concurrency. At a high level, you should be able to express everything with-streamly that you can with `async`, if you can't please raise an issue. If you-are familiar with `async`, in this document we highlight how streamly can be-used where you would use `async`.--## `async/wait` vs Concurrent Streams--Unlike `async`, streamly does not use a spawn and `wait` model.  Streamly uses-a more high level approach to concurrency and has no explicit notion of-threads. In streamly, we compose multiple actions as a stream and then express-whether you want to run the actions in the stream `serially` or `parallely`.-There are many different ways in which you can run streams concurrently, see-the reference documentation for details.--Since there is no explicit notion of threads in streamly, there are no-equivalents of `async`, `wait`, `cancel`, `poll` or `link` combinators from the-`async` package.--Since streamly is a monad transformer it can work with all monads and not just-IO, you won't need adaptations like `lifted-async` to use it for a generic-monad.--## Using Streamly for Concurrency--You can write all of your program in a streamly monad and use the full power of-the library.  Streamly can be used as a direct replacement of the IO monad with-no loss of performance, and no change in code except using `liftIO` or `fromEffect`-to run any IO actions.  Streamly IO monads (e.g. `SerialT IO`) are just a-generalization of the IO monad with non-deterministic composition of streams-added on top.--However, if you would like to just run only some concurrent portions of your-program using streamly, you can do that too. Just use `drain` if you want-to run the stream without collecting the outputs of the concurrent actions or-use `toList` if you want to convert the output stream into a list.  Other-stream folding operations can also be used, see the docs for more details.--## Features as Compared with `async`--Use the following imports to run the snippets shown below:--```haskell-import Streamly-import Streamly.Prelude ((|:))-import qualified Streamly.Prelude as S-import qualified Data.Text as Text-import Control.Concurrent (threadDelay)-```--Let us simulate a URL fetch with a delay of `n` seconds using the following-functions:--```haskell-getURL :: Int -> IO String-getURL n = threadDelay (n * 1000000) >> return (show n)-getURLString = getURL-getURLText n = getURL n >>= return . Text.pack-```--### concurrently--You can run any number of actions concurrently. For example, to fetch two URLs-concurrently:--```haskell-  urls <- S.toList $ fromParallel $ getURL 2 |: getURL 1 |: S.nil-```--This would return the results in their arrival order i.e. first 1 and then 2.-If you want to preserve the order of the results, use the lookahead style-using `fromAhead` instead. In the following example both URLs are fetched-concurrently, and even though URL 1 arrives before URL 2 the results will-return 2 first and then 1.--```haskell-  urls <- S.toList $ fromAhead $ getURL 2 |: getURL 1 |: S.nil-```--### concurrently_--Use `drain` instead of `toList` to run the actions but ignore the results:--```haskell-  S.drain $ fromParallel $ getURL 1 |: getURL 2 |: S.nil-```--### Concurrent Applicative--If the actions that you are executing result in different output types you can-use applicative zip to collect the results or to directly apply them to a-function:--```haskell-  tuples <- S.toList $ fromZipAsync $-              (,) <$> S.fromEffect (getURLString 1) <*> S.fromEffect (getURLText 2)-```--### race--There are two ways to achieve the race functionality, using `take` or using-exceptions.--#### `race` Using `take`--We can run multiple actions concurrently and take the first result that-arrives:--```haskell-  urls <- S.toList $ S.take 1 $ fromParallel $ getURL 1 |: getURL 2 |: S.nil-```--After the first result arrives, the rest of the actions are canceled-automatically.  In general, we can take first `n` results as they arrive:--```haskell-  urls <- S.toList $ S.take 2 $ fromParallel $ getURL 1 |: getURL 2 |: S.nil-```--#### `race` Using Exceptions--When an exception occurs in a concurrent stream all the concurrently running-actions are cacnceled on arrival of the exception. This can be used to-implement the race functionality. Each action in the stream can use an-exception to communicate the result. As soon as the first result arrives all-other actions will be canceled, for example:--```haskell-  data Result = Result String deriving Show-  instance Exception Result--  main = do-      url <- try $ S.drain $ fromParallel $-                   (getURL 2 >>= throwM . Result)-                |: (getURL 1 >>= throwM . Result)-                |: S.nil-      case url of-          Left (e :: SomeException) -> print e-          Right _ -> undefined-```--### mapConcurrently--There are many ways to map concurrently on a container and collect the results:--You can create a concurrent stream from a `Foldable` container of monadic-actions:--```haskell-  urls <- S.toList $ fromAhead $ S.fromFoldableM $ fmap getURL [1..3]-```--You can first convert a `Foldable` into a stream and then map an action on the-stream concurrently:--```haskell-  urls <- S.toList $ fromAhead $ S.mapM getURL $ foldMap return [1..3]-```--You can map a monadic action to a `Foldable` container to convert it into a-stream and at the same time fold it:--```haskell-  urls <- S.toList $ fromAhead $ foldMap (S.fromEffect . getURL) [1..3]-```--### replicateConcurrently--Streamly has not just the equivalent of `replicateConcurrently` which is-`replicateM` but many more ways to generate concurrent streams, for example,-`|:`, `unfoldrM`, `repeatM`, `iterateM`, `fromFoldableM` etc. See the-[Streamly.Prelude](https://hackage.haskell.org/package/streamly/docs/Streamly-Prelude.html)-module documentation for more details.--```haskell-  xs <- S.toList $ fromParallel $ S.replicateM 2 $ getURL 1-```--### Functor--The stream resulting from concurrent actions can be mapped serially or-concurrently.--To map serially just use `fmap`:--```haskell-  xs <- S.toList $ fromParallel $ fmap (+1) $ return 1 |: return 2 |: S.nil-```--To map a monadic action concurrently on all elements of the stream use `mapM`:--```haskell-  xs <- S.toList $ fromParallel $ S.mapM (\x -> return (x + 1))-                           $ return 1 |: return 2 |: S.nil-```--### Semigroup--The `Semigroup` instances of streamly merge multiple streams serially or-concurrently.--### Monad--The `Monad` instances of streamly nest loops concurrently (concurrent-non-determinism).--### Performance--Streamly has very little concurrency overhead (ranging from a few 100-nanoseconds to a few microseconds on a 2.2 GHz Intel Core i7), you can even run-very lightweight actions in parallel without worrying about the overhead of-concurrency. See the performance benchmarks [comparing streamly with the `async`-package in this repo](https://github.com/composewell/concurrency-benchmarks).--## Further Reading--There is much more that you can do with streamly. For example, you can use the-`maxThreads` combinator to restrict the total number of concurrent threads or-use the `maxBuffer` combinator to restrict the total number of bufferred-results or you can use the `avgRate` combinator to control the rate at which-the concurrent actions are executed.--See the [haddock documentation on-hackage](https://hackage.haskell.org/package/streamly) and [a comprehensive tutorial-here](https://streamly.composewell.com/streamly-0.8.2/Tutorial.html).--## References--* https://hackage.haskell.org/package/async-* https://hackage.haskell.org/package/lifted-async
− docs/streamly-vs-list-time.svg 
@@ -1,3 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?>-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"-    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"><svg xmlns="http://www.w3.org/2000/svg" height="600.0000" stroke-opacity="1" viewBox="0 0 800 600" font-size="1" width="800.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 0.0000,0.0000 v 600.0000 h 800.0000 v -600.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 118.4035,20.1694 ZM 120.5852,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 128.2341,20.1694 ZM 131.7762,5.5647 c -0.9497,-0.0000 -1.5657,-0.5518 -1.5657 -0.5518c -0.6160,-0.5518 -0.6160,-1.4245 -0.6160 -1.4245c 0.0000,-0.8727 0.6160,-1.4117 0.6160 -1.4117c 0.6160,-0.5390 1.5657,-0.5390 1.5657 -0.5390c 0.9754,0.0000 1.5785,0.5390 1.5785 0.5390c 0.6032,0.5390 0.6032,1.4117 0.6032 1.4117c 0.0000,0.8727 -0.6032,1.4245 -0.6032 1.4245c -0.6032,0.5518 -1.5785,0.5518 -1.5785 0.5518ZM 131.7762,5.5647 ZM 129.9025,7.4384 h 3.7731 v 12.7310 h -3.7731 v -12.7310 ZM 135.3183,20.1694 ZM 136.9867,7.4384 h 3.0801 l 0.2567,1.6427 h 0.1027 c 0.7957,-0.7957 1.6940,-1.3732 1.6940 -1.3732c 0.8984,-0.5775 2.1561,-0.5775 2.1561 -0.5775c 1.3604,0.0000 2.1946,0.5518 2.1946 0.5518c 0.8342,0.5518 1.3219,1.5785 1.3219 1.5785c 0.8470,-0.8727 1.7839,-1.5015 1.7839 -1.5015c 0.9369,-0.6289 2.2202,-0.6289 2.2202 -0.6289c 2.0534,0.0000 3.0159,1.3732 3.0159 1.3732c 0.9625,1.3732 0.9625,3.7603 0.9625 3.7603v 7.9055 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9497,-0.0000 -2.1817,1.2320 -2.1817 1.2320v 8.5986 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9754,-0.0000 -2.1561,1.2320 -2.1561 1.2320v 8.5986 h -3.7731 v -12.7310 ZM 157.3152,20.1694 ZM 158.2392,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 158.2392,13.8039 ZM 166.4528,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 175.9497,20.1694 ZM 178.1314,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 185.4723,20.1694 ZM 186.6786,16.6273 c 0.0000,-2.0021 1.6940,-3.1314 1.6940 -3.1314c 1.6940,-1.1294 5.4671,-1.5144 5.4671 -1.5144c -0.0513,-0.8470 -0.5133,-1.3475 -0.5133 -1.3475c -0.4620,-0.5005 -1.4887,-0.5005 -1.4887 -0.5005c -0.8214,-0.0000 -1.6427,0.3080 -1.6427 0.3080c -0.8214,0.3080 -1.7454,0.8470 -1.7454 0.8470l -1.3347,-2.4897 c 1.2320,-0.7444 2.5796,-1.2064 2.5796 -1.2064c 1.3475,-0.4620 2.8619,-0.4620 2.8619 -0.4620c 2.4641,0.0000 3.7603,1.3989 3.7603 1.3989c 1.2962,1.3989 1.2962,4.3506 1.2962 4.3506v 7.2895 h -3.0801 l -0.2823,-1.3090 h -0.0770 c -0.8214,0.7187 -1.7325,1.1679 -1.7325 1.1679c -0.9112,0.4492 -1.9892,0.4492 -1.9892 0.4492c -0.8727,-0.0000 -1.5657,-0.2952 -1.5657 -0.2952c -0.6930,-0.2952 -1.1807,-0.8214 -1.1807 -0.8214c -0.4877,-0.5262 -0.7572,-1.2192 -0.7572 -1.2192c -0.2695,-0.6930 -0.2695,-1.5144 -0.2695 -1.5144ZM 186.6786,16.6273 ZM 190.2721,16.3450 c 0.0000,0.6160 0.3978,0.9112 0.3978 0.9112c 0.3978,0.2952 1.0652,0.2952 1.0652 0.2952c 0.6674,0.0000 1.1294,-0.2823 1.1294 -0.2823c 0.4620,-0.2823 0.9754,-0.7957 0.9754 -0.7957v -2.2331 c -2.0277,0.2823 -2.7977,0.8214 -2.7977 0.8214c -0.7700,0.5390 -0.7700,1.2834 -0.7700 1.2834ZM 199.1786,20.1694 ZM 200.8470,2.1766 h 3.6704 v 10.3183 h 0.1027 l 4.0298,-5.0565 h 4.1068 l -4.4661,5.2361 l 4.7998,7.4949 h -4.0811 l -2.8747,-4.9538 l -1.6170,1.8224 v 3.1314 h -3.6704 v -17.9928 ZM 212.5257,20.1694 ZM 213.4497,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 213.4497,13.8039 ZM 221.6632,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 225.8214,20.1694 ZM 227.4897,7.4384 h 3.0801 l 0.2567,1.6170 h 0.1027 c 0.8214,-0.7700 1.7967,-1.3475 1.7967 -1.3475c 0.9754,-0.5775 2.2844,-0.5775 2.2844 -0.5775c 2.0791,0.0000 3.0159,1.3604 3.0159 1.3604c 0.9369,1.3604 0.9369,3.7731 0.9369 3.7731v 7.9055 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.7187,-0.0000 -1.2320,0.3208 -1.2320 0.3208c -0.5133,0.3208 -1.1294,0.9112 -1.1294 0.9112v 8.5986 h -3.7731 v -12.7310 ZM 245.8419,20.1694 ZM 247.5103,2.1766 h 3.7731 v 4.4148 l -0.1027,1.9507 c 0.7444,-0.6674 1.6042,-1.0395 1.6042 -1.0395c 0.8599,-0.3722 1.7582,-0.3722 1.7582 -0.3722c 1.1550,0.0000 2.0791,0.4620 2.0791 0.4620c 0.9240,0.4620 1.5785,1.2962 1.5785 1.2962c 0.6545,0.8342 1.0010,2.0277 1.0010 2.0277c 0.3465,1.1935 0.3465,2.6566 0.3465 2.6566c 0.0000,1.6427 -0.4492,2.9261 -0.4492 2.9261c -0.4492,1.2834 -1.2064,2.1689 -1.2064 2.1689c -0.7572,0.8855 -1.7197,1.3475 -1.7197 1.3475c -0.9625,0.4620 -1.9892,0.4620 -1.9892 0.4620c -0.8470,-0.0000 -1.7069,-0.4107 -1.7069 -0.4107c -0.8599,-0.4107 -1.6042,-1.2320 -1.6042 -1.2320h -0.1027 l -0.3080,1.3347 h -2.9517 v -17.9928 ZM 247.5103,2.1766 ZM 251.2834,16.5760 c 0.5133,0.4620 1.0267,0.6417 1.0267 0.6417c 0.5133,0.1797 1.0010,0.1797 1.0010 0.1797c 0.9754,0.0000 1.6684,-0.8855 1.6684 -0.8855c 0.6930,-0.8855 0.6930,-2.8619 0.6930 -2.8619c 0.0000,-3.4394 -2.2074,-3.4394 -2.2074 -3.4394c -1.1294,-0.0000 -2.1817,1.1550 -2.1817 1.1550v 5.2105 ZM 260.3439,20.1694 ZM 262.2947,22.0175 c 0.1797,0.0513 0.4107,0.1027 0.4107 0.1027c 0.2310,0.0513 0.4363,0.0513 0.4363 0.0513c 0.9497,0.0000 1.4630,-0.4620 1.4630 -0.4620c 0.5133,-0.4620 0.7700,-1.2064 0.7700 -1.2064l 0.1797,-0.6674 l -4.9025,-12.3973 h 3.7988 l 1.8224,5.4671 c 0.2823,0.8727 0.5133,1.7710 0.5133 1.7710c 0.2310,0.8984 0.4877,1.8480 0.4877 1.8480h 0.1027 c 0.2053,-0.8984 0.4235,-1.8095 0.4235 -1.8095c 0.2182,-0.9112 0.4492,-1.8095 0.4492 -1.8095l 1.5400,-5.4671 h 3.6191 l -4.4148,12.8593 c -0.4620,1.2064 -0.9625,2.1176 -0.9625 2.1176c -0.5005,0.9112 -1.1550,1.5144 -1.1550 1.5144c -0.6545,0.6032 -1.4887,0.9112 -1.4887 0.9112c -0.8342,0.3080 -1.9636,0.3080 -1.9636 0.3080c -0.5903,-0.0000 -1.0010,-0.0642 -1.0010 -0.0642c -0.4107,-0.0642 -0.7957,-0.1925 -0.7957 -0.1925l 0.6674,-2.8747 h 0.0000 ZM 279.0554,20.1694 ZM 281.1345,5.9754 l -0.1283,-3.4138 h 3.7988 l -0.1283,3.4138 l -0.7444,5.1078 h -2.0534 ZM 286.7556,20.1694 ZM 288.4240,2.1766 h 3.7731 v 14.1940 c 0.0000,0.5903 0.2182,0.8214 0.2182 0.8214c 0.2182,0.2310 0.4492,0.2310 0.4492 0.2310h 0.2182 c 0.0000,0.0000 0.2438,-0.0513 0.2438 -0.0513l 0.4620,2.7977 c -0.3080,0.1283 -0.7829,0.2182 -0.7829 0.2182c -0.4748,0.0898 -1.1165,0.0898 -1.1165 0.0898c -0.9754,-0.0000 -1.6427,-0.3080 -1.6427 -0.3080c -0.6674,-0.3080 -1.0652,-0.8599 -1.0652 -0.8599c -0.3978,-0.5518 -0.5775,-1.3347 -0.5775 -1.3347c -0.1797,-0.7829 -0.1797,-1.7582 -0.1797 -1.7582v -14.0400 ZM 294.0965,20.1694 ZM 297.6386,5.5647 c -0.9497,-0.0000 -1.5657,-0.5518 -1.5657 -0.5518c -0.6160,-0.5518 -0.6160,-1.4245 -0.6160 -1.4245c 0.0000,-0.8727 0.6160,-1.4117 0.6160 -1.4117c 0.6160,-0.5390 1.5657,-0.5390 1.5657 -0.5390c 0.9754,0.0000 1.5785,0.5390 1.5785 0.5390c 0.6032,0.5390 0.6032,1.4117 0.6032 1.4117c 0.0000,0.8727 -0.6032,1.4245 -0.6032 1.4245c -0.6032,0.5518 -1.5785,0.5518 -1.5785 0.5518ZM 297.6386,5.5647 ZM 295.7649,7.4384 h 3.7731 v 12.7310 h -3.7731 v -12.7310 ZM 301.1807,20.1694 ZM 303.4138,16.3450 c 0.8727,0.6674 1.6684,1.0010 1.6684 1.0010c 0.7957,0.3337 1.6170,0.3337 1.6170 0.3337c 0.8470,0.0000 1.2320,-0.2823 1.2320 -0.2823c 0.3850,-0.2823 0.3850,-0.7957 0.3850 -0.7957c 0.0000,-0.3080 -0.2182,-0.5518 -0.2182 -0.5518c -0.2182,-0.2438 -0.5903,-0.4492 -0.5903 -0.4492c -0.3722,-0.2053 -0.8342,-0.3722 -0.8342 -0.3722c -0.4620,-0.1668 -0.9497,-0.3722 -0.9497 -0.3722c -0.5903,-0.2310 -1.1807,-0.5390 -1.1807 -0.5390c -0.5903,-0.3080 -1.0780,-0.7572 -1.0780 -0.7572c -0.4877,-0.4492 -0.7957,-1.0524 -0.7957 -1.0524c -0.3080,-0.6032 -0.3080,-1.3989 -0.3080 -1.3989c 0.0000,-0.8727 0.3465,-1.6170 0.3465 -1.6170c 0.3465,-0.7444 0.9882,-1.2577 0.9882 -1.2577c 0.6417,-0.5133 1.5400,-0.8085 1.5400 -0.8085c 0.8984,-0.2952 2.0021,-0.2952 2.0021 -0.2952c 1.4630,0.0000 2.5667,0.5005 2.5667 0.5005c 1.1037,0.5005 1.9251,1.1165 1.9251 1.1165l -1.6940,2.2587 c -0.6930,-0.5133 -1.3604,-0.7957 -1.3604 -0.7957c -0.6674,-0.2823 -1.3347,-0.2823 -1.3347 -0.2823c -1.4374,-0.0000 -1.4374,1.0010 -1.4374 1.0010c 0.0000,0.3080 0.2053,0.5262 0.2053 0.5262c 0.2053,0.2182 0.5518,0.3978 0.5518 0.3978c 0.3465,0.1797 0.7957,0.3465 0.7957 0.3465c 0.4492,0.1668 0.9369,0.3465 0.9369 0.3465c 0.6160,0.2310 1.2192,0.5262 1.2192 0.5262c 0.6032,0.2952 1.1037,0.7315 1.1037 0.7315c 0.5005,0.4363 0.8085,1.0652 0.8085 1.0652c 0.3080,0.6289 0.3080,1.5015 0.3080 1.5015c 0.0000,0.8727 -0.3337,1.6170 -0.3337 1.6170c -0.3337,0.7444 -1.0010,1.2962 -1.0010 1.2962c -0.6674,0.5518 -1.6427,0.8727 -1.6427 0.8727c -0.9754,0.3208 -2.2587,0.3208 -2.2587 0.3208c -1.2577,-0.0000 -2.5796,-0.4877 -2.5796 -0.4877c -1.3219,-0.4877 -2.2972,-1.2834 -2.2972 -1.2834ZM 312.5513,20.1694 ZM 314.7331,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 322.3819,20.1694 ZM 324.4610,5.9754 l -0.1283,-3.4138 h 3.7988 l -0.1283,3.4138 l -0.7444,5.1078 h -2.0534 ZM 335.4209,20.1694 ZM 336.6273,16.6273 c 0.0000,-2.0021 1.6940,-3.1314 1.6940 -3.1314c 1.6940,-1.1294 5.4671,-1.5144 5.4671 -1.5144c -0.0513,-0.8470 -0.5133,-1.3475 -0.5133 -1.3475c -0.4620,-0.5005 -1.4887,-0.5005 -1.4887 -0.5005c -0.8214,-0.0000 -1.6427,0.3080 -1.6427 0.3080c -0.8214,0.3080 -1.7454,0.8470 -1.7454 0.8470l -1.3347,-2.4897 c 1.2320,-0.7444 2.5796,-1.2064 2.5796 -1.2064c 1.3475,-0.4620 2.8619,-0.4620 2.8619 -0.4620c 2.4641,0.0000 3.7603,1.3989 3.7603 1.3989c 1.2962,1.3989 1.2962,4.3506 1.2962 4.3506v 7.2895 h -3.0801 l -0.2823,-1.3090 h -0.0770 c -0.8214,0.7187 -1.7325,1.1679 -1.7325 1.1679c -0.9112,0.4492 -1.9892,0.4492 -1.9892 0.4492c -0.8727,-0.0000 -1.5657,-0.2952 -1.5657 -0.2952c -0.6930,-0.2952 -1.1807,-0.8214 -1.1807 -0.8214c -0.4877,-0.5262 -0.7572,-1.2192 -0.7572 -1.2192c -0.2695,-0.6930 -0.2695,-1.5144 -0.2695 -1.5144ZM 336.6273,16.6273 ZM 340.2207,16.3450 c 0.0000,0.6160 0.3978,0.9112 0.3978 0.9112c 0.3978,0.2952 1.0652,0.2952 1.0652 0.2952c 0.6674,0.0000 1.1294,-0.2823 1.1294 -0.2823c 0.4620,-0.2823 0.9754,-0.7957 0.9754 -0.7957v -2.2331 c -2.0277,0.2823 -2.7977,0.8214 -2.7977 0.8214c -0.7700,0.5390 -0.7700,1.2834 -0.7700 1.2834ZM 349.1273,20.1694 ZM 351.3604,16.3450 c 0.8727,0.6674 1.6684,1.0010 1.6684 1.0010c 0.7957,0.3337 1.6170,0.3337 1.6170 0.3337c 0.8470,0.0000 1.2320,-0.2823 1.2320 -0.2823c 0.3850,-0.2823 0.3850,-0.7957 0.3850 -0.7957c 0.0000,-0.3080 -0.2182,-0.5518 -0.2182 -0.5518c -0.2182,-0.2438 -0.5903,-0.4492 -0.5903 -0.4492c -0.3722,-0.2053 -0.8342,-0.3722 -0.8342 -0.3722c -0.4620,-0.1668 -0.9497,-0.3722 -0.9497 -0.3722c -0.5903,-0.2310 -1.1807,-0.5390 -1.1807 -0.5390c -0.5903,-0.3080 -1.0780,-0.7572 -1.0780 -0.7572c -0.4877,-0.4492 -0.7957,-1.0524 -0.7957 -1.0524c -0.3080,-0.6032 -0.3080,-1.3989 -0.3080 -1.3989c 0.0000,-0.8727 0.3465,-1.6170 0.3465 -1.6170c 0.3465,-0.7444 0.9882,-1.2577 0.9882 -1.2577c 0.6417,-0.5133 1.5400,-0.8085 1.5400 -0.8085c 0.8984,-0.2952 2.0021,-0.2952 2.0021 -0.2952c 1.4630,0.0000 2.5667,0.5005 2.5667 0.5005c 1.1037,0.5005 1.9251,1.1165 1.9251 1.1165l -1.6940,2.2587 c -0.6930,-0.5133 -1.3604,-0.7957 -1.3604 -0.7957c -0.6674,-0.2823 -1.3347,-0.2823 -1.3347 -0.2823c -1.4374,-0.0000 -1.4374,1.0010 -1.4374 1.0010c 0.0000,0.3080 0.2053,0.5262 0.2053 0.5262c 0.2053,0.2182 0.5518,0.3978 0.5518 0.3978c 0.3465,0.1797 0.7957,0.3465 0.7957 0.3465c 0.4492,0.1668 0.9369,0.3465 0.9369 0.3465c 0.6160,0.2310 1.2192,0.5262 1.2192 0.5262c 0.6032,0.2952 1.1037,0.7315 1.1037 0.7315c 0.5005,0.4363 0.8085,1.0652 0.8085 1.0652c 0.3080,0.6289 0.3080,1.5015 0.3080 1.5015c 0.0000,0.8727 -0.3337,1.6170 -0.3337 1.6170c -0.3337,0.7444 -1.0010,1.2962 -1.0010 1.2962c -0.6674,0.5518 -1.6427,0.8727 -1.6427 0.8727c -0.9754,0.3208 -2.2587,0.3208 -2.2587 0.3208c -1.2577,-0.0000 -2.5796,-0.4877 -2.5796 -0.4877c -1.3219,-0.4877 -2.2972,-1.2834 -2.2972 -1.2834ZM 365.8368,20.1694 ZM 367.5051,7.4384 h 3.0801 l 0.2567,1.6427 h 0.1027 c 0.7957,-0.7957 1.6940,-1.3732 1.6940 -1.3732c 0.8984,-0.5775 2.1561,-0.5775 2.1561 -0.5775c 1.3604,0.0000 2.1946,0.5518 2.1946 0.5518c 0.8342,0.5518 1.3219,1.5785 1.3219 1.5785c 0.8470,-0.8727 1.7839,-1.5015 1.7839 -1.5015c 0.9369,-0.6289 2.2202,-0.6289 2.2202 -0.6289c 2.0534,0.0000 3.0159,1.3732 3.0159 1.3732c 0.9625,1.3732 0.9625,3.7603 0.9625 3.7603v 7.9055 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9497,-0.0000 -2.1817,1.2320 -2.1817 1.2320v 8.5986 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9754,-0.0000 -2.1561,1.2320 -2.1561 1.2320v 8.5986 h -3.7731 v -12.7310 ZM 387.8337,20.1694 ZM 389.3737,7.4384 h 3.7731 v 7.4179 c 0.0000,1.3860 0.3850,1.8994 0.3850 1.8994c 0.3850,0.5133 1.2064,0.5133 1.2064 0.5133c 0.7187,0.0000 1.2064,-0.3337 1.2064 -0.3337c 0.4877,-0.3337 1.0524,-1.0780 1.0524 -1.0780v -8.4189 h 3.7731 v 12.7310 h -3.0801 l -0.2823,-1.7710 h -0.0770 c -0.8214,0.9754 -1.7582,1.5272 -1.7582 1.5272c -0.9369,0.5518 -2.2459,0.5518 -2.2459 0.5518c -2.0791,-0.0000 -3.0159,-1.3604 -3.0159 -1.3604c -0.9369,-1.3604 -0.9369,-3.7731 -0.9369 -3.7731v -7.9055 ZM 402.4127,20.1694 ZM 404.0811,2.1766 h 3.7731 v 14.1940 c 0.0000,0.5903 0.2182,0.8214 0.2182 0.8214c 0.2182,0.2310 0.4492,0.2310 0.4492 0.2310h 0.2182 c 0.0000,0.0000 0.2438,-0.0513 0.2438 -0.0513l 0.4620,2.7977 c -0.3080,0.1283 -0.7829,0.2182 -0.7829 0.2182c -0.4748,0.0898 -1.1165,0.0898 -1.1165 0.0898c -0.9754,-0.0000 -1.6427,-0.3080 -1.6427 -0.3080c -0.6674,-0.3080 -1.0652,-0.8599 -1.0652 -0.8599c -0.3978,-0.5518 -0.5775,-1.3347 -0.5775 -1.3347c -0.1797,-0.7829 -0.1797,-1.7582 -0.1797 -1.7582v -14.0400 ZM 409.7536,20.1694 ZM 411.9353,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 419.5842,20.1694 ZM 423.1263,5.5647 c -0.9497,-0.0000 -1.5657,-0.5518 -1.5657 -0.5518c -0.6160,-0.5518 -0.6160,-1.4245 -0.6160 -1.4245c 0.0000,-0.8727 0.6160,-1.4117 0.6160 -1.4117c 0.6160,-0.5390 1.5657,-0.5390 1.5657 -0.5390c 0.9754,0.0000 1.5785,0.5390 1.5785 0.5390c 0.6032,0.5390 0.6032,1.4117 0.6032 1.4117c 0.0000,0.8727 -0.6032,1.4245 -0.6032 1.4245c -0.6032,0.5518 -1.5785,0.5518 -1.5785 0.5518ZM 423.1263,5.5647 ZM 421.2526,7.4384 h 3.7731 v 12.7310 h -3.7731 v -12.7310 ZM 426.6684,20.1694 ZM 432.1099,21.1704 v 3.7218 h -3.7731 v -17.4538 h 3.0801 l 0.2567,1.2577 h 0.1027 c 0.7444,-0.6674 1.6812,-1.1165 1.6812 -1.1165c 0.9369,-0.4492 1.9379,-0.4492 1.9379 -0.4492c 1.1550,0.0000 2.0791,0.4620 2.0791 0.4620c 0.9240,0.4620 1.5657,1.3090 1.5657 1.3090c 0.6417,0.8470 0.9882,2.0406 0.9882 2.0406c 0.3465,1.1935 0.3465,2.6566 0.3465 2.6566c 0.0000,1.6427 -0.4492,2.9132 -0.4492 2.9132c -0.4492,1.2705 -1.2064,2.1561 -1.2064 2.1561c -0.7572,0.8855 -1.7197,1.3475 -1.7197 1.3475c -0.9625,0.4620 -1.9892,0.4620 -1.9892 0.4620c -0.8214,-0.0000 -1.5914,-0.3465 -1.5914 -0.3465c -0.7700,-0.3465 -1.4374,-0.9882 -1.4374 -0.9882ZM 432.1099,21.1704 ZM 432.1099,16.5760 c 0.5133,0.4620 1.0267,0.6417 1.0267 0.6417c 0.5133,0.1797 1.0010,0.1797 1.0010 0.1797c 0.9754,0.0000 1.6684,-0.8855 1.6684 -0.8855c 0.6930,-0.8855 0.6930,-2.8619 0.6930 -2.8619c 0.0000,-3.4394 -2.2074,-3.4394 -2.2074 -3.4394c -1.1037,-0.0000 -2.1817,1.1550 -2.1817 1.1550v 5.2105 ZM 441.3758,20.1694 ZM 443.0441,2.1766 h 3.7731 v 14.1940 c 0.0000,0.5903 0.2182,0.8214 0.2182 0.8214c 0.2182,0.2310 0.4492,0.2310 0.4492 0.2310h 0.2182 c 0.0000,0.0000 0.2438,-0.0513 0.2438 -0.0513l 0.4620,2.7977 c -0.3080,0.1283 -0.7829,0.2182 -0.7829 0.2182c -0.4748,0.0898 -1.1165,0.0898 -1.1165 0.0898c -0.9754,-0.0000 -1.6427,-0.3080 -1.6427 -0.3080c -0.6674,-0.3080 -1.0652,-0.8599 -1.0652 -0.8599c -0.3978,-0.5518 -0.5775,-1.3347 -0.5775 -1.3347c -0.1797,-0.7829 -0.1797,-1.7582 -0.1797 -1.7582v -14.0400 ZM 448.7166,20.1694 ZM 449.6407,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 449.6407,13.8039 ZM 457.8542,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 462.0123,20.1694 ZM 464.2454,16.3450 c 0.8727,0.6674 1.6684,1.0010 1.6684 1.0010c 0.7957,0.3337 1.6170,0.3337 1.6170 0.3337c 0.8470,0.0000 1.2320,-0.2823 1.2320 -0.2823c 0.3850,-0.2823 0.3850,-0.7957 0.3850 -0.7957c 0.0000,-0.3080 -0.2182,-0.5518 -0.2182 -0.5518c -0.2182,-0.2438 -0.5903,-0.4492 -0.5903 -0.4492c -0.3722,-0.2053 -0.8342,-0.3722 -0.8342 -0.3722c -0.4620,-0.1668 -0.9497,-0.3722 -0.9497 -0.3722c -0.5903,-0.2310 -1.1807,-0.5390 -1.1807 -0.5390c -0.5903,-0.3080 -1.0780,-0.7572 -1.0780 -0.7572c -0.4877,-0.4492 -0.7957,-1.0524 -0.7957 -1.0524c -0.3080,-0.6032 -0.3080,-1.3989 -0.3080 -1.3989c 0.0000,-0.8727 0.3465,-1.6170 0.3465 -1.6170c 0.3465,-0.7444 0.9882,-1.2577 0.9882 -1.2577c 0.6417,-0.5133 1.5400,-0.8085 1.5400 -0.8085c 0.8984,-0.2952 2.0021,-0.2952 2.0021 -0.2952c 1.4630,0.0000 2.5667,0.5005 2.5667 0.5005c 1.1037,0.5005 1.9251,1.1165 1.9251 1.1165l -1.6940,2.2587 c -0.6930,-0.5133 -1.3604,-0.7957 -1.3604 -0.7957c -0.6674,-0.2823 -1.3347,-0.2823 -1.3347 -0.2823c -1.4374,-0.0000 -1.4374,1.0010 -1.4374 1.0010c 0.0000,0.3080 0.2053,0.5262 0.2053 0.5262c 0.2053,0.2182 0.5518,0.3978 0.5518 0.3978c 0.3465,0.1797 0.7957,0.3465 0.7957 0.3465c 0.4492,0.1668 0.9369,0.3465 0.9369 0.3465c 0.6160,0.2310 1.2192,0.5262 1.2192 0.5262c 0.6032,0.2952 1.1037,0.7315 1.1037 0.7315c 0.5005,0.4363 0.8085,1.0652 0.8085 1.0652c 0.3080,0.6289 0.3080,1.5015 0.3080 1.5015c 0.0000,0.8727 -0.3337,1.6170 -0.3337 1.6170c -0.3337,0.7444 -1.0010,1.2962 -1.0010 1.2962c -0.6674,0.5518 -1.6427,0.8727 -1.6427 0.8727c -0.9754,0.3208 -2.2587,0.3208 -2.2587 0.3208c -1.2577,-0.0000 -2.5796,-0.4877 -2.5796 -0.4877c -1.3219,-0.4877 -2.2972,-1.2834 -2.2972 -1.2834ZM 478.7218,20.1694 ZM 479.6458,13.8039 c 0.0000,-1.5914 0.5133,-2.8362 0.5133 -2.8362c 0.5133,-1.2449 1.3732,-2.0919 1.3732 -2.0919c 0.8599,-0.8470 1.9892,-1.2962 1.9892 -1.2962c 1.1294,-0.4492 2.3357,-0.4492 2.3357 -0.4492c 1.2064,0.0000 2.3229,0.4492 2.3229 0.4492c 1.1165,0.4492 1.9764,1.2962 1.9764 1.2962c 0.8599,0.8470 1.3732,2.0919 1.3732 2.0919c 0.5133,1.2449 0.5133,2.8362 0.5133 2.8362c 0.0000,1.5914 -0.5133,2.8362 -0.5133 2.8362c -0.5133,1.2449 -1.3732,2.0919 -1.3732 2.0919c -0.8599,0.8470 -1.9764,1.2962 -1.9764 1.2962c -1.1165,0.4492 -2.3229,0.4492 -2.3229 0.4492c -1.2064,-0.0000 -2.3357,-0.4492 -2.3357 -0.4492c -1.1294,-0.4492 -1.9892,-1.2962 -1.9892 -1.2962c -0.8599,-0.8470 -1.3732,-2.0919 -1.3732 -2.0919c -0.5133,-1.2449 -0.5133,-2.8362 -0.5133 -2.8362ZM 479.6458,13.8039 ZM 483.5216,13.8039 c 0.0000,1.6684 0.5775,2.6437 0.5775 2.6437c 0.5775,0.9754 1.7582,0.9754 1.7582 0.9754c 1.1550,0.0000 1.7454,-0.9754 1.7454 -0.9754c 0.5903,-0.9754 0.5903,-2.6437 0.5903 -2.6437c 0.0000,-1.6684 -0.5903,-2.6437 -0.5903 -2.6437c -0.5903,-0.9754 -1.7454,-0.9754 -1.7454 -0.9754c -1.1807,-0.0000 -1.7582,0.9754 -1.7582 0.9754c -0.5775,0.9754 -0.5775,2.6437 -0.5775 2.6437ZM 492.8388,20.1694 ZM 501.6940,5.1027 c -0.7187,-0.2567 -1.3090,-0.2567 -1.3090 -0.2567c -0.6930,-0.0000 -1.0780,0.4235 -1.0780 0.4235c -0.3850,0.4235 -0.3850,1.3989 -0.3850 1.3989v 0.7700 h 2.2844 v 2.9517 h -2.2844 v 9.7793 h -3.7731 v -9.7793 h -1.6940 v -2.7977 l 1.6940,-0.1283 v -0.6930 c 0.0000,-1.0010 0.2438,-1.8994 0.2438 -1.8994c 0.2438,-0.8984 0.8085,-1.5657 0.8085 -1.5657c 0.5647,-0.6674 1.4630,-1.0524 1.4630 -1.0524c 0.8984,-0.3850 2.1817,-0.3850 2.1817 -0.3850c 0.7957,0.0000 1.4502,0.1540 1.4502 0.1540c 0.6545,0.1540 1.0909,0.3080 1.0909 0.3080ZM 506.9302,20.1694 ZM 509.0092,5.9754 l -0.1283,-3.4138 h 3.7988 l -0.1283,3.4138 l -0.7444,5.1078 h -2.0534 ZM 514.6304,20.1694 ZM 520.0719,21.1704 v 3.7218 h -3.7731 v -17.4538 h 3.0801 l 0.2567,1.2577 h 0.1027 c 0.7444,-0.6674 1.6812,-1.1165 1.6812 -1.1165c 0.9369,-0.4492 1.9379,-0.4492 1.9379 -0.4492c 1.1550,0.0000 2.0791,0.4620 2.0791 0.4620c 0.9240,0.4620 1.5657,1.3090 1.5657 1.3090c 0.6417,0.8470 0.9882,2.0406 0.9882 2.0406c 0.3465,1.1935 0.3465,2.6566 0.3465 2.6566c 0.0000,1.6427 -0.4492,2.9132 -0.4492 2.9132c -0.4492,1.2705 -1.2064,2.1561 -1.2064 2.1561c -0.7572,0.8855 -1.7197,1.3475 -1.7197 1.3475c -0.9625,0.4620 -1.9892,0.4620 -1.9892 0.4620c -0.8214,-0.0000 -1.5914,-0.3465 -1.5914 -0.3465c -0.7700,-0.3465 -1.4374,-0.9882 -1.4374 -0.9882ZM 520.0719,21.1704 ZM 520.0719,16.5760 c 0.5133,0.4620 1.0267,0.6417 1.0267 0.6417c 0.5133,0.1797 1.0010,0.1797 1.0010 0.1797c 0.9754,0.0000 1.6684,-0.8855 1.6684 -0.8855c 0.6930,-0.8855 0.6930,-2.8619 0.6930 -2.8619c 0.0000,-3.4394 -2.2074,-3.4394 -2.2074 -3.4394c -1.1037,-0.0000 -2.1817,1.1550 -2.1817 1.1550v 5.2105 ZM 529.3378,20.1694 ZM 530.8778,7.4384 h 3.7731 v 7.4179 c 0.0000,1.3860 0.3850,1.8994 0.3850 1.8994c 0.3850,0.5133 1.2064,0.5133 1.2064 0.5133c 0.7187,0.0000 1.2064,-0.3337 1.2064 -0.3337c 0.4877,-0.3337 1.0524,-1.0780 1.0524 -1.0780v -8.4189 h 3.7731 v 12.7310 h -3.0801 l -0.2823,-1.7710 h -0.0770 c -0.8214,0.9754 -1.7582,1.5272 -1.7582 1.5272c -0.9369,0.5518 -2.2459,0.5518 -2.2459 0.5518c -2.0791,-0.0000 -3.0159,-1.3604 -3.0159 -1.3604c -0.9369,-1.3604 -0.9369,-3.7731 -0.9369 -3.7731v -7.9055 ZM 543.9168,20.1694 ZM 545.5852,7.4384 h 3.0801 l 0.2567,2.2331 h 0.1027 c 0.6930,-1.3090 1.6684,-1.9251 1.6684 -1.9251c 0.9754,-0.6160 1.9507,-0.6160 1.9507 -0.6160c 0.5390,0.0000 0.8855,0.0642 0.8855 0.0642c 0.3465,0.0642 0.6289,0.1925 0.6289 0.1925l -0.6160,3.2598 c -0.3593,-0.1027 -0.6674,-0.1540 -0.6674 -0.1540c -0.3080,-0.0513 -0.7187,-0.0513 -0.7187 -0.0513c -0.7187,-0.0000 -1.5015,0.5133 -1.5015 0.5133c -0.7829,0.5133 -1.2962,1.8224 -1.2962 1.8224v 7.3922 h -3.7731 v -12.7310 ZM 553.8758,20.1694 ZM 554.7998,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 554.7998,13.8039 ZM 563.0133,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 567.1715,20.1694 ZM 568.2752,12.3409 h 6.3142 v 2.6694 h -6.3142 v -2.6694 ZM 575.6930,20.1694 ZM 577.9261,16.3450 c 0.8727,0.6674 1.6684,1.0010 1.6684 1.0010c 0.7957,0.3337 1.6170,0.3337 1.6170 0.3337c 0.8470,0.0000 1.2320,-0.2823 1.2320 -0.2823c 0.3850,-0.2823 0.3850,-0.7957 0.3850 -0.7957c 0.0000,-0.3080 -0.2182,-0.5518 -0.2182 -0.5518c -0.2182,-0.2438 -0.5903,-0.4492 -0.5903 -0.4492c -0.3722,-0.2053 -0.8342,-0.3722 -0.8342 -0.3722c -0.4620,-0.1668 -0.9497,-0.3722 -0.9497 -0.3722c -0.5903,-0.2310 -1.1807,-0.5390 -1.1807 -0.5390c -0.5903,-0.3080 -1.0780,-0.7572 -1.0780 -0.7572c -0.4877,-0.4492 -0.7957,-1.0524 -0.7957 -1.0524c -0.3080,-0.6032 -0.3080,-1.3989 -0.3080 -1.3989c 0.0000,-0.8727 0.3465,-1.6170 0.3465 -1.6170c 0.3465,-0.7444 0.9882,-1.2577 0.9882 -1.2577c 0.6417,-0.5133 1.5400,-0.8085 1.5400 -0.8085c 0.8984,-0.2952 2.0021,-0.2952 2.0021 -0.2952c 1.4630,0.0000 2.5667,0.5005 2.5667 0.5005c 1.1037,0.5005 1.9251,1.1165 1.9251 1.1165l -1.6940,2.2587 c -0.6930,-0.5133 -1.3604,-0.7957 -1.3604 -0.7957c -0.6674,-0.2823 -1.3347,-0.2823 -1.3347 -0.2823c -1.4374,-0.0000 -1.4374,1.0010 -1.4374 1.0010c 0.0000,0.3080 0.2053,0.5262 0.2053 0.5262c 0.2053,0.2182 0.5518,0.3978 0.5518 0.3978c 0.3465,0.1797 0.7957,0.3465 0.7957 0.3465c 0.4492,0.1668 0.9369,0.3465 0.9369 0.3465c 0.6160,0.2310 1.2192,0.5262 1.2192 0.5262c 0.6032,0.2952 1.1037,0.7315 1.1037 0.7315c 0.5005,0.4363 0.8085,1.0652 0.8085 1.0652c 0.3080,0.6289 0.3080,1.5015 0.3080 1.5015c 0.0000,0.8727 -0.3337,1.6170 -0.3337 1.6170c -0.3337,0.7444 -1.0010,1.2962 -1.0010 1.2962c -0.6674,0.5518 -1.6427,0.8727 -1.6427 0.8727c -0.9754,0.3208 -2.2587,0.3208 -2.2587 0.3208c -1.2577,-0.0000 -2.5796,-0.4877 -2.5796 -0.4877c -1.3219,-0.4877 -2.2972,-1.2834 -2.2972 -1.2834ZM 587.0637,20.1694 ZM 589.2454,10.3901 h -1.7454 v -2.7977 l 1.9507,-0.1540 l 0.4363,-3.3881 h 3.1314 v 3.3881 h 3.0544 v 2.9517 h -3.0544 v 5.1078 c 0.0000,1.0780 0.4492,1.5529 0.4492 1.5529c 0.4492,0.4748 1.1935,0.4748 1.1935 0.4748c 0.3080,0.0000 0.6289,-0.0770 0.6289 -0.0770c 0.3208,-0.0770 0.5775,-0.1797 0.5775 -0.1797l 0.5903,2.7464 c -0.5133,0.1540 -1.2064,0.3080 -1.2064 0.3080c -0.6930,0.1540 -1.6170,0.1540 -1.6170 0.1540c -1.1807,-0.0000 -2.0149,-0.3593 -2.0149 -0.3593c -0.8342,-0.3593 -1.3604,-1.0010 -1.3604 -1.0010c -0.5262,-0.6417 -0.7700,-1.5529 -0.7700 -1.5529c -0.2438,-0.9112 -0.2438,-2.0149 -0.2438 -2.0149v -5.1591 ZM 596.8943,20.1694 ZM 598.5626,7.4384 h 3.0801 l 0.2567,2.2331 h 0.1027 c 0.6930,-1.3090 1.6684,-1.9251 1.6684 -1.9251c 0.9754,-0.6160 1.9507,-0.6160 1.9507 -0.6160c 0.5390,0.0000 0.8855,0.0642 0.8855 0.0642c 0.3465,0.0642 0.6289,0.1925 0.6289 0.1925l -0.6160,3.2598 c -0.3593,-0.1027 -0.6674,-0.1540 -0.6674 -0.1540c -0.3080,-0.0513 -0.7187,-0.0513 -0.7187 -0.0513c -0.7187,-0.0000 -1.5015,0.5133 -1.5015 0.5133c -0.7829,0.5133 -1.2962,1.8224 -1.2962 1.8224v 7.3922 h -3.7731 v -12.7310 ZM 606.8532,20.1694 ZM 607.7772,13.8039 c 0.0000,-1.5400 0.5133,-2.7849 0.5133 -2.7849c 0.5133,-1.2449 1.3475,-2.1047 1.3475 -2.1047c 0.8342,-0.8599 1.9122,-1.3219 1.9122 -1.3219c 1.0780,-0.4620 2.2331,-0.4620 2.2331 -0.4620c 1.3604,0.0000 2.3742,0.4620 2.3742 0.4620c 1.0139,0.4620 1.6940,1.2834 1.6940 1.2834c 0.6802,0.8214 1.0139,1.9379 1.0139 1.9379c 0.3337,1.1165 0.3337,2.4256 0.3337 2.4256c 0.0000,0.5133 -0.0513,0.9369 -0.0513 0.9369c -0.0513,0.4235 -0.1027,0.6545 -0.1027 0.6545h -7.6232 c 0.2567,1.4630 1.1422,2.1176 1.1422 2.1176c 0.8855,0.6545 2.1689,0.6545 2.1689 0.6545c 1.3604,0.0000 2.7464,-0.8470 2.7464 -0.8470l 1.2577,2.2844 c -0.9754,0.6674 -2.1689,1.0524 -2.1689 1.0524c -1.1935,0.3850 -2.3486,0.3850 -2.3486 0.3850c -1.3604,-0.0000 -2.5411,-0.4492 -2.5411 -0.4492c -1.1807,-0.4492 -2.0534,-1.3090 -2.0534 -1.3090c -0.8727,-0.8599 -1.3604,-2.0919 -1.3604 -2.0919c -0.4877,-1.2320 -0.4877,-2.8234 -0.4877 -2.8234ZM 607.7772,13.8039 ZM 615.9908,12.4949 c 0.0000,-1.1037 -0.4877,-1.7967 -0.4877 -1.7967c -0.4877,-0.6930 -1.6427,-0.6930 -1.6427 -0.6930c -0.8984,-0.0000 -1.5785,0.6032 -1.5785 0.6032c -0.6802,0.6032 -0.8855,1.8866 -0.8855 1.8866h 4.5945 ZM 619.8665,20.1694 ZM 621.0729,16.6273 c 0.0000,-2.0021 1.6940,-3.1314 1.6940 -3.1314c 1.6940,-1.1294 5.4671,-1.5144 5.4671 -1.5144c -0.0513,-0.8470 -0.5133,-1.3475 -0.5133 -1.3475c -0.4620,-0.5005 -1.4887,-0.5005 -1.4887 -0.5005c -0.8214,-0.0000 -1.6427,0.3080 -1.6427 0.3080c -0.8214,0.3080 -1.7454,0.8470 -1.7454 0.8470l -1.3347,-2.4897 c 1.2320,-0.7444 2.5796,-1.2064 2.5796 -1.2064c 1.3475,-0.4620 2.8619,-0.4620 2.8619 -0.4620c 2.4641,0.0000 3.7603,1.3989 3.7603 1.3989c 1.2962,1.3989 1.2962,4.3506 1.2962 4.3506v 7.2895 h -3.0801 l -0.2823,-1.3090 h -0.0770 c -0.8214,0.7187 -1.7325,1.1679 -1.7325 1.1679c -0.9112,0.4492 -1.9892,0.4492 -1.9892 0.4492c -0.8727,-0.0000 -1.5657,-0.2952 -1.5657 -0.2952c -0.6930,-0.2952 -1.1807,-0.8214 -1.1807 -0.8214c -0.4877,-0.5262 -0.7572,-1.2192 -0.7572 -1.2192c -0.2695,-0.6930 -0.2695,-1.5144 -0.2695 -1.5144ZM 621.0729,16.6273 ZM 624.6663,16.3450 c 0.0000,0.6160 0.3978,0.9112 0.3978 0.9112c 0.3978,0.2952 1.0652,0.2952 1.0652 0.2952c 0.6674,0.0000 1.1294,-0.2823 1.1294 -0.2823c 0.4620,-0.2823 0.9754,-0.7957 0.9754 -0.7957v -2.2331 c -2.0277,0.2823 -2.7977,0.8214 -2.7977 0.8214c -0.7700,0.5390 -0.7700,1.2834 -0.7700 1.2834ZM 633.5729,20.1694 ZM 635.2413,7.4384 h 3.0801 l 0.2567,1.6427 h 0.1027 c 0.7957,-0.7957 1.6940,-1.3732 1.6940 -1.3732c 0.8984,-0.5775 2.1561,-0.5775 2.1561 -0.5775c 1.3604,0.0000 2.1946,0.5518 2.1946 0.5518c 0.8342,0.5518 1.3219,1.5785 1.3219 1.5785c 0.8470,-0.8727 1.7839,-1.5015 1.7839 -1.5015c 0.9369,-0.6289 2.2202,-0.6289 2.2202 -0.6289c 2.0534,0.0000 3.0159,1.3732 3.0159 1.3732c 0.9625,1.3732 0.9625,3.7603 0.9625 3.7603v 7.9055 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9497,-0.0000 -2.1817,1.2320 -2.1817 1.2320v 8.5986 h -3.7731 v -7.4179 c 0.0000,-1.3860 -0.3722,-1.8994 -0.3722 -1.8994c -0.3722,-0.5133 -1.1935,-0.5133 -1.1935 -0.5133c -0.9754,-0.0000 -2.1561,1.2320 -2.1561 1.2320v 8.5986 h -3.7731 v -12.7310 ZM 655.5698,20.1694 ZM 657.2382,2.1766 h 3.7731 v 14.1940 c 0.0000,0.5903 0.2182,0.8214 0.2182 0.8214c 0.2182,0.2310 0.4492,0.2310 0.4492 0.2310h 0.2182 c 0.0000,0.0000 0.2438,-0.0513 0.2438 -0.0513l 0.4620,2.7977 c -0.3080,0.1283 -0.7829,0.2182 -0.7829 0.2182c -0.4748,0.0898 -1.1165,0.0898 -1.1165 0.0898c -0.9754,-0.0000 -1.6427,-0.3080 -1.6427 -0.3080c -0.6674,-0.3080 -1.0652,-0.8599 -1.0652 -0.8599c -0.3978,-0.5518 -0.5775,-1.3347 -0.5775 -1.3347c -0.1797,-0.7829 -0.1797,-1.7582 -0.1797 -1.7582v -14.0400 ZM 662.9107,20.1694 ZM 664.8614,22.0175 c 0.1797,0.0513 0.4107,0.1027 0.4107 0.1027c 0.2310,0.0513 0.4363,0.0513 0.4363 0.0513c 0.9497,0.0000 1.4630,-0.4620 1.4630 -0.4620c 0.5133,-0.4620 0.7700,-1.2064 0.7700 -1.2064l 0.1797,-0.6674 l -4.9025,-12.3973 h 3.7988 l 1.8224,5.4671 c 0.2823,0.8727 0.5133,1.7710 0.5133 1.7710c 0.2310,0.8984 0.4877,1.8480 0.4877 1.8480h 0.1027 c 0.2053,-0.8984 0.4235,-1.8095 0.4235 -1.8095c 0.2182,-0.9112 0.4492,-1.8095 0.4492 -1.8095l 1.5400,-5.4671 h 3.6191 l -4.4148,12.8593 c -0.4620,1.2064 -0.9625,2.1176 -0.9625 2.1176c -0.5005,0.9112 -1.1550,1.5144 -1.1550 1.5144c -0.6545,0.6032 -1.4887,0.9112 -1.4887 0.9112c -0.8342,0.3080 -1.9636,0.3080 -1.9636 0.3080c -0.5903,-0.0000 -1.0010,-0.0642 -1.0010 -0.0642c -0.4107,-0.0642 -0.7957,-0.1925 -0.7957 -0.1925l 0.6674,-2.8747 h 0.0000 ZM 676.2834,20.1694 ZM 678.3624,5.9754 l -0.1283,-3.4138 h 3.7988 l -0.1283,3.4138 l -0.7444,5.1078 h -2.0534 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,444.0000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,364.6000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,285.2000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,205.8000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,126.4000 h 709.5966 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(211,211,211)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-dashoffset="0.0" stroke-linecap="butt" stroke-miterlimit="10.0" stroke-dasharray="4.999999999999998,4.999999999999998"><path d="M 80.4034,47.0000 h 709.5966 "/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip1"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip1)"><path d="M 95.4034,364.6000 v -306.3549 h 17.0946 v 306.3549 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip2"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip2)"><path d="M 112.4980,364.6000 v -219.0632 h 17.0946 v 219.0632 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip3"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip3)"><path d="M 129.5927,364.6000 v -80.0608 h 17.0946 v 80.0608 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip4"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip4)"><path d="M 146.6873,364.6000 v -60.1654 h 17.0946 v 60.1654 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip5"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip5)"><path d="M 163.7820,364.6000 v -53.0481 h 17.0946 v 53.0481 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip6"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip6)"><path d="M 180.8766,364.6000 v -48.1404 h 17.0946 v 48.1404 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip7"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip7)"><path d="M 197.9713,364.6000 v -42.4556 h 17.0946 v 42.4556 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip8"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip8)"><path d="M 215.0659,364.6000 v -38.4431 h 17.0946 v 38.4431 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip9"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip9)"><path d="M 232.1605,364.6000 v -32.7179 h 17.0946 v 32.7179 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip10"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip10)"><path d="M 249.2552,364.6000 v -32.6952 h 17.0946 v 32.6952 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip11"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip11)"><path d="M 266.3498,364.6000 v -32.2955 h 17.0946 v 32.2955 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip12"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip12)"><path d="M 283.4445,364.6000 v -31.8824 h 17.0946 v 31.8824 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip13"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip13)"><path d="M 300.5391,364.6000 v -27.0567 h 17.0946 v 27.0567 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip14"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip14)"><path d="M 317.6338,364.6000 v -20.1385 h 17.0946 v 20.1385 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip15"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip15)"><path d="M 334.7284,364.6000 v -12.6729 h 17.0946 v 12.6729 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip16"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip16)"><path d="M 351.8231,364.6000 v -4.1066 h 17.0946 v 4.1066 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip17"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip17)"><path d="M 368.9177,364.6000 v -1.3991 h 17.0946 v 1.3991 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip18"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip18)"><path d="M 386.0124,364.6000 v 2.7767 h 17.0946 v -2.7767 Z"/></g></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip19"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip19)"><path d="M 403.1070,364.6000 v 7.7712 h 17.0946 v -7.7712 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip20"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip20)"><path d="M 95.4034,364.6000 v -306.3549 h 17.0946 v 306.3549 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip21"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip21)"><path d="M 112.4980,364.6000 v -219.0632 h 17.0946 v 219.0632 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip22"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip22)"><path d="M 129.5927,364.6000 v -80.0608 h 17.0946 v 80.0608 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip23"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip23)"><path d="M 146.6873,364.6000 v -60.1654 h 17.0946 v 60.1654 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip24"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip24)"><path d="M 163.7820,364.6000 v -53.0481 h 17.0946 v 53.0481 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip25"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip25)"><path d="M 180.8766,364.6000 v -48.1404 h 17.0946 v 48.1404 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip26"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip26)"><path d="M 197.9713,364.6000 v -42.4556 h 17.0946 v 42.4556 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip27"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip27)"><path d="M 215.0659,364.6000 v -38.4431 h 17.0946 v 38.4431 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip28"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip28)"><path d="M 232.1605,364.6000 v -32.7179 h 17.0946 v 32.7179 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip29"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip29)"><path d="M 249.2552,364.6000 v -32.6952 h 17.0946 v 32.6952 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip30"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip30)"><path d="M 266.3498,364.6000 v -32.2955 h 17.0946 v 32.2955 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip31"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip31)"><path d="M 283.4445,364.6000 v -31.8824 h 17.0946 v 31.8824 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip32"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip32)"><path d="M 300.5391,364.6000 v -27.0567 h 17.0946 v 27.0567 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip33"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip33)"><path d="M 317.6338,364.6000 v -20.1385 h 17.0946 v 20.1385 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip34"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip34)"><path d="M 334.7284,364.6000 v -12.6729 h 17.0946 v 12.6729 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip35"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip35)"><path d="M 351.8231,364.6000 v -4.1066 h 17.0946 v 4.1066 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip36"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip36)"><path d="M 368.9177,364.6000 v -1.3991 h 17.0946 v 1.3991 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip37"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip37)"><path d="M 386.0124,364.6000 v 2.7767 h 17.0946 v -2.7767 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><defs><clipPath id="myClip38"><path d="M 80.4034,47.0000 v 397.0000 h 709.5966 v -397.0000 Z"/></clipPath></defs><g clip-path="url(#myClip38)"><path d="M 403.1070,364.6000 v 7.7712 h 17.0946 v -7.7712 Z"/></g></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="square" stroke-miterlimit="10.0"><path d="M 80.4034,444.0000 v -397.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,444.0000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,436.0600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,428.1200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,420.1800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,412.2400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,404.3000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,396.3600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,388.4200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,380.4800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,372.5400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,364.6000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,356.6600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,348.7200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,340.7800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,332.8400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,324.9000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,316.9600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,309.0200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,301.0800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,293.1400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,285.2000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,277.2600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,269.3200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,261.3800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,253.4400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,245.5000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,237.5600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,229.6200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,221.6800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,213.7400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,205.8000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,197.8600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,189.9200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,181.9800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,174.0400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,166.1000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,158.1600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,150.2200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,142.2800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,134.3400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,126.4000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,118.4600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,110.5200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,102.5800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,94.6400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,86.7000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,78.7600 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,70.8200 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,62.8800 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,54.9400 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,47.0000 h 2.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,444.0000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,364.6000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,285.2000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,205.8000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,126.4000 h 5.0000 "/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 80.4034,47.0000 h 5.0000 "/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 35.1681,448.8235 ZM 36.3298,447.8235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 42.4769,448.8235 ZM 46.5504,438.3824 h 0.8824 l -3.9265,12.7941 h -0.8824 ZM 47.6239,448.8235 ZM 48.5798,446.9265 c 0.4118,0.4265 0.9779,0.7500 0.9779 0.7500c 0.5662,0.3235 1.3897,0.3235 1.3897 0.3235c 0.4265,0.0000 0.8015,-0.1544 0.8015 -0.1544c 0.3750,-0.1544 0.6544,-0.4338 0.6544 -0.4338c 0.2794,-0.2794 0.4412,-0.6765 0.4412 -0.6765c 0.1618,-0.3971 0.1618,-0.8824 0.1618 -0.8824c 0.0000,-0.9706 -0.5441,-1.5147 -0.5441 -1.5147c -0.5441,-0.5441 -1.4559,-0.5441 -1.4559 -0.5441c -0.4853,-0.0000 -0.8309,0.1471 -0.8309 0.1471c -0.3456,0.1471 -0.7721,0.4265 -0.7721 0.4265l -0.6471,-0.4118 l 0.3088,-4.5147 h 4.6912 v 1.0441 h -3.6324 l -0.2500,2.7794 c 0.3382,-0.1765 0.6765,-0.2794 0.6765 -0.2794c 0.3382,-0.1029 0.7647,-0.1029 0.7647 -0.1029c 0.6029,0.0000 1.1324,0.1765 1.1324 0.1765c 0.5294,0.1765 0.9265,0.5368 0.9265 0.5368c 0.3971,0.3603 0.6250,0.9118 0.6250 0.9118c 0.2279,0.5515 0.2279,1.3162 0.2279 1.3162c 0.0000,0.7647 -0.2647,1.3529 -0.2647 1.3529c -0.2647,0.5882 -0.7059,0.9926 -0.7059 0.9926c -0.4412,0.4044 -1.0074,0.6176 -1.0074 0.6176c -0.5662,0.2132 -1.1838,0.2132 -1.1838 0.2132c -0.5588,-0.0000 -1.0221,-0.1103 -1.0221 -0.1103c -0.4632,-0.1103 -0.8382,-0.2868 -0.8382 -0.2868c -0.3750,-0.1765 -0.6765,-0.4044 -0.6765 -0.4044c -0.3015,-0.2279 -0.5368,-0.4779 -0.5368 -0.4779ZM 54.9328,448.8235 ZM 56.0945,447.8235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 65.2122,448.8235 ZM 67.7563,445.0882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 54.9328,369.4235 ZM 56.0945,368.4235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 65.2122,369.4235 ZM 67.7563,365.6882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 46.8298,290.0235 ZM 47.7857,288.1265 c 0.4118,0.4265 0.9779,0.7500 0.9779 0.7500c 0.5662,0.3235 1.3897,0.3235 1.3897 0.3235c 0.4265,0.0000 0.8015,-0.1544 0.8015 -0.1544c 0.3750,-0.1544 0.6544,-0.4338 0.6544 -0.4338c 0.2794,-0.2794 0.4412,-0.6765 0.4412 -0.6765c 0.1618,-0.3971 0.1618,-0.8824 0.1618 -0.8824c 0.0000,-0.9706 -0.5441,-1.5147 -0.5441 -1.5147c -0.5441,-0.5441 -1.4559,-0.5441 -1.4559 -0.5441c -0.4853,-0.0000 -0.8309,0.1471 -0.8309 0.1471c -0.3456,0.1471 -0.7721,0.4265 -0.7721 0.4265l -0.6471,-0.4118 l 0.3088,-4.5147 h 4.6912 v 1.0441 h -3.6324 l -0.2500,2.7794 c 0.3382,-0.1765 0.6765,-0.2794 0.6765 -0.2794c 0.3382,-0.1029 0.7647,-0.1029 0.7647 -0.1029c 0.6029,0.0000 1.1324,0.1765 1.1324 0.1765c 0.5294,0.1765 0.9265,0.5368 0.9265 0.5368c 0.3971,0.3603 0.6250,0.9118 0.6250 0.9118c 0.2279,0.5515 0.2279,1.3162 0.2279 1.3162c 0.0000,0.7647 -0.2647,1.3529 -0.2647 1.3529c -0.2647,0.5882 -0.7059,0.9926 -0.7059 0.9926c -0.4412,0.4044 -1.0074,0.6176 -1.0074 0.6176c -0.5662,0.2132 -1.1838,0.2132 -1.1838 0.2132c -0.5588,-0.0000 -1.0221,-0.1103 -1.0221 -0.1103c -0.4632,-0.1103 -0.8382,-0.2868 -0.8382 -0.2868c -0.3750,-0.1765 -0.6765,-0.4044 -0.6765 -0.4044c -0.3015,-0.2279 -0.5368,-0.4779 -0.5368 -0.4779ZM 54.1387,290.0235 ZM 55.3004,289.0235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 64.4181,290.0235 ZM 66.9622,286.2882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 40.3151,210.6235 ZM 41.4769,209.6235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 47.6239,210.6235 ZM 51.2857,210.8000 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 51.2857,210.8000 ZM 51.2857,209.8294 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 54.9328,210.6235 ZM 56.0945,209.6235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 65.2122,210.6235 ZM 67.7563,206.8882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 40.3151,131.2235 ZM 41.4769,130.2235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 47.6239,131.2235 ZM 48.5798,129.3265 c 0.4118,0.4265 0.9779,0.7500 0.9779 0.7500c 0.5662,0.3235 1.3897,0.3235 1.3897 0.3235c 0.4265,0.0000 0.8015,-0.1544 0.8015 -0.1544c 0.3750,-0.1544 0.6544,-0.4338 0.6544 -0.4338c 0.2794,-0.2794 0.4412,-0.6765 0.4412 -0.6765c 0.1618,-0.3971 0.1618,-0.8824 0.1618 -0.8824c 0.0000,-0.9706 -0.5441,-1.5147 -0.5441 -1.5147c -0.5441,-0.5441 -1.4559,-0.5441 -1.4559 -0.5441c -0.4853,-0.0000 -0.8309,0.1471 -0.8309 0.1471c -0.3456,0.1471 -0.7721,0.4265 -0.7721 0.4265l -0.6471,-0.4118 l 0.3088,-4.5147 h 4.6912 v 1.0441 h -3.6324 l -0.2500,2.7794 c 0.3382,-0.1765 0.6765,-0.2794 0.6765 -0.2794c 0.3382,-0.1029 0.7647,-0.1029 0.7647 -0.1029c 0.6029,0.0000 1.1324,0.1765 1.1324 0.1765c 0.5294,0.1765 0.9265,0.5368 0.9265 0.5368c 0.3971,0.3603 0.6250,0.9118 0.6250 0.9118c 0.2279,0.5515 0.2279,1.3162 0.2279 1.3162c 0.0000,0.7647 -0.2647,1.3529 -0.2647 1.3529c -0.2647,0.5882 -0.7059,0.9926 -0.7059 0.9926c -0.4412,0.4044 -1.0074,0.6176 -1.0074 0.6176c -0.5662,0.2132 -1.1838,0.2132 -1.1838 0.2132c -0.5588,-0.0000 -1.0221,-0.1103 -1.0221 -0.1103c -0.4632,-0.1103 -0.8382,-0.2868 -0.8382 -0.2868c -0.3750,-0.1765 -0.6765,-0.4044 -0.6765 -0.4044c -0.3015,-0.2279 -0.5368,-0.4779 -0.5368 -0.4779ZM 54.9328,131.2235 ZM 56.0945,130.2235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 65.2122,131.2235 ZM 67.7563,127.4882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.6828,51.8235 ZM 40.2710,51.1029 c 1.0588,-1.0588 1.8824,-1.9118 1.8824 -1.9118c 0.8235,-0.8529 1.3824,-1.5809 1.3824 -1.5809c 0.5588,-0.7279 0.8529,-1.3382 0.8529 -1.3382c 0.2941,-0.6103 0.2941,-1.1838 0.2941 -1.1838c 0.0000,-0.8088 -0.4412,-1.3235 -0.4412 -1.3235c -0.4412,-0.5147 -1.3382,-0.5147 -1.3382 -0.5147c -0.5882,-0.0000 -1.0882,0.3309 -1.0882 0.3309c -0.5000,0.3309 -0.9118,0.8015 -0.9118 0.8015l -0.6912,-0.6912 c 0.5882,-0.6471 1.2500,-1.0368 1.2500 -1.0368c 0.6618,-0.3897 1.5882,-0.3897 1.5882 -0.3897c 1.3088,0.0000 2.0588,0.7574 2.0588 0.7574c 0.7500,0.7574 0.7500,2.0074 0.7500 2.0074c 0.0000,0.6618 -0.2868,1.3309 -0.2868 1.3309c -0.2868,0.6691 -0.7941,1.3824 -0.7941 1.3824c -0.5074,0.7132 -1.2059,1.4853 -1.2059 1.4853c -0.6985,0.7721 -1.5368,1.6397 -1.5368 1.6397c 0.3824,-0.0294 0.7941,-0.0588 0.7941 -0.0588c 0.4118,-0.0294 0.7794,-0.0294 0.7794 -0.0294h 2.7206 v 1.0441 h -6.0588 v -0.7206 ZM 46.9916,51.8235 ZM 50.6534,52.0000 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 50.6534,52.0000 ZM 50.6534,51.0294 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 54.3004,51.8235 ZM 55.4622,50.8235 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 64.5798,51.8235 ZM 67.1239,48.0882 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 Z"/></g><g stroke-linejoin="miter" stroke-opacity="1.0" fill-opacity="0.0" stroke="rgb(0,0,0)" stroke-width="0.9999999999999997" fill="rgb(0,0,0)" stroke-linecap="square" stroke-miterlimit="10.0"><path d="M 80.4034,444.0000 h 709.5966 "/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 187.3992,470.0000 ZM 188.7773,458.0336 h 1.3782 v 10.4202 c 0.0000,0.3361 0.1176,0.4706 0.1176 0.4706c 0.1176,0.1345 0.2689,0.1345 0.2689 0.1345h 0.1261 c 0.0000,0.0000 0.1765,-0.0336 0.1765 -0.0336l 0.1849,1.0420 c -0.1345,0.0672 -0.3193,0.1008 -0.3193 0.1008c -0.1849,0.0336 -0.4706,0.0336 -0.4706 0.0336c -0.7899,-0.0000 -1.1261,-0.4706 -1.1261 -0.4706c -0.3361,-0.4706 -0.3361,-1.3782 -0.3361 -1.3782v -10.3193 ZM 191.6849,470.0000 ZM 193.7689,460.1513 c -0.4034,-0.0000 -0.6807,-0.2521 -0.6807 -0.2521c -0.2773,-0.2521 -0.2773,-0.6387 -0.2773 -0.6387c 0.0000,-0.4034 0.2773,-0.6471 0.2773 -0.6471c 0.2773,-0.2437 0.6807,-0.2437 0.6807 -0.2437c 0.4034,0.0000 0.6807,0.2437 0.6807 0.2437c 0.2773,0.2437 0.2773,0.6471 0.2773 0.6471c 0.0000,0.3866 -0.2773,0.6387 -0.2773 0.6387c -0.2773,0.2521 -0.6807,0.2521 -0.6807 0.2521ZM 193.7689,460.1513 ZM 193.0630,461.8319 h 1.3782 v 8.1681 h -1.3782 v -8.1681 ZM 195.8193,470.0000 ZM 196.9790,468.1513 c 0.5378,0.4370 1.1008,0.7059 1.1008 0.7059c 0.5630,0.2689 1.3025,0.2689 1.3025 0.2689c 0.8067,0.0000 1.2101,-0.3697 1.2101 -0.3697c 0.4034,-0.3697 0.4034,-0.9076 0.4034 -0.9076c 0.0000,-0.3193 -0.1681,-0.5546 -0.1681 -0.5546c -0.1681,-0.2353 -0.4286,-0.4118 -0.4286 -0.4118c -0.2605,-0.1765 -0.5966,-0.3109 -0.5966 -0.3109l -0.6723,-0.2689 c -0.4370,-0.1513 -0.8739,-0.3445 -0.8739 -0.3445c -0.4370,-0.1933 -0.7815,-0.4706 -0.7815 -0.4706c -0.3445,-0.2773 -0.5630,-0.6471 -0.5630 -0.6471c -0.2185,-0.3697 -0.2185,-0.8908 -0.2185 -0.8908c 0.0000,-0.4874 0.1933,-0.9160 0.1933 -0.9160c 0.1933,-0.4286 0.5546,-0.7395 0.5546 -0.7395c 0.3613,-0.3109 0.8824,-0.4874 0.8824 -0.4874c 0.5210,-0.1765 1.1765,-0.1765 1.1765 -0.1765c 0.7731,0.0000 1.4202,0.2689 1.4202 0.2689c 0.6471,0.2689 1.1176,0.6555 1.1176 0.6555l -0.6555,0.8739 c -0.4202,-0.3193 -0.8739,-0.5210 -0.8739 -0.5210c -0.4538,-0.2017 -0.9916,-0.2017 -0.9916 -0.2017c -0.7731,-0.0000 -1.1345,0.3529 -1.1345 0.3529c -0.3613,0.3529 -0.3613,0.8235 -0.3613 0.8235c 0.0000,0.2857 0.1513,0.4958 0.1513 0.4958c 0.1513,0.2101 0.4034,0.3697 0.4034 0.3697c 0.2521,0.1597 0.5798,0.2857 0.5798 0.2857c 0.3277,0.1261 0.6807,0.2605 0.6807 0.2605c 0.4370,0.1681 0.8824,0.3529 0.8824 0.3529c 0.4454,0.1849 0.7983,0.4622 0.7983 0.4622c 0.3529,0.2773 0.5798,0.6807 0.5798 0.6807c 0.2269,0.4034 0.2269,0.9748 0.2269 0.9748c 0.0000,0.5042 -0.1933,0.9412 -0.1933 0.9412c -0.1933,0.4370 -0.5714,0.7731 -0.5714 0.7731c -0.3782,0.3361 -0.9412,0.5294 -0.9412 0.5294c -0.5630,0.1933 -1.2857,0.1933 -1.2857 0.1933c -0.8739,-0.0000 -1.6639,-0.3193 -1.6639 -0.3193c -0.7899,-0.3193 -1.3782,-0.8067 -1.3782 -0.8067ZM 202.8613,470.0000 ZM 204.4748,462.9580 h -1.2101 v -1.0420 l 1.2773,-0.0840 l 0.1681,-2.2857 h 1.1597 v 2.2857 h 2.2017 v 1.1261 h -2.2017 v 4.5378 c 0.0000,0.7563 0.2773,1.1681 0.2773 1.1681c 0.2773,0.4118 0.9832,0.4118 0.9832 0.4118c 0.2185,0.0000 0.4706,-0.0672 0.4706 -0.0672c 0.2521,-0.0672 0.4538,-0.1513 0.4538 -0.1513l 0.2689,1.0420 c -0.3361,0.1176 -0.7311,0.2101 -0.7311 0.2101c -0.3950,0.0924 -0.7815,0.0924 -0.7815 0.0924c -0.6555,-0.0000 -1.1008,-0.2017 -1.1008 -0.2017c -0.4454,-0.2017 -0.7227,-0.5546 -0.7227 -0.5546c -0.2773,-0.3529 -0.3950,-0.8571 -0.3950 -0.8571c -0.1176,-0.5042 -0.1176,-1.1092 -0.1176 -1.1092v -4.5210 ZM 208.5420,470.0000 ZM 213.1975,458.0672 h 1.0084 l -4.4874,14.6218 h -1.0084 ZM 214.4244,470.0000 ZM 217.1807,470.6891 v 2.7563 h -1.3782 v -11.6134 h 1.1429 l 0.1176,0.9412 h 0.0504 c 0.5546,-0.4706 1.2185,-0.8067 1.2185 -0.8067c 0.6639,-0.3361 1.3866,-0.3361 1.3866 -0.3361c 0.7899,0.0000 1.3950,0.2941 1.3950 0.2941c 0.6050,0.2941 1.0084,0.8403 1.0084 0.8403c 0.4034,0.5462 0.6134,1.3109 0.6134 1.3109c 0.2101,0.7647 0.2101,1.7227 0.2101 1.7227c 0.0000,1.0420 -0.2857,1.8571 -0.2857 1.8571c -0.2857,0.8151 -0.7731,1.3866 -0.7731 1.3866c -0.4874,0.5714 -1.1261,0.8655 -1.1261 0.8655c -0.6387,0.2941 -1.3445,0.2941 -1.3445 0.2941c -0.5714,-0.0000 -1.1345,-0.2521 -1.1345 -0.2521c -0.5630,-0.2521 -1.1345,-0.6891 -1.1345 -0.6891ZM 217.1807,470.6891 ZM 217.1807,468.1849 c 0.5546,0.4706 1.0756,0.6639 1.0756 0.6639c 0.5210,0.1933 0.9244,0.1933 0.9244 0.1933c 0.5042,0.0000 0.9328,-0.2269 0.9328 -0.2269c 0.4286,-0.2269 0.7395,-0.6387 0.7395 -0.6387c 0.3109,-0.4118 0.4874,-1.0168 0.4874 -1.0168c 0.1765,-0.6050 0.1765,-1.3613 0.1765 -1.3613c 0.0000,-0.6723 -0.1176,-1.2269 -0.1176 -1.2269c -0.1176,-0.5546 -0.3782,-0.9496 -0.3782 -0.9496c -0.2605,-0.3950 -0.6723,-0.6134 -0.6723 -0.6134c -0.4118,-0.2185 -0.9832,-0.2185 -0.9832 -0.2185c -0.5210,-0.0000 -1.0504,0.2857 -1.0504 0.2857c -0.5294,0.2857 -1.1345,0.8235 -1.1345 0.8235v 4.2857 ZM 223.7521,470.0000 ZM 225.0126,461.8319 h 1.3950 v 4.9916 c 0.0000,1.1597 0.3613,1.6723 0.3613 1.6723c 0.3613,0.5126 1.1681,0.5126 1.1681 0.5126c 0.6387,0.0000 1.1261,-0.3277 1.1261 -0.3277c 0.4874,-0.3277 1.0756,-1.0504 1.0756 -1.0504v -5.7983 h 1.3782 v 8.1681 h -1.1429 l -0.1176,-1.2773 h -0.0504 c -0.5714,0.6723 -1.2017,1.0756 -1.2017 1.0756c -0.6303,0.4034 -1.4874,0.4034 -1.4874 0.4034c -1.3109,-0.0000 -1.9076,-0.8067 -1.9076 -0.8067c -0.5966,-0.8067 -0.5966,-2.3866 -0.5966 -2.3866v -5.1765 ZM 232.8950,470.0000 ZM 234.2731,461.8319 h 1.1429 l 0.1176,1.4790 h 0.0504 c 0.4202,-0.7731 1.0168,-1.2269 1.0168 -1.2269c 0.5966,-0.4538 1.3025,-0.4538 1.3025 -0.4538c 0.4874,0.0000 0.8739,0.1681 0.8739 0.1681l -0.2689,1.2101 c -0.2017,-0.0672 -0.3697,-0.1008 -0.3697 -0.1008c -0.1681,-0.0336 -0.4202,-0.0336 -0.4202 -0.0336c -0.5210,-0.0000 -1.0840,0.4202 -1.0840 0.4202c -0.5630,0.4202 -0.9832,1.4622 -0.9832 1.4622v 5.2437 h -1.3782 v -8.1681 ZM 238.5588,470.0000 ZM 239.3319,465.9328 c 0.0000,-1.0084 0.3109,-1.8067 0.3109 -1.8067c 0.3109,-0.7983 0.8235,-1.3529 0.8235 -1.3529c 0.5126,-0.5546 1.1681,-0.8487 1.1681 -0.8487c 0.6555,-0.2941 1.3613,-0.2941 1.3613 -0.2941c 0.7731,0.0000 1.3866,0.2689 1.3866 0.2689c 0.6134,0.2689 1.0252,0.7731 1.0252 0.7731c 0.4118,0.5042 0.6303,1.2101 0.6303 1.2101c 0.2185,0.7059 0.2185,1.5798 0.2185 1.5798c 0.0000,0.4538 -0.0504,0.7563 -0.0504 0.7563h -5.5126 c 0.0840,1.3277 0.8151,2.1008 0.8151 2.1008c 0.7311,0.7731 1.9076,0.7731 1.9076 0.7731c 0.5882,0.0000 1.0840,-0.1765 1.0840 -0.1765c 0.4958,-0.1765 0.9496,-0.4622 0.9496 -0.4622l 0.4874,0.9076 c -0.5378,0.3361 -1.1933,0.5882 -1.1933 0.5882c -0.6555,0.2521 -1.4958,0.2521 -1.4958 0.2521c -0.8235,-0.0000 -1.5378,-0.2941 -1.5378 -0.2941c -0.7143,-0.2941 -1.2437,-0.8403 -1.2437 -0.8403c -0.5294,-0.5462 -0.8319,-1.3361 -0.8319 -1.3361c -0.3025,-0.7899 -0.3025,-1.7983 -0.3025 -1.7983ZM 239.3319,465.9328 ZM 245.0462,465.3109 c 0.0000,-1.2605 -0.5294,-1.9244 -0.5294 -1.9244c -0.5294,-0.6639 -1.4874,-0.6639 -1.4874 -0.6639c -0.4370,-0.0000 -0.8319,0.1765 -0.8319 0.1765c -0.3950,0.1765 -0.7143,0.5042 -0.7143 0.5042c -0.3193,0.3277 -0.5294,0.8067 -0.5294 0.8067c -0.2101,0.4790 -0.2773,1.1008 -0.2773 1.1008h 4.3697 ZM 246.8950,470.0000 ZM 247.5840,465.2605 h 3.8655 v 1.0588 h -3.8655 v -1.0588 ZM 252.1218,470.0000 ZM 253.2815,468.1513 c 0.5378,0.4370 1.1008,0.7059 1.1008 0.7059c 0.5630,0.2689 1.3025,0.2689 1.3025 0.2689c 0.8067,0.0000 1.2101,-0.3697 1.2101 -0.3697c 0.4034,-0.3697 0.4034,-0.9076 0.4034 -0.9076c 0.0000,-0.3193 -0.1681,-0.5546 -0.1681 -0.5546c -0.1681,-0.2353 -0.4286,-0.4118 -0.4286 -0.4118c -0.2605,-0.1765 -0.5966,-0.3109 -0.5966 -0.3109l -0.6723,-0.2689 c -0.4370,-0.1513 -0.8739,-0.3445 -0.8739 -0.3445c -0.4370,-0.1933 -0.7815,-0.4706 -0.7815 -0.4706c -0.3445,-0.2773 -0.5630,-0.6471 -0.5630 -0.6471c -0.2185,-0.3697 -0.2185,-0.8908 -0.2185 -0.8908c 0.0000,-0.4874 0.1933,-0.9160 0.1933 -0.9160c 0.1933,-0.4286 0.5546,-0.7395 0.5546 -0.7395c 0.3613,-0.3109 0.8824,-0.4874 0.8824 -0.4874c 0.5210,-0.1765 1.1765,-0.1765 1.1765 -0.1765c 0.7731,0.0000 1.4202,0.2689 1.4202 0.2689c 0.6471,0.2689 1.1176,0.6555 1.1176 0.6555l -0.6555,0.8739 c -0.4202,-0.3193 -0.8739,-0.5210 -0.8739 -0.5210c -0.4538,-0.2017 -0.9916,-0.2017 -0.9916 -0.2017c -0.7731,-0.0000 -1.1345,0.3529 -1.1345 0.3529c -0.3613,0.3529 -0.3613,0.8235 -0.3613 0.8235c 0.0000,0.2857 0.1513,0.4958 0.1513 0.4958c 0.1513,0.2101 0.4034,0.3697 0.4034 0.3697c 0.2521,0.1597 0.5798,0.2857 0.5798 0.2857c 0.3277,0.1261 0.6807,0.2605 0.6807 0.2605c 0.4370,0.1681 0.8824,0.3529 0.8824 0.3529c 0.4454,0.1849 0.7983,0.4622 0.7983 0.4622c 0.3529,0.2773 0.5798,0.6807 0.5798 0.6807c 0.2269,0.4034 0.2269,0.9748 0.2269 0.9748c 0.0000,0.5042 -0.1933,0.9412 -0.1933 0.9412c -0.1933,0.4370 -0.5714,0.7731 -0.5714 0.7731c -0.3782,0.3361 -0.9412,0.5294 -0.9412 0.5294c -0.5630,0.1933 -1.2857,0.1933 -1.2857 0.1933c -0.8739,-0.0000 -1.6639,-0.3193 -1.6639 -0.3193c -0.7899,-0.3193 -1.3782,-0.8067 -1.3782 -0.8067ZM 259.1639,470.0000 ZM 260.7773,462.9580 h -1.2101 v -1.0420 l 1.2773,-0.0840 l 0.1681,-2.2857 h 1.1597 v 2.2857 h 2.2017 v 1.1261 h -2.2017 v 4.5378 c 0.0000,0.7563 0.2773,1.1681 0.2773 1.1681c 0.2773,0.4118 0.9832,0.4118 0.9832 0.4118c 0.2185,0.0000 0.4706,-0.0672 0.4706 -0.0672c 0.2521,-0.0672 0.4538,-0.1513 0.4538 -0.1513l 0.2689,1.0420 c -0.3361,0.1176 -0.7311,0.2101 -0.7311 0.2101c -0.3950,0.0924 -0.7815,0.0924 -0.7815 0.0924c -0.6555,-0.0000 -1.1008,-0.2017 -1.1008 -0.2017c -0.4454,-0.2017 -0.7227,-0.5546 -0.7227 -0.5546c -0.2773,-0.3529 -0.3950,-0.8571 -0.3950 -0.8571c -0.1176,-0.5042 -0.1176,-1.1092 -0.1176 -1.1092v -4.5210 ZM 264.8445,470.0000 ZM 266.2227,461.8319 h 1.1429 l 0.1176,1.4790 h 0.0504 c 0.4202,-0.7731 1.0168,-1.2269 1.0168 -1.2269c 0.5966,-0.4538 1.3025,-0.4538 1.3025 -0.4538c 0.4874,0.0000 0.8739,0.1681 0.8739 0.1681l -0.2689,1.2101 c -0.2017,-0.0672 -0.3697,-0.1008 -0.3697 -0.1008c -0.1681,-0.0336 -0.4202,-0.0336 -0.4202 -0.0336c -0.5210,-0.0000 -1.0840,0.4202 -1.0840 0.4202c -0.5630,0.4202 -0.9832,1.4622 -0.9832 1.4622v 5.2437 h -1.3782 v -8.1681 ZM 270.5084,470.0000 ZM 271.2815,465.9328 c 0.0000,-1.0084 0.3109,-1.8067 0.3109 -1.8067c 0.3109,-0.7983 0.8235,-1.3529 0.8235 -1.3529c 0.5126,-0.5546 1.1681,-0.8487 1.1681 -0.8487c 0.6555,-0.2941 1.3613,-0.2941 1.3613 -0.2941c 0.7731,0.0000 1.3866,0.2689 1.3866 0.2689c 0.6134,0.2689 1.0252,0.7731 1.0252 0.7731c 0.4118,0.5042 0.6303,1.2101 0.6303 1.2101c 0.2185,0.7059 0.2185,1.5798 0.2185 1.5798c 0.0000,0.4538 -0.0504,0.7563 -0.0504 0.7563h -5.5126 c 0.0840,1.3277 0.8151,2.1008 0.8151 2.1008c 0.7311,0.7731 1.9076,0.7731 1.9076 0.7731c 0.5882,0.0000 1.0840,-0.1765 1.0840 -0.1765c 0.4958,-0.1765 0.9496,-0.4622 0.9496 -0.4622l 0.4874,0.9076 c -0.5378,0.3361 -1.1933,0.5882 -1.1933 0.5882c -0.6555,0.2521 -1.4958,0.2521 -1.4958 0.2521c -0.8235,-0.0000 -1.5378,-0.2941 -1.5378 -0.2941c -0.7143,-0.2941 -1.2437,-0.8403 -1.2437 -0.8403c -0.5294,-0.5462 -0.8319,-1.3361 -0.8319 -1.3361c -0.3025,-0.7899 -0.3025,-1.7983 -0.3025 -1.7983ZM 271.2815,465.9328 ZM 276.9958,465.3109 c 0.0000,-1.2605 -0.5294,-1.9244 -0.5294 -1.9244c -0.5294,-0.6639 -1.4874,-0.6639 -1.4874 -0.6639c -0.4370,-0.0000 -0.8319,0.1765 -0.8319 0.1765c -0.3950,0.1765 -0.7143,0.5042 -0.7143 0.5042c -0.3193,0.3277 -0.5294,0.8067 -0.5294 0.8067c -0.2101,0.4790 -0.2773,1.1008 -0.2773 1.1008h 4.3697 ZM 278.6092,470.0000 ZM 279.5840,467.8824 c 0.0000,-1.3445 1.2017,-2.0588 1.2017 -2.0588c 1.2017,-0.7143 3.8235,-1.0000 3.8235 -1.0000c 0.0000,-0.3866 -0.0756,-0.7563 -0.0756 -0.7563c -0.0756,-0.3697 -0.2689,-0.6555 -0.2689 -0.6555c -0.1933,-0.2857 -0.5126,-0.4622 -0.5126 -0.4622c -0.3193,-0.1765 -0.8235,-0.1765 -0.8235 -0.1765c -0.7227,-0.0000 -1.3361,0.2689 -1.3361 0.2689c -0.6134,0.2689 -1.1008,0.6050 -1.1008 0.6050l -0.5546,-0.9580 c 0.5714,-0.3697 1.3950,-0.7143 1.3950 -0.7143c 0.8235,-0.3445 1.8151,-0.3445 1.8151 -0.3445c 1.4958,0.0000 2.1681,0.9160 2.1681 0.9160c 0.6723,0.9160 0.6723,2.4454 0.6723 2.4454v 5.0084 h -1.1429 l -0.1176,-0.9748 h -0.0336 c -0.5882,0.4874 -1.2689,0.8319 -1.2689 0.8319c -0.6807,0.3445 -1.4370,0.3445 -1.4370 0.3445c -1.0420,-0.0000 -1.7227,-0.6050 -1.7227 -0.6050c -0.6807,-0.6050 -0.6807,-1.7143 -0.6807 -1.7143ZM 279.5840,467.8824 ZM 280.9454,467.7815 c 0.0000,0.7059 0.4118,1.0084 0.4118 1.0084c 0.4118,0.3025 1.0168,0.3025 1.0168 0.3025c 0.5882,0.0000 1.1176,-0.2773 1.1176 -0.2773c 0.5294,-0.2773 1.1176,-0.8151 1.1176 -0.8151v -2.2689 c -1.0252,0.1345 -1.7311,0.3193 -1.7311 0.3193c -0.7059,0.1849 -1.1345,0.4370 -1.1345 0.4370c -0.4286,0.2521 -0.6134,0.5798 -0.6134 0.5798c -0.1849,0.3277 -0.1849,0.7143 -0.1849 0.7143ZM 287.2143,470.0000 ZM 288.5924,461.8319 h 1.1429 l 0.1176,1.1765 h 0.0504 c 0.5378,-0.5882 1.1681,-0.9832 1.1681 -0.9832c 0.6303,-0.3950 1.3697,-0.3950 1.3697 -0.3950c 0.9412,0.0000 1.4706,0.4118 1.4706 0.4118c 0.5294,0.4118 0.7815,1.1513 0.7815 1.1513c 0.6387,-0.7059 1.2857,-1.1345 1.2857 -1.1345c 0.6471,-0.4286 1.4034,-0.4286 1.4034 -0.4286c 1.2605,0.0000 1.8739,0.8067 1.8739 0.8067c 0.6134,0.8067 0.6134,2.3866 0.6134 2.3866v 5.1765 h -1.3782 v -4.9916 c 0.0000,-1.1597 -0.3697,-1.6723 -0.3697 -1.6723c -0.3697,-0.5126 -1.1429,-0.5126 -1.1429 -0.5126c -0.9244,-0.0000 -2.0504,1.2605 -2.0504 1.2605v 5.9160 h -1.3782 v -4.9916 c 0.0000,-1.1597 -0.3697,-1.6723 -0.3697 -1.6723c -0.3697,-0.5126 -1.1597,-0.5126 -1.1597 -0.5126c -0.9244,-0.0000 -2.0504,1.2605 -2.0504 1.2605v 5.9160 h -1.3782 v -8.1681 ZM 301.1471,470.0000 ZM 302.5252,458.0336 h 1.3782 v 10.4202 c 0.0000,0.3361 0.1176,0.4706 0.1176 0.4706c 0.1176,0.1345 0.2689,0.1345 0.2689 0.1345h 0.1261 c 0.0000,0.0000 0.1765,-0.0336 0.1765 -0.0336l 0.1849,1.0420 c -0.1345,0.0672 -0.3193,0.1008 -0.3193 0.1008c -0.1849,0.0336 -0.4706,0.0336 -0.4706 0.0336c -0.7899,-0.0000 -1.1261,-0.4706 -1.1261 -0.4706c -0.3361,-0.4706 -0.3361,-1.3782 -0.3361 -1.3782v -10.3193 ZM 305.4328,470.0000 ZM 306.2563,472.2521 l 0.3025,0.0756 c 0.0000,0.0000 0.3193,0.0420 0.3193 0.0420c 0.7059,0.0000 1.1513,-0.4958 1.1513 -0.4958c 0.4454,-0.4958 0.6975,-1.2521 0.6975 -1.2521l 0.1849,-0.6050 l -3.2773,-8.1849 h 1.4286 l 1.6639,4.5210 c 0.1849,0.5378 0.3950,1.1345 0.3950 1.1345c 0.2101,0.5966 0.3950,1.1681 0.3950 1.1681h 0.0672 c 0.1849,-0.5546 0.3529,-1.1597 0.3529 -1.1597c 0.1681,-0.6050 0.3361,-1.1429 0.3361 -1.1429l 1.4622,-4.5210 h 1.3445 l -3.0756,8.8403 c -0.2185,0.6050 -0.4874,1.1261 -0.4874 1.1261c -0.2689,0.5210 -0.6387,0.8992 -0.6387 0.8992c -0.3697,0.3782 -0.8403,0.5966 -0.8403 0.5966c -0.4706,0.2185 -1.0924,0.2185 -1.0924 0.2185c -0.2857,-0.0000 -0.5210,-0.0420 -0.5210 -0.0420c -0.2353,-0.0420 -0.4370,-0.1261 -0.4370 -0.1261l 0.2689,-1.0924 h 0.0000 ZM 313.2815,470.0000 ZM 316.8782,472.9580 c -1.0420,-1.6807 -1.6303,-3.5462 -1.6303 -3.5462c -0.5882,-1.8655 -0.5882,-4.0840 -0.5882 -4.0840c 0.0000,-2.2185 0.5882,-4.0756 0.5882 -4.0756c 0.5882,-1.8571 1.6303,-3.5546 1.6303 -3.5546l 0.8571,0.4034 c -0.9748,1.6134 -1.4538,3.4538 -1.4538 3.4538c -0.4790,1.8403 -0.4790,3.7731 -0.4790 3.7731c 0.0000,1.9328 0.4790,3.7731 0.4790 3.7731c 0.4790,1.8403 1.4538,3.4538 1.4538 3.4538l -0.8571,0.4034 h 0.0000 ZM 318.3739,470.0000 ZM 321.2815,465.7311 l -2.4706,-3.8992 h 1.4958 l 1.0924,1.7983 c 0.1849,0.3361 0.3866,0.6807 0.3866 0.6807c 0.2017,0.3445 0.4202,0.6807 0.4202 0.6807h 0.0672 c 0.1849,-0.3361 0.3697,-0.6807 0.3697 -0.6807c 0.1849,-0.3445 0.3697,-0.6807 0.3697 -0.6807l 0.9916,-1.7983 h 1.4454 l -2.4706,4.0504 l 2.6555,4.1176 h -1.4958 l -1.1933,-1.8992 l -0.4370,-0.7395 c 0.0000,0.0000 -0.4538,-0.7227 -0.4538 -0.7227h -0.0672 c -0.2185,0.3529 -0.4202,0.7143 -0.4202 0.7143c -0.2017,0.3613 -0.4034,0.7479 -0.4034 0.7479l -1.1092,1.8992 h -1.4454 ZM 325.8697,470.0000 ZM 326.5084,472.5546 c 0.9748,-1.6134 1.4538,-3.4538 1.4538 -3.4538c 0.4790,-1.8403 0.4790,-3.7731 0.4790 -3.7731c 0.0000,-1.9328 -0.4790,-3.7731 -0.4790 -3.7731c -0.4790,-1.8403 -1.4538,-3.4538 -1.4538 -3.4538l 0.8571,-0.4034 c 1.0420,1.6975 1.6303,3.5546 1.6303 3.5546c 0.5882,1.8571 0.5882,4.0756 0.5882 4.0756c 0.0000,2.2185 -0.5882,4.0840 -0.5882 4.0840c -0.5882,1.8655 -1.6303,3.5462 -1.6303 3.5462l -0.8571,-0.4034 h 0.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,480.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,489.2500 ZM 39.7941,485.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 39.7941,485.6912 ZM 41.0441,485.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 47.2647,489.2500 ZM 48.4706,482.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 52.2206,489.2500 ZM 52.8971,485.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 52.8971,485.6912 ZM 54.1471,485.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 60.1912,489.2500 ZM 62.6029,489.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 62.6029,489.8529 ZM 62.6029,487.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 68.3529,489.2500 ZM 68.9559,485.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 72.9265,489.2500 ZM 74.1324,482.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.4706,-0.5147 1.0221,-0.8603 1.0221 -0.8603c 0.5515,-0.3456 1.1985,-0.3456 1.1985 -0.3456c 0.8235,0.0000 1.2868,0.3603 1.2868 0.3603c 0.4632,0.3603 0.6838,1.0074 0.6838 1.0074c 0.5588,-0.6176 1.1250,-0.9926 1.1250 -0.9926c 0.5662,-0.3750 1.2279,-0.3750 1.2279 -0.3750c 1.1029,0.0000 1.6397,0.7059 1.6397 0.7059c 0.5368,0.7059 0.5368,2.0882 0.5368 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0000,-0.4485 -1.0000 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0147,-0.4485 -1.0147 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -7.1471 ZM 85.1176,489.2500 ZM 85.9706,487.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 85.9706,487.3971 ZM 87.1618,487.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 92.6471,489.2500 ZM 95.0588,489.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 95.0588,489.8529 ZM 95.0588,487.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 103.7794,489.2500 ZM 106.3235,485.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 113.3088,489.2500 ZM 117.7794,485.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 117.7794,485.6912 ZM 120.2059,486.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,480.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,489.2500 ZM 173.4559,479.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 173.3235,489.2500 ZM 175.1471,480.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 175.1471,480.6324 ZM 174.5294,482.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 176.9412,489.2500 ZM 178.1471,478.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 180.6912,489.2500 ZM 182.1029,483.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 185.5147,489.2500 ZM 186.1912,485.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 186.1912,485.6912 ZM 191.1912,485.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 192.8088,489.2500 ZM 194.0147,482.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 197.9118,489.2500 ZM 198.5147,485.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 202.4853,489.2500 ZM 203.1765,485.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 203.1765,485.6912 ZM 204.4265,485.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 210.6471,489.2500 ZM 211.8529,482.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 215.6029,489.2500 ZM 216.2794,485.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 216.2794,485.6912 ZM 217.5294,485.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 223.5735,489.2500 ZM 225.9853,489.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 225.9853,489.8529 ZM 225.9853,487.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 234.7059,489.2500 ZM 237.2500,485.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 244.2353,489.2500 ZM 248.7059,485.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 248.7059,485.6912 ZM 251.1324,486.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,480.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,489.2500 ZM 321.6765,479.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 321.5441,489.2500 ZM 323.3676,480.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 323.3676,480.6324 ZM 322.7500,482.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 325.1618,489.2500 ZM 326.3676,478.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 328.9118,489.2500 ZM 330.3235,483.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 333.7353,489.2500 ZM 334.4118,485.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 334.4118,485.6912 ZM 339.4118,485.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 341.0294,489.2500 ZM 342.2353,482.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 346.1324,489.2500 ZM 346.7353,485.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 350.7059,489.2500 ZM 351.7206,487.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 356.8676,489.2500 ZM 357.5441,485.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 363.4265,489.2500 ZM 364.2794,487.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 364.2794,487.3971 ZM 365.4706,487.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 370.9559,489.2500 ZM 372.1618,482.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 381.9706,489.2500 ZM 384.5147,485.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 391.5000,489.2500 ZM 395.9706,485.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 395.9706,485.6912 ZM 398.3971,486.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 417.9559,480.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 447.0588,489.2500 ZM 448.4706,483.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 451.7647,489.2500 ZM 452.6176,487.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 452.6176,487.3971 ZM 453.8088,487.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 459.2941,489.2500 ZM 460.5000,478.7794 h 1.1912 v 7.0882 h 0.0441 l 3.0441,-3.7647 h 1.3382 l -2.3971,2.8676 l 2.7206,4.2794 h -1.3235 l -2.0882,-3.4412 l -1.3382,1.5588 v 1.8824 h -1.1912 v -10.4706 ZM 466.3088,489.2500 ZM 466.9853,485.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 466.9853,485.6912 ZM 471.9853,485.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 473.6029,489.2500 ZM 474.2059,485.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 478.1765,489.2500 ZM 479.3824,482.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.4706,-0.5147 1.0221,-0.8603 1.0221 -0.8603c 0.5515,-0.3456 1.1985,-0.3456 1.1985 -0.3456c 0.8235,0.0000 1.2868,0.3603 1.2868 0.3603c 0.4632,0.3603 0.6838,1.0074 0.6838 1.0074c 0.5588,-0.6176 1.1250,-0.9926 1.1250 -0.9926c 0.5662,-0.3750 1.2279,-0.3750 1.2279 -0.3750c 1.1029,0.0000 1.6397,0.7059 1.6397 0.7059c 0.5368,0.7059 0.5368,2.0882 0.5368 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0000,-0.4485 -1.0000 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0147,-0.4485 -1.0147 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -7.1471 ZM 490.3676,489.2500 ZM 491.2206,487.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 491.2206,487.3971 ZM 492.4118,487.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 497.8971,489.2500 ZM 500.3088,489.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 500.3088,489.8529 ZM 500.3088,487.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 509.0294,489.2500 ZM 511.5735,485.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 518.5588,489.2500 ZM 523.0294,485.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 523.0294,485.6912 ZM 525.4559,486.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,504.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,513.2500 ZM 40.1176,511.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 45.2647,513.2500 ZM 45.9412,509.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 51.8235,513.2500 ZM 52.6765,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 52.6765,511.3971 ZM 53.8676,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 59.3529,513.2500 ZM 60.5588,506.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 67.3971,513.2500 ZM 68.0000,509.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 71.9706,513.2500 ZM 73.1765,506.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.4706,-0.5147 1.0221,-0.8603 1.0221 -0.8603c 0.5515,-0.3456 1.1985,-0.3456 1.1985 -0.3456c 0.8235,0.0000 1.2868,0.3603 1.2868 0.3603c 0.4632,0.3603 0.6838,1.0074 0.6838 1.0074c 0.5588,-0.6176 1.1250,-0.9926 1.1250 -0.9926c 0.5662,-0.3750 1.2279,-0.3750 1.2279 -0.3750c 1.1029,0.0000 1.6397,0.7059 1.6397 0.7059c 0.5368,0.7059 0.5368,2.0882 0.5368 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0000,-0.4485 -1.0000 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0147,-0.4485 -1.0147 -0.4485c -0.8088,-0.0000 -1.7941,1.1029 -1.7941 1.1029v 5.1765 h -1.2059 v -7.1471 ZM 84.1618,513.2500 ZM 85.0147,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 85.0147,511.3971 ZM 86.2059,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 91.6912,513.2500 ZM 94.1029,513.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 94.1029,513.8529 ZM 94.1029,511.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 102.8235,513.2500 ZM 105.3676,509.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 112.3529,513.2500 ZM 116.8235,509.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 116.8235,509.6912 ZM 119.2500,510.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,504.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,513.2500 ZM 169.4853,512.6029 l 3.7647,-5.5147 h -3.3529 v -0.9853 h 4.8824 v 0.6471 l -3.7647,5.5147 h 3.8824 v 0.9853 h -5.4118 v -0.6471 ZM 175.2794,513.2500 ZM 177.1029,504.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 177.1029,504.6324 ZM 176.4853,506.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 178.8971,513.2500 ZM 181.3088,513.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 181.3088,513.8529 ZM 181.3088,511.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,504.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,513.2500 ZM 321.6765,503.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 321.5441,513.2500 ZM 323.3676,504.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 323.3676,504.6324 ZM 322.7500,506.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 325.1618,513.2500 ZM 326.3676,502.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 328.9118,513.2500 ZM 330.3235,507.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 333.7353,513.2500 ZM 334.4118,509.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 334.4118,509.6912 ZM 339.4118,509.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 341.0294,513.2500 ZM 342.2353,506.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 346.1324,513.2500 ZM 346.7353,509.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 350.7059,513.2500 ZM 352.1176,507.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 355.4118,513.2500 ZM 356.2647,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 356.2647,511.3971 ZM 357.4559,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 362.9412,513.2500 ZM 364.1471,502.7794 h 1.1912 v 7.0882 h 0.0441 l 3.0441,-3.7647 h 1.3382 l -2.3971,2.8676 l 2.7206,4.2794 h -1.3235 l -2.0882,-3.4412 l -1.3382,1.5588 v 1.8824 h -1.1912 v -10.4706 ZM 369.9559,513.2500 ZM 370.6324,509.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 370.6324,509.6912 ZM 375.6324,509.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 380.2206,513.2500 ZM 382.7647,509.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 389.7500,513.2500 ZM 394.2206,509.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 394.2206,509.6912 ZM 396.6471,510.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 417.9559,504.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 447.0588,513.2500 ZM 448.4706,507.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 451.7647,513.2500 ZM 452.6176,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 452.6176,511.3971 ZM 453.8088,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 459.2941,513.2500 ZM 460.5000,502.7794 h 1.1912 v 7.0882 h 0.0441 l 3.0441,-3.7647 h 1.3382 l -2.3971,2.8676 l 2.7206,4.2794 h -1.3235 l -2.0882,-3.4412 l -1.3382,1.5588 v 1.8824 h -1.1912 v -10.4706 ZM 466.3088,513.2500 ZM 466.9853,509.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 466.9853,509.6912 ZM 471.9853,509.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 473.6029,513.2500 ZM 474.2059,509.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 478.1765,513.2500 ZM 479.1912,511.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 484.3382,513.2500 ZM 485.0147,509.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 490.8971,513.2500 ZM 491.7500,511.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 491.7500,511.3971 ZM 492.9412,511.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 498.4265,513.2500 ZM 499.6324,506.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 509.4412,513.2500 ZM 511.9853,509.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 518.9706,513.2500 ZM 523.4412,509.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 523.4412,509.6912 ZM 525.8676,510.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,528.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,537.2500 ZM 39.7941,533.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 39.7941,533.6912 ZM 41.0441,533.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 47.2647,537.2500 ZM 48.4706,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 52.2206,537.2500 ZM 52.8971,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 52.8971,533.6912 ZM 54.1471,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 60.1912,537.2500 ZM 62.6029,537.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 62.6029,537.8529 ZM 62.6029,535.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 68.3529,537.2500 ZM 68.9559,533.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 72.9265,537.2500 ZM 73.6029,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 73.6029,533.6912 ZM 74.8529,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 80.8971,537.2500 ZM 82.1029,530.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 88.9412,537.2500 ZM 89.6176,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 89.6176,533.6912 ZM 94.6176,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,528.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,537.2500 ZM 169.7206,533.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 169.7206,533.6912 ZM 170.9706,533.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 177.1912,537.2500 ZM 178.3971,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 182.1471,537.2500 ZM 182.8235,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 182.8235,533.6912 ZM 184.0735,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 190.1176,537.2500 ZM 192.5294,537.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 192.5294,537.8529 ZM 192.5294,535.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 198.2794,537.2500 ZM 198.6176,527.6029 h 1.2647 l 1.0147,5.2500 c 0.1324,0.7941 0.2794,1.5588 0.2794 1.5588c 0.1471,0.7647 0.2794,1.5588 0.2794 1.5588h 0.0588 c 0.1618,-0.7941 0.3382,-1.5662 0.3382 -1.5662c 0.1765,-0.7721 0.3382,-1.5515 0.3382 -1.5515l 1.3382,-5.2500 h 1.1176 l 1.3382,5.2500 c 0.1765,0.7647 0.3529,1.5441 0.3529 1.5441c 0.1765,0.7794 0.3529,1.5735 0.3529 1.5735h 0.0588 c 0.1324,-0.7941 0.2647,-1.5662 0.2647 -1.5662c 0.1324,-0.7721 0.2794,-1.5515 0.2794 -1.5515l 1.0147,-5.2500 h 1.1765 l -2.0000,9.6471 h -1.4706 l -1.4559,-5.8088 c -0.1324,-0.5588 -0.2426,-1.0956 -0.2426 -1.0956c -0.1103,-0.5368 -0.2279,-1.0956 -0.2279 -1.0956h -0.0588 c -0.1176,0.5588 -0.2426,1.0956 -0.2426 1.0956c -0.1250,0.5368 -0.2426,1.0956 -0.2426 1.0956l -1.4265,5.8088 h -1.4559 ZM 209.8382,537.2500 ZM 211.0441,526.7794 h 1.2059 v 2.8529 l -0.0441,1.4706 c 0.5147,-0.4853 1.0735,-0.8309 1.0735 -0.8309c 0.5588,-0.3456 1.3088,-0.3456 1.3088 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -10.4706 ZM 217.8382,537.2500 ZM 219.6618,528.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 219.6618,528.6324 ZM 219.0441,530.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 221.4559,537.2500 ZM 222.6618,526.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 225.2059,537.2500 ZM 225.8824,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 225.8824,533.6912 ZM 230.8824,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 232.5000,537.2500 ZM 233.1029,533.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 237.0735,537.2500 ZM 241.5000,527.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 241.0735,537.2500 ZM 241.9265,535.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 241.9265,535.3971 ZM 243.1176,535.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 248.6029,537.2500 ZM 249.8088,526.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 252.3529,537.2500 ZM 253.3676,535.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 258.5147,537.2500 ZM 259.1912,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 259.1912,533.6912 ZM 264.1912,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,528.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,537.2500 ZM 317.9412,533.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 317.9412,533.6912 ZM 319.1912,533.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 325.4118,537.2500 ZM 326.6176,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 330.3676,537.2500 ZM 331.0441,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 331.0441,533.6912 ZM 332.2941,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 338.3382,537.2500 ZM 340.7500,537.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 340.7500,537.8529 ZM 340.7500,535.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 346.5000,537.2500 ZM 347.1029,533.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 351.0735,537.2500 ZM 351.7500,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 351.7500,533.6912 ZM 353.0000,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 359.0441,537.2500 ZM 360.2500,530.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 367.0882,537.2500 ZM 367.7647,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 367.7647,533.6912 ZM 372.7647,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 377.3529,537.2500 ZM 379.8971,533.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 386.8824,537.2500 ZM 391.3529,533.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 391.3529,533.6912 ZM 393.7794,534.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 417.9559,528.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 447.0588,537.2500 ZM 447.7500,533.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 447.7500,533.6912 ZM 449.0000,533.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 455.2206,537.2500 ZM 456.4265,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 460.1765,537.2500 ZM 460.8529,533.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 460.8529,533.6912 ZM 462.1029,533.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 468.1471,537.2500 ZM 470.5588,537.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 470.5588,537.8529 ZM 470.5588,535.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 476.3088,537.2500 ZM 476.6471,527.6029 h 1.2647 l 1.0147,5.2500 c 0.1324,0.7941 0.2794,1.5588 0.2794 1.5588c 0.1471,0.7647 0.2794,1.5588 0.2794 1.5588h 0.0588 c 0.1618,-0.7941 0.3382,-1.5662 0.3382 -1.5662c 0.1765,-0.7721 0.3382,-1.5515 0.3382 -1.5515l 1.3382,-5.2500 h 1.1176 l 1.3382,5.2500 c 0.1765,0.7647 0.3529,1.5441 0.3529 1.5441c 0.1765,0.7794 0.3529,1.5735 0.3529 1.5735h 0.0588 c 0.1324,-0.7941 0.2647,-1.5662 0.2647 -1.5662c 0.1324,-0.7721 0.2794,-1.5515 0.2794 -1.5515l 1.0147,-5.2500 h 1.1765 l -2.0000,9.6471 h -1.4706 l -1.4559,-5.8088 c -0.1324,-0.5588 -0.2426,-1.0956 -0.2426 -1.0956c -0.1103,-0.5368 -0.2279,-1.0956 -0.2279 -1.0956h -0.0588 c -0.1176,0.5588 -0.2426,1.0956 -0.2426 1.0956c -0.1250,0.5368 -0.2426,1.0956 -0.2426 1.0956l -1.4265,5.8088 h -1.4559 ZM 487.8676,537.2500 ZM 489.0735,526.7794 h 1.2059 v 2.8529 l -0.0441,1.4706 c 0.5147,-0.4853 1.0735,-0.8309 1.0735 -0.8309c 0.5588,-0.3456 1.3088,-0.3456 1.3088 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -10.4706 ZM 495.8676,537.2500 ZM 497.6912,528.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 497.6912,528.6324 ZM 497.0735,530.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 499.4853,537.2500 ZM 500.6912,526.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 503.2353,537.2500 ZM 503.9118,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 503.9118,533.6912 ZM 508.9118,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 510.5294,537.2500 ZM 511.1324,533.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 515.1029,537.2500 ZM 516.5147,531.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 520.0735,537.2500 ZM 521.2794,530.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 525.1765,537.2500 ZM 526.2794,530.1029 h 1.2206 v 4.3676 c 0.0000,1.0147 0.3162,1.4632 0.3162 1.4632c 0.3162,0.4485 1.0221,0.4485 1.0221 0.4485c 0.5588,0.0000 0.9853,-0.2868 0.9853 -0.2868c 0.4265,-0.2868 0.9412,-0.9191 0.9412 -0.9191v -5.0735 h 1.2059 v 7.1471 h -1.0000 l -0.1029,-1.1176 h -0.0441 c -0.5000,0.5882 -1.0515,0.9412 -1.0515 0.9412c -0.5515,0.3529 -1.3015,0.3529 -1.3015 0.3529c -1.1471,-0.0000 -1.6691,-0.7059 -1.6691 -0.7059c -0.5221,-0.7059 -0.5221,-2.0882 -0.5221 -2.0882v -4.5294 ZM 533.1765,537.2500 ZM 533.8529,533.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 533.8529,533.6912 ZM 538.8529,533.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,552.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,561.2500 ZM 39.7941,557.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 39.7941,557.6912 ZM 41.0441,557.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 47.2647,561.2500 ZM 48.4706,554.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 52.2206,561.2500 ZM 52.8971,557.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 52.8971,557.6912 ZM 54.1471,557.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 60.1912,561.2500 ZM 62.6029,561.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 62.6029,561.8529 ZM 62.6029,559.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 68.3529,561.2500 ZM 68.9559,557.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 72.9265,561.2500 ZM 73.9412,559.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 79.0882,561.2500 ZM 79.7647,557.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 85.6471,561.2500 ZM 86.5000,559.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 86.5000,559.3971 ZM 87.6912,559.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 93.1765,561.2500 ZM 94.3824,554.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 104.1912,561.2500 ZM 106.7353,557.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 113.7206,561.2500 ZM 118.1912,557.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 118.1912,557.6912 ZM 120.6176,558.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,128,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,552.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,561.2500 ZM 169.7206,557.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 169.7206,557.6912 ZM 170.9706,557.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 177.1912,561.2500 ZM 178.3971,554.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 182.1471,561.2500 ZM 182.8235,557.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 182.8235,557.6912 ZM 184.0735,557.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 190.1176,561.2500 ZM 192.5294,561.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 192.5294,561.8529 ZM 192.5294,559.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 198.2794,561.2500 ZM 198.8824,557.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 202.8529,561.2500 ZM 203.7059,559.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 203.7059,559.3971 ZM 204.8971,559.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 210.3824,561.2500 ZM 211.5882,550.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 214.1324,561.2500 ZM 215.3382,550.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,552.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,561.2500 ZM 318.6618,555.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 321.9559,561.2500 ZM 322.8088,559.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 322.8088,559.3971 ZM 324.0000,559.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 329.4853,561.2500 ZM 330.6912,550.7794 h 1.1912 v 7.0882 h 0.0441 l 3.0441,-3.7647 h 1.3382 l -2.3971,2.8676 l 2.7206,4.2794 h -1.3235 l -2.0882,-3.4412 l -1.3382,1.5588 v 1.8824 h -1.1912 v -10.4706 ZM 336.5000,561.2500 ZM 337.1765,557.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 337.1765,557.6912 ZM 342.1765,557.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 343.7941,561.2500 ZM 344.3971,557.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 348.3676,561.2500 ZM 349.0588,557.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 349.0588,557.6912 ZM 350.3088,557.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 356.5294,561.2500 ZM 357.7353,554.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 361.4853,561.2500 ZM 362.1618,557.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 362.1618,557.6912 ZM 363.4118,557.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 369.4559,561.2500 ZM 371.8676,561.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 371.8676,561.8529 ZM 371.8676,559.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 380.5882,561.2500 ZM 383.1324,557.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 390.1176,561.2500 ZM 394.5882,557.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 394.5882,557.6912 ZM 397.0147,558.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,165,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 417.9559,552.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 447.0588,561.2500 ZM 447.7500,557.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 447.7500,557.6912 ZM 449.0000,557.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 455.2206,561.2500 ZM 456.4265,554.1029 h 1.0000 l 0.1029,1.2941 h 0.0441 c 0.3676,-0.6765 0.8897,-1.0735 0.8897 -1.0735c 0.5221,-0.3971 1.1397,-0.3971 1.1397 -0.3971c 0.4265,0.0000 0.7647,0.1471 0.7647 0.1471l -0.2353,1.0588 c -0.1765,-0.0588 -0.3235,-0.0882 -0.3235 -0.0882c -0.1471,-0.0294 -0.3676,-0.0294 -0.3676 -0.0294c -0.4559,-0.0000 -0.9485,0.3676 -0.9485 0.3676c -0.4926,0.3676 -0.8603,1.2794 -0.8603 1.2794v 4.5882 h -1.2059 v -7.1471 ZM 460.1765,561.2500 ZM 460.8529,557.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 460.8529,557.6912 ZM 462.1029,557.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 468.1471,561.2500 ZM 470.5588,561.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 470.5588,561.8529 ZM 470.5588,559.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 476.3088,561.2500 ZM 476.6471,551.6029 h 1.2647 l 1.0147,5.2500 c 0.1324,0.7941 0.2794,1.5588 0.2794 1.5588c 0.1471,0.7647 0.2794,1.5588 0.2794 1.5588h 0.0588 c 0.1618,-0.7941 0.3382,-1.5662 0.3382 -1.5662c 0.1765,-0.7721 0.3382,-1.5515 0.3382 -1.5515l 1.3382,-5.2500 h 1.1176 l 1.3382,5.2500 c 0.1765,0.7647 0.3529,1.5441 0.3529 1.5441c 0.1765,0.7794 0.3529,1.5735 0.3529 1.5735h 0.0588 c 0.1324,-0.7941 0.2647,-1.5662 0.2647 -1.5662c 0.1324,-0.7721 0.2794,-1.5515 0.2794 -1.5515l 1.0147,-5.2500 h 1.1765 l -2.0000,9.6471 h -1.4706 l -1.4559,-5.8088 c -0.1324,-0.5588 -0.2426,-1.0956 -0.2426 -1.0956c -0.1103,-0.5368 -0.2279,-1.0956 -0.2279 -1.0956h -0.0588 c -0.1176,0.5588 -0.2426,1.0956 -0.2426 1.0956c -0.1250,0.5368 -0.2426,1.0956 -0.2426 1.0956l -1.4265,5.8088 h -1.4559 ZM 487.8676,561.2500 ZM 489.0735,550.7794 h 1.2059 v 2.8529 l -0.0441,1.4706 c 0.5147,-0.4853 1.0735,-0.8309 1.0735 -0.8309c 0.5588,-0.3456 1.3088,-0.3456 1.3088 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -10.4706 ZM 495.8676,561.2500 ZM 497.6912,552.6324 c -0.3529,-0.0000 -0.5956,-0.2206 -0.5956 -0.2206c -0.2426,-0.2206 -0.2426,-0.5588 -0.2426 -0.5588c 0.0000,-0.3529 0.2426,-0.5662 0.2426 -0.5662c 0.2426,-0.2132 0.5956,-0.2132 0.5956 -0.2132c 0.3529,0.0000 0.5956,0.2132 0.5956 0.2132c 0.2426,0.2132 0.2426,0.5662 0.2426 0.5662c 0.0000,0.3382 -0.2426,0.5588 -0.2426 0.5588c -0.2426,0.2206 -0.5956,0.2206 -0.5956 0.2206ZM 497.6912,552.6324 ZM 497.0735,554.1029 h 1.2059 v 7.1471 h -1.2059 v -7.1471 ZM 499.4853,561.2500 ZM 500.6912,550.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 503.2353,561.2500 ZM 503.9118,557.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 503.9118,557.6912 ZM 508.9118,557.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 510.5294,561.2500 ZM 511.1324,557.1029 h 3.3824 v 0.9265 h -3.3824 v -0.9265 ZM 515.1029,561.2500 ZM 519.5294,551.7647 c -0.3971,-0.1765 -0.8088,-0.1765 -0.8088 -0.1765c -1.0000,-0.0000 -1.0000,1.3824 -1.0000 1.3824v 1.1324 h 1.5147 v 0.9853 h -1.5147 v 6.1618 h -1.2059 v -6.1618 h -0.9706 v -0.9118 l 0.9706,-0.0735 v -1.1324 c 0.0000,-1.1029 0.5074,-1.7353 0.5074 -1.7353c 0.5074,-0.6324 1.5809,-0.6324 1.5809 -0.6324c 0.3382,0.0000 0.6397,0.0662 0.6397 0.0662c 0.3015,0.0662 0.5515,0.1691 0.5515 0.1691ZM 519.1029,561.2500 ZM 519.9559,559.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 519.9559,559.3971 ZM 521.1471,559.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 526.6324,561.2500 ZM 527.8382,550.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 530.3824,561.2500 ZM 531.3971,559.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 536.5441,561.2500 ZM 537.2206,557.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 537.2206,557.6912 ZM 542.2206,557.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 546.8088,561.2500 ZM 549.3529,557.5147 l -2.1618,-3.4118 h 1.3088 l 0.9559,1.5735 c 0.1618,0.2941 0.3382,0.5956 0.3382 0.5956c 0.1765,0.3015 0.3676,0.5956 0.3676 0.5956h 0.0588 c 0.1618,-0.2941 0.3235,-0.5956 0.3235 -0.5956c 0.1618,-0.3015 0.3235,-0.5956 0.3235 -0.5956l 0.8676,-1.5735 h 1.2647 l -2.1618,3.5441 l 2.3235,3.6029 h -1.3088 l -1.0441,-1.6618 l -0.3824,-0.6471 c 0.0000,0.0000 -0.3971,-0.6324 -0.3971 -0.6324h -0.0588 c -0.1912,0.3088 -0.3676,0.6250 -0.3676 0.6250c -0.1765,0.3162 -0.3529,0.6544 -0.3529 0.6544l -0.9706,1.6618 h -1.2647 ZM 556.3382,561.2500 ZM 560.8088,557.6912 v -2.7206 c 0.0000,-0.3824 0.0221,-0.9044 0.0221 -0.9044c 0.0221,-0.5221 0.0515,-0.9044 0.0515 -0.9044h -0.0588 c -0.1765,0.3382 -0.3676,0.6618 -0.3676 0.6618c -0.1912,0.3235 -0.3971,0.6618 -0.3971 0.6618l -2.1912,3.2059 h 2.9412 ZM 560.8088,557.6912 ZM 563.2353,558.6618 h -1.2794 v 2.5882 h -1.1471 v -2.5882 h -4.2206 v -0.7941 l 4.0147,-6.0000 h 1.3529 v 5.8235 h 1.2794 v 0.9706 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(255,255,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 10.0000,576.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 39.1029,585.2500 ZM 40.3088,574.7794 h 1.2059 v 9.1176 c 0.0000,0.2941 0.1029,0.4118 0.1029 0.4118c 0.1029,0.1176 0.2353,0.1176 0.2353 0.1176h 0.1103 c 0.0000,0.0000 0.1544,-0.0294 0.1544 -0.0294l 0.1618,0.9118 c -0.1176,0.0588 -0.2794,0.0882 -0.2794 0.0882c -0.1618,0.0294 -0.4118,0.0294 -0.4118 0.0294c -0.6912,-0.0000 -0.9853,-0.4118 -0.9853 -0.4118c -0.2941,-0.4118 -0.2941,-1.2059 -0.2941 -1.2059v -9.0294 ZM 42.8529,585.2500 ZM 43.7059,583.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 43.7059,583.3971 ZM 44.8971,583.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 50.3824,585.2500 ZM 51.3971,583.6324 c 0.4706,0.3824 0.9632,0.6176 0.9632 0.6176c 0.4926,0.2353 1.1397,0.2353 1.1397 0.2353c 0.7059,0.0000 1.0588,-0.3235 1.0588 -0.3235c 0.3529,-0.3235 0.3529,-0.7941 0.3529 -0.7941c 0.0000,-0.2794 -0.1471,-0.4853 -0.1471 -0.4853c -0.1471,-0.2059 -0.3750,-0.3603 -0.3750 -0.3603c -0.2279,-0.1544 -0.5221,-0.2721 -0.5221 -0.2721l -0.5882,-0.2353 c -0.3824,-0.1324 -0.7647,-0.3015 -0.7647 -0.3015c -0.3824,-0.1691 -0.6838,-0.4118 -0.6838 -0.4118c -0.3015,-0.2426 -0.4926,-0.5662 -0.4926 -0.5662c -0.1912,-0.3235 -0.1912,-0.7794 -0.1912 -0.7794c 0.0000,-0.4265 0.1691,-0.8015 0.1691 -0.8015c 0.1691,-0.3750 0.4853,-0.6471 0.4853 -0.6471c 0.3162,-0.2721 0.7721,-0.4265 0.7721 -0.4265c 0.4559,-0.1544 1.0294,-0.1544 1.0294 -0.1544c 0.6765,0.0000 1.2426,0.2353 1.2426 0.2353c 0.5662,0.2353 0.9779,0.5735 0.9779 0.5735l -0.5735,0.7647 c -0.3676,-0.2794 -0.7647,-0.4559 -0.7647 -0.4559c -0.3971,-0.1765 -0.8676,-0.1765 -0.8676 -0.1765c -0.6765,-0.0000 -0.9926,0.3088 -0.9926 0.3088c -0.3162,0.3088 -0.3162,0.7206 -0.3162 0.7206c 0.0000,0.2500 0.1324,0.4338 0.1324 0.4338c 0.1324,0.1838 0.3529,0.3235 0.3529 0.3235c 0.2206,0.1397 0.5074,0.2500 0.5074 0.2500c 0.2868,0.1103 0.5956,0.2279 0.5956 0.2279c 0.3824,0.1471 0.7721,0.3088 0.7721 0.3088c 0.3897,0.1618 0.6985,0.4044 0.6985 0.4044c 0.3088,0.2426 0.5074,0.5956 0.5074 0.5956c 0.1985,0.3529 0.1985,0.8529 0.1985 0.8529c 0.0000,0.4412 -0.1691,0.8235 -0.1691 0.8235c -0.1691,0.3824 -0.5000,0.6765 -0.5000 0.6765c -0.3309,0.2941 -0.8235,0.4632 -0.8235 0.4632c -0.4926,0.1691 -1.1250,0.1691 -1.1250 0.1691c -0.7647,-0.0000 -1.4559,-0.2794 -1.4559 -0.2794c -0.6912,-0.2794 -1.2059,-0.7059 -1.2059 -0.7059ZM 56.5441,585.2500 ZM 57.9559,579.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(238,130,238)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 139.9265,576.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 169.0294,585.2500 ZM 169.8824,583.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 169.8824,583.3971 ZM 171.0735,583.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 176.5588,585.2500 ZM 178.9706,585.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 178.9706,585.8529 ZM 178.9706,583.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 184.7206,585.2500 ZM 187.1324,585.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 187.1324,585.8529 ZM 187.1324,583.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 ZM 192.8824,585.2500 ZM 193.5588,581.6912 c 0.0000,-0.8824 0.2721,-1.5809 0.2721 -1.5809c 0.2721,-0.6985 0.7206,-1.1838 0.7206 -1.1838c 0.4485,-0.4853 1.0221,-0.7426 1.0221 -0.7426c 0.5735,-0.2574 1.1912,-0.2574 1.1912 -0.2574c 0.6765,0.0000 1.2132,0.2353 1.2132 0.2353c 0.5368,0.2353 0.8971,0.6765 0.8971 0.6765c 0.3603,0.4412 0.5515,1.0588 0.5515 1.0588c 0.1912,0.6176 0.1912,1.3824 0.1912 1.3824c 0.0000,0.3971 -0.0441,0.6618 -0.0441 0.6618h -4.8235 c 0.0735,1.1618 0.7132,1.8382 0.7132 1.8382c 0.6397,0.6765 1.6691,0.6765 1.6691 0.6765c 0.5147,0.0000 0.9485,-0.1544 0.9485 -0.1544c 0.4338,-0.1544 0.8309,-0.4044 0.8309 -0.4044l 0.4265,0.7941 c -0.4706,0.2941 -1.0441,0.5147 -1.0441 0.5147c -0.5735,0.2206 -1.3088,0.2206 -1.3088 0.2206c -0.7206,-0.0000 -1.3456,-0.2574 -1.3456 -0.2574c -0.6250,-0.2574 -1.0882,-0.7353 -1.0882 -0.7353c -0.4632,-0.4779 -0.7279,-1.1691 -0.7279 -1.1691c -0.2647,-0.6912 -0.2647,-1.5735 -0.2647 -1.5735ZM 193.5588,581.6912 ZM 198.5588,581.1471 c 0.0000,-1.1029 -0.4632,-1.6838 -0.4632 -1.6838c -0.4632,-0.5809 -1.3015,-0.5809 -1.3015 -0.5809c -0.3824,-0.0000 -0.7279,0.1544 -0.7279 0.1544c -0.3456,0.1544 -0.6250,0.4412 -0.6250 0.4412c -0.2794,0.2868 -0.4632,0.7059 -0.4632 0.7059c -0.1838,0.4191 -0.2426,0.9632 -0.2426 0.9632h 3.8235 ZM 200.1765,585.2500 ZM 201.3824,578.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 208.2206,585.2500 ZM 208.9118,581.6912 c 0.0000,-0.8676 0.2574,-1.5662 0.2574 -1.5662c 0.2574,-0.6985 0.6838,-1.1838 0.6838 -1.1838c 0.4265,-0.4853 0.9853,-0.7500 0.9853 -0.7500c 0.5588,-0.2647 1.1765,-0.2647 1.1765 -0.2647c 0.6176,0.0000 1.0735,0.2206 1.0735 0.2206c 0.4559,0.2206 0.9265,0.6029 0.9265 0.6029l -0.0588,-1.2206 v -2.7500 h 1.2206 v 10.4706 h -1.0000 l -0.1029,-0.8382 h -0.0441 c -0.4265,0.4118 -0.9779,0.7132 -0.9779 0.7132c -0.5515,0.3015 -1.1838,0.3015 -1.1838 0.3015c -1.3529,-0.0000 -2.1544,-0.9706 -2.1544 -0.9706c -0.8015,-0.9706 -0.8015,-2.7647 -0.8015 -2.7647ZM 208.9118,581.6912 ZM 210.1618,581.6765 c 0.0000,1.2941 0.5147,2.0147 0.5147 2.0147c 0.5147,0.7206 1.4559,0.7206 1.4559 0.7206c 0.5000,0.0000 0.9412,-0.2426 0.9412 -0.2426c 0.4412,-0.2426 0.8824,-0.7426 0.8824 -0.7426v -3.7353 c -0.4559,-0.4118 -0.8750,-0.5809 -0.8750 -0.5809c -0.4191,-0.1691 -0.8603,-0.1691 -0.8603 -0.1691c -0.4265,-0.0000 -0.8015,0.1985 -0.8015 0.1985c -0.3750,0.1985 -0.6544,0.5588 -0.6544 0.5588c -0.2794,0.3603 -0.4412,0.8603 -0.4412 0.8603c -0.1618,0.5000 -0.1618,1.1176 -0.1618 1.1176ZM 216.3824,585.2500 ZM 218.9265,580.1765 h 1.6176 c 1.1324,0.0000 1.7353,-0.4632 1.7353 -0.4632c 0.6029,-0.4632 0.6029,-1.4044 0.6029 -1.4044c 0.0000,-0.9559 -0.6029,-1.3382 -0.6029 -1.3382c -0.6029,-0.3824 -1.7353,-0.3824 -1.7353 -0.3824h -1.6176 v 3.5882 ZM 218.9265,580.1765 ZM 223.0000,585.2500 l -2.3235,-4.0735 h -1.7500 v 4.0735 h -1.2206 v -9.6471 h 3.0147 c 0.7353,0.0000 1.3603,0.1397 1.3603 0.1397c 0.6250,0.1397 1.0735,0.4632 1.0735 0.4632c 0.4485,0.3235 0.6985,0.8382 0.6985 0.8382c 0.2500,0.5147 0.2500,1.2647 0.2500 1.2647c 0.0000,1.1324 -0.5882,1.8088 -0.5882 1.8088c -0.5882,0.6765 -1.5735,0.9265 -1.5735 0.9265l 2.4412,4.2059 h -1.3824 ZM 224.9265,585.2500 ZM 226.3088,574.8382 h 2.6324 v 0.6912 h -1.7206 v 11.2647 h 1.7206 v 0.6912 h -2.6324 v -12.6471 ZM 229.3824,585.2500 ZM 230.5441,584.2500 h 2.1471 v -6.9118 h -1.7059 v -0.7794 c 0.6471,-0.1176 1.1250,-0.2868 1.1250 -0.2868c 0.4779,-0.1691 0.8603,-0.4044 0.8603 -0.4044h 0.9265 v 8.3824 h 1.9412 v 1.0000 h -5.2941 v -1.0000 ZM 236.6912,585.2500 ZM 240.3529,585.4265 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 240.3529,585.4265 ZM 240.3529,584.4559 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 244.0000,585.2500 ZM 247.6618,585.4265 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 247.6618,585.4265 ZM 247.6618,584.4559 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 251.3088,585.2500 ZM 254.9706,585.4265 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 254.9706,585.4265 ZM 254.9706,584.4559 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 258.6176,585.2500 ZM 262.2794,585.4265 c -1.4265,-0.0000 -2.2206,-1.2647 -2.2206 -1.2647c -0.7941,-1.2647 -0.7941,-3.6324 -0.7941 -3.6324c 0.0000,-2.3676 0.7941,-3.6029 0.7941 -3.6029c 0.7941,-1.2353 2.2206,-1.2353 2.2206 -1.2353c 1.4118,0.0000 2.2059,1.2353 2.2059 1.2353c 0.7941,1.2353 0.7941,3.6029 0.7941 3.6029c 0.0000,2.3676 -0.7941,3.6324 -0.7941 3.6324c -0.7941,1.2647 -2.2059,1.2647 -2.2059 1.2647ZM 262.2794,585.4265 ZM 262.2794,584.4559 c 0.4118,0.0000 0.7426,-0.2279 0.7426 -0.2279c 0.3309,-0.2279 0.5735,-0.7059 0.5735 -0.7059c 0.2426,-0.4779 0.3750,-1.2206 0.3750 -1.2206c 0.1324,-0.7426 0.1324,-1.7721 0.1324 -1.7721c 0.0000,-1.0294 -0.1324,-1.7647 -0.1324 -1.7647c -0.1324,-0.7353 -0.3750,-1.1985 -0.3750 -1.1985c -0.2426,-0.4632 -0.5735,-0.6838 -0.5735 -0.6838c -0.3309,-0.2206 -0.7426,-0.2206 -0.7426 -0.2206c -0.4118,-0.0000 -0.7500,0.2206 -0.7500 0.2206c -0.3382,0.2206 -0.5809,0.6838 -0.5809 0.6838c -0.2426,0.4632 -0.3750,1.1985 -0.3750 1.1985c -0.1324,0.7353 -0.1324,1.7647 -0.1324 1.7647c 0.0000,2.0588 0.5074,2.9926 0.5074 2.9926c 0.5074,0.9338 1.3309,0.9338 1.3309 0.9338ZM 265.9265,585.2500 ZM 268.0882,586.7941 v -11.2647 h -1.7059 v -0.6912 h 2.6176 v 12.6471 h -2.6176 v -0.6912 h 1.7059 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,255)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 288.1471,576.0000 v 14.0000 h 22.0000 v -14.0000 Z"/></g><g stroke-linejoin="bevel" stroke-opacity="0.0" fill-opacity="1.0" stroke="rgb(0,0,0)" stroke-width="0.0" fill="rgb(0,0,0)" stroke-linecap="butt" stroke-miterlimit="10.0"><path d="M 317.2500,585.2500 ZM 317.9265,581.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 323.6471,585.2500 ZM 324.3235,581.6912 c 0.0000,-0.8971 0.2721,-1.5956 0.2721 -1.5956c 0.2721,-0.6985 0.7279,-1.1838 0.7279 -1.1838c 0.4559,-0.4853 1.0515,-0.7353 1.0515 -0.7353c 0.5956,-0.2500 1.2574,-0.2500 1.2574 -0.2500c 0.6618,0.0000 1.2574,0.2500 1.2574 0.2500c 0.5956,0.2500 1.0515,0.7353 1.0515 0.7353c 0.4559,0.4853 0.7279,1.1838 0.7279 1.1838c 0.2721,0.6985 0.2721,1.5956 0.2721 1.5956c 0.0000,0.8824 -0.2721,1.5809 -0.2721 1.5809c -0.2721,0.6985 -0.7279,1.1765 -0.7279 1.1765c -0.4559,0.4779 -1.0515,0.7279 -1.0515 0.7279c -0.5956,0.2500 -1.2574,0.2500 -1.2574 0.2500c -0.6618,-0.0000 -1.2574,-0.2500 -1.2574 -0.2500c -0.5956,-0.2500 -1.0515,-0.7279 -1.0515 -0.7279c -0.4559,-0.4779 -0.7279,-1.1765 -0.7279 -1.1765c -0.2721,-0.6985 -0.2721,-1.5809 -0.2721 -1.5809ZM 324.3235,581.6912 ZM 325.5735,581.6912 c 0.0000,0.6176 0.1471,1.1176 0.1471 1.1176c 0.1471,0.5000 0.4191,0.8603 0.4191 0.8603c 0.2721,0.3603 0.6544,0.5588 0.6544 0.5588c 0.3824,0.1985 0.8382,0.1985 0.8382 0.1985c 0.4559,0.0000 0.8382,-0.1985 0.8382 -0.1985c 0.3824,-0.1985 0.6544,-0.5588 0.6544 -0.5588c 0.2721,-0.3603 0.4191,-0.8603 0.4191 -0.8603c 0.1471,-0.5000 0.1471,-1.1176 0.1471 -1.1176c 0.0000,-0.6176 -0.1471,-1.1250 -0.1471 -1.1250c -0.1471,-0.5074 -0.4191,-0.8750 -0.4191 -0.8750c -0.2721,-0.3676 -0.6544,-0.5662 -0.6544 -0.5662c -0.3824,-0.1985 -0.8382,-0.1985 -0.8382 -0.1985c -0.4559,-0.0000 -0.8382,0.1985 -0.8382 0.1985c -0.3824,0.1985 -0.6544,0.5662 -0.6544 0.5662c -0.2721,0.3676 -0.4191,0.8750 -0.4191 0.8750c -0.1471,0.5074 -0.1471,1.1250 -0.1471 1.1250ZM 331.6176,585.2500 ZM 332.8235,578.1029 h 1.0000 l 0.1029,1.0294 h 0.0441 c 0.5147,-0.5147 1.0809,-0.8603 1.0809 -0.8603c 0.5662,-0.3456 1.3162,-0.3456 1.3162 -0.3456c 1.1324,0.0000 1.6544,0.7059 1.6544 0.7059c 0.5221,0.7059 0.5221,2.0882 0.5221 2.0882v 4.5294 h -1.2059 v -4.3676 c 0.0000,-1.0147 -0.3235,-1.4632 -0.3235 -1.4632c -0.3235,-0.4485 -1.0294,-0.4485 -1.0294 -0.4485c -0.5588,-0.0000 -0.9853,0.2794 -0.9853 0.2794c -0.4265,0.2794 -0.9706,0.8235 -0.9706 0.8235v 5.1765 h -1.2059 v -7.1471 ZM 339.6618,585.2500 ZM 340.3382,581.6912 c 0.0000,-0.8971 0.2794,-1.5956 0.2794 -1.5956c 0.2794,-0.6985 0.7500,-1.1838 0.7500 -1.1838c 0.4706,-0.4853 1.0956,-0.7353 1.0956 -0.7353c 0.6250,-0.2500 1.3162,-0.2500 1.3162 -0.2500c 0.7059,0.0000 1.2132,0.2574 1.2132 0.2574c 0.5074,0.2574 0.8750,0.5956 0.8750 0.5956l -0.6029,0.7794 c -0.3235,-0.2794 -0.6691,-0.4559 -0.6691 -0.4559c -0.3456,-0.1765 -0.7721,-0.1765 -0.7721 -0.1765c -0.4853,-0.0000 -0.8971,0.1985 -0.8971 0.1985c -0.4118,0.1985 -0.7059,0.5662 -0.7059 0.5662c -0.2941,0.3676 -0.4632,0.8750 -0.4632 0.8750c -0.1691,0.5074 -0.1691,1.1250 -0.1691 1.1250c 0.0000,0.6176 0.1618,1.1176 0.1618 1.1176c 0.1618,0.5000 0.4485,0.8603 0.4485 0.8603c 0.2868,0.3603 0.6985,0.5588 0.6985 0.5588c 0.4118,0.1985 0.8971,0.1985 0.8971 0.1985c 0.5147,0.0000 0.9338,-0.2132 0.9338 -0.2132c 0.4191,-0.2132 0.7426,-0.5074 0.7426 -0.5074l 0.5441,0.7941 c -0.4853,0.4265 -1.0809,0.6765 -1.0809 0.6765c -0.5956,0.2500 -1.2426,0.2500 -1.2426 0.2500c -0.7059,-0.0000 -1.3235,-0.2500 -1.3235 -0.2500c -0.6176,-0.2500 -1.0662,-0.7279 -1.0662 -0.7279c -0.4485,-0.4779 -0.7059,-1.1765 -0.7059 -1.1765c -0.2574,-0.6985 -0.2574,-1.5809 -0.2574 -1.5809ZM 346.2206,585.2500 ZM 347.0735,583.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 347.0735,583.3971 ZM 348.2647,583.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 353.7500,585.2500 ZM 355.1618,579.0882 h -1.0588 v -0.9118 l 1.1176,-0.0735 l 0.1471,-2.0000 h 1.0147 v 2.0000 h 1.9265 v 0.9853 h -1.9265 v 3.9706 c 0.0000,0.6618 0.2426,1.0221 0.2426 1.0221c 0.2426,0.3603 0.8603,0.3603 0.8603 0.3603c 0.1912,0.0000 0.4118,-0.0588 0.4118 -0.0588c 0.2206,-0.0588 0.3971,-0.1324 0.3971 -0.1324l 0.2353,0.9118 c -0.2941,0.1029 -0.6397,0.1838 -0.6397 0.1838c -0.3456,0.0809 -0.6838,0.0809 -0.6838 0.0809c -0.5735,-0.0000 -0.9632,-0.1765 -0.9632 -0.1765c -0.3897,-0.1765 -0.6324,-0.4853 -0.6324 -0.4853c -0.2426,-0.3088 -0.3456,-0.7500 -0.3456 -0.7500c -0.1029,-0.4412 -0.1029,-0.9706 -0.1029 -0.9706v -3.9559 ZM 358.7206,585.2500 ZM 360.0441,575.6029 h 1.4412 l 1.8676,5.1765 l 0.7059,1.9706 h 0.0588 l 0.6765,-1.9706 l 1.8529,-5.1765 h 1.4412 v 9.6471 h -1.1618 v -5.3088 c 0.0000,-0.6471 0.0515,-1.4265 0.0515 -1.4265c 0.0515,-0.7794 0.1103,-1.4265 0.1103 -1.4265h -0.0588 l -0.7794,2.1471 l -1.8529,5.0441 h -0.6912 l -1.8676,-5.0441 l -0.7647,-2.1471 h -0.0588 c 0.0441,0.6471 0.1029,1.4265 0.1029 1.4265c 0.0588,0.7794 0.0588,1.4265 0.0588 1.4265v 5.3088 h -1.1324 v -9.6471 ZM 369.4118,585.2500 ZM 370.2647,583.3971 c 0.0000,-1.1765 1.0515,-1.8015 1.0515 -1.8015c 1.0515,-0.6250 3.3456,-0.8750 3.3456 -0.8750c 0.0000,-0.3382 -0.0662,-0.6618 -0.0662 -0.6618c -0.0662,-0.3235 -0.2353,-0.5735 -0.2353 -0.5735c -0.1691,-0.2500 -0.4485,-0.4044 -0.4485 -0.4044c -0.2794,-0.1544 -0.7206,-0.1544 -0.7206 -0.1544c -0.6324,-0.0000 -1.1691,0.2353 -1.1691 0.2353c -0.5368,0.2353 -0.9632,0.5294 -0.9632 0.5294l -0.4853,-0.8382 c 0.5000,-0.3235 1.2206,-0.6250 1.2206 -0.6250c 0.7206,-0.3015 1.5882,-0.3015 1.5882 -0.3015c 1.3088,0.0000 1.8971,0.8015 1.8971 0.8015c 0.5882,0.8015 0.5882,2.1397 0.5882 2.1397v 4.3824 h -1.0000 l -0.1029,-0.8529 h -0.0294 c -0.5147,0.4265 -1.1103,0.7279 -1.1103 0.7279c -0.5956,0.3015 -1.2574,0.3015 -1.2574 0.3015c -0.9118,-0.0000 -1.5074,-0.5294 -1.5074 -0.5294c -0.5956,-0.5294 -0.5956,-1.5000 -0.5956 -1.5000ZM 370.2647,583.3971 ZM 371.4559,583.3088 c 0.0000,0.6176 0.3603,0.8824 0.3603 0.8824c 0.3603,0.2647 0.8897,0.2647 0.8897 0.2647c 0.5147,0.0000 0.9779,-0.2426 0.9779 -0.2426c 0.4632,-0.2426 0.9779,-0.7132 0.9779 -0.7132v -1.9853 c -0.8971,0.1176 -1.5147,0.2794 -1.5147 0.2794c -0.6176,0.1618 -0.9926,0.3824 -0.9926 0.3824c -0.3750,0.2206 -0.5368,0.5074 -0.5368 0.5074c -0.1618,0.2868 -0.1618,0.6250 -0.1618 0.6250ZM 376.9412,585.2500 ZM 379.3529,585.8529 v 2.4118 h -1.2059 v -10.1618 h 1.0000 l 0.1029,0.8235 h 0.0441 c 0.4853,-0.4118 1.0662,-0.7059 1.0662 -0.7059c 0.5809,-0.2941 1.2132,-0.2941 1.2132 -0.2941c 0.6912,0.0000 1.2206,0.2574 1.2206 0.2574c 0.5294,0.2574 0.8824,0.7353 0.8824 0.7353c 0.3529,0.4779 0.5368,1.1471 0.5368 1.1471c 0.1838,0.6691 0.1838,1.5074 0.1838 1.5074c 0.0000,0.9118 -0.2500,1.6250 -0.2500 1.6250c -0.2500,0.7132 -0.6765,1.2132 -0.6765 1.2132c -0.4265,0.5000 -0.9853,0.7574 -0.9853 0.7574c -0.5588,0.2574 -1.1765,0.2574 -1.1765 0.2574c -0.5000,-0.0000 -0.9926,-0.2206 -0.9926 -0.2206c -0.4926,-0.2206 -0.9926,-0.6029 -0.9926 -0.6029ZM 379.3529,585.8529 ZM 379.3529,583.6618 c 0.4853,0.4118 0.9412,0.5809 0.9412 0.5809c 0.4559,0.1691 0.8088,0.1691 0.8088 0.1691c 0.4412,0.0000 0.8162,-0.1985 0.8162 -0.1985c 0.3750,-0.1985 0.6471,-0.5588 0.6471 -0.5588c 0.2721,-0.3603 0.4265,-0.8897 0.4265 -0.8897c 0.1544,-0.5294 0.1544,-1.1912 0.1544 -1.1912c 0.0000,-0.5882 -0.1029,-1.0735 -0.1029 -1.0735c -0.1029,-0.4853 -0.3309,-0.8309 -0.3309 -0.8309c -0.2279,-0.3456 -0.5882,-0.5368 -0.5882 -0.5368c -0.3603,-0.1912 -0.8603,-0.1912 -0.8603 -0.1912c -0.4559,-0.0000 -0.9191,0.2500 -0.9191 0.2500c -0.4632,0.2500 -0.9926,0.7206 -0.9926 0.7206v 3.7500 Z"/></g></svg>
− docs/streamly-vs-lists.md 
@@ -1,265 +0,0 @@-# Streams are concurrent monadic lists--Streamly streams are a generalization of Haskell lists with a similar API with-two crucial additions:--* A list is a _pure sequence_ of values whereas a stream is a _monadic-  sequence_ of values i.e. a sequence of values generated by monadic actions.-* The monadic actions producing the sequence can be executed concurrently.-  Concurrency is declarative and can be switched on or off using an appropriate-  combinator.--## Pure Streams vs Monadic Streams--A list is a sequence of pure values or pure steps that produce a value on-evaluation.  Ideally, we want to process each element in the sequence through a-pipeline of processing stages without first accumulating all the elements in-the sequence. This style of processing is known as "streaming" and it runs in-constant memory because we do not accumulate elements in memory, data gets-consumed as soon as it is produced.  If all the processing stages are pure,-lists can be used in a streaming style processing. For example, this is-streaming style processing:--```-  replicate 10 1-    & zipWith (+) [1..10]-    & map (+1)-    & filter odd-    & sum-```--However, if a list is generated in a strict monad (e.g. IO) it cannot be-consumed in a streaming fashion as described above. In that case the full list-first gets accumulated and then processed. This means we will consume memory-proportional to the size of the list and therefore it becomes unusable for-large lists. For example, the following code accumulates `xs` before it-processes it:--```-  xs <- replicateM 10 (return 1)-  zipWith (+) [1..10] xs-    & map (+1)-    & filter odd-    & sum-```--Monadic streams solve this problem. To be able to consume elements from-`replicateM` as it produces them we need a monadic representation of the stream-and stream processing operations that can consume the stream elements lazily-one at a time. Streamly provides a monadic representation for lists with the-same API.  So we can represent the previous example in a streaming fashion by-replacing the list combinators with corresponding streamly combinators:--```-  S.replicateM 10 (return 1)-    & S.zipWith (+) (S.fromList [1..10])-    & S.map (+1)-    & S.filter odd-    & S.sum-```--Streamly's monadic streams are a generalization of pure streams (aka lists) and-therefore can represent pure streams just as easily, making lists a special-case.--## Streamly as lists--`SerialT Identity a` can be used in place of `[a]` with equivalent or better-performance and almost identical interface except a few differences. Use of-`OverloadedLists` extension can make the difference even less significant. ---### Construction--Lists are constructed using `[]` and `:`.--```-> "hello" : "world" : []-["hello","world"]-```--Pure streams are constructed using `S.nil` (corresponds to `[]`) and `S.cons`-or `.:` (corresponds to `:`):--```-import Streamly-import Streamly.Prelude ((.:))-import qualified Streamly.Prelude as S--> "hello" .: "world" .: S.nil :: SerialT Identity String-fromList ["hello","world"]-```--### Pattern Matching--The crucial difference is that lists are built using constructors whereas-streams are built using functions. `S.nil` and `S.cons` are functions.-Therefore, you cannot directly pattern match on streams.  However, the yet-unexposed `Streamly.List` module also provides `Nil` and `Cons` pattern-synonyms corresponding to the list `[]` and `:` constructors for pattern-matches.--### Pure Operations--`SerialT Identity a` is an instance of `Show`, `Read`, `Eq`, `Ord`, `IsList`,-`Foldable` and `Traversable` type classes. Furthermore, `SerialT Identity Char`-is an instance of `IsString`. Use of `OverloadedLists` and `OverloadedStrings`-can make the use of streams in place of lists quite convenient.--Along with these we can use combinators from `Streamly.Prelude` to perform all-list operations on pure streams.--Lists:--```-> replicate 10 1-> map (+1) $ replicate 10 1-> length $ replicate 10 1-```--Pure streams are almost identical:--```-> S.replicate 10 1 :: SerialT Identity Int-> S.map (+1) $ S.replicate 10 1 :: SerialT Identity Int-> length (S.replicate 10 1 :: SerialT Identity Int)-```--## Monadic Operations--Lists have great performance as long as we perform only pure operations on-them. When monadic operations are performed on lists, they may accumulate-potentially unbounded or large lists in memory degrading performance massively.--Such "unsafe" list operations exist in `Control.Monad`, `Data.Traversable`, and-`Data.Foldable` in `base`. They are typically found with an `M` suffix.--Streamly provides monadic streams and the equivalents of the above mentioned-monadic list operations work on streams without any issues.--Unsafe monadic operations involving lists, run these example with `+RTS -s`-options:--```-import Control.Monad-main = do-  xs <- replicateM 10000000 (pure 1)-  ys <- mapM (\x -> return $ x + 1) xs-  print $ length ys-```--Streams:--```-import Streamly-import qualified Streamly.Prelude as S-main = do-  n <- S.length-      $ S.mapM (\x -> return $ x + 1)-      $ S.replicateM 10000000 (pure 1)-  print n-```--## Splitting Operations--Another unsafe category of operations for lists is stream splitting operations-e.g. `lines`, `splitAt` and `group`. Such operations may also accumulate-unbounded data in memory.--Stream splitting operations in streamly are streaming in nature and can work-without accumulating any data in memory.--### Monadic Lists--Monadic streams are nothing but lists made monadic. We can construct streams-using monadic actions, just the way pure lists are constructed:--```-> import Streamly.Prelude ((|:))-> import qualified Streamly.Prelude as S-> S.toList $ getLine |: getLine |: S.nil-hello-world-["hello","world"]-```--`|:` is the monadic construction equivalent of `:`.-The monadic action `getLine` is executed twice in a sequence, the first one-gets "hello" and second one gets "world" from the terminal and a stream-consisting of those strings is produced.--## Concurrent Monadic Lists--Streamly streams are not just monadic lists but they are concurrent monadic-lists. All the monadic streaming operations provided by streamly are inherently-concurrent.  Concurrent behavior can be enabled by just using an appropriate-modifying combinator, without any other change to the code.--The following code prints one element every second:--```haskell-import Control.Concurrent-import Streamly-import qualified Streamly.Prelude as S--func = S.mapM (\x -> threadDelay 1000000 >> print x) $ S.replicate 10 1-main = runStream func-```--To run it concurrently, just run the same code with `fromAsync` combinator:--```haskell-main = runStream $ fromAsync func-```--The `mapM` combinator now maps the monadic delay action concurrently on all the-stream elements.  It prints all the 10 elements after one second because all-the delay actions run concurrently. Alternatively we can write:--```-func = S.mapM $ fromAsync $ S.replicateM (threadDelay 1000000 >> print 1)-main = runStream func-```--Here, the `replicateM` operation replicates the action concurrently.  In real-applications this could be a request to a web server that you may want to-perform multiple times concurrently.--## Performance: Streamly vs Lists--The following figures show the ratio of time and memory consumed by `[Int]`-(`base-4.12`) vs `SerialT Identity Int`-([streamly@00c7613](https://github.com/composewell/streamly)) for exactly the-same operation. `5x` on the y axis means lists take 5 times more resources-compared to streamly. Whereas a `1/5x` means that lists take 5 times less-resources compared to streamly. We only show those operations that are at least-10% better or worse in one library compared to the other. The operations are-shown in a sorted order, from list's worst performing ones on the left to its-best ones on the right.--![Streamly vs Lists (time) comparison](/docs/streamly-vs-list-time.svg)--## Why use streams instead of lists?--By using monadic streams instead of lists you get the following benefits:--* Use just one library for pure or monadic lists. There is no difference in-  pure or monadic code, its all the same.-* You can use a monadic action anywhere in the code e.g. printing a warning or-  error message or any other effectful operations. This is not possible in pure-  list code.-* You can make the code concurrent whenever you want without having to modify-  it.-* You do not have the risk of using unsafe/accumulating list operations-  degrading performance massively and resulting in space leaks.-* Streamly provides safe versions of partial list functions like `head`, `tail`-  etc.-* You get better fusion and therefore better performance for many operations,-  the only operation which is significantly faster for lists is `concatMap`.--## References--* [Data.List](https://hackage.haskell.org/package/base/docs/Data-List.html)-* [Control.Monad](http://hackage.haskell.org/package/base/docs/Control-Monad.html)-* [Data.Foldable](http://hackage.haskell.org/package/base/docs/Data-Foldable.html)-* [Data.Traversable](http://hackage.haskell.org/package/base/docs/Data-Traversable.html)
− docs/unified-abstractions.md 
@@ -1,275 +0,0 @@-# Unified Functional Abstractions in Streamly--The goal of Streamly is to provide unified abstractions with high-performance.  The basic abstractions in Streamly are streams and arrays-and yet it provides the functionality of many packages in the Haskell-ecosystem.--This document discusses the related packages in the Haskell ecosystem-and how streamly unifies, overlaps, or compares with those. We provide-simple code snippets for illustrations, for a better overview of the-library please see the [Streamly Quick Overview](/docs/Introduction.md) document.--## Existing Haskell Libraries--In the Haskell ecosystem effectful streaming functionality is provided-by several streaming libraries e.g. `streaming`, nested looping by list-transformers e.g. `list-t`, interleaved scheduling by `logict`,-concurrency by `async`, time-domain programming by FRP libraries like-`Yampa` and `reflex`, and array functionality by `bytestring`, `text`,-`vector`, and `arrays` packages.--For basic programming needs, one needs to discover and learn all of-these or roll something on their own. These libraries have evolved-independently for specialized needs. They are not designed with a big-picture in mind to eliminate duplicate functionality and to come up with-the most optimal abstractions on the whole. For example, there is no-reason why streaming, list-t, and logict cannot be provided by the same-implementation. Concurrency and reactive programming also naturally fit-with the streaming model and can be unified. `Bytestring`, `text`,-`vector`, and `arrays` all provide the same functionality which can-be unified under one umbrella of arrays. Moreover, there are many-of flavors some of these packages like lazy bytestring, Char8 bytestrings,-lazy text which can be eliminated by using streams instead.--On the performance side, existing streaming libraries lack stream fusion-leading to a function call overhead in each iteration of the loop,-therefore, providing orders of magnitude lower performance in tight-loops compared to writing a monolithic loop by hand. Similarly, `logict`-shows quadratic performance characteristics in some basic use cases.-These problems are solved by Streamly.--## How Streamly Unifies them?--Streamly unifies streaming, nested looping, scheduling, concurrency,-time, and array functionality using two basic constructs, namely streams-and arrays. Streams provide efficient, immutable, composable serial-processing capabilities for in-flight data, whereas arrays provide-efficient storage, mutability, and random access for data at rest.--Streamly builds all the functionality on top of these two building-blocks. It takes a big picture view of programming in general and-provides well-integrated APIs with the same look and feel. Moreover,-performance is a primary goal of streamly, all the functionality is-built for performance comparable to C.--Streamly streams are like lists and provide non-determinism just like-lists.  Streamly also adds asynchronicity and concurrency to-streaming composition.  This seemingly simple change unifies several-disparate abstractions into one powerful, concise, and elegant-abstraction.  A wide variety of programming problems can be solved-elegantly with this abstraction. In particular, it unifies three major-programming domains namely non-deterministic (logic) programming,-concurrent programming, and functional Reactive programming.--## Streaming--The basic, bare-bones functionality of Streamly is processing streams of-data.  In simple terms, stream processing is the functional equivalent-of loops in imperative programming.--Like Haskell lists, `vector`, and `streaming` packages, Streamly composes-streams of data rather than stream processor functions as in other-streaming libraries like `pipes` and `machines`. This makes the types-and API very simple and is very similar to Haskell lists which is-familiar to everyone. The fundamental difference is that Streamly adds-concurrency support but the good thing is that it does not change the-API.--This simple console echo program shows the simplicity of Streamly API-and its similarity with the list API:--```haskell-echo =-      Stream.repeatM getLine-    & Stream.mapM putStrLn-    & Stream.drain-```--Streamly uses dual representation for streams. On top it uses Scott-encoded CPS streams which provide a way to incrementally construct and-append streams efficiently. Under the good, for tight loops, Streamly-uses a vector-like stream representation which is amenable to-`case-of-case` and `SPEC constructor` optimizations by GHC resulting in-low-level code having performance comparable to C.--To further understand the similarity with list API, please see [Streamly vs.-lists](/docs/streamly-vs-lists.md).-For comparison of Streamly performance with other libraries see-[streaming benchmarks](https://github.com/composewell/streaming-benchmarks).--## Non-determinism--Roughly speaking, non-determinism is a fancy term that functional-programmers use for what you call nested loops in imperative-programming. List transformers are the basic implementations for-non-determinism.--The stream monad in Streamly is a list-transformer with behavior similar-to the list monad. It provides the functionality provided by `list-t` or-`logict` packages for free.  Here is an example of nested looping using-the serial stream monad:--```haskell-import qualified Streamly.Prelude as S--loops = do-    x <- Stream.fromFoldable [1,2]-    y <- Stream.fromFoldable [3,4]-    Stream.fromEffect $ print (x, y)-```--Moreover, the list transformer in Streamly can be concurrent. The Scott-encoding of streams also avoids the quadratic performance issue of-`logict`.--## Scheduling Behaviors--When we execute a stream or combine two streams, the actions in the-stream need to be scheduled for execution.  Existing streaming libraries-are limited to just one form of scheduling of actions in the stream-which is serial execution. Streamly provides several ways of scheduling-the actions in the stream. The good thing is the API does not change, we-just need to use a combinator or a different type to change the-scheduling behavior.--In a single stream, the actions in the stream can be executed-concurrently with different concurrent scheduling behaviors.  Two or-more streams can be combined in several ways. For example, the actions-from two streams being combined can be interleaved.  Similarly, streams-can be interleaved with concurrent execution providing a fair,-concurrent round-robin scheduling of streams.--The monad instance provides a convenient way to combine streams in-different ways. It is just non-determinism with different flavors of-scheduling behavior.  The example from the previous section can be run-with interleaved scheduling behavior as follows, without changing the-code at all:--```haskell-main = Stream.drain $ Stream.fromWserial loops-```--Scheduling is fundamental to expressing many common programming problems-in an idiomatic functional manner.  One example application of-interleaving is breadth-first search mechanism for logic programming.-Please see [mini kanren implementation using streamly](https://github.com/composewell/ds-kanren).--## Declarative Concurrency--The same combinators that are used for serial streams e.g. 'unfoldrM',-'replicateM', 'repeatM' work concurrently when used at the appropriate type.-It allows concurrent programs to be written declaratively and composed-idiomatically. They are not much different than serial programs.  See-[Streamly vs async](/docs/streamly-vs-async.md)-for a comparison of Streamly with the `async` package.--Streamly provides concurrent scheduling and looping similar to to-[OpenMP](https://en.wikipedia.org/wiki/OpenMP) and-[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative-style.  The list transformer example can be run with concurrent-execution of loop iterations as follows, without changing the code at-all:--```haskell-main = Stream.drain $ Stream.fromAhead loops-```--And interleaving with concurrent execution of the loop iterations can be-written like this:--```haskell-main = Stream.drain $ Stream.fromWAsync loops-```--All this comes with no change in the streaming APIs.--## Reactive Programming--The combination of non-determinism, concurrency, and streaming makes-Streamly a strong reactive programming library as well. Reactive-programming fundamentally deals with streams of events that can be-processed concurrently. The [Acid Rain][AcidRain.hs] and-[Circling Square][CirclingSquare.hs]-examples demonstrate the basic reactive capability of Streamly.--In core concepts, Streamly is strikingly similar to `dunai`.  `dunai` was-designed from a FRP perspective and Streamly was originally designed-from a concurrency perspective. However, both have similarities at the-core.--## Arrays--Streamly provides immutable, mutable, pinned, unpinned, boxed, and-unboxed arrays with streaming interfaces.  The combination of efficient-streaming and polymorphic arrays lets it express the functionality of-`bytestring` and `text` packages as special cases of arrays with no loss-of performance. Since we can use explicit streaming, the lazy versions-of `bytestring` and `text` are not required.--## Conclusion--Streamly, provides effectful streams, with a simple API, almost-identical to standard lists, and in-built support for concurrency.-By using stream-style combinators on stream composition, streams can be-generated, merged, chained, mapped, zipped, and consumed concurrently –-providing a generalized high-level programming framework unifying-streaming and concurrency. Controlled concurrency allows even infinite-streams to be evaluated concurrently.  Concurrency is auto-scaled based-on feedback from the stream consumer.--Streamly is a programmer-first library, designed to be useful and-friendly to programmers for solving practical problems in a simple and-concise manner. Some key points that Streamly stresses are:--* _Simplicity_: Simple list like streaming API, if you know how to use lists-  then you know how to use Streamly. This library is built with simplicity-  and ease of use as a design goal.-* _Concurrency_: Simple, powerful, and scalable concurrency.  Concurrency is-  built-in, and not intrusive, concurrent programs are written exactly-  as non-concurrent ones.-* _Generality_: Unifies functionality provided by several disparate packages-  (streaming, concurrency, list transformer, logic programming, reactive-  programming) in a concise API.-* _Performance_: Streamly is designed for high performance. It employs stream-  fusion optimizations for the best possible performance. Serial performance is-  equivalent to the venerable `vector` library in most cases and even better-  in some cases.  Concurrent performance is unbeatable.  See-  [streaming-benchmarks](https://github.com/composewell/streaming-benchmarks)-  for a comparison of popular streaming libraries on micro-benchmarks.--## Appendix--Streamly unifies the functionality overlapping the following Haskell-libraries:--### Streaming--* [vector](https://hackage.haskell.org/package/vector)-* [streaming](https://hackage.haskell.org/package/streaming)-* [pipes](https://hackage.haskell.org/package/pipes)-* [conduit](https://hackage.haskell.org/package/conduit)--### List Transformers and Logic Programming--* [pipes](https://hackage.haskell.org/package/pipes)-* [list-t](https://hackage.haskell.org/package/list-t)-* [logict](https://hackage.haskell.org/package/logict)--### Concurrency--* [async](https://hackage.haskell.org/package/async)--### Reactive Programming--* [Yampa](https://hackage.haskell.org/package/Yampa)-* [reflex](https://hackage.haskell.org/package/reflex)--### Arrays--* [vector](https://hackage.haskell.org/package/vector)--<!-- Markdown Links -->--[AcidRain.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/AcidRain.hs-[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/CirclingSquare.hs
− jsbits/clock.js 
@@ -1,31 +0,0 @@-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/Streamly.hs 
@@ -1,690 +0,0 @@--- |--- Module      : Streamly--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Streamly is a general purpose programming framework using cocnurrent data--- flow programming paradigm.  It can be considered as a generalization of--- Haskell lists to monadic streaming with concurrent composition capability.--- The serial stream type in streamly @SerialT m a@ is like the list type @[a]@--- parameterized by the monad @m@. For example, @SerialT IO a@ is a moral--- equivalent of @[a]@ in the IO monad.  Streams are constructed very much like--- lists, except that they use 'nil' and 'cons' instead of '[]' and ':'.------ @--- > import "Streamly"--- > import "Streamly.Prelude" (cons, consM)--- > import qualified "Streamly.Prelude" as S--- >--- > S.toList $ 1 \`cons` 2 \`cons` 3 \`cons` nil--- [1,2,3]--- @------ Unlike lists, streams can be constructed from monadic effects:------ @--- > S.'toList' $ 'getLine' \`consM` 'getLine' \`consM` S.'nil'--- hello--- world--- ["hello","world"]--- @------ Streams are processed just like lists, with list like combinators, except--- that they are monadic and work in a streaming fashion.  Here is a simple--- console echo program example:------ @--- > S.drain $ S.repeatM getLine & S.mapM putStrLn--- @------ @SerialT Identity a@ is a moral equivalent of pure lists. Streamly utilizes--- fusion for high performance, therefore, we can represent and process strings--- as streams of 'Char', encode and decode the streams to/from UTF8 and--- serialize them to @Array Word8@ obviating the need for special purpose--- libraries like @bytestring@ and @text@.------ For more details--- please see the "Streamly.Tutorial" module and the examples directory in this--- package.--{-# LANGUAGE NoMonomorphismRestriction #-}-{-# OPTIONS_GHC -Wno-orphans #-}--#include "inline.hs"--module Streamly {-# DEPRECATED "Please use \"Streamly.Prelude\" instead." #-}-    (-    -- -- * Concepts Overview-    -- -- ** Streams-    -- -- $streams--    -- -- ** Folds-    -- -- $folds--    -- -- ** Arrays-    -- -- $arrays--    -- * Module Overview-    -- $streamtypes--    -- * Type Synonyms-      MonadAsync--    -- * Stream transformers-    -- | A stream represents a sequence of pure or effectful actions. The-    -- `cons` and `consM` operations and the corresponding operators '.:' and-    -- '|:' can be used to join pure values or effectful actions in a sequence.-    -- The effects in the stream can be executed in many different ways-    -- depending on the type of stream. In other words, the behavior of 'consM'-    -- depends on the type of the stream.-    ---    -- There are three high level categories of streams, /spatially ordered/-    -- streams, /speculative/ streams and /time ordered/ streams. Spatially-    -- ordered streams, 'SerialT' and 'WSerialT', execute the effects in serial-    -- order i.e. one at a time and present the outputs of those effects to the-    -- consumer in the same order.  Speculative streams, 'AheadT', may execute-    -- many effects concurrently but present the outputs to the consumer in the-    -- specified spatial order.  Time ordered streams, 'AsyncT', 'WAsyncT' and-    -- 'ParallelT', may execute many effects concurrently and present the-    -- outputs of those effects to the consumer in time order i.e. as soon as-    -- the output is generated.-    ---    -- We described above how the effects in a sequence are executed for-    -- different types of streams. The behvavior of the 'Semigroup' and 'Monad'-    -- instances follow the behavior of 'consM'. Stream generation operations-    -- like 'repeatM' also execute the effects differently for different-    -- streams, providing a concurrent generation capability when used with-    -- stream types that execute effects concurrently. Similarly, effectful-    -- transformation operations like 'mapM' also execute the transforming-    -- effects differently for different types of streams.--    -- ** Serial Streams-    -- $serial-    , SerialT-    , WSerialT--    -- ** Speculative Streams-    -- $ahead-    , AheadT--    -- ** Asynchronous Streams-    -- $async-    , AsyncT-    , WAsyncT-    , ParallelT--    -- ** Zipping Streams-    -- $zipping-    , ZipSerialM-    , ZipAsyncM--    -- * Parallel Function Application-    -- $application-    , (IP.|$)-    , (IP.|&)-    , (IP.|$.)-    , (IP.|&.)-    , mkAsync--    -- * Merging Streams-    -- $sum-    , serial-    , wSerial-    , ahead-    , async-    , wAsync-    , parallel--    -- * Concurrency Control-    -- $concurrency-    , maxThreads-    , maxBuffer--    -- * Rate Limiting-    , Rate (..)-    , rate-    , avgRate-    , minRate-    , maxRate-    , constRate--    -- * Stream Type Adapters-    -- $adapters-    , IsStream ()--    , serially-    , wSerially-    , asyncly-    , aheadly-    , wAsyncly-    , parallely-    , zipSerially-    , zipAsyncly-    , adapt--    -- * IO Streams-    , Serial-    , WSerial-    , Ahead-    , Async-    , WAsync-    , Parallel-    , ZipSerial-    , ZipAsync--    -- ** Folding Containers of Streams-    -- | These are variants of standard 'Foldable' fold functions that use a-    -- polymorphic stream sum operation (e.g. 'async' or 'wSerial') to fold a-    -- finite container of streams. Note that these are just special cases of-    -- the more general 'concatMapWith' operation.-    ---    , foldWith-    , foldMapWith-    , forEachWith--    -- * Re-exports-    , Semigroup (..)-    -- * Deprecated-    , Streaming-    , runStream-    , runStreaming-    , runStreamT-    , runInterleavedT-    , runAsyncT-    , runParallelT-    , runZipStream-    , runZipAsync-    , StreamT-    , InterleavedT-    , ZipStream-    , interleaving-    , zipping-    , zippingAsync-    , (<=>)-    , (<|)-    )-where--import Data.Semigroup (Semigroup(..))-import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.SVar (Rate(..))-import Streamly.Internal.Data.Stream.Ahead-import Streamly.Internal.Data.Stream.Async-import Streamly.Internal.Data.Stream.IsStream.Combinators-import Streamly.Internal.Data.Stream.IsStream.Expand-import Streamly.Internal.Data.Stream.IsStream.Type-import Streamly.Internal.Data.Stream.Serial (StreamT, InterleavedT)-import Streamly.Internal.Data.Stream.Zip--import qualified Streamly.Prelude as P-import qualified Streamly.Internal.Data.Stream.IsStream as IP-import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform---- XXX provide good succinct examples of pipelining, merging, splitting etc.--- below.------ $streams------ A program is expressed as a network of streams and folds. A stream is a--- source or generator of data elements and a fold is a consumer of data elements that--- reduces multiple input elements to a single value.------ In the following example, a 'Word8' stream is generated by using--- 'Streamly.FileSystem.Handle.read' on a file handle, then the--- 'Streamly.Prelude.splitBySuffix' transformation splits the stream on--- newlines (ascii value 10); it uses the 'Streamly.Data.Fold.drain' fold to reduce--- the resulting lines to unit values (@()@), 'Streamly.Prelude.length' fold--- then counts the unit elements in the resulting stream which gives us the--- number of lines in the file:------ > S.length $ S.splitOnSuffix FL.drain 10 $ FH.read fh------ The following example folds the lines to arrays of 'Word8' using the--- 'Streamly.Data.Array.Foreign.writeF' fold and then wraps the lines in square--- brackets before writing them to standard output using--- 'Streamly.FileSystem.Handle.write':------ > wrapLine ln = S.fromList "[" <> A.read ln <> S.fromList "]\n"--- > readLines = S.splitOnSuffix A.writeF 10--- > FH.write stdout $ S.concatMap wrapLine $ readLines fh1------ One stream can be appended after another:------ > FH.write stdout $ S.concatMap wrapLine $ readLines fh1 <> readLines fh2------ The following example reads two files concurrently, merges the lines from--- the two streams and writes the resulting stream to another file:------ > FH.write stdout $ S.concatMap wrapLine $ readLines fh1 `parallel` readLines fh2------ There are many ways to generate, merge, zip, transform and fold data--- streams.  Many transformations can be chained in a stream pipeline. See--- "Streamly.Prelude" module for combinators to manipulate streams.---- $folds------ The way stream types in this module like 'SerialT' represent data sources,--- the same way the 'Fold' type from "Streamly.Data.Fold" represents data sinks or--- reducers of streams. Reducers can be combined to consume a stream source in--- many ways. The simplest is to reduce a stream source using a fold e.g.:------ > S.fold FL.length $ S.enumerateTo 100------ Folds are consumers of streams and can be used to split a stream into--- multiple independent flows. Grouping transforms a stream by applying a fold--- on segments of a stream, distributing applies multiple folds in parallel on--- the same stream and combines them, partitioning sends different elements of--- a stream to different folds, unzipping divides the elements of a stream into--- parts and sends them through different folds. Parsers are nothing but a--- particular type of folds. Transformations can be applied contravariantly on--- the input of a fold.------ @------                             |---transform----Fold m a b--------|--- ---stream m a-->transform-->|                                  |---f b c ...---                             |---transform----Fold m a c--------|---                             |                                  |---                                        ...--- @------- $arrays------ Streamly arrays (See "Streamly.Data.Array.Foreign") complement streams to provide an--- efficient computing paradigm.  Streams are suitable for immutable--- transformations of /potentially infinite/ data using /sequential access/ and--- pipelined transformations whereas arrays are suitable for in-place--- transformations of /necessarily finite/ data using /random access/. Streams--- are synonymous with /sequential pipelined processing/ whereas arrays are--- synonymous with /efficient buffering and random access/.------ In general, a data processing pipeline reads data from some IO device, does--- some processing on it and finally writes the output to another IO device.--- Streams provide the overall framework of sequential processing pipeline in--- which arrays are used as buffering elements in the middle.  In addition to--- buffering in the middle, arrays can also be used at the boundaries of the--- pipeline to efficiently interface with external storage systems like memory,--- files and network.  If streams are the pipes in a water pipeline network--- then arrays are like the storage tanks in the middle.  On the input side,--- think of arrays as buckets to fetch water to feed the pipeline and on the--- output side buckets to remove the processed water.------ 'ByteString' data type from the 'bytestring' package and the 'Text' data--- type from the 'text' package are special cases of arrays.  'ByteString' is--- like @Array Word8@ and 'Text' is like @utf16@ encoded @Array Word8@.--- Streamly arrays can be transformed as efficiently as @bytestring@ or @text@--- by using stream operations on them.---- Streams and arrays are equally important in computing. They are computing--- duals of each other.---- $streamtypes--- The basic stream type is 'Serial', it represents a sequence of IO actions,--- and is a 'Monad'.  The type 'SerialT' is a monad transformer that can--- represent a sequence of actions in an arbitrary monad. The type 'Serial' is--- in fact a synonym for @SerialT IO@.  There are a few more types similar to--- 'SerialT', all of them represent a stream and differ only in the--- 'Semigroup', 'Applicative' and 'Monad' compositions of the stream. 'Serial'--- and 'WSerial' types compose serially whereas 'Async' and 'WAsync'--- types compose concurrently. All these types can be freely inter-converted--- using type combinators without any cost. You can freely switch to any type--- of composition at any point in the program.  When no type annotation or--- explicit stream type combinators are used, the default stream type is--- inferred as 'Serial'.------ This module exports stream types, instances and combinators for:------ * converting between different stream types--- * appending and concurrently merging streams--- * Concurrency control--- * Concurrent function application--- * Stream rate control------ This module is designed to be imported unqualified:------ @--- import Streamly--- @------ See the "Streamly.Prelude" module for APIs for construction,--- generation, elimination and transformation of streams.----------------------------------------------------------------------------------- Eliminating a stream----------------------------------------------------------------------------------- | Same as 'runStream'------ @since 0.1.0-{-# DEPRECATED runStreaming "Please use runStream instead." #-}-runStreaming :: (Monad m, IsStream t) => t m a -> m ()-runStreaming = P.drain . adapt---- | Same as @runStream@.------ @since 0.1.0-{-# DEPRECATED runStreamT "Please use runStream instead." #-}-runStreamT :: Monad m => SerialT m a -> m ()-runStreamT = P.drain---- | Same as "Streamly.Prelude.runStream".----{-# DEPRECATED runStream "Please use Streamly.Prelude.drain instead." #-}-runStream :: Monad m => SerialT m a -> m ()-runStream = P.drain---- | Same as @drain . fromWSerial@.------ @since 0.1.0-{-# DEPRECATED runInterleavedT "Please use 'drain . interleaving' instead." #-}-runInterleavedT :: Monad m => WSerialT m a -> m ()-runInterleavedT = P.drain . adapt---- | Same as @drain . fromParallel@.------ @since 0.1.0-{-# DEPRECATED runParallelT "Please use 'drain . fromParallel' instead." #-}-runParallelT :: Monad m => ParallelT m a -> m ()-runParallelT = P.drain . adapt---- | Same as @drain . fromAsync@.------ @since 0.1.0-{-# DEPRECATED runAsyncT "Please use 'drain . fromAsync' instead." #-}-runAsyncT :: Monad m => AsyncT m a -> m ()-runAsyncT = P.drain . adapt---- | Same as @drain . zipping@.------ @since 0.1.0-{-# DEPRECATED runZipStream "Please use 'drain . fromZipSerial instead." #-}-runZipStream :: Monad m => ZipSerialM m a -> m ()-runZipStream = P.drain . adapt---- | Same as @drain . zippingAsync@.------ @since 0.1.0-{-# DEPRECATED runZipAsync "Please use 'drain . fromZipAsync instead." #-}-runZipAsync :: Monad m => ZipAsyncM m a -> m ()-runZipAsync = P.drain . adapt--{---- | Same as "Streamly.Prelude.foldWith".----{-# DEPRECATED foldWith "Please use Streamly.Prelude.foldWith instead." #-}-{-# INLINABLE foldWith #-}-foldWith :: (IsStream t, Foldable f)-    => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-foldWith = P.foldWith---- | Same as "Streamly.Prelude.foldMapWith".----{-# DEPRECATED foldMapWith "Please use Streamly.Prelude.foldMapWith instead." #-}-{-# INLINABLE foldMapWith #-}-foldMapWith :: (IsStream t, Foldable f)-    => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-foldMapWith = P.foldMapWith---- | Same as "Streamly.Prelude.forEachWith".----{-# DEPRECATED forEachWith "Please use Streamly.Prelude.forEachWith instead." #-}-{-# INLINABLE forEachWith #-}-forEachWith :: (IsStream t, Foldable f)-    => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-forEachWith = P.forEachWith--}---- XXX Deprecate it in 0.8.0------ | Make a stream asynchronous, triggers the computation and returns a stream--- in the underlying monad representing the output generated by the original--- computation. The returned action is exhaustible and must be drained once. If--- not drained fully we may have a thread blocked forever and once exhausted it--- will always return 'empty'.------ @since 0.2.0-{-# INLINABLE mkAsync #-}-mkAsync :: (IsStream t, MonadAsync m) => t m a -> m (t m a)-mkAsync = return . Transform.mkAsync----------------------------------------------------------------------------------- Documentation----------------------------------------------------------------------------------- $serial------ When a stream consumer demands an element from a serial stream constructed--- as @a \`consM` b \`consM` ... nil@, the action @a@ at the head of the stream--- sequence is executed and the result is supplied to the consumer. When the--- next element is demanded, the action @b@ is executed and its result is--- supplied.  Thus, the effects are performed and results are consumed strictly--- in a serial order.  Serial streams can be considered as /spatially ordered/--- streams as the order of execution and consumption is the same as the spatial--- order in which the actions are composed by the programmer.------ Serial streams enforce the side effects as well as the results of the--- actions to be in the same order in which the actions are added to the--- stream.  Therefore, the semigroup operation for serial streams is not--- commutative:------ @--- a <> b is not the same as b <> a--- @------ There are two serial stream types 'SerialT' and 'WSerialT'. The stream--- evaluation of both the variants works in the same way as described above,--- they differ only in the 'Semigroup' and 'Monad' implementaitons.---- $ahead------ When a stream consumer demands an element from a speculative stream--- constructed as @a \`consM` b \`consM` ... nil@, the action @a@ at the head--- of the stream is executed and the output of the action is supplied to the--- consumer. However, in addition to the action at the head multiple actions--- following it may also be executed concurrently and the results buffered.--- When the next element is demanded it may be served from the buffer and we--- may execute the next action in the sequence to keep the buffer adequately--- filled.  Thus, the actions are executed concurrently but results consumed in--- serial order just like serial streams.  `consM` can be used to fold an--- infinite lazy container of effects, as the number of concurrent executions--- is limited.------ Similar to 'consM', the monadic stream generation (e.g. replicateM) and--- transformation operations (e.g. mapM) on speculative streams can execute--- multiple effects concurrently in a speculative manner.------ How many effects can be executed concurrently and how many results can be--- buffered are controlled by 'maxThreads' and 'maxBuffer' combinators--- respectively.  The actual number of concurrent threads is adjusted according--- to the rate at which the consumer is consuming the stream. It may even--- execute actions serially in a single thread if that is enough to match the--- consumer's speed.------ Speculative streams enforce ordering of the results of actions in the stream--- but the side effects are only partially ordered.  Therefore, the semigroup--- operation for speculative streams is not commutative from the pure outputs--- perspective but commutative from side effects perspective.---- $async------ /Scheduling and execution:/ In an asynchronous stream @a \`consM` b \`consM`--- c ...@, the actions @a@, @b@, and @c@ are executed concurrently with the--- consumer of the stream.  The actions are /scheduled/ for execution in the--- same order as they are specified in the stream. Multiple scheduled actions--- may be /executed/ concurrently in parallel threads of execution.  The--- actions may be executed out of order and they may complete at arbitrary--- times.  Therefore, the /effects/ of the actions may be observed out of--- order.------ /Buffering:/ The /results/ from multiple threads of execution are queued in--- a buffer as soon as they become available. The consumer of the stream is--- served from this buffer.  Therefore, the consumer may observe the results to--- be out of order.  In other words, an asynchronous stream is an unordered--- stream i.e.  order does not matter.------ /Concurrency control:/ Threads are suspended if the `maxBuffer` limit is--- reached, and resumed when the consumer makes space in the buffer.  The--- maximum number of concurrent threads depends on `maxThreads`. Number of--- threads is increased or decreased based on the speed of the consumer.------ /Generation operations:/ Concurrent stream generation operations e.g.--- 'Streamly.Prelude.replicateM' when used in async style schedule and execute--- the stream generating actions in the manner described above. The generation--- actions run concurrently, effects and results of the actions as observed by--- the consumer of the stream may be out of order.------ /Transformation operations:/ Concurrent stream transformation operations--- e.g.  'Streamly.Prelude.mapM', when used in async style, schedule and--- execute transformation actions in the manner described above. Transformation--- actions run concurrently, effects and results of the actions may be--- observed by the consumer out of order.------ /Variants:/ There are two asynchronous stream types 'AsyncT' and 'WAsyncT'.--- They are identical with respect to single stream evaluation behavior.  Their--- behaviors differ in how they combine multiple streams using 'Semigroup' or--- 'Monad' composition. Since the order of elements does not matter in--- asynchronous streams the 'Semigroup' operation is effectively commutative.---- $zipping------ 'ZipSerialM' and 'ZipAsyncM', provide 'Applicative' instances for zipping the--- corresponding elements of two streams together. Note that these types are--- not monads.---- $application------ Stream processing functions can be composed in a chain using function--- application with or without the '$' operator, or with reverse function--- application operator '&'. Streamly provides concurrent versions of these--- operators applying stream processing functions such that each stage of the--- stream can run in parallel. The operators start with a @|@; we can read '|$'--- as "@parallel dollar@" to remember that @|@ comes before '$'.------ Imports for the code snippets below:------ @---  import Streamly---  import qualified Streamly.Prelude as S---  import Control.Concurrent--- @---- $sum--- The 'Semigroup' operation '<>' of each stream type combines two streams in a--- type specific manner. This section provides polymorphic versions of '<>'--- which can be used to combine two streams in a predetermined way irrespective--- of the type.---- XXX An alternative design choice would be to let a control parameter affect--- the nearest SVar only and then it gets cleared. The benefit of the current--- choice is that it is simply just like global configuration, just like state--- behaves, so should be easy to comprehend. But it has the downside of leaking--- to undesired actions, that is we can forget to reset it.------ $concurrency------ These combinators can be used at any point in a stream composition to set--- parameters to control the concurrency of the /argument stream/.  A control--- parameter set at any point remains effective for any concurrent combinators--- used in the argument stream until it is reset by using the combinator again.--- These control parameters have no effect on non-concurrent combinators in the--- stream, or on non-concurrent streams.------ /Pitfall:/ Remember that 'maxBuffer' in the following example applies to--- 'mapM' and any other combinators that may follow it, and it does not apply--- to the combinators before it:------ @---  ...---  $ maxBuffer 10---  $ S.mapM ...---  ...--- @------ If we use '&' instead of '$' the situation will reverse, in the following--- example, 'maxBuffer' does not apply to 'mapM', it applies to combinators--- that come before it, because those are the arguments to 'maxBuffer':------ @---  ...---  & maxBuffer 10---  & S.mapM ...---  ...--- @---- $adapters------ You may want to use different stream composition styles at different points--- in your program. Stream types can be freely converted or adapted from one--- type to another.  The 'IsStream' type class facilitates type conversion of--- one stream type to another. It is not used directly, instead the type--- combinators provided below are used for conversions.------ To adapt from one monomorphic type (e.g. 'AsyncT') to another monomorphic--- type (e.g. 'SerialT') use the 'adapt' combinator. To give a polymorphic code--- a specific interpretation or to adapt a specific type to a polymorphic type--- use the type specific combinators e.g. 'fromAsync' or 'fromWSerial'. You--- cannot adapt polymorphic code to polymorphic code, as the compiler would not know--- which specific type you are converting from or to. If you see a an--- @ambiguous type variable@ error then most likely you are using 'adapt'--- unnecessarily on polymorphic code.---- | Same as 'Streamly.Prelude.concatFoldableWith'------ @since 0.1.0-{-# DEPRECATED foldWith "Please use 'Streamly.Prelude.concatFoldableWith' instead." #-}-{-# INLINEABLE foldWith #-}-foldWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-foldWith = P.concatFoldableWith---- | Same as 'Streamly.Prelude.concatMapFoldableWith'------ @since 0.1.0-{-# DEPRECATED foldMapWith "Please use 'Streamly.Prelude.concatMapFoldableWith' instead." #-}-{-# INLINEABLE foldMapWith #-}-foldMapWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-foldMapWith = P.concatMapFoldableWith---- | Same as 'Streamly.Prelude.concatForFoldableWith'------ @since 0.1.0-{-# DEPRECATED forEachWith "Please use 'Streamly.Prelude.concatForFoldableWith' instead." #-}-{-# INLINEABLE forEachWith #-}-forEachWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-forEachWith = P.concatForFoldableWith--{-# DEPRECATED serially "Please use 'Streamly.Prelude.fromSerial' instead." #-}-serially :: IsStream t => SerialT m a -> t m a-serially = fromSerial--{-# DEPRECATED wSerially "Please use 'Streamly.Prelude.fromWSerial' instead." #-}-wSerially :: IsStream t => WSerialT m a -> t m a-wSerially = fromWSerial--{-# DEPRECATED asyncly "Please use 'Streamly.Prelude.fromAsync' instead." #-}-asyncly :: IsStream t => AsyncT m a -> t m a-asyncly = fromAsync--{-# DEPRECATED aheadly "Please use 'Streamly.Prelude.fromAhead' instead." #-}-aheadly :: IsStream t => AheadT m a -> t m a-aheadly = fromAhead--{-# DEPRECATED wAsyncly "Please use 'Streamly.Prelude.fromWAsync' instead." #-}-wAsyncly :: IsStream t => WAsyncT m a -> t m a-wAsyncly = fromWAsync--{-# DEPRECATED parallely "Please use 'Streamly.Prelude.fromParallel' instead." #-}-parallely :: IsStream t => ParallelT m a -> t m a-parallely = fromParallel--{-# DEPRECATED zipSerially "Please use 'Streamly.Prelude.fromZipSerial' instead." #-}-zipSerially :: IsStream t => ZipSerialM m a -> t m a-zipSerially = fromZipSerial--{-# DEPRECATED zipAsyncly "Please use 'Streamly.Prelude.fromZipAsync' instead." #-}-zipAsyncly :: IsStream t => ZipAsyncM m a -> t m a-zipAsyncly = fromZipAsync
− src/Streamly/Console/Stdio.hs 
@@ -1,31 +0,0 @@--- |--- 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-    (-    -- * Read (stdin)-      read-    , readChunks--    -- * Write (stdout)-    , write-    , writeChunks--    -- * Write (stderr)-    , writeErr-    , writeErrChunks-    )-where--import Streamly.Internal.Console.Stdio-import Prelude hiding (read)
− src/Streamly/Data/Array.hs 
@@ -1,43 +0,0 @@--- |--- Module      : Streamly.Data.Array--- Copyright   : (c) 2019 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Data.Array-    ( Array--    -- * Construction-    , A.fromListN-    , A.fromList--    -- Stream Folds-    , A.fromStreamN-    , A.fromStream--    -- MonadicAPIs-    , A.writeN-    , A.write--    -- * Elimination--    , A.toStream-    , A.toStreamRev-    , A.read--    -- * Random Access--    -- * Folding Arrays-    , A.streamFold-    , A.fold--    , A.length-    )-where--import Streamly.Internal.Data.Array (Array)--import qualified Streamly.Internal.Data.Array as A
src/Streamly/Data/Array/Foreign.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-orphans #-} #include "inline.hs"  -- |@@ -24,17 +25,35 @@ -- -- = Programmer Notes --+-- Array creation APIs require a 'MonadIO' Monad, except 'fromList' which is a+-- pure API. To operate on streams in pure Monads like 'Identity' you can hoist+-- it to IO monad as follows:+--+-- >>> import Data.Functor.Identity (Identity, runIdentity)+-- >>> s = Stream.fromList [1..10] :: SerialT Identity Int+-- >>> s1 = Stream.hoist (return . runIdentity) s :: SerialT IO Int+-- >>> Stream.fold Array.write s1 :: IO (Array Int)+-- fromList [1,2,3,4,5,6,7,8,9,10]+--+-- 'unsafePerformIO' can be used to get a pure API from IO, as long as you know+-- it is safe to do so:+--+-- >>> import System.IO.Unsafe (unsafePerformIO)+-- >>> unsafePerformIO $ Stream.fold Array.write s1 :: Array Int+-- fromList [1,2,3,4,5,6,7,8,9,10]+-- -- To apply a transformation to an array use 'read' to unfold the array into a -- stream, apply a transformation on the stream and then use 'write' to fold it -- back to an array. -- -- This module is designed to be imported qualified: ----- > import qualified Streamly.Data.Array.Foreign as Array+-- > import qualified Streamly.Data.Array as Array ----- For experimental APIs see "Streamly.Internal.Data.Array.Foreign".+-- For experimental APIs see "Streamly.Internal.Data.Array".  module Streamly.Data.Array.Foreign+    {-# DEPRECATED "Please use Streamly.Data.Array module from the streamly-core package." #-}     (       A.Array @@ -75,4 +94,26 @@     ) where -import Streamly.Internal.Data.Array.Foreign as A+import Control.DeepSeq (NFData(..), NFData1(..))+import Streamly.Internal.Data.Array as A++-- $setup+-- >>> :m+-- >>> :set -fno-warn-deprecations+-- >>> :set -XFlexibleContexts+-- >>> :set -package streamly+-- >>> import Streamly.Prelude (SerialT)+-- >>> import Streamly.Data.Array (Array)+-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream+-- >>> import qualified Streamly.Data.Array as Array++-- Orphan instances for backward compatibility+-- Since this is an Unbox array we cannot have unevaluated data in it so+-- this is just a no op.++instance NFData (Array a) where+    {-# INLINE rnf #-}+    rnf _ = ()++instance NFData1 Array where+    liftRnf _ _ = ()
− src/Streamly/Data/Fold.hs 
@@ -1,289 +0,0 @@--- |--- Module      : Streamly.Data.Fold--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : released--- Portability : GHC------ A 'Fold' is a sink or a consumer of a stream of values.  The 'Fold' type--- consists of an accumulator and an effectful action that absorbs a value into--- the accumulator.------ >>> import Data.Function ((&))--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Prelude as Stream------ For example, a 'sum' Fold represents adding the input to the accumulated--- sum.  A fold driver e.g. 'Streamly.Prelude.fold' pushes values from a stream--- to the 'Fold' one at a time, reducing the stream to a single value.------ >>> Stream.fold Fold.sum $ Stream.fromList [1..100]--- 5050------ Conceptually, a 'Fold' is a data type that can mimic a strict left fold--- ('Data.List.foldl') as well as lazy right fold ('Prelude.foldr').  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 'head' fold would--- terminate on an infinite stream:------ >>> Stream.fold Fold.head $ 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 = Stream.map 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.serialWith (,) (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.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"]------ Please see "Streamly.Internal.Data.Fold" for additional @Pre-release@--- functions.------ = 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.--- 'Streamly.Prelude.serial' or 'Streamly.Prelude.mergeBy') whereas folds are--- more efficient in composition of consumers (e.g.  'serialWith', 'partition'--- or 'teeWith').------ Streams are producers, transformations on streams happen on the output side:------ >>> :{---  f stream =---        Stream.filter odd stream---      & Stream.map (+1)---      & Stream.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.--module Streamly.Data.Fold-    (-    -- * Fold Type--      Fold -- (..)--    -- * Constructors-    , foldl'-    , foldlM'-    , 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-    , drainBy-    , last-    , length-    , sum-    , product-    , maximumBy-    , maximum-    , minimumBy-    , minimum-    , mean-    , variance-    , stdDev-    , rollingHash-    , rollingHashWithSalt--    -- Collectors-    , toList-    , toListRev--    -- ** Terminating Folds-    -- | These are much like lazy right folds.--    , index-    , head-    , find-    , lookup-    , findIndex-    , elemIndex-    , null-    , elem-    , notElem-    , all-    , any-    , and-    , or--    -- * 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 or on the output side.  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)-    ---    -- Output transformations are also known as covariant transformations, and-    -- input transformations are also known as contravariant transformations.-    -- The input side transformations are more interesting for folds.  Most of-    -- the following sections describe the input transformation operations on a-    -- fold.  The names and signatures of the operations are consistent with-    -- corresponding operations in "Streamly.Prelude". 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--    -- ** Filtering-    , filter-    , filterM--    -- -- ** Mapping Filters-    , catMaybes-    , mapMaybe--    -- ** Trimming-    , take-    -- , takeInterval-    , takeEndBy_-    , takeEndBy--    -- ** Serial Append-    , serialWith--    -- ** 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-    , chunksOf-    -- , intervalsOf--    -- ** Nesting-    , concatMap--    -- * Deprecated-    , sequence-    , mapM-    )-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)--import Streamly.Internal.Data.Fold---- $setup--- >>> import Data.Function ((&))--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Prelude as Stream
+ src/Streamly/Data/Fold/Prelude.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.Fold.Prelude+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- All Fold related combinators including the streamly-core+-- "Streamly.Data.Fold" module, concurrency, unordered container operations.+--+module Streamly.Data.Fold.Prelude+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * "Streamly.Data.Fold"+    -- | All "Streamly.Data.Fold" combinators are re-exported via this+    -- module. For more pre-release combinators also see+    -- "Streamly.Internal.Data.Fold" module.+      module Streamly.Data.Fold+    -- * Concurrent Operations+    -- ** Configuration+    , Config+    , maxBuffer+    , boundThreads+    , inspect++    -- ** Combinators+    , parBuffered+    , parTee+    , parDistribute+    , parDistributeScan+    , parPartition+    , parDemuxScan+    , parUnzip++    -- * Container Related+    , toHashMapIO++    -- ** Deprecated+    , parEval+    )+where++import Control.Monad.IO.Class (MonadIO)+import Data.HashMap.Strict (HashMap)+import Data.Hashable (Hashable)+import Streamly.Data.Fold+import Streamly.Internal.Data.Fold (toContainerIO)+import Streamly.Internal.Data.Fold.Prelude+import Streamly.Internal.Data.IsMap.HashMap ()++#include "DocTestDataFold.hs"++-- | Split the input stream based on a hashable component of the key field and+-- fold each split using the given fold. Useful for map/reduce, bucketizing+-- the input in different bins or for generating histograms.+--+-- Consider a stream of key value pairs:+--+-- >>> input = Stream.fromList [("k1",1),("k1",1.1),("k2",2), ("k2",2.2)]+--+-- Classify each key to a different hash bin and fold the bins:+--+-- >>> classify = Fold.toHashMapIO fst (Fold.lmap snd Fold.toList)+-- >>> sortOn fst . HM.toList <$> Stream.fold classify input :: IO [(String, [Double])]+-- [("k1",[1.0,1.1]),("k2",[2.0,2.2])]+--+-- /Pre-release/+--+{-# INLINE toHashMapIO #-}+toHashMapIO :: (MonadIO m, Hashable k+#if __GLASGOW_HASKELL__ == 810+    , Eq k+#endif+    ) =>+    (a -> k) -> Fold m a b -> Fold m a (HashMap k b)+toHashMapIO = toContainerIO
src/Streamly/Data/Fold/Tee.hs view
@@ -6,36 +6,11 @@ -- Stability   : released -- Portability : GHC ----- The 'Tee' type is a newtype wrapper over the 'Streamly.Data.Fold.Fold' type providing--- distributive 'Applicative', 'Semigroup', 'Monoid', 'Num', 'Floating' and--- 'Fractional' instances. The input received by the composed 'Tee' is--- replicated and distributed to both the constituent Tees.------ For example, to compute the average of numbers in a stream without going--- through the stream twice:------ >>> import Streamly.Data.Fold.Tee (Tee(..))--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold------ >>> avg = (/) <$> (Tee Fold.sum) <*> (Tee $ fmap fromIntegral Fold.length)--- >>> Stream.fold (toFold 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.head <> Tee Fold.last--- >>> Stream.fold (toFold 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.--- module Streamly.Data.Fold.Tee+{-# DEPRECATED "Please use Streamly.Data.Fold module from the streamly-core package." #-}     ( Tee(..)+    , toFold     ) where -import Streamly.Internal.Data.Fold.Tee+import Streamly.Internal.Data.Fold
− src/Streamly/Data/Prim/Array.hs 
@@ -1,43 +0,0 @@--- |--- Module      : Streamly.Data.Prim.Array--- Copyright   : (c) 2019 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Data.Prim.Array-    ( Array--    -- * Construction-    , A.fromListN-    , A.fromList--    -- Stream Folds-    -- , A.fromStreamN-    -- , A.fromStream--    -- MonadicAPIs-    , A.writeN-    , A.write--    -- * Elimination--    -- , A.toStream-    -- , A.toStreamRev-    , A.read--    -- * Random Access--    -- * Folding Arrays-    -- , A.streamFold-    -- , A.fold--    , A.length-    )-where--import Streamly.Internal.Data.Array.Prim (Array)--import qualified Streamly.Internal.Data.Array.Prim as A
+ src/Streamly/Data/Scanl/Prelude.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.Scanl.Prelude+-- Copyright   : (c) 2025 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- All Scan related combinators including the streamly-core+-- "Streamly.Data.Scanl" module, concurrency, unordered container operations.+--+module Streamly.Data.Scanl.Prelude+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * "Streamly.Data.Scanl"+    -- | All "Streamly.Data.Scanl" combinators are re-exported via this+    -- module. For more pre-release combinators also see+    -- "Streamly.Internal.Data.Scanl" module.+      module Streamly.Data.Scanl+    -- * Concurrent Operations+    -- ** Configuration+    , Config+    , maxBuffer+    , boundThreads+    , inspect++    -- ** Combinators+    , parTeeWith+    , parDistributeScanM+    , parDistributeScan+    , parDemuxScanM+    , parDemuxScan+    )+where++import Streamly.Data.Scanl+import Streamly.Internal.Data.Scanl.Prelude++#include "DocTestDataScanl.hs"
src/Streamly/Data/SmallArray.hs view
@@ -17,9 +17,9 @@   , A.writeN    -- * Elimination-  , A.toStream-  , A.toStreamRev   , A.read+  , A.readRev+  , A.reader    -- * Folding Arrays   , A.streamFold
+ src/Streamly/Data/Stream/MkType.hs view
@@ -0,0 +1,191 @@+-- |+-- Module      : Streamly.Data.Stream.MkType+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- Template Haskell macros to create custom newtype wrappers for the 'Stream'+-- type. See the examples below to create the standard stream types that were+-- available in streamly versions before 0.9.0.+--+-- To use this module, the following extensions must be enabled:+--+-- >>> :set -XStandaloneDeriving+-- >>> :set -XTemplateHaskell+-- >>> :set -XTypeFamilies+-- >>> :set -XUndecidableInstances+--+-- Import this module unqualified to bring everything needed in scope without+-- having to import several other modules. Also, "Streamly.Data.Stream" or+-- "Streamly.Data.Stream.Prelude" must be imported @as Stream@.+--+-- >>> import Streamly.Data.Stream.MkType+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream+--+-- We are describing below many useful types that can be created using macros+-- in this module and the behavior of those types. These could be useful if you+-- like to program using the monad \"do notation\" instead of using concatMap+-- like operations.+--+-- == Parallel+--+-- An unordered concurrent version of the serial 'Nested' type. Runs multiple+-- iterations of the nested loops concurrently, iterations may execute out of+-- order. More outer iterations are started only if the existing inner+-- iterations are not saturating the resources.+--+-- >>> :{+--  bind = flip (Stream.parConcatMap id)+--  $(mkCrossType "Parallel" "bind" True)+-- :}+--+-- This is a bounded concurrent, unordered list-transformer (ListT) monad.+--+-- WARNING! By design, monad bind of this type is not associative, because of+-- concurrency order of effects as well as results may be unpredictable.+--+-- Same as the deprecated 'Streamly.Prelude.AsyncT' type.+--+-- == FairParallel+--+-- Like Parallel but strikes a balance between going deeper into existing+-- iterations of the loop and starting new iterations.+--+-- >>> :{+--  bind = flip (Stream.parConcatMap (Stream.interleaved True))+--  $(mkCrossType "FairParallel" "bind" True)+-- :}+--+-- This is a bounded concurrent, fair logic programming (LogicT) monad.+--+-- WARNING! By design, monad bind of this type is not associative, because of+-- concurrency order of effects as well as results may be unpredictable.+--+-- Same as the deprecated 'Streamly.Prelude.WAsyncT' type.+--+-- == EagerParallel+--+-- Like Parallel, but executes as many actions concurrently as possible. This+-- is useful if you want all actions to be scheduled at the same time so that+-- something does not get starved due to others.+--+-- >>> :{+--  parBind = flip (Stream.parConcatMap (Stream.eager True))+--  $(mkCrossType "EagerParallel" "parBind" True)+-- :}+--+-- This is an unbounded concurrent, unordered list transformer (ListT) monad.+--+-- WARNING! By design, monad bind of this type is not associative, because of+-- concurrency order of effects as well as results may be unpredictable.+--+-- Same as the deprecated 'Streamly.Prelude.ParallelT' type.+--+-- == OrderedParallel+--+-- Like Parallel, runs many iterations concurrently, but stages the results+-- such that the results of iterations are presented in the same order as+-- specified in the code. This is closest to the serial Nested type in behavior+-- among all the concurrent types.+--+-- >>> :{+--  bind = flip (Stream.parConcatMap (Stream.ordered True))+--  $(mkCrossType "OrderedParallel" "bind" True)+-- :}+--+-- This is a bounded concurrent, ordered list transformer (ListT) monad.+--+-- WARNING! Monad bind of this type is associative for values, but because of+-- concurrency, order of effects may be unpredictable.+--+-- Same as the deprecated 'Streamly.Prelude.AheadT' type.+--+-- == Zip+--+-- An applicative type to zip two streams.+--+-- >>> :{+--  zipApply = Stream.zipWith ($)+--  $(mkZipType "Zip" "zipApply" False)+-- :}+--+-- Same as the deprcated 'Streamly.Prelude.ZipSerialM' type.+--+-- == ParZip+--+-- Like Zip but evaluates the two streams concurrently.+--+-- >>> :{+--  parCrossApply = Stream.parCrossApply id+--  $(mkZipType "ParZip" "parCrossApply" True)+-- :}+--+-- Same as the deprecated 'Streamly.Prelude.ZipAsync' type.+--+-- == Avoiding Template Haskell+--+-- Instead of using these macros directly you could copy and paste the+-- generated code as well. Use these macros in ghci to generate the required+-- code and paste it in your package, you can customize the code as desired.+-- See the docs of the macros below for examples about how to view the+-- generated code. For example:+--+-- >>> bind = flip (Stream.parConcatMap id)+-- >>> expr <- runQ (mkCrossType "AsyncT" "bind" True)+--+-- >> putStrLn $ pprint expr++-- XXX TBD+--+-- == Nested+--+-- A serial cross monad type, same as 'Streamly.Data.StreamK.Nested' but with+-- mtl instances.+--+-- == FairNested+--+-- Like Nested but strikes a balance between going deeper into existing+-- iterations of the loop and starting new iterations. Same as+-- 'Streamly.Data.StreamK.FairNested' but additional with mtl instances.+--+-- == InvertedParallel+--+-- gives more priority to opening new iterations than to run existing+-- iterations. The interleaved options should be diagonal, and interleaved can+-- be for giving priority to iterations.++module Streamly.Data.Stream.MkType+    (+    -- * Imports for Examples+    -- $setup++    -- * Template Haskell Macros+      mkZipType+    , mkCrossType++    -- * Re-exports+    , Read(..)+    , MonadIO(..)+    , MonadThrow(..)+    , MonadReader(..)+    , MonadTrans(..)+    , Identity+    , IsList+    , IsString+    , ap+    )+where++import Data.Functor.Identity (Identity)+import GHC.Exts (IsList, IsString)+import Text.Read (Read(..))++import Streamly.Internal.Data.Stream.MkType++-- $setup+-- >>> :m+-- >>> import Language.Haskell.TH+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream+-- >>> import Streamly.Data.Stream.MkType
+ src/Streamly/Data/Stream/Prelude.hs view
@@ -0,0 +1,238 @@+-- |+-- Module      : Streamly.Data.Stream.Prelude+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- For upgrading to streamly-0.9.0+ please read the+-- <https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md Streamly-0.9.0 upgrade guide>.+-- Also, see the "Streamly.Data.Stream.MkType" module for direct replacement of+-- stream types that have been removed in 0.9.0.+--+-- All Stream related combinators including the streamly-core+-- "Streamly.Data.Stream" module, concurrency, time and lifted+-- exception operations. For more pre-release operations also see+-- "Streamly.Internal.Data.Stream.Prelude" module.+--+module Streamly.Data.Stream.Prelude+    (+    -- * "Streamly.Data.Stream"+    -- | All "Streamly.Data.Stream" combinators are re-exported via this+    -- module. For more pre-release combinators also see+    -- "Streamly.Internal.Data.Stream" module.+      module Streamly.Data.Stream++    -- * Concurrent Operations+    -- $concurrency++    -- ** Types+    , MonadAsync++    -- ** Configuration+    , Config++    -- *** Limits+    , maxThreads+    , maxBuffer++    -- *** Rate Control+    , Rate(..)+    , rate+    , avgRate+    , minRate+    , maxRate+    , constRate++    -- *** Stop behavior+    , StopWhen (..)+    , stopWhen++    -- *** Scheduling behavior+    , eager+    , ordered+    , interleaved++    -- *** Resource management+    , useAcquire+    , clearAcquire++    -- *** Diagnostics+    , inspect++    -- ** Combinators+    -- | Stream combinators using a concurrent channel.++    -- *** Evaluate+    -- | Evaluate a stream as a whole concurrently with respect to the consumer+    -- of the stream.++    , parBuffered++    -- *** Generate+    -- | Generate a stream by evaluating multiple actions concurrently.+    , parRepeatM+    , parReplicateM+    , fromCallback++    -- *** Map+    -- | Map actions on a stream such that the mapped actions are evaluated+    -- concurrently with each other.++    , parMapM+    , parSequence++    -- *** Combine two+    -- | Combine two streams such that each stream as a whole is evaluated+    -- concurrently with respect to the other stream as well as the consumer of+    -- the resulting stream.+    , parZipWithM+    , parZipWith+    , parMergeByM+    , parMergeBy++    -- *** List of streams+    -- | Shares a single channel across many streams.++    , parList+    -- , zipWithM+    -- , zipWith++    -- *** Stream of streams+    -- **** Apply++    , parCrossApply++    -- **** Concat+    -- | Shares a single channel across many streams.++    , parConcat+    , parConcatMap++    -- **** ConcatIterate+    , parConcatIterate++    -- *** Observation+    , parTapCount++    -- * Time Related++    -- ** Timers+    , interject++    -- ** Trimming+    , takeInterval+    , dropInterval++    -- ** Chunking+    , intervalsOf++    -- ** Sampling+    , sampleIntervalEnd+    , sampleIntervalStart+    , sampleBurstEnd+    , sampleBurstStart++    -- * Lifted Exceptions+    , after+    , bracket+    -- , bracket3+    , finally++    -- ** Deprecated+    , tapCount+    , parEval+    , parApply+    )+where++import Streamly.Data.Stream+import Streamly.Internal.Data.Stream.Prelude++-- $concurrency+--+-- == Channels+--+-- At a lower level, concurrency is implemented using channels that support+-- concurrent evaluation of streams. We create a channel, and add one or more+-- streams to it. The channel evaluates multiple streams concurrently and then+-- generates a single output stream from the results. How the streams are+-- combined depends on the configuration of the channel.+--+-- == Primitives+--+-- There are only a few fundamental abstractions for concurrency, 'parBuffered',+-- 'parConcatMap', and 'parConcatIterate', all concurrency combinators can be+-- expressed in terms of these.+--+-- 'parBuffered' evaluates a stream as a whole asynchronously with respect to+-- the consumer of the stream. A worker thread evaluates multiple elements of+-- the stream ahead of time and buffers the results; the consumer of the stream+-- runs in another thread consuming the elements from the buffer, thus+-- decoupling the production and consumption of the stream. 'parBuffered' can be+-- used to run different stages of a pipeline concurrently.+--+-- 'parConcatMap' is used to evaluate multiple actions in a stream concurrently+-- with respect to each other or to evaluate multiple streams concurrently and+-- combine the results. A stream generator function is mapped to the input+-- stream and all the generated streams are then evaluated concurrently, and+-- the results are combined.+--+-- 'parConcatIterate' is like 'parConcatMap' but iterates a stream generator+-- function recursively over the stream. This can be used to traverse trees or+-- graphs.+--+-- == Configuration+--+-- Concurrent combinators take a 'Config' argument which controls the+-- concurrent behavior. For example, maximum number of threads to be used+-- ('maxThreads') or the maxmimum size of the buffer ('maxBuffer'), or how the+-- streams are scheduled with respect to each other ('interleaved'), or how the+-- results are consumed ('ordered').+--+-- Configuration is specified as @Config -> Config@ modifier functions that can+-- be composed together using function composition. For example, to specify the+-- maximum threads we can use @parConcatMap (maxThreads 10)@ if we also want to+-- specify the maximum buffer we can compose the two options @parConcatMap+-- (maxThreads 10 . maxBuffer 100)@. To use default configuration use 'id' as+-- the config modifier e.g. @parConcatMap id@.+--+-- See the @Configuration@ section and individual configuration options'+-- documentation for the default behavior and default values of configuration+-- parameters.+--+-- == Scheduling+--+-- The most important configuration option is to control whether the output of+-- the concurrent execution is consumed in the same order as the corresponding+-- actions in the input stream or as soon as they arrive. The default is the+-- latter, however, we can enforce the original order by using the 'ordered'+-- option.+--+-- Another important option controls whether the number of worker threads are+-- automatically increased and decreased based on the consumption rate or+-- threads are started as aggresively as possible until the 'maxThreads' or+-- 'maxBuffer' limits are hit. The default is the former. However, the 'eager'+-- option can be enabled to use the latter behavior. When 'eager' is on, even+-- if the stream consumer thread blocks it does not make any impact on the+-- scheduling of the available tasks.+--+-- == Combinators+--+-- Using the few fundamental concurrency primitives we can implement all the+-- usual streaming combinators with concurrent behavior. Combinators like+-- 'unfoldrM', 'iterateM' that are inherently serial can be evaluated+-- concurrently with respect to the consumer pipeline using 'parBuffered'.+-- Combinators like 'zipWithM', 'mergeByM' can also use 'parBuffered' on the input+-- streams to evaluate them concurrently before combining.+--+-- Combinators like 'repeatM', 'replicateM', 'fromListM', 'sequence', 'mapM' in+-- which all actions are independent of each other can be made concurrent using+-- the 'parConcatMap' operation.+--+-- A concurrent 'repeatM' repeats an action using multiple concurrent+-- executions of the action. Similarly, a concurrent 'mapM' performs the mapped+-- action in independent threads.+--+-- Some common concurrent combinators are provided in this module.
− src/Streamly/Data/Unfold.hs 
@@ -1,165 +0,0 @@-#include "inline.hs"---- |--- Module      : Streamly.Data.Unfold--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : released--- Portability : GHC------ 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.------ >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Prelude as Stream------ For example, the 'fromList' Unfold generates a stream of values from a--- supplied list.  Unfolds can be converted to 'Streamly.Prelude.SerialT'--- stream using the Stream.unfold operation.------ >>> stream = Stream.unfold Unfold.fromList [1..100]--- >>> Stream.sum stream--- 5050------ All the serial stream generation operations in "Streamly.Prelude"--- can be expressed using unfolds:------ > Stream.fromList = Stream.unfold Unfold.fromList [1..100]------ Conceptually, an 'Unfold' is just like "Data.List.unfoldr". Let us write a--- step function to unfold a list using "Data.List.unfoldr":------ >>> :{---  f [] = Nothing---  f (x:xs) = Just (x, xs)--- :}------ >>> Data.List.unfoldr f [1,2,3]--- [1,2,3]------ Unfold.unfoldr is just the same, it uses the same step function:------ >>> Stream.toList $ Stream.unfold (Unfold.unfoldr f) [1,2,3]--- [1,2,3]------ The input of an unfold can be transformed using 'lmap':------ >>> u = Unfold.lmap (fmap (+1)) Unfold.fromList--- >>> Stream.toList $ Stream.unfold u [1..5]--- [2,3,4,5,6]------ 'Unfold' streams 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.toList $ Stream.unfold u [1..100]--- [1,2]------ Multiple unfolds can be combined in several interesting ways. For example,--- to generate nested looping as in imperative languages (also known as cross--- product of the two streams):------ >>> u1 = Unfold.lmap fst Unfold.fromList--- >>> u2 = Unfold.lmap snd Unfold.fromList--- >>> u = Unfold.crossWith (,) u1 u2--- >>> Stream.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)]------ Nested loops using unfolds provide C like performance due to complete stream--- fusion.------ Please see "Streamly.Internal.Data.Unfold" for additional @Pre-release@--- functions.------ = Unfolds vs. Streams------ Unfolds' raison d'etre is their efficiency in nested stream operations due--- to complete stream fusion.  'Streamly.Prelude.concatMap' or the 'Monad'--- instance of streams use stream generation operations of the shape @a -> t m--- b@ and then flatten the resulting stream.  This implementation is more--- powerful but does not allow for complete stream fusion.  Unfolds provide--- less powerful but more efficient 'Streamly.Prelude.unfoldMany', 'many' and--- 'crossWith' operations as an alternative to a subset of use cases of--- 'concatMap' and 'Applicative' stream operations.------ "Streamly.Prelude" exports polymorphic stream generation operations that--- provide the same functionality as unfolds in this module.  Since unfolds can--- be easily converted to streams, several modules in streamly provide only--- unfolds for serial stream generation.  We cannot use unfolds exclusively for--- stream generation as they do not support concurrency.--module Streamly.Data.Unfold-    (-    -- * Unfold Type-      Unfold--    -- * Unfolds-    -- One to one correspondence with-    -- "Streamly.Internal.Data.Stream.IsStream.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.Stream.IsStream.Type (IsStream)-import Streamly.Internal.Data.Unfold hiding (fromStream)--import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Unfold as Unfold---- | Convert a stream into an 'Unfold'. Note that a stream converted to an--- 'Unfold' may not be as efficient as an 'Unfold' in some situations.------ /Since: 0.8.0/----{-# INLINE_NORMAL fromStream #-}-fromStream :: (IsStream t, Monad m) => Unfold m (t m a) a-fromStream = lmap IsStream.adapt Unfold.fromStream
− src/Streamly/Data/Unicode/Stream.hs 
@@ -1,99 +0,0 @@--- |--- Module      : Streamly.Data.Unicode.Stream--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- 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.Foreign.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.Prelude.fromList'.  An @Array--- Char@ can be 'Streamly.Prelude.unfold'ed into a stream using the array--- 'Streamly.Data.Array.Foreign.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.Prelude.toList' or using the--- '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.Prelude.fold' the 'Char'--- stream as @Array Char@ using the array 'Streamly.Data.Array.Foreign.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------ @SerialT 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.------ = 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.Memory.Unicode.Array".---- XXX an unpinned array representation can be useful to store short and short--- lived strings in memory.----module Streamly.Data.Unicode.Stream-    {-# DEPRECATED "Use \"Streamly.Unicode.Stream\" instead" #-}-    (-    -- * Construction (Decoding)-      decodeLatin1-    , decodeUtf8--    -- * Elimination (Encoding)-    , encodeLatin1-    , encodeUtf8-    {--    -- * 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--    -- * Deprecations-    , decodeUtf8Lax-    , encodeLatin1Lax-    , encodeUtf8Lax-    )-where--import Streamly.Internal.Unicode.Stream-import Prelude hiding (lines, words, unlines, unwords)
− src/Streamly/FileSystem/Handle.hs 
@@ -1,96 +0,0 @@-#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.*@--- modules for encoding and decoding a byte stream, use stream splitting--- operations in "Streamly.Prelude" 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.Prelude.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.Prelude.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.Foreign" 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.--    , read-    , readWithBufferOf-    , readChunks-    , readChunksWithBufferOf--    -- ** Writing-    -- | '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-    , writeWithBufferOf-    , writeChunks-    )-where--import Streamly.Internal.FileSystem.Handle-import Prelude hiding (read)
− src/Streamly/Internal/BaseCompat.hs 
@@ -1,66 +0,0 @@--- |--- Module      : Streamly.Internal.BaseCompat--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Compatibility functions for "base" package.----module Streamly.Internal.BaseCompat-    (-      (#.)-    , errorWithoutStackTrace-    , fromLeft-    , fromRight-    , unsafeWithForeignPtr-    , oneShot-    )-where--import Data.Coerce (Coercible, coerce)-#if MIN_VERSION_base(4,10,0)-import Data.Either (fromRight, fromLeft)-import qualified GHC.Exts as GHCExt-#endif-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--#if !(MIN_VERSION_base(4,9,0))-{-# NOINLINE errorWithoutStackTrace #-}-errorWithoutStackTrace :: String -> a-errorWithoutStackTrace = error-#endif--#if !(MIN_VERSION_base(4,10,0))-fromLeft :: a -> Either a b -> a-fromLeft _ (Left a) = a-fromLeft a _        = a--fromRight :: b -> Either a b -> b-fromRight _ (Right b) = b-fromRight b _         = b-#endif--unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b-#if MIN_VERSION_base(4,15,0)-unsafeWithForeignPtr = GHCForeignPtr.unsafeWithForeignPtr-#else-unsafeWithForeignPtr = withForeignPtr-#endif--oneShot :: (a -> b) -> a -> b-#if MIN_VERSION_base(4,10,0)-oneShot = GHCExt.oneShot-#else-oneShot = id-#endif
− src/Streamly/Internal/Console/Stdio.hs 
@@ -1,229 +0,0 @@--- |--- 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-    (-    -- * Read-      read-    , getBytes-    , getChars-    , readChunks-    , getChunks-    -- , 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--    -- * Write-    , write-    , writeErr-    , putBytes  -- Buffered (32K)-    , putChars-    , writeChunks-    , writeErrChunks-    , 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.Foreign.Type (Array(..))-import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Unfold (Unfold)-import Streamly.Internal.Data.Fold (Fold)--import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Stream.IsStream as Stream-import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Streamly.Internal.FileSystem.Handle as Handle-import qualified Streamly.Internal.Unicode.Stream as Unicode------------------------------------------------------------------------------------ Reads------------------------------------------------------------------------------------ | Unfold standard input into a stream of 'Word8'.------ @since 0.8.0-{-# INLINE read #-}-read :: MonadIO m => Unfold m () Word8-read = Unfold.lmap (\() -> stdin) Handle.read---- | Read a byte stream from standard input.------ > getBytes = Handle.toBytes stdin--- > getBytes = Stream.unfold Stdio.read ()------ /Pre-release/----{-# INLINE getBytes #-}-getBytes :: MonadIO m => SerialT m Word8-getBytes = Handle.toBytes stdin---- | Read a character stream from Utf8 encoded standard input.------ > getChars = Unicode.decodeUtf8 Stdio.getBytes------ /Pre-release/----{-# INLINE getChars #-}-getChars :: MonadIO m => SerialT m Char-getChars = Unicode.decodeUtf8 getBytes---- | Unfolds standard input into a stream of 'Word8' arrays.------ @since 0.8.0-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m () (Array Word8)-readChunks = Unfold.lmap (\() -> stdin) Handle.readChunks---- | 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@.------ > getChunks = Handle.toChunks stdin--- > getChunks = Stream.unfold Stdio.readChunks ()------ /Pre-release/----{-# INLINE getChunks #-}-getChunks :: MonadIO m => SerialT m (Array Word8)-getChunks = Handle.toChunks 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 => SerialT 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.------ @since 0.8.0-{-# INLINE write #-}-write :: MonadIO m => Fold m Word8 ()-write = Handle.write stdout---- | Fold a stream of 'Word8' to standard error.------ @since 0.8.0-{-# 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 => SerialT 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 => SerialT m Char -> m ()-putChars = putBytes . Unicode.encodeUtf8---- | Fold a stream of @Array Word8@ to standard output.------ @since 0.8.0-{-# INLINE writeChunks #-}-writeChunks :: MonadIO m => Fold m (Array Word8) ()-writeChunks = Handle.writeChunks stdout---- | Fold a stream of @Array Word8@ to standard error.------ @since 0.8.0-{-# 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 => SerialT 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-    => (SerialT m Char -> SerialT m Word8) -> SerialT 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 => SerialT 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 => SerialT m String -> m ()-putStringsLn =-      putChunks-    . Stream.intersperseSuffix (return $ Array.fromList [10])-    . Unicode.encodeStrings Unicode.encodeUtf8
src/Streamly/Internal/Control/Concurrent.hs view
@@ -23,6 +23,7 @@ where  import Control.Monad.Catch (MonadThrow)+import Streamly.Internal.Data.SVar.Type (RunInIO(..))  #ifdef USE_UNLIFTIO import Control.Monad.IO.Unlift (MonadUnliftIO(..), UnliftIO(..), askUnliftIO)@@ -37,26 +38,14 @@ type MonadRunInIO m = (MonadIO m, MonadBaseControl IO m) #endif --- /Since: 0.8.0 ("Streamly.Prelude")/--- -- | A monad that can perform concurrent or parallel IO operations. Streams -- that can be composed concurrently require the underlying monad to be -- 'MonadAsync'. ----- /Since: 0.1.0 ("Streamly")/------ @since 0.8.0 #ifdef USE_UNLIFTIO type MonadAsync m = (MonadUnliftIO m, MonadThrow m) #else type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)-#endif---#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  -- | When we run computations concurrently, we completely isolate the state of
− src/Streamly/Internal/Control/Exception.hs 
@@ -1,50 +0,0 @@--- |--- 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-    ( assertM-    , verify-    , verifyM-    )-where--import Control.Exception (assert)---- Like 'assert' but returns @()@ in an 'Applicative' context so that it can be--- used as an independent statement in a @do@ block.------ /Pre-release/----{-# INLINE assertM #-}-assertM :: Applicative f => Bool -> f ()-assertM predicate = assert predicate (pure ())---- | 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 
@@ -1,50 +0,0 @@-{-# 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/ForkLifted.hs view
@@ -9,15 +9,17 @@ module Streamly.Internal.Control.ForkLifted     (       doFork+    , doForkWith     , fork     , forkManaged     ) where -import Control.Concurrent (ThreadId, forkIO)+import Control.Concurrent (ThreadId, forkIO, forkOS) import Control.Exception (SomeException(..), catch, mask) import Data.Functor (void)-import Streamly.Internal.Control.Concurrent (MonadRunInIO, RunInIO(..), withRunInIO, withRunInIONoRestore)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, RunInIO(..), withRunInIO, withRunInIONoRestore) import Streamly.Internal.Control.ForkIO (rawForkIO, forkManagedWith)  -- | Fork a thread to run the given computation, installing the provided@@ -32,11 +34,22 @@     -> RunInIO m     -> (SomeException -> IO ())     -> m ThreadId-doFork action (RunInIO mrun) exHandler =+doFork = doForkWith False++-- | Similar to 'doFork', but has a \"bound\" boolean parameter for specifying+-- whether 'forkOS' should be used instead of 'rawForkIO'.+{-# INLINE doForkWith #-}+doForkWith :: MonadRunInIO m+    => Bool+    -> m ()+    -> RunInIO m+    -> (SomeException -> IO ())+    -> m ThreadId+doForkWith bound action (RunInIO mrun) exHandler =     withRunInIO $ \run ->         mask $ \restore -> do-                tid <- rawForkIO $ catch (restore $ void $ mrun action)-                                         exHandler+                let frk = if bound then forkOS else rawForkIO+                tid <- frk $ catch (restore $ void $ mrun action) exHandler                 run (return tid)  -- | 'fork' lifted to any monad with 'MonadBaseControl IO m' capability.
− src/Streamly/Internal/Control/Monad.hs 
@@ -1,26 +0,0 @@--- |--- 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 
@@ -1,315 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--{-# LANGUAGE UnboxedTuples #-}-#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Array--- Copyright   : (c) 2019 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC----module Streamly.Internal.Data.Array-    ( Array(..)--    -- * Construction-    , nil-    , writeN-    , write-    , writeLastN--    , fromStreamDN-    , fromStreamD-    , fromStreamN-    , fromStream--    , fromListN-    , fromList--    -- * Elimination-    , length-    , read--    , toStreamD-    , toStreamDRev-    , toStream-    , toStreamRev--    , foldl'-    , foldr-    , streamFold-    , fold--    -- * Random Access-    , getIndexUnsafe-    , strip-    )-where--#if !MIN_VERSION_primitive(0,7,1)-import Control.DeepSeq (NFData(..))-#endif-import Control.Monad (when)-import Control.Monad.IO.Class (liftIO, MonadIO)-import Data.Functor.Identity (runIdentity)-import Data.IORef-import GHC.Base (Int(..))-import GHC.IO (unsafePerformIO)--import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified GHC.Exts as Exts-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Ring as RB-import qualified Streamly.Internal.Data.Stream.StreamD as D--import Data.Primitive.Array hiding (fromList, fromListN)-import Prelude hiding (foldr, length, read)--{-# NOINLINE bottomElement #-}-bottomElement :: a-bottomElement = undefined--{-# NOINLINE nil #-}-nil :: Array a-nil = unsafePerformIO $ do-    marr <- liftIO $ newArray 0 bottomElement-    liftIO $ freezeArray marr 0 0------------------------------------------------------------------------------------ Construction - Folds----------------------------------------------------------------------------------{-# INLINE_NORMAL writeN #-}-writeN :: MonadIO m => Int -> Fold m a (Array a)-writeN len = Fold step initial extract--    where--    {-# INLINE next #-}-    next marr i = do-        let i1 = i + 1-            st = Tuple' marr i1-        if len > i1-        then return $ FL.Partial st-        else fmap FL.Done $ extract st--    initial = do-        marr <- liftIO $ newArray len bottomElement-        next marr (-1)--    step (Tuple' marr i) x = do-        liftIO $ writeArray marr i x-        next marr i--    extract (Tuple' marr l) = liftIO $ freezeArray marr 0 l--{-# INLINE_NORMAL write #-}-write :: MonadIO m => Fold m a (Array a)-write = Fold step initial extract-  where-    initial = do-        marr <- liftIO $ newArray 0 bottomElement-        return $ FL.Partial (Tuple3' marr 0 0)-    step (Tuple3' marr i capacity) x-        | i == capacity =-            let newCapacity = max (capacity * 2) 1-             in do newMarr <- liftIO $ newArray newCapacity bottomElement-                   liftIO $ copyMutableArray newMarr 0 marr 0 i-                   liftIO $ writeArray newMarr i x-                   return $ FL.Partial $ Tuple3' newMarr (i + 1) newCapacity-        | otherwise = do-            liftIO $ writeArray marr i x-            return $ FL.Partial $ Tuple3' marr (i + 1) capacity-    extract (Tuple3' marr len _) = liftIO $ freezeArray marr 0 len------------------------------------------------------------------------------------ Construction - from streams----------------------------------------------------------------------------------{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: MonadIO m => Int -> D.Stream m a -> m (Array a)-fromStreamDN limit str = do-    marr <- liftIO $ newArray (max limit 0) bottomElement-    i <--        D.foldlM'-            (\i x -> i `seq` liftIO $ writeArray marr i x >> return (i + 1))-            (return 0) $-        D.take limit str-    liftIO $ freezeArray marr 0 i--{-# INLINE fromStreamD #-}-fromStreamD :: MonadIO m => D.Stream m a -> m (Array a)-fromStreamD = D.fold write--{-# INLINE fromStreamN #-}-fromStreamN :: MonadIO m => Int -> SerialT m a -> m (Array a)-fromStreamN n (SerialT m) = do-    when (n < 0) $ error "fromStreamN: negative write count specified"-    fromStreamDN n $ D.fromStreamK m--{-# INLINE fromStream #-}-fromStream :: MonadIO m => SerialT m a -> m (Array a)-fromStream (SerialT m) = fromStreamD $ D.fromStreamK m--{-# INLINABLE fromListN #-}-fromListN :: Int -> [a] -> Array a-fromListN n xs = unsafePerformIO $ fromStreamDN n $ D.fromList xs--{-# INLINABLE fromList #-}-fromList :: [a] -> Array a-fromList xs = unsafePerformIO $ fromStreamD $ D.fromList xs------------------------------------------------------------------------------------ Elimination - Unfolds----------------------------------------------------------------------------------{-# INLINE length #-}-length :: Array a -> Int-length = sizeofArray--{-# INLINE_NORMAL read #-}-read :: Monad m => Unfold m (Array a) a-read = Unfold step inject-  where-    inject arr = return (arr, 0)-    step (arr, i)-        | i == length arr = return D.Stop-    step (arr, I# i) =-        return $-        case Exts.indexArray# (array# arr) i of-            (# x #) -> D.Yield x (arr, I# i + 1)------------------------------------------------------------------------------------ Elimination - to streams----------------------------------------------------------------------------------{-# INLINE_NORMAL toStreamD #-}-toStreamD :: Monad m => Array a -> D.Stream m a-toStreamD arr = D.Stream step 0-  where-    {-# INLINE_LATE step #-}-    step _ i-        | i == length arr = return D.Stop-    step _ (I# i) =-        return $-        case Exts.indexArray# (array# arr) i of-            (# x #) -> D.Yield x (I# i + 1)--{-# INLINE_NORMAL toStreamDRev #-}-toStreamDRev :: Monad m => Array a -> D.Stream m a-toStreamDRev arr = D.Stream step (length arr - 1)-  where-    {-# INLINE_LATE step #-}-    step _ i-        | i < 0 = return D.Stop-    step _ (I# i) =-        return $-        case Exts.indexArray# (array# arr) i of-            (# x #) -> D.Yield x (I# i - 1)--{-# INLINE_EARLY toStream #-}-toStream :: Monad m => Array a -> SerialT m a-toStream = SerialT . D.toStreamK . toStreamD--{-# INLINE_EARLY toStreamRev #-}-toStreamRev :: Monad m => Array a -> SerialT m a-toStreamRev = SerialT . D.toStreamK . toStreamDRev------------------------------------------------------------------------------------ Elimination - using Folds----------------------------------------------------------------------------------{-# INLINE_NORMAL foldl' #-}-foldl' :: (b -> a -> b) -> b -> Array a -> b-foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr--{-# INLINE_NORMAL foldr #-}-foldr :: (a -> b -> b) -> b -> Array a -> b-foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr--#if !MIN_VERSION_primitive(0,7,1)-instance NFData a => NFData (Array a) where-    {-# INLINE rnf #-}-    rnf = foldl' (\_ x -> rnf x) ()-#endif--{-# INLINE fold #-}-fold :: Monad m => Fold m a b -> Array a -> m b-fold f arr = D.fold f (toStreamD arr)--{-# INLINE streamFold #-}-streamFold :: Monad m => (SerialT m a -> m b) -> Array a -> m b-streamFold f arr = f (toStream 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 :: Array a -> Int -> a-getIndexUnsafe = indexArray--{-# INLINE writeLastN #-}-writeLastN :: MonadIO m => Int -> Fold m a (Array a)-writeLastN n-    | n <= 0 = fmap (const mempty) FL.drain-    | otherwise = Fold step initial done--    where--    initial = do-        rb <- liftIO $ RB.createRing n-        return $ FL.Partial $ Tuple' rb (0 :: Int)--    step (Tuple' rb rh) x = do-        liftIO $ RB.unsafeInsertRing rb rh x-        return $ FL.Partial $ Tuple' rb (rh + 1)--    done (Tuple' rb rh) = do-        arr' <- liftIO $ newArray (min rh n) (undefined :: a)-        ref <- liftIO $ readIORef $ RB.ringHead rb-        if rh < n-        then-            liftIO $ copyMutableArray arr' 0 (RB.arr rb) 0 ref-        else do-            liftIO $ copyMutableArray arr' 0 (RB.arr rb) ref (n - ref)-            liftIO $ copyMutableArray arr' (n - ref) (RB.arr rb) 0 ref-        liftIO $ unsafeFreezeArray arr'---- 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.-strip :: (a -> Bool) -> Array a -> Array a-strip p arr =-    let lastIndex = length arr - 1-        indexR = getIndexR lastIndex -- last predicate failing index-    in if indexR == -1-       then nil-       else-            let indexL = getIndexL 0 -- first predicate failing index-            in if indexL == 0 && indexR == lastIndex-               then arr-               else cloneArray arr indexL (indexR - indexL + 1)--    where--    getIndexR idx-        | idx < 0 = idx-        | otherwise =-            if p (indexArray arr idx) then getIndexR (idx - 1) else idx--    getIndexL idx = if p (indexArray arr idx) then getIndexL (idx + 1) else idx
− src/Streamly/Internal/Data/Array/ArrayMacros.h 
@@ -1,27 +0,0 @@----------------------------------------------------------------------------------- Macros to access array 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 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` SIZE_OF(a)-#define PTR_PREV(ptr,a) ptr `plusPtr` negate (SIZE_OF(a))--#define PTR_INDEX(ptr,i,a) ptr `plusPtr` (SIZE_OF(a) * i)-#define PTR_RINDEX(ptr,i,a) ptr `plusPtr` negate (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` SIZE_OF(a) <= end-#define PTR_INVALID(ptr,end,a) ptr `plusPtr` SIZE_OF(a) > end-
− src/Streamly/Internal/Data/Array/Foreign.hs 
@@ -1,586 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Foreign--- Copyright   : (c) 2019 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ 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.Array.Stream.Foreign.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.--module Streamly.Internal.Data.Array.Foreign-    (-      Array--    -- * Construction--    -- Pure, From Static Memory (Unsafe)-    -- We can use fromPtrM#, fromCStringM# and fromAddrM# to create arrays from-    -- a dynamic memory address which requires a finalizer.-    , A.fromPtr-    , A.fromAddr#-    , A.fromCString#--    -- 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-    , A.toList-    , A.toStream-    , A.toStreamRev-    , read-    , unsafeRead    -- XXX readUnsafe?-    , A.readRev-    , 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-    , unsafeCast   -- castUnsafe?-    , asPtrUnsafe-    , unsafeAsCString -- asCStringUnsafe?-    , A.unsafeFreeze -- asImmutableUnsafe?-    , A.unsafeThaw   -- asMutableUnsafe?--    -- * Subarrays-    , getSliceUnsafe-    -- , getSlice-    , genSlicesFromLen-    , getSlicesFromLen-    , splitOn--    -- * Streaming Operations-    , streamTransform--    -- ** Folding-    , streamFold-    , fold-    )-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)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif-import Data.Word (Word8)-import Foreign.C.String (CString)-import Foreign.Ptr (plusPtr, castPtr)-import Foreign.Storable (Storable(..))-import Prelude hiding (length, null, last, map, (!!), read, concat)--import Streamly.Internal.Data.Array.Foreign.Mut.Type (ReadUState(..), touch)-import Streamly.Internal.Data.Array.Foreign.Type-    (Array(..), length, asPtrUnsafe)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-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.Foreign.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Foreign.Mut as MA-import qualified Streamly.Internal.Data.Array.Foreign.Type as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream.Prelude as P-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Streamly.Internal.Data.Ring.Foreign as RB------------------------------------------------------------------------------------ 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, Storable a) => Int -> SerialT m a -> m (Array a)-fromStreamN n (SerialT m) = do-    when (n < 0) $ error "writeN: negative write count specified"-    A.fromStreamDN n $ D.fromStreamK 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, `arraysOf` followed by--- processing of indvidual arrays in the resulting stream should be preferred.------ /Pre-release/-{-# INLINE fromStream #-}-fromStream :: (MonadIO m, Storable a) => SerialT m a -> m (Array a)-fromStream (SerialT m) = P.fold A.write m--- write m = A.fromStreamD $ D.fromStreamK m------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE_NORMAL producer #-}-producer :: forall m a. (Monad m, Storable a) => Producer m (Array a) a-producer = Producer step inject extract-    where--    {-# INLINE inject #-}-    inject (Array contents start end) = return $ ReadUState contents end start--    {-# INLINE_LATE step #-}-    step (ReadUState contents end cur)-        | assert (cur <= end) (cur == end) =-            let x = unsafeInlineIO $ touch contents-            in x `seq` return D.Stop-    step (ReadUState contents end cur) = 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 $ peek cur-            return $ D.Yield x (ReadUState contents end (PTR_NEXT(cur,a)))--    extract (ReadUState contents end cur) = return $ Array contents cur end---- | Unfold an array into a stream.------ /Since 0.7.0 (Streamly.Memory.Array)/------ @since 0.8.0-{-# INLINE_NORMAL read #-}-read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-read = 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 unsafeRead #-}-unsafeRead :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-unsafeRead = Unfold step inject-    where--    inject (Array contents start end) =-        return (ReadUState contents end start)--    {-# INLINE_LATE step #-}-    step (ReadUState 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 $ do-                        r <- peek p-                        touch contents-                        return r-            let !p1 = PTR_NEXT(p,a)-            return $ D.Yield x (ReadUState contents end p1)---- |------ >>> import qualified Streamly.Internal.Data.Array.Foreign.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. Storable a => Int -> Array a -> Maybe a-getIndexRev i arr =-    unsafeInlineIO-        $ asPtrUnsafe arr-            $ \ptr -> do-                let elemPtr = PTR_RINDEX(aEnd arr,i,a)-                if i >= 0 && elemPtr >= ptr-                then Just <$> peek elemPtr-                else return Nothing---- |------ >>> import qualified Streamly.Internal.Data.Array.Foreign as Array--- >>> last arr = Array.getIndexRev arr 0------ /Pre-release/-{-# INLINE last #-}-last :: Storable 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'.------ @since 0.8.0-{-# INLINE writeLastN #-}-writeLastN :: (Storable 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.newArray 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.head . 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. Storable 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)-        fp1 = start `plusPtr` (index * size)-        end = fp1 `plusPtr` (len * size)-     in assert (end <= e) (Array contents fp1 end)---- | 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, Storable a) =>-    (a -> Bool) -> Array a -> SerialT m (Array a)-splitOn predicate arr =-    SerialT $ D.toStreamK-        $ fmap (\(i, len) -> getSliceUnsafe i len arr)-        $ D.sliceOnSuffix predicate (A.toStreamD arr)--{-# INLINE genSlicesFromLen #-}-genSlicesFromLen :: forall m a. (Monad m, Storable 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, Storable 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.------ XXX The signature should be "Int -> Array a -> Maybe a"--- XXX This is a released API so make this change in the next major release.--- | /O(1)/ Lookup the element at the given index. Index starts from 0.------ @since 0.8.0-{-# INLINE getIndex #-}-getIndex :: forall a. Storable a => Array a -> Int -> Maybe a-getIndex arr i =-    unsafeInlineIO-        $ asPtrUnsafe arr-            $ \ptr -> do-                let elemPtr = PTR_INDEX(ptr,i,a)-                if i >= 0 && PTR_VALID(elemPtr,aEnd arr,a)-                then Just <$> peek 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, Storable a) => SerialT m Int -> Unfold m (Array a) a-getIndices (SerialT stream) =-    let unf = MA.getIndicesD (return . unsafeInlineIO) $ D.fromStreamK stream-     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.------ @since 0.7.0-{-# INLINE runPipe #-}-runPipe :: (MonadIO m, Storable a, Storable 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, Storable a, Storable b)-    => (SerialT m a -> SerialT m b) -> Array a -> m (Array b)-streamTransform f arr =-    P.fold (A.writeWith (length arr)) $ getSerialT $ f (A.toStream arr)------------------------------------------------------------------------------------ Casts------------------------------------------------------------------------------------ | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The array size must be a multiple of the size of type @b@--- otherwise accessing the last element of the array may result into a crash or--- a random value.------ /Pre-release/----unsafeCast ::-#ifdef DEVBUILD-    Storable b =>-#endif-    Array a -> Array b-unsafeCast (Array contents start end) =-    Array contents (castPtr start) (castPtr end)---- | Cast an @Array a@ into an @Array Word8@.------ @since 0.8.0----asBytes :: Array a -> Array Word8-asBytes = unsafeCast---- | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The length of the array should be a multiple of the size of the--- target element otherwise 'Nothing' is returned.------ @since 0.8.0----cast :: forall a b. (Storable 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 $ unsafeCast 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/----unsafeAsCString :: Array a -> (CString -> IO b) -> IO b-unsafeAsCString arr act = do-    let arr1 = asBytes arr <> A.fromList [0]-    asPtrUnsafe arr1 $ \ptr -> act (castPtr ptr)------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ | Fold an array using a 'Fold'.------ /Pre-release/-{-# INLINE fold #-}-fold :: forall m a b. (MonadIO m, Storable a) => Fold m a b -> Array a -> m b-fold f arr = P.fold f (getSerialT (A.toStream arr))---- | Fold an array using a stream fold operation.------ /Pre-release/-{-# INLINE streamFold #-}-streamFold :: (MonadIO m, Storable a) => (SerialT m a -> m b) -> Array a -> m b-streamFold f arr = f (A.toStream arr)
− src/Streamly/Internal/Data/Array/Foreign/Mut.hs 
@@ -1,103 +0,0 @@-#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Array.Foreign.Mut--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Unboxed pinned mutable array type for 'Storable' types with an option to use--- foreign (non-GHC) memory allocators. 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)--- * Fragmentation control (foreign allocators)------ Stream and Fold APIs allow easy, efficient and convenient operations on--- arrays.--module Streamly.Internal.Data.Array.Foreign.Mut-    (-      module Streamly.Internal.Data.Array.Foreign.Mut.Type-    , splitOn-    , genSlicesFromLen-    , getSlicesFromLen-    , fromStream-    )-where--import Control.Monad.IO.Class (MonadIO(..))-import Foreign.Storable (Storable)-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-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 qualified Streamly.Internal.Data.Stream.Prelude as P--import Prelude hiding (foldr, length, read, splitAt)-import Streamly.Internal.Data.Array.Foreign.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, Storable a) =>-    (a -> Bool) -> Array a -> SerialT m (Array a)-splitOn predicate arr =-    SerialT-        $ D.toStreamK-        $ 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, Storable a)-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Unfold m (Array 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.mapMWithInput 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, Storable a)-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Unfold m (Array a) (Array a)-getSlicesFromLen from len =-    let mkSlice arr (i, n) = return $ getSliceUnsafe i n arr-     in Unfold.mapMWithInput 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, `arraysOf` followed by--- processing of indvidual arrays in the resulting stream should be preferred.------ /Pre-release/-{-# INLINE fromStream #-}-fromStream :: (MonadIO m, Storable a) => SerialT m a -> m (Array a)-fromStream (SerialT m) = fromStreamD $ D.fromStreamK m--- fromStream (SerialT m) = P.fold write m
− src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs 
@@ -1,2288 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}--- |--- Module      : Streamly.Internal.Data.Array.Foreign.Mut.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ 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.Foreign.Mut.Type-    (-    -- * Type-    -- $arrayNotes-      Array (..)-    , ArrayContents-    , arrayToFptrContents-    , fptrToArrayContents-    , nilArrayContents-    , touch--    -- * Constructing and Writing-    -- ** Construction-    , nil--    -- *** Uninitialized Arrays-    , newArray-    , newArrayAligned-    , newArrayAlignedUnmanaged-    , newArrayWith--    -- *** Initialized Arrays-    , withNewArrayUnsafe--    -- *** From streams-    , ArrayUnsafe (..)-    , writeNWithUnsafe-    , writeNWith-    , writeNUnsafe-    , writeN-    , writeNAligned-    , writeNAlignedUnmanaged--    , writeWith-    , write--    -- , writeRevN-    -- , writeRev--    -- ** From containers-    , fromForeignPtrUnsafe-    , 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-    , 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-    , appendNUnsafe-    , appendN-    , appendWith-    , append--    -- * Eliminating and Reading--    -- ** To streams-    , ReadUState(..)-    , read-    , readRev--    -- ** To containers-    , toStreamD-    , toStreamDRev-    , toStreamK-    , toStreamKRev-    , toList--    -- experimental-    , 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-    , reverse-    , permute-    , partitionBy-    , shuffleBy-    , divideBy-    , mergeBy--    -- * 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-    , arraysOf-    , 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-    -- , putSlice-    -- , appendSlice-    -- , appendSliceFrom--    -- * Utilities-    , roundUpToPower2-    , memcpy-    , memcmp-    , c_memchr-    )-where--#include "inline.hs"-#include "ArrayMacros.h"-#include "MachDeps.h"--#ifdef USE_C_MALLOC-#define USE_FOREIGN_PTR-#endif--import Control.Exception (assert)-import Control.DeepSeq (NFData(..))-import Control.Monad (when, void)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bits (shiftR, (.|.), (.&.))-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif-import Data.Word (Word8)-import Foreign.C.Types (CSize(..), CInt(..))-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-#ifndef USE_FOREIGN_PTR-import Foreign.Marshal.Alloc (mallocBytes)-#endif-import Foreign.Ptr (plusPtr, minusPtr, castPtr, nullPtr)-import Foreign.Storable (Storable(..))-import GHC.Base-    ( touch#, IO(..), byteArrayContents#-    , Int(..), newAlignedPinnedByteArray#-    )-#ifndef USE_FOREIGN_PTR-import GHC.Base (RealWorld, MutableByteArray#)-#endif-#if __GLASGOW_HASKELL__ < 802-#define noinline-#else-import GHC.Base (noinline)-#endif-import GHC.Exts (unsafeCoerce#)-import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))-#ifdef USE_C_MALLOC-import GHC.ForeignPtr (mallocForeignPtrAlignedBytes)-#endif-import GHC.Ptr (Ptr(..))--import Streamly.Internal.BaseCompat-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer (..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)-import System.IO.Unsafe (unsafePerformIO)--#ifdef DEVBUILD-import qualified Data.Foldable as F-#endif-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-#ifdef USE_FOREIGN_PTR-import qualified Streamly.Internal.Foreign.Malloc as Malloc-#endif--import Prelude hiding-    (length, foldr, read, unlines, splitAt, reverse, truncate)---- $setup--- >>> :m--- >>> import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as Array--- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream--- >>> import qualified Streamly.Internal.Data.Stream.StreamD as StreamD--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold------------------------------------------------------------------------------------ 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 a 'Storable' 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. Storable 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------------------------------------------------------------------------------------ Array Contents------------------------------------------------------------------------------------ We support using ForeignPtrContents or MutableByteArray.--#ifdef USE_FOREIGN_PTR-newtype ArrayContents = ArrayContents ForeignPtrContents-#define UNPACKIF-#else--- XXX can use UnliftedNewtypes-data ArrayContents = ArrayContents !(MutableByteArray# RealWorld)-#define UNPACKIF {-# UNPACK #-}-#endif--{-# INLINE touch #-}-touch :: ArrayContents -> IO ()-touch (ArrayContents contents) =-    IO $ \s -> case touch# contents s of s' -> (# s', () #)--fptrToArrayContents :: ForeignPtrContents -> ArrayContents-arrayToFptrContents :: ArrayContents -> ForeignPtrContents-#ifdef USE_FOREIGN_PTR-fptrToArrayContents = ArrayContents-arrayToFptrContents (ArrayContents contents) = contents-#else-fptrToArrayContents (PlainPtr mbarr) = ArrayContents mbarr-fptrToArrayContents _ = error "Unsupported foreign ptr"-arrayToFptrContents (ArrayContents contents) = PlainPtr contents-#endif------------------------------------------------------------------------------------ Array Data Type------------------------------------------------------------------------------------ $arrayNotes------ We can use a 'Storable' 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.---- XXX Rename the fields to better names.---- | An unboxed, pinned 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 Array a =-#ifdef DEVBUILD-    Storable a =>-#endif-    Array-    { arrContents :: UNPACKIF !ArrayContents-    , arrStart :: {-# UNPACK #-} !(Ptr a)      -- ^ first address-    , aEnd   :: {-# UNPACK #-} !(Ptr a)        -- ^ first unused address-    , aBound :: {-# UNPACK #-} !(Ptr a)        -- ^ first address beyond allocated memory-    }------------------------------------------------------------------------------------ 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.------ /Pre-release/-{-# INLINE newArrayWith #-}-newArrayWith :: forall m a. (MonadIO m, Storable a)-    => (Int -> Int -> m (ArrayContents, Ptr a)) -> Int -> Int -> m (Array a)-newArrayWith alloc alignSize count = do-    let size = max (count * SIZE_OF(a)) 0-    (contents, p) <- alloc size alignSize-    return $ Array-        { arrContents = contents-        , arrStart = p-        , aEnd   = p-        , aBound = p `plusPtr` size-        }--newAlignedArrayContents :: Int -> Int -> IO (ArrayContents, Ptr a)-#ifdef USE_C_MALLOC-newAlignedArrayContents size align = do-    (ForeignPtr addr contents) <- mallocForeignPtrAlignedBytes size align-    return (ArrayContents contents, Ptr addr)-#else-newAlignedArrayContents size _align | size < 0 =-  errorWithoutStackTrace "newAlignedArrayContents: size must be >= 0"-newAlignedArrayContents (I# size) (I# align) = IO $ \s ->-    case newAlignedPinnedByteArray# size align s of-        (# s', mbarr# #) ->-           let p = Ptr (byteArrayContents# (unsafeCoerce# mbarr#))-#ifdef USE_FOREIGN_PTR-               c = ArrayContents (PlainPtr mbarr#)-#else-               c = ArrayContents mbarr#-#endif-            in (# s', (c, p) #)-#endif--{-# NOINLINE nilArrayContents #-}-nilArrayContents :: ArrayContents-nilArrayContents =-    fst $ unsafePerformIO $ newAlignedArrayContents 0 0--nil ::-#ifdef DEVBUILD-    Storable a =>-#endif-    Array a-nil = Array nilArrayContents nullPtr nullPtr nullPtr---- | @fromForeignPtrUnsafe foreignPtr end bound@ creates an 'Array' that starts--- at the memory pointed by the @foreignPtr@, @end@ is the first unused--- address, and @bound@ is the first address beyond the allocated memory.------ Unsafe: Make sure that foreignPtr <= end <= bound and (end - start) is an--- integral multiple of the element size. Only PlainPtr type ForeignPtr is--- supported.------ /Pre-release/----{-# INLINE fromForeignPtrUnsafe #-}-fromForeignPtrUnsafe ::-#ifdef DEVBUILD-    Storable a =>-#endif-    ForeignPtr a -> Ptr a -> Ptr a -> Array a-fromForeignPtrUnsafe (ForeignPtr start _) _ _-    | Ptr start == nullPtr = nil-fromForeignPtrUnsafe fp@(ForeignPtr start contents) end bound =-    assert (unsafeForeignPtrToPtr fp <= end && end <= bound)-           (Array (fptrToArrayContents contents) (Ptr start) end bound)---- | Like 'newArrayWith' but using an allocator that allocates unmanaged pinned--- memory. The memory will never be freed by GHC.  This could be useful in--- allocate-once global data structures. Use carefully as incorrect use can--- lead to memory leak.------ /Internal/-{-# INLINE newArrayAlignedUnmanaged #-}-newArrayAlignedUnmanaged :: forall m a. (MonadIO m, Storable a) =>-    Int -> Int -> m (Array a)-#ifdef USE_FOREIGN_PTR-newArrayAlignedUnmanaged = do-    newArrayWith mallocForeignPtrAlignedUnmanagedBytes--    where--    mallocForeignPtrAlignedUnmanagedBytes size align = do-        ForeignPtr addr contents <--            liftIO $ Malloc.mallocForeignPtrAlignedUnmanagedBytes size align-        return (ArrayContents contents, Ptr addr)-#else-newArrayAlignedUnmanaged _align count = do-    let size = max (count * SIZE_OF(a)) 0-    p <- liftIO $ mallocBytes size-    return $ Array-        { arrContents = nilArrayContents-        , arrStart = p-        , aEnd = p-        , aBound = p `plusPtr` size-        }-#endif---- | Like 'newArrayWith' but using an allocator that aligns the memory to the--- alignment dictated by the 'Storable' instance of the type.------ /Internal/-{-# INLINE newArrayAligned #-}-newArrayAligned :: (MonadIO m, Storable a) => Int -> Int -> m (Array a)-newArrayAligned = newArrayWith (\s a -> liftIO $ newAlignedArrayContents s a)---- XXX can unaligned allocation be more efficient when alignment is not needed?------ | 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.------ /Pre-release/-{-# INLINE newArray #-}-newArray :: forall m a. (MonadIO m, Storable a) => Int -> m (Array a)-newArray = newArrayAligned (alignment (undefined :: a))---- | Allocate an Array of the given size and run an IO action passing the array--- start pointer.------ /Internal/-{-# INLINE withNewArrayUnsafe #-}-withNewArrayUnsafe ::-       (MonadIO m, Storable a) => Int -> (Ptr a -> m ()) -> m (Array a)-withNewArrayUnsafe count f = do-    arr <- newArray 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, Storable a)-    => Int -> a -> Array a -> m ()-putIndexUnsafe i x arr@(Array{..}) =-    asPtrUnsafe arr $ \ptr -> do-        let elemPtr = PTR_INDEX(ptr,i,a)-        assert (i >= 0 && PTR_VALID(elemPtr,aEnd,a)) (return ())-        liftIO $ poke elemPtr x--invalidIndex :: String -> Int -> a-invalidIndex label i =-    error $ label ++ ": invalid array index " ++ show i--{-# INLINE putIndexPtr #-}-putIndexPtr :: forall m a. (MonadIO m, Storable a) =>-    Ptr a -> Ptr a -> Int -> a -> m ()-putIndexPtr start end i x = do-    let elemPtr = PTR_INDEX(start,i,a)-    if i >= 0 && PTR_VALID(elemPtr,end,a)-    then liftIO $ poke elemPtr x-    else invalidIndex "putIndexPtr" i---- | /O(1)/ Write the given element at the given index in the array.--- Performs in-place mutation of the array.------ >>> putIndex arr ix val = Array.modifyIndex ix (const (val, ())) arr--- >>> f = Array.putIndices--- >>> putIndex ix val arr = Stream.fold (f arr) (Stream.fromPure (ix, val))------ /Pre-release/-{-# INLINE putIndex #-}-putIndex :: (MonadIO m, Storable a) => Int -> a -> Array a -> m ()-putIndex i x arr =-    asPtrUnsafe arr-        $ \p -> putIndexPtr p (aEnd arr) i x---- | 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, Storable a)-    => Array a -> Fold m (Int, a) ()-putIndices Array{..} = FL.mkFoldM step initial extract--    where--    initial = return $ FL.Partial ()--    step () (i, x) = FL.Partial <$> liftIO (putIndexPtr arrStart aEnd i x)--    extract () = liftIO $ touch arrContents---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndexUnsafe :: forall m a b. (MonadIO m, Storable a) =>-    Int -> (a -> (a, b)) -> Array a -> m b-modifyIndexUnsafe i f arr@(Array{..}) = do-    liftIO $ asPtrUnsafe arr $ \ptr -> do-        let elemPtr = PTR_INDEX(ptr,i,a)-        assert (i >= 0 && PTR_NEXT(elemPtr,a) <= aEnd) (return ())-        r <- peek elemPtr-        let (x, res) = f r-        poke elemPtr x-        return res--{-# INLINE modifyIndexPtr #-}-modifyIndexPtr :: forall m a b. (MonadIO m, Storable a) =>-    Int -> (a -> (a, b)) -> Ptr a -> Ptr a -> m b-modifyIndexPtr i f start end = liftIO $ do-    let elemPtr = PTR_INDEX(start,i,a)-    if i >= 0 && PTR_VALID(elemPtr,end,a)-    then do-        r <- peek elemPtr-        let (x, res) = f r-        poke elemPtr x-        return res-    else invalidIndex "modifyIndex" i---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndex :: forall m a b. (MonadIO m, Storable a) =>-    Int -> (a -> (a, b)) -> Array a -> m b-modifyIndex i f arr@(Array{..}) = do-    liftIO $ asPtrUnsafe arr $ \ptr -> do-        modifyIndexPtr i f ptr aEnd---- | Modify the array indices generated by the supplied stream.------ /Pre-release/-{-# INLINE modifyIndices #-}-modifyIndices :: forall m a. (MonadIO m, Storable a)-    => (a -> a) -> Array a -> Fold m Int ()-modifyIndices f Array{..} = Fold step initial extract--    where--    initial = return $ FL.Partial ()--    step () i =-        let f1 x = (f x, ())-         in FL.Partial <$> liftIO (modifyIndexPtr i f1 arrStart aEnd)--    extract () = liftIO $ touch arrContents---- | Modify each element of an array using the supplied modifier function.------ /Pre-release/-modify :: forall m a. (MonadIO m, Storable a)-    => (a -> a) -> Array a -> m ()-modify f arr@Array{..} = liftIO $-    asPtrUnsafe arr go--    where--    go ptr =-        when (PTR_VALID(ptr,aEnd,a)) $ do-            r <- peek ptr-            poke ptr (f r)-            go (PTR_NEXT(ptr,a))--{-# INLINE swapPtrs #-}-swapPtrs :: Storable a => Ptr a -> Ptr a -> IO ()-swapPtrs ptr1 ptr2 = do-    r1 <- peek ptr1-    r2 <- peek ptr2-    poke ptr1 r2-    poke ptr2 r1---- | 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, Storable a)-    => Int -> Int -> Array a -> m ()-unsafeSwapIndices i1 i2 arr = liftIO $ do-    asPtrUnsafe arr $ \ptr -> do-        let ptr1 = PTR_INDEX(ptr,i1,a)-            ptr2 = PTR_INDEX(ptr,i2,a)-        swapPtrs ptr1 (ptr2 :: Ptr a)---- | Swap the elements at two indices.------ /Pre-release/-swapIndices :: forall m a. (MonadIO m, Storable a)-    => Int -> Int -> Array a -> m ()-swapIndices i1 i2 Array{..} = liftIO $ do-        let ptr1 = PTR_INDEX(arrStart,i1,a)-            ptr2 = PTR_INDEX(arrStart,i2,a)-        when (i1 < 0 || PTR_INVALID(ptr1,aEnd,a))-            $ invalidIndex "swapIndices" i1-        when (i2 < 0 || PTR_INVALID(ptr2,aEnd,a))-            $ invalidIndex "swapIndices" i2-        swapPtrs ptr1 (ptr2 :: Ptr a)------------------------------------------------------------------------------------ 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. Storable a => a -> Int -> Int-allocBytesToBytes _ n = max (arrayPayloadSize n) (SIZE_OF(a))---- | Given a 'Storable' 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 :: Storable 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.----{-# NOINLINE reallocAligned #-}-reallocAligned :: Int -> Int -> Int -> Array a -> IO (Array a)-reallocAligned elemSize alignSize newCapacity Array{..} = do-    assert (aEnd <= aBound) (return ())--    -- Allocate new array-    let newCapMax = roundUpLargeArray newCapacity-    (contents, pNew) <- newAlignedArrayContents newCapMax alignSize--    -- Copy old data-    let oldStart = arrStart-        oldSize = aEnd `minusPtr` oldStart-        newCap = roundDownTo elemSize newCapMax-        newLen = min oldSize newCap-    assert (oldSize `mod` elemSize == 0) (return ())-    assert (newLen >= 0) (return ())-    assert (newLen `mod` elemSize == 0) (return ())-    memcpy (castPtr pNew) (castPtr oldStart) newLen-    touch arrContents--    return $ Array-        { arrStart = pNew-        , arrContents = contents-        , aEnd   = pNew `plusPtr` newLen-        , aBound = pNew `plusPtr` newCap-        }---- | @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, Storable a) => Int -> Array a -> m (Array a)-realloc n arr =-    liftIO $ reallocAligned (SIZE_OF(a)) (alignment (undefined :: a)) n arr---- | @reallocWith label capSizer minIncrement 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 , Storable a) =>-       String-    -> (Int -> Int)-    -> Int-    -> Array a-    -> m (Array a)-reallocWith label capSizer minIncr arr = do-    let oldSize = aEnd arr `minusPtr` arrStart arr-        newCap = capSizer oldSize-        newSize = oldSize + minIncr-        safeCap = max newCap newSize-    assert (newCap >= newSize || error (badSize newSize)) (return ())-    realloc safeCap arr--    where--    badSize newSize = concat-        [ label-        , ": new array size 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, Storable a) =>-    Int -> Array a -> m (Array a)-resize n arr@Array{..} = do-    let req = SIZE_OF(a) * n-        len = aEnd `minusPtr` arrStart-    if req < len-    then return arr-    else realloc req arr---- | Like 'resize' but if the 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, Storable a) =>-    Int -> Array a -> m (Array a)-resizeExp n arr@Array{..} = do-    let req = roundUpLargeArray (SIZE_OF(a) * n)-        req1 =-            if req > largeObjectThreshold-            then roundUpToPower2 req-            else req-        len = aEnd `minusPtr` 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, Storable a) => Array a -> m (Array a)-rightSize arr@Array{..} = do-    assert (aEnd <= aBound) (return ())-    let start = arrStart-        len = aEnd `minusPtr` start-        capacity = aBound `minusPtr` start-        target = roundUpLargeArray len-        waste = aBound `minusPtr` aEnd-    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--- :: Array 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, Storable a) => Ptr a -> Array a -> a -> m (Array a)-snocNewEnd newEnd arr@Array{..} x = liftIO $ do-    assert (newEnd <= aBound) (return ())-    poke aEnd x-    touch arrContents-    return $ arr {aEnd = 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, Storable a) =>-    Array a -> a -> m (Array a)-snocUnsafe arr@Array{..} = snocNewEnd (PTR_NEXT(aEnd,a)) arr---- | Like 'snoc' but does not reallocate when pre-allocated array capacity--- becomes full.------ /Internal/-{-# INLINE snocMay #-}-snocMay :: forall m a. (MonadIO m, Storable a) =>-    Array a -> a -> m (Maybe (Array a))-snocMay arr@Array{..} x = liftIO $ do-    let newEnd = PTR_NEXT(aEnd,a)-    if newEnd <= aBound-    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, Storable a) =>-       (Int -> Int)-    -> Array a-    -> a-    -> m (Array 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, Storable a) =>-       (Int -> Int)-    -> Array a-    -> a-    -> m (Array a)-snocWith allocSize arr x = liftIO $ do-    let newEnd = PTR_NEXT(aEnd arr,a)-    if newEnd <= aBound 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, Storable a) => Array a -> a -> m (Array 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 = Array.snocWith (* 2)------ Performs O(n * log n) copies to grow, but is liberal with memory allocation.------ /Pre-release/-{-# INLINE snoc #-}-snoc :: forall m a. (MonadIO m, Storable a) => Array a -> a -> m (Array a)-snoc = snocWith f--    where--    f oldSize =-        if isPower2 oldSize-        then oldSize * 2-        else roundUpToPower2 oldSize * 2------------------------------------------------------------------------------------ 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 :: forall m a. (MonadIO m, Storable a) => Int -> Array a -> m a-getIndexUnsafe i arr@(Array {..}) =-    asPtrUnsafe arr $ \ptr -> do-        let elemPtr = PTR_INDEX(ptr,i,a)-        assert (i >= 0 && PTR_VALID(elemPtr,aEnd,a)) (return ())-        liftIO $ peek elemPtr--{-# INLINE getIndexPtr #-}-getIndexPtr :: forall m a. (MonadIO m, Storable a) =>-    Ptr a -> Ptr a -> Int -> m a-getIndexPtr start end i = do-    let elemPtr = PTR_INDEX(start,i,a)-    if i >= 0 && PTR_VALID(elemPtr,end,a)-    then liftIO $ peek elemPtr-    else invalidIndex "getIndexPtr" i---- | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: (MonadIO m, Storable a) => Int -> Array a -> m a-getIndex i arr =-    asPtrUnsafe arr-        $ \p -> getIndexPtr p (aEnd arr) i--{-# INLINE getIndexPtrRev #-}-getIndexPtrRev :: forall m a. (MonadIO m, Storable a) =>-    Ptr a -> Ptr a -> Int -> m a-getIndexPtrRev start end i = do-    let elemPtr = PTR_RINDEX(end,i,a)-    if i >= 0 && elemPtr >= start-    then liftIO $ peek elemPtr-    else invalidIndex "getIndexPtrRev" 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 :: (MonadIO m, Storable a) => Int -> Array a -> m a-getIndexRev i arr =-    asPtrUnsafe arr-        $ \p -> getIndexPtrRev p (aEnd arr) 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 Array. An error is thrown if an index is out of--- bounds.------ /Pre-release/-{-# INLINE getIndicesD #-}-getIndicesD :: (Monad m, Storable a) =>-    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (Array a) a-getIndicesD liftio (D.Stream stepi sti) = Unfold step inject--    where--    inject (Array contents start (Ptr end) _) =-        return $ GetIndicesState contents start (Ptr 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 $ getIndexPtr start end i-                return $ D.Yield x (GetIndicesState contents start end s)-            D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)-            D.Stop -> do-                liftio $ touch contents-                return D.Stop--{-# INLINE getIndices #-}-getIndices :: (MonadIO m, Storable a) => SerialT m Int -> Unfold m (Array a) a-getIndices (SerialT stream) = getIndicesD liftIO $ D.fromStreamK stream------------------------------------------------------------------------------------ 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. Storable a-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Array a-    -> Array a-getSliceUnsafe index len (Array contents start e _) =-    let fp1 = PTR_INDEX(start,index,a)-        end = fp1 `plusPtr` (len * SIZE_OF(a))-     in assert-            (index >= 0 && len >= 0 && end <= e)-            (Array 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. Storable a =>-       Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Array a-    -> Array a-getSlice index len (Array contents start e _) =-    let fp1 = PTR_INDEX(start,index,a)-        end = fp1 `plusPtr` (len * SIZE_OF(a))-     in if index >= 0 && len >= 0 && end <= e-        then Array 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 'readRev'. 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.------ /Pre-release/-{-# INLINE reverse #-}-reverse :: forall m a. (MonadIO m, Storable a) => Array a -> m ()-reverse Array{..} = liftIO $ do-    let l = arrStart-        h = PTR_PREV(aEnd,a)-     in swap l h--    where--    swap l h = do-        when (l < h) $ do-            swapPtrs l h-            swap (PTR_NEXT(l,a)) (PTR_PREV(h,a))---- | Generate the next permutation of the sequence, returns False if this is--- the last permutation.------ /Unimplemented/-{-# INLINE permute #-}-permute :: Array 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, Storable a)-    => (a -> Bool) -> Array a -> m (Array a, Array a)-partitionBy f arr@Array{..} = liftIO $ do-    if arrStart >= aEnd-    then return (arr, arr)-    else do-        ptr <- go arrStart (PTR_PREV(aEnd,a))-        let pl = Array arrContents arrStart ptr ptr-            pr = Array arrContents ptr aEnd aEnd-        return (pl, pr)--    where--    -- Invariant low < high on entry, and on return as well-    moveHigh low high = do-        h <- peek high-        if f h-        then-            -- Correctly classified, continue the loop-            let high1 = PTR_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 <- peek 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-                        poke low h-                        poke high1 l-                        let low1 = PTR_NEXT(low,a)-                            high2 = PTR_PREV(high1,a)-                        if low1 <= high2-                        then go low1 high2-                        else return low1 -- low1 > high2--        else do-            -- low is correctly classified-            let low1 = PTR_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) -> Array a -> Array 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 -> (Array a -> m (Array a, Array a)) -> Array 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 -> (Array a -> Array a -> m ()) -> Array a -> m ()-mergeBy = undefined------------------------------------------------------------------------------------ Size------------------------------------------------------------------------------------ | /O(1)/ Get the byte length of the array.------ @since 0.7.0-{-# INLINE byteLength #-}-byteLength :: Array a -> Int-byteLength Array{..} =-    let len = aEnd `minusPtr` 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--- int he 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.------ @since 0.7.0-{-# INLINE length #-}-length :: forall a. Storable a => Array 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 :: Array a -> Int-byteCapacity Array{..} =-    let len = aBound `minusPtr` arrStart-    in assert (len >= 0) len---- | The remaining capacity in the array for appending more elements without--- reallocation.------ /Pre-release/-{-# INLINE bytesFree #-}-bytesFree :: Array a -> Int-bytesFree Array{..} =-    let n = aBound `minusPtr` aEnd-    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---- | @arraysOf n stream@ groups the input stream into a stream of--- arrays of size n.------ @arraysOf n = StreamD.foldMany (Array.writeN n)@------ /Pre-release/-{-# INLINE_NORMAL arraysOf #-}-arraysOf :: forall m a. (MonadIO m, Storable a)-    => Int -> D.Stream m a -> D.Stream m (Array 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.--- arraysOf n = D.foldMany (writeN n)-arraysOf 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.Array.Foreign.Mut.Type.arraysOf: "-                    ++ "the size of arrays [" ++ show n-                    ++ "] must be a natural number"-        Array contents start end bound <- liftIO $ newArray 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 $ poke end x >> touch contents-                let end1 = PTR_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 (Array 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, Storable a) =>-    D.Stream m a -> m (K.Stream m (Array a))-arrayStreamKFromStreamD =-    let n = allocBytesToElemCount (undefined :: a) defaultChunkSize-     in D.foldr K.cons K.nil . arraysOf n------------------------------------------------------------------------------------ Streams of arrays - Flattening----------------------------------------------------------------------------------data FlattenState s contents a =-      OuterLoop s-    | InnerLoop s contents !(Ptr a) !(Ptr a)---- | 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, Storable a)-    => D.Stream m (Array 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 Array{..} s ->-                D.Skip (InnerLoop s arrContents arrStart aEnd)-            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 $ do-                    r <- peek p-                    touch contents-                    return r-        return $ D.Yield x (InnerLoop st contents (PTR_NEXT(p,a)) end)---- | 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, Storable a)-    => D.Stream m (Array 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 Array{..} s ->-                let p = PTR_PREV(aEnd,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 $ do-                    r <- peek p-                    touch contents-                    return r-        let cur = PTR_PREV(p,a)-        return $ D.Yield x (InnerLoop st contents cur start)------------------------------------------------------------------------------------ Unfolds----------------------------------------------------------------------------------data ReadUState a = ReadUState-    UNPACKIF !ArrayContents  -- contents-    !(Ptr a)           -- end address-    !(Ptr a)           -- current address--toReadUState :: Array a -> ReadUState a-toReadUState (Array contents start end _) = ReadUState contents end start---- | Resumable unfold of an array.----{-# INLINE_NORMAL producer #-}-producer :: forall m a. (MonadIO m, Storable a) => Producer m (Array a) a-producer = Producer step (return . toReadUState) extract-    where--    {-# INLINE_LATE step #-}-    step (ReadUState contents end cur)-        | assert (cur <= end) (cur == end) = do-            liftIO $ touch contents-            return D.Stop-    step (ReadUState contents end cur) = do-            !x <- liftIO $ peek cur-            return $ D.Yield x (ReadUState contents end (PTR_NEXT(cur,a)))--    extract (ReadUState contents end cur) = return $ Array contents cur end end---- | Unfold an array into a stream.------ @since 0.7.0-{-# INLINE_NORMAL read #-}-read :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a-read = Producer.simplify producer---- | Unfold an array into a stream in reverse order.------ /Pre-release/-{-# INLINE_NORMAL readRev #-}-readRev :: forall m a. (MonadIO m, Storable a) => Unfold m (Array a) a-readRev = Unfold step inject-    where--    inject (Array contents start end _) =-        let p = PTR_PREV(end,a)-         in return $ ReadUState contents start p--    {-# INLINE_LATE step #-}-    step (ReadUState contents start p) | p < start = do-        liftIO $ touch contents-        return D.Stop-    step (ReadUState contents start p) = do-        x <- liftIO $ peek p-        return $ D.Yield x (ReadUState contents start (PTR_PREV(p,a)))------------------------------------------------------------------------------------ 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. Storable a => (a -> b -> b) -> b -> Array a -> b-toListFB c n Array{..} = go arrStart-    where--    go p | assert (p <= aEnd) (p == aEnd) = 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 <- peek p-                    touch arrContents-                    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 an 'Array' into a list.------ @since 0.7.0-{-# INLINE toList #-}-toList :: forall m a. (MonadIO m, Storable a) => Array a -> m [a]-toList Array{..} = liftIO $ go arrStart-    where--    go p | assert (p <= aEnd) (p == aEnd) = return []-    go p = do-        x <- peek p-        touch arrContents-        (:) x <$> go (PTR_NEXT(p,a))---- | Use the 'read' unfold instead.------ @toStreamD = D.unfold read@------ We can try this if the unfold has any performance issues.-{-# INLINE_NORMAL toStreamD #-}-toStreamD :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a-toStreamD Array{..} = D.Stream step arrStart--    where--    {-# INLINE_LATE step #-}-    step _ p | assert (p <= aEnd) (p == aEnd) = return D.Stop-    step _ p = liftIO $ do-        r <- peek p-        touch arrContents-        return $ D.Yield r (PTR_NEXT(p,a))--{-# INLINE toStreamK #-}-toStreamK :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a-toStreamK Array{..} = go arrStart--    where--    go p | assert (p <= aEnd) (p == aEnd) = K.nil-         | otherwise =-        let elemM = do-              r <- peek p-              touch arrContents-              return r-        in liftIO elemM `K.consM` go (PTR_NEXT(p,a))---- | Use the 'readRev' unfold instead.------ @toStreamDRev = D.unfold readRev@------ We can try this if the unfold has any perf issues.-{-# INLINE_NORMAL toStreamDRev #-}-toStreamDRev :: forall m a. (MonadIO m, Storable a) => Array a -> D.Stream m a-toStreamDRev Array{..} =-    let p = PTR_PREV(aEnd,a)-    in D.Stream step p--    where--    {-# INLINE_LATE step #-}-    step _ p | p < arrStart = return D.Stop-    step _ p = liftIO $ do-        r <- peek p-        touch arrContents-        return $ D.Yield r (PTR_PREV(p,a))--{-# INLINE toStreamKRev #-}-toStreamKRev :: forall m a. (MonadIO m, Storable a) => Array a -> K.Stream m a-toStreamKRev Array {..} =-    let p = PTR_PREV(aEnd,a)-    in go p--    where--    go p | p < arrStart = K.nil-         | otherwise =-        let elemM = do-              r <- peek p-              touch arrContents-              return r-        in liftIO elemM `K.consM` go (PTR_PREV(p,a))------------------------------------------------------------------------------------ Folding------------------------------------------------------------------------------------ XXX Need something like "Array m a" enforcing monadic action to avoid the--- possibility of such APIs.------ | Strict left fold of an array.-{-# INLINE_NORMAL foldl' #-}-foldl' :: (MonadIO m, Storable a) => (b -> a -> b) -> b -> Array a -> m b-foldl' f z arr = D.foldl' f z $ toStreamD arr---- | Right fold of an array.-{-# INLINE_NORMAL foldr #-}-foldr :: (MonadIO m, Storable a) => (a -> b -> b) -> b -> Array a -> m b-foldr f z arr = D.foldr f z $ toStreamD arr------------------------------------------------------------------------------------ Folds----------------------------------------------------------------------------------data ArrayUnsafe a = ArrayUnsafe-    UNPACKIF !ArrayContents  -- contents-    {-# UNPACK #-} !(Ptr a)  -- start address-    {-# UNPACK #-} !(Ptr a)  -- first unused address--toArrayUnsafe :: Array a -> ArrayUnsafe a-toArrayUnsafe (Array contents start end _) =-    ArrayUnsafe contents start end--fromArrayUnsafe ::-#ifdef DEVBUILD-    Storable a =>-#endif-    ArrayUnsafe a -> Array a-fromArrayUnsafe (ArrayUnsafe contents start end) =-         Array contents start end end---- 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?---- | Append 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 appendNUnsafe #-}-appendNUnsafe :: forall m a. (MonadIO m, Storable a) =>-       m (Array a)-    -> Int-    -> Fold m a (Array a)-appendNUnsafe action n =-    fmap fromArrayUnsafe $ FL.foldlM' step initial--    where--    initial = do-        assert (n >= 0) (return ())-        arr@(Array _ _ end bound) <- action-        let free = bound `minusPtr` 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 "appendNUnsafeWith" (+ needed) needed arr-            else return arr-        return $ toArrayUnsafe arr1--    step (ArrayUnsafe contents start end) x = do-        liftIO $ poke end x >> touch contents-        return $ ArrayUnsafe contents start (PTR_NEXT(end,a))---- | Append @n@ elements to an existing array. Any free space left in the array--- after appending @n@ elements is lost.------ >>> appendN initial n = Fold.take n (Array.appendNUnsafe initial n)------ /Pre-release/-{-# INLINE_NORMAL appendN #-}-appendN :: forall m a. (MonadIO m, Storable a) =>-    m (Array a) -> Int -> Fold m a (Array a)-appendN initial n = FL.take n (appendNUnsafe initial n)---- | @appendWith realloc action@ mutates the array generated by @action@ to--- append the input stream. If there is no reserved space available in the--- array it is reallocated to a size in bytes  determined by @realloc oldSize@,--- where @oldSize@ is the current size of the array in bytes.------ Note that the returned array may be a mutated version of original array.------ >>> appendWith sizer = Fold.foldlM' (Array.snocWith sizer)------ /Pre-release/-{-# INLINE appendWith #-}-appendWith :: forall m a. (MonadIO m, Storable a) =>-    (Int -> Int) -> m (Array a) -> Fold m a (Array a)-appendWith 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.------ >>> append = Array.appendWith (* 2)------ /Pre-release/-{-# INLINE append #-}-append :: forall m a. (MonadIO m, Storable a) =>-    m (Array a) -> Fold m a (Array a)-append = appendWith (* 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 = Array.appendNUnsafe (alloc n) n------ /Pre-release/-{-# INLINE_NORMAL writeNWithUnsafe #-}-writeNWithUnsafe :: forall m a. (MonadIO m, Storable a)-    => (Int -> m (Array a)) -> Int -> Fold m a (Array a)-writeNWithUnsafe alloc n = Fold step initial (return . fromArrayUnsafe)--    where--    initial = FL.Partial . toArrayUnsafe <$> alloc (max n 0)--    step (ArrayUnsafe contents start end) x = do-        liftIO $ poke end x >> touch contents-        return-          $ FL.Partial-          $ ArrayUnsafe contents start (PTR_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 = Array.writeNWithUnsafe Array.newArray------ @since 0.7.0-{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: forall m a. (MonadIO m, Storable a)-    => Int -> Fold m a (Array a)-writeNUnsafe = writeNWithUnsafe newArray---- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array--- allocated using the @alloc@ function.------ >>> writeNWith alloc n = Fold.take n (Array.writeNWithUnsafe alloc n)--- >>> writeNWith alloc n = Array.appendN (alloc n) n----{-# INLINE_NORMAL writeNWith #-}-writeNWith :: forall m a. (MonadIO m, Storable a)-    => (Int -> m (Array a)) -> Int -> Fold m a (Array a)-writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)---- | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'Array'.------ >>> writeN = Array.writeNWith Array.newArray--- >>> writeN n = Fold.take n (Array.writeNUnsafe n)--- >>> writeN n = Array.appendN (Array.newArray n) n------ @since 0.7.0-{-# INLINE_NORMAL writeN #-}-writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)-writeN = writeNWith newArray---- | @writeNAligned align n@ folds a maximum of @n@ elements from the input--- stream to an 'Array' aligned to the given size.------ >>> writeNAligned align = Array.writeNWith (Array.newArrayAligned align)--- >>> writeNAligned align n = Array.appendN (Array.newArrayAligned align n) n------ /Pre-release/----{-# INLINE_NORMAL writeNAligned #-}-writeNAligned :: forall m a. (MonadIO m, Storable a)-    => Int -> Int -> Fold m a (Array a)-writeNAligned align = writeNWith (newArrayAligned align)---- | @writeNAlignedUnmanaged align n@ folds a maximum of @n@ elements from the--- input stream to an 'Array' whose starting address is aligned to @align@--- bytes and is allocated using unmanaged memory (never freed).  This could be--- useful to allocate memory that we need to allocate only once in the lifetime--- of the program.------ >>> f = Array.newArrayAlignedUnmanaged--- >>> writeNAlignedUnmanaged a = Array.writeNWith (f a)--- >>> writeNAlignedUnmanaged a n = Array.appendN (f a n) n------ /Pre-release/----{-# INLINE_NORMAL writeNAlignedUnmanaged #-}-writeNAlignedUnmanaged :: forall m a. (MonadIO m, Storable a)-    => Int -> Int -> Fold m a (Array a)-writeNAlignedUnmanaged align = writeNWith (newArrayAlignedUnmanaged align)---- XXX Buffer to a list instead?------ | Buffer a stream into a stream of arrays.------ >>> writeChunks n = Fold.many (Array.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, Storable a) =>-    Int -> Fold m a (K.Stream n (Array 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 = Array.appendWith (* 2) (Array.newArray n)--- >>> writeWith n = Fold.rmapM Array.rightSize (f n)--- >>> writeWith n = Fold.rmapM Array.fromArrayStreamK (Array.writeChunks n)------ /Pre-release/-{-# INLINE_NORMAL writeWith #-}-writeWith :: forall m a. (MonadIO m, Storable a)-    => Int -> Fold m a (Array a)--- writeWith n = FL.rmapM rightSize $ appendWith (* 2) (newArray n)-writeWith elemCount =-    FL.rmapM extract $ FL.foldlM' step initial--    where--    insertElem (Array contents start end bound) x = do-        liftIO $ poke end x-        return $ Array contents start (PTR_NEXT(end,a)) bound--    initial = do-        when (elemCount < 0) $ error "writeWith: elemCount is negative"-        liftIO $ newArrayAligned (alignment (undefined :: a)) elemCount-    step arr@(Array _ start end bound) x-        | PTR_NEXT(end,a) > bound = do-        let oldSize = end `minusPtr` start-            newSize = max (oldSize * 2) 1-        arr1 <--            liftIO-                $ reallocAligned-                    (SIZE_OF(a))-                    (alignment (undefined :: a))-                    newSize-                    arr-        insertElem arr1 x-    step arr x = insertElem 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./------ @since 0.7.0-{-# INLINE write #-}-write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)-write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)------------------------------------------------------------------------------------ construct from streams, known size------------------------------------------------------------------------------------ | Use the 'writeN' fold instead.------ >>> fromStreamDN n = StreamD.fold (Array.writeN n)----{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: forall m a. (MonadIO m, Storable a)-    => Int -> D.Stream m a -> m (Array a)--- fromStreamDN n = D.fold (writeN n)-fromStreamDN limit str = do-    arr <- liftIO $ newArray limit-    end <- D.foldlM' fwrite (return $ aEnd arr) $ D.take limit str-    return $ arr {aEnd = end}--    where--    fwrite ptr x = do-        liftIO $ poke ptr x-        return $ PTR_NEXT(ptr,a)---- | 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.------ @since 0.7.0-{-# INLINABLE fromListN #-}-fromListN :: (MonadIO m, Storable a) => Int -> [a] -> m (Array a)-fromListN n xs = fromStreamDN n $ D.fromList xs------------------------------------------------------------------------------------ convert stream to a single array----------------------------------------------------------------------------------{-# INLINE arrayStreamKLength #-}-arrayStreamKLength :: (Monad m, Storable a) => K.Stream m (Array 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 :: (Storable a, MonadIO m) =>-    K.Stream m (Array a) -> m (Array a)-fromArrayStreamK as = do-    len <- arrayStreamKLength as-    fromStreamDN len $ D.unfoldMany read $ 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 Array.write----{-# INLINE fromStreamD #-}-fromStreamD :: (MonadIO m, Storable a) => D.Stream m a -> m (Array a)-fromStreamD m = arrayStreamKFromStreamD m >>= fromArrayStreamK---- | Create an 'Array' from a list. The list must be of finite size.------ @since 0.7.0-{-# INLINE fromList #-}-fromList :: (MonadIO m, Storable a) => [a] -> m (Array a)-fromList xs = fromStreamD $ D.fromList xs------------------------------------------------------------------------------------ Combining------------------------------------------------------------------------------------ | Copy two arrays into a newly allocated array.-{-# INLINE spliceCopy #-}-spliceCopy :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)-spliceCopy arr1 arr2 = do-    let src1 = arrStart arr1-        src2 = arrStart arr2-        len1 = aEnd arr1 `minusPtr` src1-        len2 = aEnd arr2 `minusPtr` src2--    arr <- liftIO $ newArray (len1 + len2)-    let dst = arrStart arr--    -- XXX Should we use copyMutableByteArray# instead? Is there an overhead to-    -- ccall?-    liftIO $ do-        memcpy (castPtr dst) (castPtr src1) len1-        touch (arrContents arr1)-        memcpy (castPtr (dst `plusPtr` len1)) (castPtr src2) len2-        touch (arrContents arr2)-    return arr { aEnd = dst `plusPtr` (len1 + len2) }---- | 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 => Array a -> (Array a, Int) -> m (Array a)-spliceUnsafe dst (src, srcLen) =-    liftIO $ do-         let psrc = arrStart src-         let pdst = aEnd dst-         assert (pdst `plusPtr` srcLen <= aBound dst) (return ())-         memcpy (castPtr pdst) (castPtr psrc) srcLen-         touch (arrContents src)-         touch (arrContents dst)-         return $ dst {aEnd = pdst `plusPtr` 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 dstBytesn 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, Storable a) =>-    (Int -> Int -> Int) -> Array a -> Array a -> m (Array a)-spliceWith sizer dst@(Array _ start end bound) src = do-{--    let f = appendWith (`sizer` byteLength src) (return dst)-     in D.fold f (toStreamD src)--}-    assert (end <= bound) (return ())-    let srcLen = aEnd src `minusPtr` arrStart src--    dst1 <--        if end `plusPtr` srcLen >= bound-        then do-            let oldSize = end `minusPtr` start-                newSize = sizer oldSize srcLen-            when (newSize < oldSize + srcLen)-                $ error-                    $ "splice: newSize is less than the total size "-                    ++ "of arrays being appended. Please check the "-                    ++ "newSize function passed."-            liftIO $ realloc newSize dst-        else return dst-    spliceUnsafe dst1 (src, srcLen)---- | 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 = Array.spliceWith (+)------ /Pre-release/-{-# INLINE splice #-}-splice :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array 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 = Array.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))------ /Pre-release/-{-# INLINE spliceExp #-}-spliceExp :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)-spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))------------------------------------------------------------------------------------ Splitting------------------------------------------------------------------------------------ | Drops the separator byte-{-# INLINE breakOn #-}-breakOn :: MonadIO m-    => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))-breakOn sep arr@Array{..} = liftIO $ do-    let p = arrStart-    loc <- c_memchr p sep (fromIntegral $ aEnd `minusPtr` p)-    return $-        if loc == nullPtr-        then (arr, Nothing)-        else-            ( Array-                { arrContents = arrContents-                , arrStart = arrStart-                , aEnd = loc-                , aBound = loc-                }-            , Just $ Array-                    { arrContents = arrContents-                    , arrStart = arrStart `plusPtr` (loc `minusPtr` p + 1)-                    , aEnd = aEnd-                    , aBound = aBound-                    }-            )---- | Create two slices of an array without copying the original array. The--- specified index @i@ is the first index of the second slice.------ @since 0.7.0-splitAt :: forall a. Storable a => Int -> Array a -> (Array a, Array a)-splitAt i arr@Array{..} =-    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 `plusPtr` off-                in ( Array-                  { arrContents = arrContents-                  , arrStart = arrStart-                  , aEnd = p-                  , aBound = p-                  }-                , Array-                  { arrContents = arrContents-                  , arrStart = arrStart `plusPtr` off-                  , aEnd = aEnd-                  , aBound = aBound-                  }-                )------------------------------------------------------------------------------------ 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-    Storable b =>-#endif-    Array a -> Array b-castUnsafe (Array contents start end bound) =-    Array contents (castPtr start) (castPtr end) (castPtr bound)---- | Cast an @Array a@ into an @Array Word8@.------ /Pre-release/----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.------ /Pre-release/----cast :: forall a b. Storable b => Array a -> Maybe (Array b)-cast arr =-    let len = byteLength arr-        r = len `mod` SIZE_OF(b)-     in if r /= 0-        then Nothing-        else Just $ castUnsafe arr---- | Use an @Array a@ as @Ptr a@.------ /Unsafe/------ /Pre-release/----asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b-asPtrUnsafe Array{..} f = do-  r <- f arrStart-  liftIO $ touch arrContents-  return r------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ | Compare if two arrays are equal.------ /Pre-release/-{-# INLINE cmp #-}-cmp :: MonadIO m => Array a -> Array a -> m Bool-cmp arr1 arr2 =-    liftIO $ do-        let ptr1 = arrStart arr1-        let ptr2 = arrStart arr2-        let len1 = aEnd arr1 `minusPtr` ptr1-        let len2 = aEnd arr2 `minusPtr` ptr2--        if len1 == len2-        then-            if ptr1 == ptr2-            then return True-            else do-                r <- memcmp (castPtr ptr1) (castPtr ptr2) len1-                touch (arrContents arr1)-                touch (arrContents arr2)-                return r-        else return False------------------------------------------------------------------------------------ NFData------------------------------------------------------------------------------------ This is a Storable array, we cannot have unevaluated data in it so this is--- just a no op.-instance NFData (Array a) where-    {-# INLINE rnf #-}-    rnf Array {} = ()
− src/Streamly/Internal/Data/Array/Foreign/Type.hs 
@@ -1,820 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Foreign.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.Foreign.Mut.Type"----module Streamly.Internal.Data.Array.Foreign.Type-    (-    -- $arrayNotes-      Array (..)-    , asPtrUnsafe--    -- * Freezing and Thawing-    , unsafeFreeze-    , unsafeFreezeWithShrink-    , unsafeThaw--    -- * Construction-    , splice--    , fromPtr-    , fromForeignPtrUnsafe-    , fromAddr#-    , fromCString#-    , fromList-    , fromListN-    , fromListRev-    , fromListRevN-    , fromStreamDN-    , fromStreamD--    -- * Split-    , breakOn--    -- * Elimination-    , unsafeIndexIO-    , unsafeIndex-    , byteLength-    , length--    , foldl'-    , foldr-    , splitAt--    , readRev-    , toStreamD-    , toStreamDRev-    , toStreamK-    , toStreamKRev-    , toStream-    , toStreamRev-    , toList--    -- * Folds-    , writeWith-    , writeN-    , writeNUnsafe-    , MA.ArrayUnsafe (..)-    , writeNAligned-    , writeNAlignedUnmanaged-    , write--    -- * Streams of arrays-    , arraysOf-    , bufferChunks-    , flattenArrays-    , flattenArraysRev-    )-where--#include "ArrayMacros.h"-#include "inline.hs"--import Control.Exception (assert)-import Control.DeepSeq (NFData(..))-import Control.Monad.IO.Class (MonadIO(..))-import Data.Functor.Identity (Identity(..))-import Data.Word (Word8)-import Foreign.C.String (CString)-import Foreign.C.Types (CSize(..))-import Foreign.Ptr (plusPtr, castPtr)-import Foreign.Storable (Storable(..))-import GHC.Base (Addr#, nullAddr#, build)-import GHC.Exts (IsList, IsString(..))-import GHC.ForeignPtr (ForeignPtr)--import GHC.IO (unsafePerformIO)-import GHC.Ptr (Ptr(..))-import Streamly.Internal.Data.Array.Foreign.Mut.Type-    (ArrayContents, ReadUState(..), touch)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Text.Read (readPrec, readListPrec, readListPrecDefault)--import Prelude hiding (length, foldr, read, unlines, splitAt)--import qualified Streamly.Internal.Data.Array.Foreign.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 GHC.Exts as Exts--import Streamly.Internal.System.IO (unsafeInlineIO, defaultChunkSize)--#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif--#ifdef DEVBUILD-import qualified Data.Foldable as F-#endif------- $setup--- >>> :m--- >>> :set -XMagicHash--- >>> import Prelude hiding (length, foldr, read, unlines, splitAt)--- >>> import Streamly.Internal.Data.Array.Foreign as Array---- XXX Since these are immutable arrays MonadIO constraint can be removed from--- most places.------------------------------------------------------------------------------------ Array Data Type------------------------------------------------------------------------------------ $arrayNotes------ We can use a 'Storable' 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.------ XXX Rename the fields to better names.----data Array a =-#ifdef DEVBUILD-    Storable a =>-#endif-    Array-    { arrContents ::-#ifndef USE_FOREIGN_PTR-        {-# UNPACK #-}-#endif-            !ArrayContents -- ^ first address-    , arrStart :: {-# UNPACK #-} !(Ptr a) -- start address-    , aEnd   :: {-# UNPACK #-} !(Ptr a)        -- first unused addres-    }------------------------------------------------------------------------------------ Utility functions----------------------------------------------------------------------------------foreign import ccall unsafe "string.h strlen" c_strlen-    :: CString -> IO CSize---- | Use an @Array a@ as @Ptr a@.------ /Unsafe/------ /Pre-release/----asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b-asPtrUnsafe Array{..} f = do-  r <- f arrStart-  liftIO $ touch arrContents-  return r------------------------------------------------------------------------------------ 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 :: MA.Array a -> Array a-unsafeFreeze (MA.Array ac as ae _) = Array ac as ae---- | Similar to 'unsafeFreeze' but uses 'MA.rightSize' on the mutable array--- first.-{-# INLINE unsafeFreezeWithShrink #-}-unsafeFreezeWithShrink :: Storable a => MA.Array a -> Array a-unsafeFreezeWithShrink arr = unsafePerformIO $ do-  MA.Array 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 -> MA.Array a-unsafeThaw (Array ac as ae) = MA.Array ac as ae ae------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ Splice two immutable arrays creating a new array.-{-# INLINE splice #-}-splice :: (MonadIO m, Storable a) => Array a -> Array a -> m (Array a)-splice arr1 arr2 =-    unsafeFreeze <$> MA.splice (unsafeThaw arr1) (unsafeThaw arr2)---- | Create an 'Array' of the given number of elements of type @a@ from a read--- only pointer @Ptr a@.  The pointer is not freed when the array is garbage--- collected. This API is unsafe for the following reasons:------ 1. The pointer must point to static pinned memory or foreign memory that--- does not require freeing..--- 2. The pointer must be legally accessible upto the given length.--- 3. To guarantee that the array is immutable, the contents of the address--- must be guaranteed to not change.------ /Unsafe/------ /Pre-release/----{-# INLINE fromPtr #-}-fromPtr ::-#ifdef DEVBUILD-    Storable a =>-#endif-    Int -> Ptr a -> Array a-fromPtr n ptr = unsafeInlineIO $ do-    let end = ptr `plusPtr` n-    return $ Array-        { arrContents = MA.nilArrayContents-        , arrStart = ptr-        , aEnd = end-        }---- | @fromForeignPtrUnsafe foreignPtr end bound@ creates an 'Array' that starts--- at the memory pointed by the @foreignPtr@, @end@ is the first unused--- address.------ Unsafe: Make sure that foreignPtr <= end and (end - start) is an--- integral multiple of the element size. Only PlainPtr type ForeignPtr is--- supported.------ /Pre-release/----{-# INLINE fromForeignPtrUnsafe #-}-fromForeignPtrUnsafe ::-#ifdef DEVBUILD-    Storable a =>-#endif-    ForeignPtr a -> Ptr a -> Array a-fromForeignPtrUnsafe fp end = unsafeFreeze $ MA.fromForeignPtrUnsafe fp end end---- XXX when converting an array of Word8 from a literal string we can simply--- refer to the literal string. Is it possible to write rules such that--- fromList Word8 can be rewritten so that GHC does not first convert the--- literal to [Char] and then we convert it back to an Array Word8?------ TBD: We can also add template haskell quasiquotes to specify arrays of other--- literal types. TH will encode them into a string literal and we read that as--- an array of the required type. With template Haskell we can provide a safe--- version of fromString#.------ | Create an @Array Word8@ of the given length from a static, read only--- machine address 'Addr#'. See 'fromPtr' for safety caveats.------ A common use case for this API is to create an array from a static unboxed--- string literal. GHC string literals are of type 'Addr#', and must contain--- characters that can be encoded in a byte i.e. characters or literal bytes in--- the range from 0-255.------ >>> import Data.Word (Word8)--- >>> Array.fromAddr# 5 "hello world!"# :: Array Word8--- [104,101,108,108,111]------ >>> Array.fromAddr# 3 "\255\NUL\255"# :: Array Word8--- [255,0,255]------ /See also: 'fromString#'/------ /Unsafe/------ /Time complexity: O(1)/------ /Pre-release/----{-# INLINE fromAddr# #-}-fromAddr# ::-#ifdef DEVBUILD-    Storable a =>-#endif-    Int -> Addr# -> Array a-fromAddr# n addr# = fromPtr n (castPtr $ Ptr addr#)---- | Generate a byte array from an 'Addr#' that contains a sequence of NUL--- (@0@) terminated bytes. The array would not include the NUL byte. The--- address must be in static read-only memory and must be legally accessible up--- to and including the first NUL byte.------ An unboxed string literal (e.g. @"hello"#@) is a common example of an--- 'Addr#' in static read only memory. It represents the UTF8 encoded sequence--- of bytes terminated by a NUL byte (a 'CString') corresponding to the--- given unicode string.------ >>> Array.fromCString# "hello world!"#--- [104,101,108,108,111,32,119,111,114,108,100,33]------ >>> Array.fromCString# "\255\NUL\255"#--- [255]------ /See also: 'fromAddr#'/------ /Unsafe/------ /Time complexity: O(n) (computes the length of the string)/------ /Pre-release/----{-# INLINE fromCString# #-}-fromCString# :: Addr# -> Array Word8-fromCString# addr# = do-    let cstr = Ptr addr#-        len = unsafeInlineIO $ c_strlen cstr-    fromPtr (fromIntegral len) (castPtr cstr)---- | 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.------ /Since 0.7.0 (Streamly.Memory.Array)/------ @since 0.8.0-{-# INLINABLE fromListN #-}-fromListN :: Storable a => Int -> [a] -> Array a-fromListN n xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListN n xs---- XXX We can possibly have a direction flag in the array to reverse it without--- actually doing anything. With that we can just do "reverse . fromList". But--- it may complicate all the APIs as all reads of the array will have to handle--- the flag.------ | 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.------ /Unimplemented/-{-# INLINABLE fromListRevN #-}-fromListRevN :: {- Storable a => -} Int -> [a] -> Array a-fromListRevN _n _xs = undefined---- | Create an 'Array' from a list. The list must be of finite size.------ /Since 0.7.0 (Streamly.Memory.Array)/------ @since 0.8.0-{-# INLINE fromList #-}-fromList :: Storable 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.------ /Unimplemented/-{-# INLINABLE fromListRev #-}-fromListRev :: {- Storable a => -} [a] -> Array a-fromListRev _xs = undefined--{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: forall m a. (MonadIO m, Storable 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, Storable a)-    => D.Stream m a -> m (Array a)-fromStreamD str = unsafeFreeze <$> MA.fromStreamD str------------------------------------------------------------------------------------ Streams of arrays----------------------------------------------------------------------------------{-# INLINE bufferChunks #-}-bufferChunks :: (MonadIO m, Storable a) =>-    D.Stream m a -> m (K.Stream m (Array a))-bufferChunks m = D.foldr K.cons K.nil $ arraysOf defaultChunkSize m---- | @arraysOf n stream@ groups the input stream into a stream of--- arrays of size n.-{-# INLINE_NORMAL arraysOf #-}-arraysOf :: forall m a. (MonadIO m, Storable a)-    => Int -> D.Stream m a -> D.Stream m (Array a)-arraysOf n str = D.map unsafeFreeze $ MA.arraysOf 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, Storable 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, Storable 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. Storable 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. Storable 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.------ @since 0.7.0-{-# 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.------ /Since 0.7.0 (Streamly.Memory.Array)/------ @since 0.8.0-{-# INLINE length #-}-length :: forall a. Storable a => Array a -> Int-length arr = MA.length (unsafeThaw arr)---- | Unfold an array into a stream in reverse order.------ @since 0.8.0-{-# INLINE_NORMAL readRev #-}-readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-readRev = Unfold step inject-    where--    inject (Array contents start end) =-        let p = PTR_PREV(end,a)-         in return $ ReadUState contents start p--    {-# INLINE_LATE step #-}-    step (ReadUState contents start p) | p < start =-        let x = unsafeInlineIO $ touch contents-        in x `seq` return D.Stop-    step (ReadUState contents start 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 $ peek p-            return $ D.Yield x (ReadUState contents start (PTR_PREV(p,a)))---{-# INLINE_NORMAL toStreamD #-}-toStreamD :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a-toStreamD Array{..} = D.Stream step arrStart--    where--    {-# INLINE_LATE step #-}-    step _ p | assert (p <= aEnd) (p == aEnd) = return D.Stop-    step _ 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 $ do-                    r <- peek p-                    touch arrContents-                    return r-        return $ D.Yield x (PTR_NEXT(p,a))--{-# INLINE toStreamK #-}-toStreamK :: forall m a. Storable a => Array a -> K.Stream m a-toStreamK Array{..} = go arrStart--    where--    go p | assert (p <= aEnd) (p == aEnd) = K.nil-         | otherwise =-        -- See Note in toStreamD.-        let !x = unsafeInlineIO $ do-                    r <- peek p-                    touch arrContents-                    return r-        in x `K.cons` go (PTR_NEXT(p,a))--{-# INLINE_NORMAL toStreamDRev #-}-toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a-toStreamDRev Array{..} = D.Stream step (PTR_PREV(aEnd,a))--    where--    {-# INLINE_LATE step #-}-    step _ p | p < arrStart = return D.Stop-    step _ p = do-        -- See comments in toStreamD for why we use unsafeInlineIO-        let !x = unsafeInlineIO $ do-                    r <- peek p-                    touch arrContents-                    return r-        return $ D.Yield x (PTR_PREV(p,a))--{-# INLINE toStreamKRev #-}-toStreamKRev :: forall m a. Storable a => Array a -> K.Stream m a-toStreamKRev Array {..} = go (PTR_PREV(aEnd,a))--    where--    go p | p < arrStart = K.nil-         | otherwise =-        let !x = unsafeInlineIO $ do-                    r <- peek p-                    touch arrContents-                    return r-        in x `K.cons` go (PTR_PREV(p,a))---- | Convert an 'Array' into a stream.------ /Pre-release/-{-# INLINE_EARLY toStream #-}-toStream :: (Monad m, Storable a) => Array a -> SerialT m a-toStream = SerialT . D.toStreamK . toStreamD--- 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 toStreamRev #-}-toStreamRev :: (Monad m, Storable a) => Array a -> SerialT m a-toStreamRev = SerialT . D.toStreamK . toStreamDRev---- 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. Storable a => (b -> a -> b) -> b -> Array a -> b-foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr--{-# INLINE_NORMAL foldr #-}-foldr :: Storable 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.------ @since 0.7.0-splitAt :: forall a. Storable 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. Storable a => (a -> b -> b) -> b -> Array a -> b-toListFB c n Array{..} = go arrStart-    where--    go p | assert (p <= aEnd) (p == aEnd) = 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.-        let !x = unsafeInlineIO $ do-                    r <- peek p-                    touch arrContents-                    return r-        in c x (go (PTR_NEXT(p,a)))---- | Convert an 'Array' into a list.------ /Since 0.7.0 (Streamly.Memory.Array)/------ @since 0.8.0-{-# INLINE toList #-}-toList :: Storable 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'.------ /Since 0.7.0 (Streamly.Memory.Array)/------ @since 0.8.0-{-# INLINE_NORMAL writeN #-}-writeN :: forall m a. (MonadIO m, Storable 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, Storable a)-    => Int -> Int -> Fold m a (Array a)-writeNAligned alignSize = fmap unsafeFreeze . MA.writeNAligned alignSize---- | @writeNAlignedUnmanaged n@ folds a maximum of @n@ elements from the input--- stream to an 'Array' aligned to the given size and using unmanaged memory.--- This could be useful to allocate memory that we need to allocate only once--- in the lifetime of the program.------ /Pre-release/----{-# INLINE_NORMAL writeNAlignedUnmanaged #-}-writeNAlignedUnmanaged :: forall m a. (MonadIO m, Storable a)-    => Int -> Int -> Fold m a (Array a)-writeNAlignedUnmanaged alignSize =-    fmap unsafeFreeze . MA.writeNAlignedUnmanaged 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.------ @since 0.7.0-{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: forall m a. (MonadIO m, Storable a)-    => Int -> Fold m a (Array a)-writeNUnsafe n = unsafeFreeze <$> MA.writeNUnsafe n--{-# INLINE_NORMAL writeWith #-}-writeWith :: forall m a. (MonadIO m, Storable 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./------ /Since 0.7.0 (Streamly.Memory.Array)/------ @since 0.8.0-{-# INLINE write #-}-write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)-write = fmap unsafeFreeze MA.write------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------instance (Show a, Storable a) => Show (Array a) where-    {-# INLINE showsPrec #-}-    showsPrec _ = shows . toList--instance (Storable a, Read a, Show a) => Read (Array a) where-    {-# INLINE readPrec #-}-    readPrec = fromList <$> readPrec-    readListPrec = readListPrecDefault--instance (a ~ Char) => IsString (Array a) where-    {-# INLINE fromString #-}-    fromString = fromList---- GHC versions 8.0 and below cannot derive IsList-instance Storable 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 Storable equality means element equality. This may--- or may not be correct? arrcmp is 40% faster compared to stream equality.-instance (Storable a, Eq a) => Eq (Array a) where-    {-# INLINE (==) #-}-    arr1 == arr2 = unsafeInlineIO $! unsafeThaw arr1 `MA.cmp` unsafeThaw arr2---- Since this is a Storable array we cannot have unevaluated data in it so--- this is just a no op.-instance NFData (Array a) where-    {-# INLINE rnf #-}-    rnf Array {} = ()--instance (Storable 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 Storable 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 == aEnd = return D.Stop-    step _ p = liftIO $ do-        x <- peek p-        touch arrContents-        return $ D.Yield x (p `plusPtr` size)--{---XXX Why isn't Storable implicit? This does not compile unless I use the Storable-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 Storable a => Semigroup (Array a) where-    arr1 <> arr2 = unsafePerformIO $ splice arr1 arr2--nil ::-#ifdef DEVBUILD-    Storable a =>-#endif-    Array a-nil = Array MA.nilArrayContents (Ptr nullAddr#) (Ptr nullAddr#)--instance Storable a => Monoid (Array a) where-    mempty = nil-    mappend = (<>)
− src/Streamly/Internal/Data/Array/Mut/Type.hs 
@@ -1,569 +0,0 @@-{-# 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----module Streamly.Internal.Data.Array.Mut.Type-(-    -- * Type-    -- $arrayNotes-      Array (..)--    -- * Constructing and Writing-    -- ** Construction-    -- , nil--    -- *** Uninitialized Arrays-    , newArray-    -- , 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.--    -- ** Appending elements-    , snocWith-    , snoc-    -- , snocLinear-    -- , snocMay-    , snocUnsafe--    -- ** Appending streams-    -- , appendNUnsafe-    -- , appendN-    -- , appendWith-    -- , append--    -- ** 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--    -- ** To streams-    , read-    -- , readRev--    -- ** To containers-    , toStreamD-    -- , toStreamDRev-    , toStreamK-    -- , toStreamKRev-    , toList--    -- experimental-    , producer--    -- ** Random reads-    , getIndex-    , getIndexUnsafe-    -- , getIndices-    -- , getFromThenTo-    -- , getIndexRev--    -- * In-place Mutation Algorithms-    -- , reverse-    -- , permute-    -- , partitionBy-    -- , shuffleBy-    -- , divideBy-    -- , mergeBy--    -- * 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-    -- , arraysOf-    -- , 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-    -- , putSlice-    -- , appendSlice-    -- , appendSliceFrom-    )-where--#include "inline.hs"--import Control.Exception (assert)-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 as D-import qualified Streamly.Internal.Data.Stream.StreamK as K--import Prelude hiding (read)---- $setup--- >>> :m--- >>> import qualified Streamly.Internal.Data.Array.Mut.Type as Array--- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream--- >>> import qualified Streamly.Internal.Data.Stream.StreamD as StreamD--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold------------------------------------------------------------------------------------ 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.--        , 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.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.--- | @newArray count@ allocates an empty array that can hold 'count' items.------ /Pre-release/-{-# INLINE newArray #-}-newArray :: forall m a. MonadIO m => Int -> m (Array a)-newArray n@(I# n#) =-    liftIO-        $ IO-        $ \s# ->-              case newArray# n# bottomElement s# of-                  (# s1#, arr# #) ->-                      let ma = Array arr# 0 0 n-                       in (# s1#, ma #)------------------------------------------------------------------------------------ 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 => Array a -> Int -> a -> m ()-putIndexUnsafe Array {..} i x =-    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 arr ix val = Array.modifyIndex arr ix (const (val, ()))------ /Pre-release/-{-# INLINE putIndex #-}-putIndex :: MonadIO m => Array a -> Int -> a -> m ()-putIndex arr@Array {..} i x =-    if i >= 0 && i < arrLen-    then putIndexUnsafe arr i x-    else invalidIndex "putIndex" i---- | 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 => Array a -> Int -> (a -> (a, b)) -> m b-modifyIndexUnsafe Array {..} i 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 => Array a -> Int -> (a -> (a, b)) -> m b-modifyIndex arr@Array {..} i f = do-    if i >= 0 && i < arrLen-    then modifyIndexUnsafe arr i 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 -> Array a -> m (Array a)-realloc n arr = do-    arr1 <- newArray 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 -> Array a -> m (Array 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 => Array a -> a -> m (Array a)-snocUnsafe arr@Array {..} a = do-    assert (arrStart + arrLen < arrTrueLen) (return ())-    putIndexUnsafe arr arrLen a-    return $ arr {arrLen = arrLen + 1}---- NOINLINE to move it out of the way and not pollute the instruction cache.-{-# NOINLINE snocWithRealloc #-}-snocWithRealloc :: MonadIO m => (Int -> Int) -> Array a -> a -> m (Array 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) -> Array a -> a -> m (Array a)-snocWith sizer arr@Array {..} 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 = Array.snocWith (* 2)------ Performs O(n * log n) copies to grow, but is liberal with memory allocation.------ /Pre-release/-{-# INLINE snoc #-}-snoc :: MonadIO m => Array a -> a -> m (Array a)-snoc = snocWith (* 2)------------------------------------------------------------------------------------ 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 => Array a -> Int -> m a-getIndexUnsafe Array {..} n =-    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 => Array a -> Int -> m a-getIndex arr@Array {..} i =-    if i >= 0 && i < arrLen-    then getIndexUnsafe arr i-    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-    -> Array a-    -> Array a-getSliceUnsafe index len arr@Array {..} =-    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-    -> Array a-    -> Array a-getSlice index len arr@Array{..} =-    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------------------------------------------------------------------------------------ | Convert an 'Array' into a list.------ /Pre-release/-{-# INLINE toList #-}-toList :: MonadIO m => Array a -> m [a]-toList arr@Array{..} = 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 => Array a -> D.Stream m a-toStreamD arr@Array{..} =-    D.mapM (getIndexUnsafe arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)--{-# INLINE toStreamK #-}-toStreamK :: MonadIO m => Array a -> K.Stream m a-toStreamK arr@Array{..} = K.unfoldrM step 0--    where--    step i-        | i == arrLen = return Nothing-        | otherwise = do-            x <- getIndexUnsafe arr i-            return $ Just (x, i + 1)------------------------------------------------------------------------------------- Folds------------------------------------------------------------------------------------ | 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 (Array a)-writeNUnsafe n = Fold step initial return--    where--    initial = FL.Partial <$> newArray (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 (Array.writeNUnsafe n)------ /Pre-release/-{-# INLINE_NORMAL writeN #-}-writeN :: MonadIO m => Int -> Fold m a (Array a)-writeN n = FL.take n $ writeNUnsafe n------------------------------------------------------------------------------------ Unfolds------------------------------------------------------------------------------------ | Resumable unfold of an array.----{-# INLINE_NORMAL producer #-}-producer :: MonadIO m => Producer m (Array a) a-producer = 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 <- getIndexUnsafe arr i-        return $ D.Yield x (arr, i + 1)---- | Unfold an array into a stream.----{-# INLINE_NORMAL read #-}-read :: MonadIO m => Unfold m (Array a) a-read = Producer.simplify producer
− src/Streamly/Internal/Data/Array/Prim.hs 
@@ -1,110 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Array.Prim--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Prim-    (-      Array--    -- * Construction--    -- Pure List APIs-    , A.fromListN-    , A.fromList--    -- Stream Folds-    , fromStreamN-    , fromStream--    -- Monadic APIs-    -- , newArray-    , A.writeN      -- drop new-    , A.write       -- full buffer--    -- * Elimination--    , A.toList-    , toStream-    , toStreamRev-    , read-    , unsafeRead--    -- * Random Access-    , length-    , null-    , last-    -- , (!!)-    , readIndex-    , A.unsafeIndex-    -- , readIndices-    -- , readRanges--    -- , readFrom    -- read from a given position to the end of file-    -- , readFromRev -- read from a given position to 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--    -- , readChunksOfFrom-    -- , ...--    -- , writeIndex-    -- , writeFrom -- start writing at the given position-    -- , writeFromRev-    -- , writeTo   -- write from beginning up to the given position-    -- , writeToRev-    -- , writeFromTo-    -- , writeFromThenTo-    ---    -- , writeChunksOfFrom-    -- , ...--    -- , writeIndex-    -- , writeIndices-    -- , writeRanges--    -- -- * Search-    -- , bsearch-    -- , bsearchIndex-    -- , find-    -- , findIndex-    -- , findIndices--    -- -- * In-pace mutation (for Mutable Array type)-    -- , partitionBy-    -- , shuffleBy-    -- , foldtWith-    -- , foldbWith--    -- * Immutable Transformations---    , streamTransform--    -- * Folding Arrays-    , streamFold-    , fold--    -- * Folds with Array as the container---    , D.lastN--    -- * Streaming array operations--    , concat-    , compact--    )-where--import Streamly.Internal.Data.Array.Prim.Type (Array(..), length)-import qualified Streamly.Internal.Data.Array.Prim.Type as A--#include "Streamly/Internal/Data/Array/PrimInclude.hs"
− src/Streamly/Internal/Data/Array/Prim/Mut/Type.hs 
@@ -1,94 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Array.Prim.Mut.Type--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Prim.Mut.Type-    (-      Array (..)--    -- * Construction-    , newArray-    , unsafeWriteIndex--    , spliceTwo-    , unsafeCopy--    , fromListM-    , fromListNM-    , fromStreamDN-    , fromStreamD--    -- * Streams of arrays-    , fromStreamDArraysOf--    , packArraysChunksOf-    , lpackArraysChunksOf--#if !defined(mingw32_HOST_OS)---    , groupIOVecsOf-#endif--    -- * Elimination-    , unsafeReadIndex-    , length-    , byteLength--    , writeN-    , ArrayUnsafe(..)-    , writeNUnsafe-    , write--    -- * Utilities-    , resizeArray-    , shrinkArray-    )-where--#include "Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs"------------------------------------------------------------------------------------ Allocation (Unpinned)------------------------------------------------------------------------------------ | Allocate an array that is unpinned and can hold 'count' items.  The memory--- of the array is uninitialized.------ Note that this is internal routine, the reference to this array cannot be--- given out until the array has been written to and frozen.-{-# INLINE newArray #-}-newArray ::-       forall m a. (MonadIO m, Prim a)-    => Int-    -> m (Array a)-newArray (I# n#) =-    liftIO $ do-        let bytes = n# *# sizeOf# (undefined :: a)-        primitive $ \s# ->-            case newByteArray# bytes s# of-                (# s1#, arr# #) -> (# s1#, Array arr# #)---- | Resize (unpinned) mutable byte array to new specified size (in elem--- count). The returned array is either the original array resized in-place or,--- if not possible, a newly allocated (unpinned) array (with the original--- content copied over).-{-# INLINE resizeArray #-}-resizeArray ::-       forall m a. (MonadIO m, Prim a)-    => Array a-    -> Int -- ^ new size in elem count-    -> m (Array a)-resizeArray (Array arr#) (I# n#) =-    liftIO $ do-        let bytes = n# *# sizeOf# (undefined :: a)-        primitive $ \s# ->-            case resizeMutableByteArray# arr# bytes s# of-                (# s1#, arr1# #) -> (# s1#, Array arr1# #)
− src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs 
@@ -1,413 +0,0 @@--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bifunctor (first)-import Data.Primitive.Types (Prim(..), sizeOf)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.SVar (adaptState)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))--import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Stream.StreamD as D--import GHC.Exts-import Control.Monad.Primitive-import Prelude hiding (length, unlines)------------------------------------------------------------------------------------ Array Data Type----------------------------------------------------------------------------------data Array a = Array (MutableByteArray# RealWorld)------------------------------------------------------------------------------------ Utilities------------------------------------------------------------------------------------ | Copy a range of the first array to the specified region in the second--- array. Both arrays must fully contain the specified ranges, but this is not--- checked. The regions are allowed to overlap, although this is only possible--- when the same array is provided as both the source and the destination.-{-# INLINE unsafeCopy #-}-unsafeCopy ::-       forall m a. (MonadIO m, Prim a)-    => Array a -- ^ destination array-    -> Int -- ^ offset into destination array-    -> Array a -- ^ source array-    -> Int -- ^ offset into source array-    -> Int -- ^ number of elements to copy-    -> m ()-unsafeCopy (Array dst#) (I# doff#) (Array src#) (I# soff#) (I# n#) =-    liftIO $ do-        let toBytes cnt# = cnt# *# (sizeOf# (undefined :: a))-        primitive_ $-            copyMutableByteArray#-                src#-                (toBytes soff#)-                dst#-                (toBytes doff#)-                (toBytes n#)------------------------------------------------------------------------------------ Length------------------------------------------------------------------------------------ XXX rename to byteCount?-{-# INLINE byteLength #-}-byteLength :: MonadIO m => Array a -> m Int-byteLength (Array arr#) =-    liftIO $-    primitive-        (\s0# ->-             case getSizeofMutableByteArray# arr# s0# of-                 (# s1#, blen# #) -> (# s1#, I# blen# #))----- XXX Rename length to elemCount so that there is no confusion bout what it--- means.------ XXX Since size of 'a' is statically known, we can replace `quot` with shift--- when it is power of 2. Though it may not matter unless length is used too--- often.----{-# INLINE length #-}-length ::-       forall m a. (MonadIO m, Prim a)-    => Array a-    -> m Int-length arr =-    liftIO $ do-        blen <- byteLength arr-        return $ blen `quot` (max 1 $ sizeOf (undefined :: a))------------------------------------------------------------------------------------ Random Access----------------------------------------------------------------------------------{-# INLINE unsafeReadIndex #-}-unsafeReadIndex :: (MonadIO m, Prim a) => Array a -> Int -> m a-unsafeReadIndex (Array arr#) (I# i#) =-    liftIO $ primitive (readByteArray# arr# i#)--{-# INLINE unsafeWriteIndex #-}-unsafeWriteIndex ::-       (MonadIO m, Prim a)-    => Array a -- ^ array-    -> Int -- ^ index-    -> a -- ^ element-    -> m ()-unsafeWriteIndex (Array arr#) (I# i#) x =-    liftIO $ primitive_ (writeByteArray# arr# i# x)------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ Note: We do not store the actual length of the array in the Array--- constructor. Therefore, for "length" API to work correctly we need to match--- the ByteArray length with the used length by shrinking it.------ However, it may be expensive to always shrink the array. We may want to--- shrink only if significant space is being wasted. If we want to do that then--- we will have to store the used length separately. Or does GHC take care of--- that?--- Although the docs are not explicit about it, given how the signature is,--- the shrinking must me inplace. "resizeMutableByteArray#" shrinks the--- array inplace.-{-# INLINE shrinkArray #-}-shrinkArray ::-       forall m a. (MonadIO m, Prim a)-    => Array a-    -> Int -- ^ new size-    -> m ()-shrinkArray (Array arr#) (I# n#) =-    liftIO $ do-        let bytes = n# *# (sizeOf# (undefined :: a))-        primitive_ (shrinkMutableByteArray# arr# bytes)---- | Fold the whole input to a single array.------ /Caution! Do not use this on infinite streams./------ /Pre-release/-{-# INLINE_NORMAL write #-}-write :: (MonadIO m, Prim a) => Fold m a (Array a)-write = FL.rmapM extract $ FL.foldlM' step initial--    where--    initial = do-        marr <- newArray 0-        return $ Tuple3' marr 0 0--    step (Tuple3' marr i capacity) x-        | i == capacity = do-            let newCapacity = max (capacity * 2) 1-            newMarr <- resizeArray marr newCapacity-            unsafeWriteIndex newMarr i x-            return $ Tuple3' newMarr (i + 1) newCapacity-        | otherwise = do-            unsafeWriteIndex marr i x-            return $ Tuple3' marr (i + 1) capacity--    extract (Tuple3' marr len _) = shrinkArray marr len >> return marr---- | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'Array'.------ /Pre-release/-{-# INLINE_NORMAL writeN #-}-writeN :: (MonadIO m, Prim a) => Int -> Fold m a (Array a)-writeN len = Fold step initial extract--    where--    {-# INLINE next #-}-    next marr i = do-        let i1 = i + 1-            st = Tuple' marr i1-        if len > i1-        then return $ FL.Partial st-        else fmap FL.Done $ extract st--    initial = do-        marr <- liftIO $ newArray len-        next marr (-1)--    step (Tuple' marr i) x = do-        liftIO $ unsafeWriteIndex marr i x-        next marr i--    extract (Tuple' marr l) = shrinkArray marr l >> return marr---- Use Tuple' instead?-data ArrayUnsafe a = ArrayUnsafe-    {-# UNPACK #-} !(Array a)-    {-# UNPACK #-} !Int---- | 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, Prim a) => Int -> Fold m a (Array a)-writeNUnsafe n = FL.rmapM extract $ FL.foldlM' step initial--    where--    initial = do-        arr <- newArray (max n 0)-        return $ ArrayUnsafe arr 0-    step (ArrayUnsafe marr i) x = do-        unsafeWriteIndex marr i x-        return $ ArrayUnsafe marr (i + 1)-    extract (ArrayUnsafe marr i) = shrinkArray marr i >> return marr--{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: (MonadIO m, Prim a) => Int -> D.Stream m a -> m (Array a)-fromStreamDN limit str = do-    marr <- newArray (max limit 0)-    let step i x = i `seq` (unsafeWriteIndex marr i x) >> return (i + 1)-    n <- D.foldlM' step (return 0) $ D.take limit str-    shrinkArray marr n-    return marr--{-# INLINE fromStreamD #-}-fromStreamD :: (MonadIO m, Prim a) => D.Stream m a -> m (Array a)-fromStreamD str = D.fold write str--{-# INLINABLE fromListNM #-}-fromListNM :: (MonadIO m, Prim a) => Int -> [a] -> m (Array a)-fromListNM n xs = fromStreamDN n $ D.fromList xs--{-# INLINABLE fromListM #-}-fromListM :: (MonadIO m, Prim a) => [a] -> m (Array a)-fromListM xs = fromStreamD $ D.fromList xs------------------------------------------------------------------------------------ Combining------------------------------------------------------------------------------------ Splice two mutable arrays creating a new array.-{-# INLINE spliceTwo #-}-spliceTwo :: (MonadIO m, Prim a) => Array a -> Array a -> m (Array a)-spliceTwo a1 a2 = do-    l1 <- length a1-    l2 <- length a2-    a3 <- resizeArray a1 (l1 + l2)-    unsafeCopy a2 0 a3 l1 l2-    return a3------------------------------------------------------------------------------------ Stream of Arrays----------------------------------------------------------------------------------data GroupState s a-    = GroupStart s-    | GroupBuffer s (Array a) Int-    | GroupYield (Array a) s-    | GroupLastYield (Array a) Int-    | GroupFinish---- | @fromStreamArraysOf n stream@ groups the input stream into a stream of--- arrays of size n.-{-# INLINE_NORMAL fromStreamDArraysOf #-}-fromStreamDArraysOf ::-       (MonadIO m, Prim a) => Int -> D.Stream m a -> D.Stream m (Array a)--- fromStreamDArraysOf n str = D.groupsOf n (writeN n) str-fromStreamDArraysOf 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.Array.Foreign.Mut.Type.fromStreamDArraysOf: the size of " ++-            "arrays [" ++ show n ++ "] must be a natural number"-        arr <- newArray n-        return $ D.Skip (GroupBuffer st arr 0)-    step' gst (GroupBuffer st arr i)-        | i < n = do-            r <- step (adaptState gst) st-            case r of-                D.Yield x s -> do-                    unsafeWriteIndex arr i x-                    return $ D.Skip (GroupBuffer s arr (i + 1))-                D.Skip s -> return $ D.Skip (GroupBuffer s arr i)-                D.Stop -> return $ D.Skip (GroupLastYield arr i)-        | otherwise = return $ D.Skip (GroupYield arr st)-    step' _ (GroupYield arr st) = do-        nArr <- newArray n-        return $ D.Yield arr (GroupBuffer st nArr 0)-    step' _ (GroupLastYield arr i)-        | i == 0 = return D.Stop-        | otherwise = do-            shrinkArray arr i-            return $ D.Yield arr GroupFinish-    step' _ GroupFinish = return D.Stop--data SpliceState s arr-    = SpliceInitial s-    | SpliceBuffering s arr-    | SpliceYielding arr (SpliceState s arr)-    | SpliceFinish---- XXX can use general grouping combinators to achieve this?--- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes. 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.------ /Pre-release/-{-# INLINE_NORMAL packArraysChunksOf #-}-packArraysChunksOf ::-       (MonadIO m, Prim a)-    => Int-    -> D.Stream m (Array a)-    -> D.Stream m (Array 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.Foreign.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 -> do-              len <- byteLength arr-              return $-                  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-                blen <- byteLength buf-                alen <- byteLength arr-                let len = blen + alen-                if len > n-                then return $-                    D.Skip (SpliceYielding buf (SpliceBuffering s arr))-                else do-                    buf' <- spliceTwo 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--{-# INLINE_NORMAL lpackArraysChunksOf #-}-lpackArraysChunksOf ::-       (MonadIO m, Prim a) => Int -> Fold m (Array a) () -> Fold m (Array 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.Foreign.Mut.Type."-              ++ "packArraysChunksOf: the size of arrays ["-              ++ show n-              ++ "] must be a natural number"-        res <- initial1-        return $ first (Tuple' Nothing) res--    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 = do-        len <- byteLength arr-        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-        blen <- byteLength buf-        alen <- byteLength arr-        let len = blen + alen-        buf' <- spliceTwo buf arr-        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
− src/Streamly/Internal/Data/Array/Prim/Pinned.hs 
@@ -1,108 +0,0 @@-#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Array.Prim.Pinned--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Prim.Pinned-    (-      Array--    -- * Construction--    -- Pure List APIs-    , A.fromListN-    , A.fromList--    -- Stream Folds-    , fromStreamN-    , fromStream--    -- Monadic APIs-    -- , newArray-    , A.writeN      -- drop new-    , A.write       -- full buffer--    -- * Elimination--    , A.toList-    , toStream-    , toStreamRev-    , read-    , unsafeRead--    -- * Random Access-    , length-    , null-    , last-    -- , (!!)-    , readIndex-    , A.unsafeIndex-    -- , readIndices-    -- , readRanges--    -- , readFrom    -- read from a given position to the end of file-    -- , readFromRev -- read from a given position to 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--    -- , readChunksOfFrom-    -- , ...--    -- , writeIndex-    -- , writeFrom -- start writing at the given position-    -- , writeFromRev-    -- , writeTo   -- write from beginning up to the given position-    -- , writeToRev-    -- , writeFromTo-    -- , writeFromThenTo-    ---    -- , writeChunksOfFrom-    -- , ...--    -- , writeIndex-    -- , writeIndices-    -- , writeRanges--    -- -- * Search-    -- , bsearch-    -- , bsearchIndex-    -- , find-    -- , findIndex-    -- , findIndices--    -- -- * In-pace mutation (for Mutable Array type)-    -- , partitionBy-    -- , shuffleBy-    -- , foldtWith-    -- , foldbWith--    -- * Immutable Transformations---    , streamTransform--    -- * Folding Arrays-    , streamFold-    , fold--    -- * Folds with Array as the container---  , D.lastN--    -- * Streaming array operations--    , concat-    , compact--    )-where--import Streamly.Internal.Data.Array.Prim.Pinned.Type (Array(..), length)-import qualified Streamly.Internal.Data.Array.Prim.Pinned.Type as A--#include "Streamly/Internal/Data/Array/PrimInclude.hs"
− src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Type.hs 
@@ -1,176 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Array.Prim.Pinned.Mut.Type--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Prim.Pinned.Mut.Type-    (-      Array (..)--    -- * Construction-    , newArray-    , newAlignedArray-    , unsafeWriteIndex--    , spliceTwo-    , unsafeCopy--    , fromListM-    , fromListNM-    , fromStreamDN-    , fromStreamD--    -- * Streams of arrays-    , fromStreamDArraysOf--    , packArraysChunksOf-    , lpackArraysChunksOf--#if !defined(mingw32_HOST_OS)---    , groupIOVecsOf-#endif--    -- * Elimination-    , unsafeReadIndex-    , length-    , byteLength--    , writeN-    , ArrayUnsafe(..)-    , writeNUnsafe-    , writeNAligned-    , write--    -- * Utilities-    , resizeArray-    , shrinkArray--    , touchArray-    , withArrayAsPtr-    )-where--import GHC.IO (IO(..))--#include "Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs"------------------------------------------------------------------------------------ Allocation (Pinned)------------------------------------------------------------------------------------ XXX we can use a single newArray routine which accepts an allocation--- function which could be newByteArray#, newPinnedByteArray# or--- newAlignedPinnedByteArray#. That function can go in the common include file.------ | Allocate an array that is pinned and can hold 'count' items.  The memory of--- the array is uninitialized.------ Note that this is internal routine, the reference to this array cannot be--- given out until the array has been written to and frozen.-{-# INLINE newArray #-}-newArray ::-       forall m a. (MonadIO m, Prim a)-    => Int-    -> m (Array a)-newArray (I# n#) =-    liftIO $ do-        let bytes = n# *# sizeOf# (undefined :: a)-        primitive $ \s# ->-            case newPinnedByteArray# bytes s# of-                (# s1#, arr# #) -> (# s1#, Array arr# #)---- Change order of args?--- | Allocate a new array aligned to the specified alignment and using pinned--- memory.-{-# INLINE newAlignedArray #-}-newAlignedArray ::-       forall m a. (MonadIO m, Prim a)-    => Int -- size-    -> Int -- Alignment-    -> m (Array a)-newAlignedArray (I# n#) (I# a#) =-    liftIO $ do-        let bytes = n# *# sizeOf# (undefined :: a)-        primitive $ \s# ->-            case newAlignedPinnedByteArray# bytes a# s# of-                (# s1#, arr# #) -> (# s1#, Array arr# #)---- | Resize (pinned) mutable byte array to new specified size (in elem--- count). The returned array is either the original array resized in-place or,--- if not possible, a newly allocated (pinned) array (with the original content--- copied over).-{-# INLINE resizeArray #-}-resizeArray ::-       (MonadIO m, Prim a)-    => Array a-    -> Int -- ^ new size-    -> m (Array a)-resizeArray arr i = do-    len <- length arr-    if len == i-    then return arr-    else if i < len-         then shrinkArray arr i >> return arr-         else do-             nArr <- newArray i-             unsafeCopy nArr 0 arr 0 len-             return nArr------------------------------------------------------------------------------------ Aligned Construction------------------------------------------------------------------------------------ XXX we can also factor out common code in writeN and writeNAligned in the--- same way as suggested above.----{-# INLINE_NORMAL writeNAligned #-}-writeNAligned ::-       (MonadIO m, Prim a)-    => Int-    -> Int-    -> Fold m a (Array a)-writeNAligned align limit = Fold step initial extract--    where--    initial = do-        marr <- newAlignedArray limit align-        return $ FL.Partial $ Tuple' marr 0--    extract (Tuple' marr len) = shrinkArray marr len >> return marr--    step s@(Tuple' marr i) x-        | i == limit = FL.Done <$> extract s-        | otherwise = do-            unsafeWriteIndex marr i x-            return $ FL.Partial $ Tuple' marr (i + 1)------------------------------------------------------------------------------------ Mutation with pointers------------------------------------------------------------------------------------ XXX This section can probably go in a common include file for pinned arrays.---- Change name later.-{-# INLINE toPtr #-}-toPtr :: Array a -> Ptr a-toPtr (Array arr#) = Ptr (byteArrayContents# (unsafeCoerce# arr#))--{-# INLINE touchArray #-}-touchArray :: Array a -> IO ()-touchArray arr = IO $ \s -> case touch# arr s of s' -> (# s', () #)--{-# INLINE withArrayAsPtr #-}-withArrayAsPtr :: Array a -> (Ptr a -> IO b) -> IO b-withArrayAsPtr arr f = do-    r <- f (toPtr arr)-    touchArray arr-    return r
− src/Streamly/Internal/Data/Array/Prim/Pinned/Type.hs 
@@ -1,127 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Array.Prim.Pinned.Type--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Prim.Pinned.Type-    (-      Array (..)-    , unsafeFreeze-    , unsafeFreezeWithShrink---    , unsafeThaw-    , defaultChunkSize-    , nil--    -- * Construction-    , spliceTwo--    , fromList-    , fromListN-    , fromStreamDN-    , fromStreamD--    -- * Streams of arrays-    , fromStreamDArraysOf-    , FlattenState (..) -- for inspection testing-    , flattenArrays-    , flattenArraysRev-    , SpliceState (..) -- for inspection testing-    , packArraysChunksOf-    , lpackArraysChunksOf-#if !defined(mingw32_HOST_OS)---    , groupIOVecsOf-#endif-    , splitOn-    , breakOn--    -- * Elimination-    , unsafeIndex-    , byteLength-    , length--    , foldl'-    , foldr-    , foldr'-    , foldlM'-    , splitAt--    , toStreamD-    , toStreamDRev-    , toStreamK-    , toStreamKRev-    , toList---    , toArrayMinChunk-    , writeN-    , MA.ArrayUnsafe(..)-    , writeNUnsafe-    , write--    , unlines--    , toPtr--    , touchArray-    , withArrayAsPtr-    )-where--import Foreign.C.Types (CSize(..))-import GHC.IO (IO(..))-import Foreign.Ptr (minusPtr, nullPtr, plusPtr)--import qualified Streamly.Internal.Data.Array.Prim.Pinned.Mut.Type as MA--#include "Streamly/Internal/Data/Array/Prim/TypesInclude.hs"------------------------------------------------------------------------------------ Utility functions----------------------------------------------------------------------------------foreign import ccall unsafe "string.h memchr" c_memchr-    :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)------------------------------------------------------------------------------------ Using as a Pointer------------------------------------------------------------------------------------ Change name later.-{-# INLINE toPtr #-}-toPtr :: Array a -> Ptr a-toPtr (Array arr# off _) = Ptr (byteArrayContents# arr#) `plusPtr` off--{-# INLINE touchArray #-}-touchArray :: Array a -> IO ()-touchArray (Array arr# _ _) = IO $ \s -> case touch# arr# s of s1 -> (# s1, () #)--{-# INLINE withArrayAsPtr #-}-withArrayAsPtr :: Array a -> (Ptr a -> IO b) -> IO b-withArrayAsPtr arr f = do-    r <- f (toPtr arr)-    touchArray arr-    return r---- Drops the separator byte-{-# INLINE breakOn #-}-breakOn ::-       MonadIO m-    => Word8-    -> Array Word8-    -> m (Array Word8, Maybe (Array Word8))-breakOn sep arr@(Array arr# off len) = do-    let p = toPtr arr-        loc = unsafePerformIO $ c_memchr p sep (fromIntegral (byteLength arr))-        len1 = loc `minusPtr` p-        len2 = len - len1 - 1-    return $-        if loc == nullPtr-        then (arr, Nothing)-        else ( Array arr# off len1-             , Just $ Array arr# (off + len1 + 1) len2)
− src/Streamly/Internal/Data/Array/Prim/Type.hs 
@@ -1,98 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Array.Prim.Type--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Prim.Type-    (-      Array (..)-    , unsafeFreeze-    , unsafeFreezeWithShrink---    , unsafeThaw-    , defaultChunkSize-    , nil--    -- * Construction-    , spliceTwo--    , fromList-    , fromListN-    , fromStreamDN-    , fromStreamD--    -- * Streams of arrays-    , fromStreamDArraysOf-    , FlattenState (..) -- for inspection testing-    , flattenArrays-    , flattenArraysRev-    , SpliceState (..) -- for inspection testing-    , packArraysChunksOf-    , lpackArraysChunksOf-#if !defined(mingw32_HOST_OS)---    , groupIOVecsOf-#endif-    , splitOn-    , breakOn--    -- * Elimination-    , unsafeIndex-    , byteLength-    , length--    , foldl'-    , foldr-    , foldr'-    , foldlM'-    , splitAt--    , toStreamD-    , toStreamDRev-    , toStreamK-    , toStreamKRev-    , toList---    , toArrayMinChunk-    , writeN-    , MA.ArrayUnsafe(..)-    , writeNUnsafe-    , write--    , unlines-    )-where--import qualified Streamly.Internal.Data.Array.Prim.Mut.Type as MA--#include "Streamly/Internal/Data/Array/Prim/TypesInclude.hs"---- Drops the separator byte--- Inefficient compared to Memory Array-{-# INLINE breakOn #-}-breakOn ::-       MonadIO m-    => Word8-    -> Array Word8-    -> m (Array Word8, Maybe (Array Word8))-breakOn sep arr@(Array arr# off len) =-    case loc of-        Left _ -> return (arr, Nothing)-        Right len1 -> do-            let len2 = len - len1 - 1-            return (Array arr# off len1, Just $ Array arr# (off + len1 + 1) len2)--    where--    loc = foldl' chk (Left 0) arr--    chk (Left i) a =-        if a == sep-            then Right i-            else Left (i + 1)-    chk r _ = r
− src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs 
@@ -1,706 +0,0 @@--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--import Control.DeepSeq (NFData(..))-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Primitive (PrimMonad(..), primitive_)-import Data.Bifunctor (first)-import Data.Primitive.Types (Prim(..), sizeOf)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif-import Data.Word (Word8)-import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.SVar (adaptState)-import System.IO.Unsafe (unsafePerformIO)-import Text.Read (readPrec, readListPrec, readListPrecDefault)--import qualified GHC.Exts as Exts-import qualified Prelude as P-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K--import GHC.Exts hiding (fromListN, fromList, toList)-import Prelude hiding (length, unlines, foldr)------------------------------------------------------------------------------------ Array Data Type----------------------------------------------------------------------------------data Array a = Array ByteArray# Int Int------------------------------------------------------------------------------------ Utilities------------------------------------------------------------------------------------ | Both arrays must fully contain the specified ranges, but this is not--- checked. The two arrays must not be the same array in different states, but--- this is not checked either.-{-# INLINE unsafeCopy #-}-unsafeCopy ::-       forall m a. (MonadIO m, Prim a)-    => MA.Array a -- ^ destination array-    -> Int -- ^ offset into destination array-    -> Array a -- ^ source array-    -> Int -- ^ offset into source array-    -> Int -- ^ number of elements to copy-    -> m ()-unsafeCopy (MA.Array dst#) (I# doff#) (Array src# (I# off#) _) (I# soff#) (I# n#) =-    liftIO $ do-        let toBytes cnt# = cnt# *# (sizeOf# (undefined :: a))-        primitive_ $-            copyByteArray#-                src#-                (toBytes (off# +# soff#))-                dst#-                (toBytes doff#)-                (toBytes n#)------------------------------------------------------------------------------------ Basic Byte Array Operations----------------------------------------------------------------------------------{-# INLINE unsafeFreeze #-}-unsafeFreeze :: (Prim a, MonadIO m) => MA.Array a -> m (Array a)-unsafeFreeze marr@(MA.Array arr#) =-    liftIO $ do-        len <- MA.length marr-        primitive $ \s# ->-            case unsafeFreezeByteArray# arr# s# of-                (# s1#, arr1# #) -> (# s1#, Array arr1# 0 len #)--{-# INLINE unsafeFreezeWithShrink #-}-unsafeFreezeWithShrink ::-       (Prim a, MonadIO m) => MA.Array a -> Int -> m (Array a)-unsafeFreezeWithShrink marr@(MA.Array arr#) n =-    liftIO $ do-        MA.shrinkArray marr n-        len <- MA.length marr-        primitive $ \s# ->-            case unsafeFreezeByteArray# arr# s# of-                (# s1#, arr1# #) -> (# s1#, Array arr1# 0 len #)--{---- Should never be used in general-{-# INLINE unsafeThaw #-}-unsafeThaw :: MonadIO m => Array a -> m (MA.Array a)-unsafeThaw (Array arr#) =-    primitive $ \s# -> (# s#, MA.Array (unsafeCoerce# arr#) #)--}---- Unsafe because the index bounds are not checked-{-# INLINE unsafeIndex #-}-unsafeIndex :: Prim a => Array a -> Int -> a-unsafeIndex (Array arr# (I# off#) _) (I# i#) = indexByteArray# arr# (off# +# i#)---- unsafe-sameByteArray :: ByteArray# -> ByteArray# -> Bool-sameByteArray ba1 ba2 =-    case reallyUnsafePtrEquality#-             (unsafeCoerce# ba1 :: ())-             (unsafeCoerce# ba2 :: ()) of-        r -> isTrue# r------------------------------------------------------------------------------------ Chunk Size------------------------------------------------------------------------------------ XXX move this section to mutable array module?--mkChunkSizeKB :: Int -> Int-mkChunkSizeKB n = n * k-    where k = 1024---- | 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 = mkChunkSizeKB 32------------------------------------------------------------------------------------ Length----------------------------------------------------------------------------------sizeOfPrimElem :: forall a . (Prim a) => a -> Int-sizeOfPrimElem _ = max 1 $ sizeOf (undefined :: a)---- XXX rename to byteCount?-{-# INLINE byteLength #-}-byteLength :: forall a. Prim a => Array a -> Int-byteLength (Array _ _ len) = len * sizeOfPrimElem (undefined :: a)---- XXX Also, rename to elemCount--- XXX I would prefer length to keep the API consistent--- XXX Also, re-export sizeOf from Primitive-{-# INLINE length #-}-length :: Array a -> Int-length (Array _ _ len) = len------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ | Use a slice of an array as another array. Note that this is unsafe and does--- not check the bounds-slice :: Array a -> Int -> Int -> Array a-slice (Array arr# off _) off1 len1 = Array arr# (off + off1) len1--nil :: Prim a => Array a-nil =-    unsafePerformIO $ do-        arr <- MA.newArray 0-        unsafeFreeze arr---- | Fold the whole input to a single array.------ /Caution! Do not use this on infinite streams./------ /Pre-release/-{-# INLINE_NORMAL write #-}-write :: (MonadIO m, Prim a) => Fold m a (Array a)-write = FL.rmapM unsafeFreeze MA.write---- | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'Array'.------ /Pre-release/-{-# INLINE_NORMAL writeN #-}-writeN :: (MonadIO m, Prim a) => Int -> Fold m a (Array a)-writeN limit = FL.rmapM unsafeFreeze (MA.writeN limit)---- | 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, Prim a) => Int -> Fold m a (Array a)-writeNUnsafe limit = FL.rmapM unsafeFreeze (MA.writeNUnsafe limit)--{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: (MonadIO m, Prim a) => Int -> D.Stream m a -> m (Array a)-fromStreamDN limit str = MA.fromStreamDN limit str >>= unsafeFreeze--{-# INLINE fromStreamD #-}-fromStreamD :: (MonadIO m, Prim a) => D.Stream m a -> m (Array a)-fromStreamD str = MA.fromStreamD str >>= unsafeFreeze---- | @fromStreamArraysOf n stream@ groups the input stream into a stream of--- arrays of size n.-{-# INLINE_NORMAL fromStreamDArraysOf #-}-fromStreamDArraysOf ::-       (MonadIO m, Prim a) => Int -> D.Stream m a -> D.Stream m (Array a)-fromStreamDArraysOf n str = D.mapM unsafeFreeze (MA.fromStreamDArraysOf n str)---- XXX derive from MA.fromListN?-{-# INLINE fromListN #-}-fromListN :: Prim a => Int -> [a] -> Array a-fromListN len xs = unsafePerformIO $ MA.fromListNM len xs >>= unsafeFreeze---- XXX derive from MA.fromList?-{-# INLINE fromList #-}-fromList :: Prim a => [a] -> Array a-fromList xs = fromListN (P.length xs) xs------------------------------------------------------------------------------------ Combining------------------------------------------------------------------------------------ | Splice two immutable arrays creating a new immutable array.-{-# INLINE spliceTwo #-}-spliceTwo :: (MonadIO m, Prim a) => Array a -> Array a -> m (Array a)-spliceTwo a1 a2 = do-    let l1 = length a1-        l2 = length a2-    a3 <- MA.newArray (l1 + l2)-    unsafeCopy a3 0 a1 0 l1-    unsafeCopy a3 l1 a2 0 l2-    unsafeFreeze a3 -- Use `unsafeFreezeWith off len`?------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE_LATE toListFB #-}-toListFB :: Prim a => (a -> b -> b) -> b -> Array a -> b-toListFB c n arr = go 0-    where-    len = length arr-    go p | p == len = n-    go p =-        let !x = unsafeIndex arr p-        in c x (go (p + 1))---- | Convert an 'Array' into a list.------ /Pre-release/-{-# INLINE toList #-}-toList :: Prim a => Array a -> [a]-toList s = build (\c n -> toListFB c n s)------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------instance (Eq a, Prim a) => Eq (Array a) where-    {-# INLINE (==) #-}-    a1@(Array ba1# _ len1) == a2@(Array ba2# _ len2)-        | sameByteArray ba1# ba2# = True-        | len1 /= len2 = False-        | otherwise = loop (len1 - 1)--        where--        loop !i-            | i < 0 = True-            | otherwise = unsafeIndex a1 i == unsafeIndex a2 i && loop (i - 1)---- | Lexicographic ordering. Subject to change between major versions.-instance (Ord a, Prim a) => Ord (Array a) where-    {-# INLINE compare #-}-    compare a1@(Array ba1# _ len1) a2@(Array ba2# _ len2)-        | sameByteArray ba1# ba2# = EQ-        | otherwise = loop 0--        where--        sz = min len1 len2--        loop !i-            | i < sz =-                compare (unsafeIndex a1 i) (unsafeIndex a2 i) <> loop (i + 1)-            | otherwise = compare len1 len2--instance Prim a => Semigroup (Array a) where-    -- XXX can't we use runST instead of inlineIO?-    -- XXX I plan to remove MonadIO and replace it with IO-    a <> b = unsafePerformIO (spliceTwo a b :: IO (Array a))--instance Prim a => Monoid (Array a) where-    mempty = nil-    mappend = (<>)--instance NFData (Array a) where-    {-# INLINE rnf #-}-    rnf _ = ()----- XXX check if this is compatible with Memory.Array?--- XXX It isn't. I might prefer this Show instance though--- XXX Memory.Array: showsPrec _ = shows . toList-instance (Show a, Prim a) => Show (Array a) where-    showsPrec p a =-        showParen (p > 10) $-              showString "fromListN "-            . shows (length a)-            . showString " "-            . shows (toList a)--instance (a ~ Char) => IsString (Array a) where-    {-# INLINE fromString #-}-    fromString = fromList---- GHC versions 8.0 and below cannot derive IsList-instance Prim a => IsList (Array a) where-    type (Item (Array a)) = a--    {-# INLINE fromList #-}-    fromList = fromList--    {-# INLINE fromListN #-}-    fromListN = fromListN--    {-# INLINE toList #-}-    toList = toList--instance (Prim a, Read a, Show a) => Read (Array a) where-    {-# INLINE readPrec #-}-    readPrec = fromList <$> readPrec-    readListPrec = readListPrecDefault---- XXX these folds can be made common with mutable arrays by defining a--- unsafeIndex in the specific module?------------------------------------------------------------------------------------ Folds----------------------------------------------------------------------------------{-# INLINE foldr #-}-foldr :: Prim a => (a -> b -> b) -> b -> Array a -> b-foldr f z arr = go 0--    where--    !len = length arr--    go !i-        | len > i = f (unsafeIndex arr i) (go (i + 1))-        | otherwise = z---- | Strict right-associated fold over the elements of an 'Array'.-{-# INLINE foldr' #-}-foldr' :: Prim a => (a -> b -> b) -> b -> Array a -> b-foldr' f z0 arr = go (length arr - 1) z0--    where--    go !i !acc-        | i < 0 = acc-        | otherwise = go (i - 1) (f (unsafeIndex arr i) acc)---- | Strict left-associated fold over the elements of an 'Array'.-{-# INLINE foldl' #-}-foldl' :: Prim a => (b -> a -> b) -> b -> Array a -> b-foldl' f z0 arr = go 0 z0--    where--    !len = length arr--    go !i !acc-        | i < len = go (i + 1) (f acc (unsafeIndex arr i))-        | otherwise = acc---- | Strict left-associated fold over the elements of an 'Array'.-{-# INLINE foldlM' #-}-foldlM' :: (Prim a, Monad m) => (b -> a -> m b) -> b -> Array a -> m b-foldlM' f z0 arr = go 0 z0--    where--    !len = length arr--    go !i !acc1-        | i < len = do-            acc2 <- f acc1 (unsafeIndex arr i)-            go (i + 1) acc2-        | otherwise = return acc1------------------------------------------------------------------------------------ Converting to streams----------------------------------------------------------------------------------{-# INLINE_NORMAL toStreamD #-}-toStreamD :: (Prim a, Monad m) => Array a -> D.Stream m a-toStreamD arr = D.Stream step 0--    where--    {-# INLINE_LATE step #-}-    step _ i-        | i == length arr = return D.Stop-    step _ i = return $ D.Yield (unsafeIndex arr i) (i + 1)--{-# INLINE toStreamK #-}-toStreamK :: Prim a => Array a -> K.Stream m a-toStreamK arr = go 0--    where--    len = length arr--    go p-        | p == len = K.nil-        | otherwise =-            let !x = unsafeIndex arr p-            in x `K.cons` go (p + 1)--{-# INLINE_NORMAL toStreamDRev #-}-toStreamDRev :: (Prim a, Monad m) => Array a -> D.Stream m a-toStreamDRev arr = D.Stream step (length arr - 1)--    where--    {-# INLINE_LATE step #-}-    step _ i-        | i < 0 = return D.Stop-    step _ i = return $ D.Yield (unsafeIndex arr i) (i - 1)--{-# INLINE toStreamKRev #-}-toStreamKRev :: Prim a => Array a -> K.Stream m a-toStreamKRev arr = go (length arr - 1)--    where--    go p | p == -1 = K.nil-         | otherwise =-        let !x = unsafeIndex arr p-        in x `K.cons` go (p - 1)------------------------------------------------------------------------------------ Stream of Arrays----------------------------------------------------------------------------------data FlattenState s a =-      OuterLoop s-    | InnerLoop s !(Array a) !Int !Int--{-# INLINE_NORMAL flattenArrays #-}-flattenArrays :: (MonadIO m, Prim a) => D.Stream m (Array 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 arr s ->-                let len = length arr-                in if len == 0-                   then D.Skip (OuterLoop s)-                   else D.Skip (InnerLoop s arr len 0)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ len i) | i == len =-        return $ D.Skip $ OuterLoop st--    step' _ (InnerLoop st arr len i) = do-        let x = unsafeIndex arr i-        return $ D.Yield x (InnerLoop st arr len (i + 1))--{-# INLINE_NORMAL flattenArraysRev #-}-flattenArraysRev :: (MonadIO m, Prim a) => D.Stream m (Array 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 arr s ->-                let len = length arr-                in if len == 0-                   then D.Skip (OuterLoop s)-                   else D.Skip (InnerLoop s arr len (len - 1))-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ _ i) | i == -1 =-        return $ D.Skip $ OuterLoop st--    step' _ (InnerLoop st arr len i) = do-        let x = unsafeIndex arr i-        return $ D.Yield x (InnerLoop st arr len (i - 1))--{-# INLINE_NORMAL unlines #-}-unlines :: (MonadIO m, Prim 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 arr s ->-                let len = length arr-                in D.Skip (InnerLoop s arr len 0)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ len i) | i == len =-        return $ D.Yield sep $ OuterLoop st--    step' _ (InnerLoop st arr len i) = do-        let x = unsafeIndex arr i-        return $ D.Yield x (InnerLoop st arr len (i + 1))---- Splice an array into a pre-reserved mutable array.  The user must ensure--- that there is enough space in the mutable array.-{-# INLINE spliceInto #-}-spliceInto :: (MonadIO m, Prim a) => MA.Array a -> Int -> Array a -> m Int-spliceInto dst doff src@(Array _ _ len) = do-    unsafeCopy dst doff src 0 len-    return $ doff + len--data SpliceState s arr1 arr2-    = SpliceInitial s-    | SpliceBuffering s arr2-    | SpliceYielding arr1 (SpliceState s arr1 arr2)-    | SpliceFinish---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes. 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.------ /Pre-release/-{-# INLINE_NORMAL packArraysChunksOf #-}-packArraysChunksOf ::-       forall m a. (MonadIO m, Prim a)-    => Int-    -> D.Stream m (Array a)-    -> D.Stream m (Array a)-packArraysChunksOf n (D.Stream step state) =-    D.Stream step' (SpliceInitial state)--    where--    nElem = n `quot` sizeOfPrimElem (undefined :: a)--    {-# 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.Foreign.Type.packArraysChunksOf: the size of "-                 ++ "arrays [" ++ show n ++ "] must be a natural number"-        r <- step gst st-        case r of-            D.Yield arr s ->-                if length arr >= nElem-                then return $ D.Skip (SpliceYielding arr (SpliceInitial s))-                else do-                    buf <- MA.newArray nElem-                    noff <- spliceInto buf 0 arr-                    return $ D.Skip (SpliceBuffering s (buf, noff))-            D.Skip s -> return $ D.Skip (SpliceInitial s)-            D.Stop -> return $ D.Stop--    step' gst (SpliceBuffering st arr2@(buf, boff)) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                if boff + length arr > nElem-                then do-                    nArr <- unsafeFreeze buf-                    return $ D.Skip (SpliceYielding (slice nArr 0 boff) (SpliceBuffering s arr2))-                else do-                    noff <- spliceInto buf boff arr-                    return $ D.Skip (SpliceBuffering s (buf, noff))-            D.Skip s -> return $ D.Skip (SpliceBuffering s arr2)-            D.Stop -> do-                nArr <- unsafeFreeze buf-                return $ D.Skip (SpliceYielding (slice nArr 0 boff) SpliceFinish)--    step' _ SpliceFinish = return D.Stop--    step' _ (SpliceYielding arr next) = return $ D.Yield arr next--{-# INLINE_NORMAL lpackArraysChunksOf #-}-lpackArraysChunksOf ::-       forall m a. (MonadIO m, Prim a)-    => Int-    -> Fold m (Array a) ()-    -> Fold m (Array a) ()-lpackArraysChunksOf n (Fold step1 initial1 extract1) =-    Fold step initial extract--    where--    nElem = n `quot` sizeOfPrimElem (undefined :: a)--    initial = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.Array.Foreign.Type.packArraysChunksOf: the size of "-                 ++ "arrays [" ++ show n ++ "] must be a natural number"-        res <- initial1-        return $ first (Tuple3' Nothing' 0) res--    extract (Tuple3' Nothing' _ r1) = extract1 r1-    extract (Tuple3' (Just' buf) boff r1) = do-        nArr <- unsafeFreeze buf-        r <- step1 r1 (slice nArr 0 boff)-        case r of-            FL.Partial rr -> extract1 rr-            FL.Done _ -> return ()--    step (Tuple3' Nothing' _ r1) arr =-            if length arr >= nElem-            then do-                r <- step1 r1 arr-                case r of-                    FL.Done _ -> return $ FL.Done ()-                    FL.Partial s -> do-                        extract1 s-                        res <- initial1-                        return $ first (Tuple3' Nothing' 0) res-            else do-                buf <- MA.newArray nElem-                noff <- spliceInto buf 0 arr-                return $ FL.Partial $ Tuple3' (Just' buf) noff r1--    step (Tuple3' (Just' buf) boff r1) arr = do-            noff <- spliceInto buf boff arr--            if noff >= nElem-            then do-                nArr <- unsafeFreeze buf-                r <- step1 r1 (slice nArr 0 noff)-                case r of-                    FL.Done _ -> return $ FL.Done ()-                    FL.Partial s -> do-                        extract1 s-                        res <- initial1-                        return $ first (Tuple3' Nothing' 0) res-            else return $ FL.Partial $ Tuple3' (Just' buf) noff r1--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.------ /Pre-release/-{-# 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) <- 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) <- breakOn byte arr-                buf' <- spliceTwo 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 byteLength buf == 0-                then D.Stop-                else D.Skip (Yielding buf Finishing)--    step' _ (Splitting st buf) = do-        (arr1, marr2) <- 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
− src/Streamly/Internal/Data/Array/PrimInclude.hs 
@@ -1,184 +0,0 @@--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Primitive.Types (Prim(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))--import qualified Streamly.Internal.Data.Stream.Prelude as P-import qualified Streamly.Internal.Data.Stream.StreamD as D--import Prelude hiding (length, null, last, map, (!!), read, concat)------------------------------------------------------------------------------------ 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, Prim a) => Int -> SerialT m a -> m (Array a)-fromStreamN n (SerialT m) = do-    when (n < 0) $ error "writeN: negative write count specified"-    A.fromStreamDN n $ D.fromStreamK 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, `arraysOf` followed by--- processing of indvidual arrays in the resulting stream should be preferred.------ /Pre-release/-{-# INLINE fromStream #-}-fromStream :: (MonadIO m, Prim a) => SerialT m a -> m (Array a)-fromStream (SerialT m) = P.fold A.write m--- write m = A.fromStreamD $ D.toStreamD m------------------------------------------------------------------------------------ Elimination------------------------------------------------------------------------------------ | Convert an 'Array' into a stream.------ /Pre-release/-{-# INLINE_EARLY toStream #-}-toStream :: (MonadIO m, Prim a) => Array a -> SerialT m a-toStream = SerialT . D.toStreamK . A.toStreamD--- 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 toStreamRev #-}-toStreamRev :: (MonadIO m, Prim a) => Array a -> SerialT m a-toStreamRev = SerialT . D.toStreamK . A.toStreamDRev--- XXX add fallback to StreamK rule--- {-# RULES "Streamly.Array.readRev fallback to StreamK" [1]---     forall a. S.toStreamK (readRev a) = K.revFromArray a #-}---- | Unfold an array into a stream.------ @since 0.7.0-{-# INLINE_NORMAL read #-}-read :: (MonadIO m, Prim a) => Unfold m (Array a) a-read = Unfold step inject-    where--    inject = return--    {-# INLINE_LATE step #-}-    step (Array _ _ len) | len == 0 = return D.Stop-    step arr@(Array arr# off len) =-            let !x = A.unsafeIndex arr 0-            in return $ D.Yield x (Array arr# (off + 1) (len - 1))---- | 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.------ The following might not be true, not that the representation changed.--- 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 unsafeRead #-}-unsafeRead :: (MonadIO m, Prim a) => Unfold m (Array a) a-unsafeRead = Unfold step inject-    where--    inject = return--    {-# INLINE_LATE step #-}-    step arr@(Array arr# off len) =-            let !x = A.unsafeIndex arr 0-            in return $ D.Yield x (Array arr# (off + 1) (len - 1))---- | > null arr = length arr == 0------ /Pre-release/-{-# INLINE null #-}-null :: Array a -> Bool-null arr = length arr == 0------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ | Fold an array using a 'Fold'.------ /Pre-release/-{-# INLINE fold #-}-fold :: forall m a b. (MonadIO m, Prim a) => Fold m a b -> Array a -> m b-fold f arr = P.fold f (getSerialT (toStream arr))---- | Fold an array using a stream fold operation.------ /Pre-release/-{-# INLINE streamFold #-}-streamFold :: (MonadIO m, Prim a) => (SerialT m a -> m b) -> Array a -> m b-streamFold f arr = f (toStream arr)------------------------------------------------------------------------------------ Random reads------------------------------------------------------------------------------------ | /O(1)/ Lookup the element at the given index, starting from 0.------ /Pre-release/-{-# INLINE readIndex #-}-readIndex :: Prim a => Array a -> Int -> Maybe a-readIndex arr i =-    if i < 0 || i > length arr - 1-        then Nothing-        else Just $ A.unsafeIndex arr i---- | > last arr = readIndex arr (length arr - 1)------ /Pre-release/-{-# INLINE last #-}-last :: Prim a => Array a -> Maybe a-last arr = readIndex arr (length arr - 1)------------------------------------------------------------------------------------ Array stream operations------------------------------------------------------------------------------------ | Convert a stream of arrays into a stream of their elements.------ Same as the following but more efficient:------ > concat = S.concatMap A.read------ /Pre-release/-{-# INLINE concat #-}-concat :: (MonadIO m, Prim a) => SerialT m (Array a) -> SerialT m a--- concat m = D.fromStreamD $ A.flattenArrays (D.toStreamD m)--- concat m = D.fromStreamD $ D.concatMap A.toStreamD (D.toStreamD m)-concat (SerialT m) =-    SerialT $ D.toStreamK $ D.unfoldMany read (D.fromStreamK m)---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes.------ /Pre-release/-{-# INLINE compact #-}-compact ::-       (MonadIO m, Prim a) => Int -> SerialT m (Array a) -> SerialT m (Array a)-compact n (SerialT xs) =-    SerialT $ D.toStreamK $ A.packArraysChunksOf n (D.fromStreamK xs)
− src/Streamly/Internal/Data/Array/Stream/Fold/Foreign.hs 
@@ -1,349 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Stream.Fold.Foreign--- Copyright   : (c) 2021 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ 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.Array.Stream.Foreign as ArrayStream--- >>> import qualified Streamly.Internal.Data.Array.Stream.Fold.Foreign as ArrayFold--- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (arraysOf)--- >>> import qualified Streamly.Prelude as Stream------ >>> ArrayStream.foldArr (ArrayFold.fromFold (Fold.take 7 Fold.toList)) $ Stream.arraysOf 5 $ Stream.fromList "hello world"--- "hello w"----module Streamly.Internal.Data.Array.Stream.Fold.Foreign-    (-      Fold (..)--    -- * Construction-    , fromFold-    , fromParser-    , fromParserD-    , fromArrayFold--    -- * Mapping-    , rmapM--    -- * Applicative-    , fromPure-    , fromEffect-    , serialWith--    -- * Monad-    , concatMap--    -- * Transformation-    , take-    )-where--#include "ArrayMacros.h"--import Control.Applicative (liftA2)-import Control.Exception (assert)-import Control.Monad.Catch (MonadThrow)-import Control.Monad.IO.Class (MonadIO(..))-import Foreign.Ptr (minusPtr, plusPtr)-import Foreign.Storable (Storable(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Array.Foreign.Mut.Type (touch)-import Streamly.Internal.Data.Array.Foreign.Type (Array(..))-import Streamly.Internal.Data.Parser.ParserD (Initial(..), Step(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))--import qualified Streamly.Internal.Data.Array.Foreign 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.ParserK.Type as ParserK-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 Fold m a b = Fold (ParserD.Parser m (Array a) 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, Storable a) =>-    Fold.Fold m a b -> Fold m a b-fromFold (Fold.Fold fstep finitial fextract) =-    Fold (ParserD.Parser step initial 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 ())-            liftIO $ touch contents-            return $ Partial 0 fs-        goArray !_ !cur !fs = do-            x <- liftIO $ peek cur-            res <- fstep fs x-            let elemSize = SIZE_OF(a)-                next = PTR_NEXT(cur,a)-            case res of-                Fold.Done b ->-                    return $ Done ((end `minusPtr` 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, Storable a) =>-    ParserD.Parser m a b -> Fold m a b-fromParserD (ParserD.Parser step1 initial1 extract1) =-    Fold (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 `plusPtr` negate (n * elemSize)-            if next1 >= start && cur < end-            then goArray SPEC next1 fs1-            else return $ st (arrRem + n) fs1--        goArray !_ !cur !fs = do-            x <- liftIO $ peek cur-            liftIO $ touch contents-            res <- step1 fs x-            let elemSize = SIZE_OF(a)-                next = PTR_NEXT(cur,a)-                arrRem = (end `minusPtr` 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. (MonadThrow m, MonadIO m, Storable a) =>-    Parser.Parser m a b -> Fold m a b-fromParser = fromParserD . ParserK.fromParserK---- | Adapt an array stream fold.------ /Pre-release/-{-# INLINE fromArrayFold #-}-fromArrayFold :: forall m a b. (MonadIO m) =>-    Fold.Fold m (Array a) b -> Fold m a b-fromArrayFold f = Fold $ ParserD.fromFold f------------------------------------------------------------------------------------ Functor------------------------------------------------------------------------------------ | Maps a function over the result of fold.------ /Pre-release/-instance Functor m => Functor (Fold m a) where-    {-# INLINE fmap #-}-    fmap f (Fold p) = Fold $ fmap f p---- | Map a monadic function on the output of a fold.------ /Pre-release/-{-# INLINE rmapM #-}-rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-rmapM f (Fold p) = Fold $ 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 -> Fold m a b-fromPure = Fold . 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 -> Fold m a b-fromEffect = Fold . ParserD.fromEffect---- | Applies two folds sequentially on the input stream and combines their--- results using the supplied function.------ /Pre-release/-{-# INLINE serial_ #-}-serial_ :: MonadThrow m => Fold m x a -> Fold m x b -> Fold m x b-serial_ (Fold p1) (Fold p2) = Fold $ ParserD.noErrorUnsafeSplit_ p1 p2---- | Applies two folds sequentially on the input stream and combines their--- results using the supplied function.------ /Pre-release/-{-# INLINE serialWith #-}-serialWith :: MonadThrow m-    => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-serialWith f (Fold p1) (Fold p2) =-    Fold $ ParserD.noErrorUnsafeSplitWith f p1 p2---- | 'Applicative' form of 'serialWith'.--- > (<*>) = serialWith id-instance MonadThrow m => Applicative (Fold m a) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = serialWith id--    {-# INLINE (*>) #-}-    (*>) = serial_--#if MIN_VERSION_base(4,10,0)-    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)-#endif------------------------------------------------------------------------------------ Monad------------------------------------------------------------------------------------ | 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 :: MonadThrow m =>-    (b -> Fold m a c) -> Fold m a b -> Fold m a c-concatMap func (Fold p) =-    Fold $ ParserD.noErrorUnsafeConcatMap (\x -> let Fold y = func x in y) p---- | Monad instance applies folds sequentially. Next fold can depend on the--- output of the previous fold. See 'concatMap'.------ > (>>=) = flip concatMap-instance MonadThrow m => Monad (Fold m a) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip concatMap--    {-# INLINE (>>) #-}-    (>>) = (*>)------------------------------------------------------------------------------------ Array to Array folds----------------------------------------------------------------------------------{-# INLINE take #-}-take :: forall m a b. (Monad m, Storable a) => Int -> Fold m a b -> Fold m a b-take n (Fold (ParserD.Parser step1 initial1 extract1)) =-    Fold $ ParserD.Parser step initial extract--    where--    initial = do-        res <- initial1-        case res of-            IPartial s ->-                if n > 0-                then return $ IPartial $ Tuple' n s-                else IDone <$> extract1 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 Done 0 <$> extract1 s -- i2 == i1 == j == 0--    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 = PTR_INDEX(start,i,a)-                arr1 = Array contents start end-                remaining = negate i1-            res <- step1 r arr1-            case res of-                Partial 0 s -> Done remaining <$> extract1 s-                Partial j s -> return $ Partial (remaining + j) (Tuple' j s)-                Continue 0 s -> Done remaining <$> 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' _ r) = extract1 r
− src/Streamly/Internal/Data/Array/Stream/Foreign.hs 
@@ -1,859 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Stream.Foreign--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Combinators to efficiently manipulate streams of immutable arrays.----module Streamly.Internal.Data.Array.Stream.Foreign-    (-    -- * Creation-      arraysOf--    -- * Flattening to elements-    , concat-    , concatRev-    , interpose-    , interposeSuffix-    , intercalateSuffix-    , unlines--    -- * Elimination-    -- ** Element Folds-    , fold-    , parse-    , parseD--    -- ** Array Folds-    , foldArr-    , foldArr_-    -- , parseArr-    , parseArrD-    , foldArrMany--    , toArray--    -- * Compaction-    , lpackArraysChunksOf-    , compact--    -- * Splitting-    , splitOn-    , splitOnSuffix-    )-where--#include "ArrayMacros.h"-#include "inline.hs"--import Data.Bifunctor (second)-import Control.Exception (assert)-import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.IO.Class (MonadIO(..))-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif-import Data.Word (Word8)-import Foreign.ForeignPtr (touchForeignPtr)-import Foreign.Ptr (minusPtr, plusPtr, castPtr)-import Foreign.Storable (Storable(..))-import Fusion.Plugin.Types (Fuse(..))-import GHC.Exts (SpecConstrAnnotation(..))-import GHC.ForeignPtr (ForeignPtr(..))-import GHC.Ptr (Ptr(..))-import GHC.Types (SPEC(..))-import Prelude hiding (null, last, (!!), read, concat, unlines)--import Streamly.Internal.Data.Array.Foreign.Mut.Type-    (arrayToFptrContents, fptrToArrayContents, touch)-import Streamly.Internal.Data.Array.Foreign.Type (Array(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream, fromStreamD, toStreamD)-import Streamly.Internal.Data.SVar (adaptState, defState)-import Streamly.Internal.Data.Array.Foreign.Mut.Type-    (memcpy, allocBytesToElemCount)--import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Array.Foreign.Type as A-import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Stream.Mut.Foreign as AS-import qualified Streamly.Internal.Data.Array.Stream.Fold.Foreign as ASF-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.StreamD as D---- XXX Since these are immutable arrays MonadIO constraint can be removed from--- most places.------------------------------------------------------------------------------------ Generation------------------------------------------------------------------------------------ | @arraysOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ > arraysOf n = Stream.chunksOf n (Array.writeN n)------ /Pre-release/-{-# INLINE arraysOf #-}-arraysOf :: (IsStream t, MonadIO m, Storable a)-    => Int -> t m a -> t m (Array a)-arraysOf n str = fromStreamD $ A.arraysOf n (toStreamD str)------------------------------------------------------------------------------------ Append------------------------------------------------------------------------------------ XXX efficiently compare two streams of arrays. Two streams can have chunks--- of different sizes, we can handle that in the stream comparison abstraction.--- This could be useful e.g. to fast compare whether two files differ.---- | Convert a stream of arrays into a stream of their elements.------ Same as the following:------ > concat = Stream.unfoldMany Array.read------ @since 0.7.0-{-# INLINE concat #-}-concat :: (IsStream t, Monad m, Storable a) => t m (Array a) -> t m a--- concat m = fromStreamD $ A.flattenArrays (toStreamD m)--- concat m = fromStreamD $ D.concatMap A.toStreamD (toStreamD m)-concat m = fromStreamD $ D.unfoldMany A.read (toStreamD m)---- | Convert a stream of arrays into a stream of their elements reversing the--- contents of each array before flattening.------ > concatRev = Stream.unfoldMany Array.readRev------ @since 0.7.0-{-# INLINE concatRev #-}-concatRev :: (IsStream t, Monad m, Storable a) => t m (Array a) -> t m a--- concatRev m = fromStreamD $ A.flattenArraysRev (toStreamD m)-concatRev m = fromStreamD $ D.unfoldMany A.readRev (toStreamD m)------------------------------------------------------------------------------------ Intersperse and append------------------------------------------------------------------------------------ | Flatten a stream of arrays after inserting the given element between--- arrays.------ /Pre-release/-{-# INLINE interpose #-}-interpose :: (Monad m, IsStream t, Storable a) => a -> t m (Array a) -> t m a-interpose x = S.interpose x A.read--{-# INLINE intercalateSuffix #-}-intercalateSuffix :: (Monad m, IsStream t, Storable a)-    => Array a -> t m (Array a) -> t m a-intercalateSuffix = S.intercalateSuffix A.read---- | Flatten a stream of arrays appending the given element after each--- array.------ @since 0.7.0-{-# INLINE interposeSuffix #-}-interposeSuffix :: (Monad m, IsStream t, Storable a)-    => a -> t m (Array a) -> t m a--- interposeSuffix x = fromStreamD . A.unlines x . toStreamD-interposeSuffix x = S.interposeSuffix x A.read--data FlattenState s a =-      OuterLoop s-    | InnerLoop s !MA.ArrayContents !(Ptr a) !(Ptr a)---- XXX Remove monadIO constraint-{-# INLINE_NORMAL unlines #-}-unlines :: forall m a. (MonadIO m, Storable a)-    => a -> D.Stream m (Array a) -> D.Stream m a-unlines 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 aEnd)-            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 $ do-                    r <- peek p-                    touch contents-                    return r-        return $ D.Yield x (InnerLoop st contents (PTR_NEXT(p,a)) end)------------------------------------------------------------------------------------ Compact------------------------------------------------------------------------------------ XXX These would not be needed once we implement compactLEFold, see--- module Streamly.Internal.Data.Array.Stream.Mut.Foreign----{-# INLINE_NORMAL packArraysChunksOf #-}-packArraysChunksOf :: (MonadIO m, Storable a)-    => Int -> D.Stream m (Array a) -> D.Stream m (Array a)-packArraysChunksOf 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.-{-# INLINE_NORMAL lpackArraysChunksOf #-}-lpackArraysChunksOf :: (MonadIO m, Storable 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, Storable a)-    => Int -> SerialT m (Array a) -> SerialT m (Array a)-compact n xs = fromStreamD $ packArraysChunksOf n (toStreamD xs)------------------------------------------------------------------------------------ Split----------------------------------------------------------------------------------data SplitState s arr-    = Initial s-    | Buffering s arr-    | Splitting s arr-    | Yielding arr (SplitState s arr)-    | Finishing---- | Split a stream of arrays on a given separator byte, dropping the separator--- and coalescing all the arrays between two separators into a single array.------ @since 0.7.0-{-# INLINE_NORMAL _splitOn #-}-_splitOn-    :: MonadIO m-    => Word8-    -> D.Stream m (Array Word8)-    -> D.Stream m (Array Word8)-_splitOn 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-    :: (IsStream t, MonadIO m)-    => Word8-    -> t m (Array Word8)-    -> t m (Array Word8)-splitOn byte s =-    fromStreamD $ D.splitInnerBy (A.breakOn byte) A.splice $ toStreamD s--{-# INLINE splitOnSuffix #-}-splitOnSuffix-    :: (IsStream t, MonadIO m)-    => Word8-    -> t m (Array Word8)-    -> t m (Array Word8)--- splitOn byte s = fromStreamD $ A.splitOn byte $ toStreamD s-splitOnSuffix byte s =-    fromStreamD $ D.splitInnerBySuffix (A.breakOn byte) A.splice $ toStreamD s------------------------------------------------------------------------------------ Elimination - Running folds------------------------------------------------------------------------------------ XXX This should be written using CPS (as foldK) if we want it to scale wrt--- to the number of times it can be called on the same stream.----{-# INLINE_NORMAL foldD #-}-foldD :: forall m a b. (MonadIO m, Storable a) =>-    Fold m a b -> D.Stream m (Array a) -> m (b, D.Stream m (Array a))-foldD (Fold 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 (Ptr end)) s ->-                let fp = ForeignPtr end (arrayToFptrContents 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 fp@(ForeignPtr end _) !cur !fs-        | cur == Ptr end = do-            liftIO $ touchForeignPtr fp-            go SPEC s fs-    goArray !_ st fp@(ForeignPtr end contents) !cur !fs = do-        x <- liftIO $ peek cur-        res <- fstep fs x-        let next = PTR_NEXT(cur,a)-        case res of-            FL.Done b -> do-                let arr = Array (fptrToArrayContents contents) next (Ptr end)-                return $! (b, D.cons arr (D.Stream step st))-            FL.Partial fs1 -> goArray SPEC st fp next fs1---- | Fold an array stream using the supplied 'Fold'. Returns the fold result--- and the unconsumed stream.------ /Internal/----{-# INLINE_NORMAL fold #-}-fold ::-       (MonadIO m, Storable a)-    => FL.Fold m a b-    -> SerialT m (A.Array a)-    -> m (b, SerialT m (A.Array a))-fold f s = fmap fromStreamD <$> foldD f (toStreamD s)------------------------------------------------------------------------------------ Fold to a single Array------------------------------------------------------------------------------------ When we have to take an array partially, take the last part of the array.-{-# INLINE takeArrayListRev #-}-takeArrayListRev :: forall a. Storable a => Int -> [Array a] -> [Array a]-takeArrayListRev = 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 `plusPtr` negate (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. Storable 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 `plusPtr` negate (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, Storable a)-    => Int -> SerialT m (MA.Array a) -> m (MA.Array a)-spliceArraysLenUnsafe len buffered = do-    arr <- liftIO $ MA.newArray len-    end <- S.foldlM' writeArr (return $ MA.aEnd arr) buffered-    return $ arr {MA.aEnd = end}--    where--    writeArr dst (MA.Array ac src ae _) =-        liftIO $ do-            let count = ae `minusPtr` src-            memcpy (castPtr dst) (castPtr src) count-            touch ac-            return $ dst `plusPtr` count--{-# INLINE _spliceArrays #-}-_spliceArrays :: (MonadIO m, Storable a)-    => SerialT m (Array a) -> m (Array a)-_spliceArrays s = do-    buffered <- S.foldr S.cons S.nil s-    len <- S.sum (S.map Array.length buffered)-    arr <- liftIO $ MA.newArray len-    end <- S.foldlM' writeArr (return $ MA.aEnd arr) s-    return $ A.unsafeFreeze $ arr {MA.aEnd = end}--    where--    writeArr dst (Array ac src ae) =-        liftIO $ do-            let count = ae `minusPtr` src-            memcpy (castPtr dst) (castPtr src) count-            touch ac-            return $ dst `plusPtr` count--{-# INLINE _spliceArraysBuffered #-}-_spliceArraysBuffered :: (MonadIO m, Storable a)-    => SerialT m (Array a) -> m (Array a)-_spliceArraysBuffered s = do-    buffered <- S.foldr S.cons S.nil s-    len <- S.sum (S.map Array.length buffered)-    A.unsafeFreeze <$> spliceArraysLenUnsafe len (S.map A.unsafeThaw s)--{-# INLINE spliceArraysRealloced #-}-spliceArraysRealloced :: forall m a. (MonadIO m, Storable a)-    => SerialT m (Array a) -> m (Array a)-spliceArraysRealloced s = do-    let n = allocBytesToElemCount (undefined :: a) (4 * 1024)-        idst = liftIO $ MA.newArray n--    arr <- S.foldlM' MA.spliceExp idst (S.map 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, Storable a) => SerialT 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 :: (IsStream t, MonadIO m, Storable a)-    => Int -> Int -> Fold m (Array a) b -> Fold m a b-toArraysInRange low high (Fold step initial extract) =--}--{---- | Fold the input to a pure buffered stream (List) of arrays.-{-# INLINE _toArraysOf #-}-_toArraysOf :: (MonadIO m, Storable a)-    => Int -> Fold m a (SerialT Identity (Array a))-_toArraysOf n = FL.chunksOf n (A.writeNF n) FL.toStream--}------------------------------------------------------------------------------------ Elimination - running element parsers------------------------------------------------------------------------------------ GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need--- to make a newtype.-{-# ANN type List NoSpecConstr #-}-newtype List a = List {getList :: [a]}---- This can be generalized to any type provided it can be unfolded to a stream--- and it can be combined using a semigroup operation.------ XXX This should be written using CPS (as parseK) if we want it to scale wrt--- to the number of times it can be called on the same stream.-{-# INLINE_NORMAL parseD #-}-parseD ::-       forall m a b. (MonadIO m, MonadThrow m, Storable a)-    => PRD.Parser m a b-    -> D.Stream m (Array.Array a)-    -> m (b, D.Stream m (Array.Array a))-parseD (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 (Ptr end)) s ->-                gobuf SPEC s backBuf-                    (ForeignPtr end (arrayToFptrContents 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 fp@(ForeignPtr end _) !cur !pst-        | cur == Ptr end = do-            liftIO $ touchForeignPtr fp-            go SPEC s backBuf pst-    gobuf !_ s backBuf fp@(ForeignPtr end contents) !cur !pst = do-        x <- liftIO $ peek cur-        pRes <- pstep pst x-        let next = PTR_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 (fptrToArrayContents contents) next (Ptr end)-                    src = arr0 <> arr1-                let !(Array cont1 start (Ptr end1)) = src-                    fp1 = ForeignPtr end1 (arrayToFptrContents 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 (fptrToArrayContents contents) next (Ptr end)-                    src = arr0 <> arr1-                let !(Array cont1 start (Ptr end1)) = src-                    fp1 = ForeignPtr end1 (arrayToFptrContents cont1)-                gobuf SPEC s (List buf1) fp1 start pst1-            PR.Done 0 b -> do-                let arr = Array (fptrToArrayContents contents) next (Ptr 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 (fptrToArrayContents contents) next (Ptr 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---- | Parse an array stream using the supplied 'Parser'.  Returns the parse--- result and the unconsumed stream. Throws 'ParseError' if the parse fails.------ /Internal/----{-# INLINE_NORMAL parse #-}-parse ::-       (MonadIO m, MonadThrow m, Storable a)-    => PRD.Parser m a b-    -> SerialT m (A.Array a)-    -> m (b, SerialT m (A.Array a))-parse p s = fmap fromStreamD <$> parseD p (toStreamD s)------------------------------------------------------------------------------------ Elimination - Running Array Folds and parsers----------------------------------------------------------------------------------{-# INLINE_NORMAL parseArrD #-}-parseArrD ::-       forall m a b. (MonadIO m, MonadThrow m, Storable a)-    => PRD.Parser m (Array a) b-    -> D.Stream m (Array.Array a)-    -> m (b, D.Stream m (Array.Array a))-parseArrD (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 x s -> gobuf SPEC [x] s backBuf pst-            D.Skip s -> go SPEC s backBuf pst-            D.Stop -> do-                b <- extract pst-                return (b, D.nil)--    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 ->-                return (b, D.Stream step s)-            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 (b, D.append (D.fromList src) (D.Stream step s))-            PR.Error err -> throwM $ ParseError err--{---- | Parse an array stream using the supplied 'Parser'.  Returns the parse--- result and the unconsumed stream. Throws 'ParseError' if the parse fails.------ /Internal/----{-# INLINE parseArr #-}-parseArr ::-       (MonadIO m, MonadThrow m, Storable a)-    => ASF.Parser m a b-    -> SerialT m (A.Array a)-    -> m (b, SerialT m (A.Array a))-parseArr p s = fmap fromStreamD <$> parseD p (toStreamD s)--}---- | Fold an array stream using the supplied array stream 'Fold'.------ /Pre-release/----{-# INLINE foldArr #-}-foldArr :: (MonadIO m, MonadThrow m, Storable a) =>-    ASF.Fold m a b -> SerialT m (A.Array a) -> m b-foldArr (ASF.Fold p) s = fst <$> parseArrD p (toStreamD s)---- | Like 'fold' but also returns the remaining stream.------ /Pre-release/----{-# INLINE foldArr_ #-}-foldArr_ :: (MonadIO m, MonadThrow m, Storable a) =>-    ASF.Fold m a b -> SerialT m (A.Array a) -> m (b, SerialT m (A.Array a))-foldArr_ (ASF.Fold p) s = second fromStreamD <$> parseArrD p (toStreamD s)--{-# ANN type ParseChunksState Fuse #-}-data ParseChunksState x inpBuf st pst =-      ParseChunksInit inpBuf st-    | ParseChunksInitLeftOver inpBuf-    | ParseChunksStream st inpBuf !pst-    | ParseChunksBuf inpBuf st inpBuf !pst-    | ParseChunksYield x (ParseChunksState x inpBuf st pst)--{-# INLINE_NORMAL foldArrManyD #-}-foldArrManyD-    :: (MonadThrow m, Storable a)-    => ASF.Fold m a b-    -> D.Stream m (Array a)-    -> D.Stream m b-foldArrManyD (ASF.Fold (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 ->-                        let next = ParseChunksInit [x] s-                         in return $ D.Skip $ ParseChunksYield pb next-                    PRD.IError err -> throwM $ ParseError err-            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 pb next-            PRD.IError err -> throwM $ ParseError err--    -- 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 b (ParseChunksInit [] s)-                    PR.Done n b -> do-                        assert-                            (n <= sum (map Array.length (x:backBuf)))-                            (return ())-                        let src0 = takeArrayListRev n (x:backBuf)-                        let src = Prelude.reverse src0-                        return $ D.Skip $-                            ParseChunksYield b (ParseChunksInit src s)-                    PR.Error err -> throwM $ ParseError err-            D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst-            D.Stop   -> do-                b <- extract pst-                let src = Prelude.reverse backBuf-                return $ D.Skip $-                    ParseChunksYield b (ParseChunksInitLeftOver src)--    -- 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 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 b (ParseChunksInit src s)-            PR.Error err -> throwM $ ParseError err--    stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next---- | Apply an array stream 'Fold' repeatedly on an array stream and emit the--- fold outputs in the output stream.------ See "Streamly.Prelude.foldMany" for more details.------ /Pre-release/-{-# INLINE foldArrMany #-}-foldArrMany-    :: (IsStream t, MonadThrow m, Storable a)-    => ASF.Fold m a b-    -> t m (Array a)-    -> t m b-foldArrMany p m = fromStreamD $ foldArrManyD p (toStreamD m)
− src/Streamly/Internal/Data/Array/Stream/Mut/Foreign.hs 
@@ -1,326 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Stream.Mut.Foreign--- 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.Stream.Mut.Foreign-    (-    -- * Generation-      arraysOf--    -- * 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 Control.Monad.Catch (MonadThrow)-import Data.Bifunctor (first)-import Foreign.Storable (Storable(..))-import Streamly.Internal.Data.Array.Foreign.Mut.Type (Array(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))--import qualified Streamly.Internal.Data.Array.Foreign.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---- | @arraysOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ Same as the following but may be more efficient:------ > arraysOf n = Stream.foldMany (MArray.writeN n)------ /Pre-release/-{-# INLINE arraysOf #-}-arraysOf :: (MonadIO m, Storable a)-    => Int -> SerialT m a -> SerialT m (Array a)-arraysOf n (SerialT xs) =-    SerialT $ D.toStreamK $ MArray.arraysOf n $ D.fromStreamK xs------------------------------------------------------------------------------------ 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, Storable a)-    => Int -> D.Stream m (Array a) -> D.Stream m (Array 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.Foreign.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, Storable a)-    => Int -> Fold m (Array a) () -> Fold m (Array 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.Foreign.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, Storable a)-    => Int -> SerialT m (Array a) -> SerialT m (Array a)-compact n (SerialT xs) =-    SerialT $ D.toStreamK $ packArraysChunksOf n (D.fromStreamK xs)---- | 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. (MonadThrow m, MonadIO m, Storable a)-    => Int -> ParserD.Parser m (Array a) (Array 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 MArray.nil-    extract (Just buf) = return buf--    functionPath =-        "Streamly.Internal.Data.Array.Stream.Mut.Foreign.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, Storable a)-    => Int -> FL.Fold m (Array a) (Array 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.Stream.Mut.Foreign.compactGEFold"---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes.------ /Internal/-compactLE :: (MonadThrow m, MonadIO m, Storable a) =>-    Int -> SerialT m (Array a) -> SerialT m (Array a)-compactLE n (SerialT xs) =-    SerialT $ D.toStreamK $ D.parseMany (compactLEParserD n) (D.fromStreamK xs)---- | 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, Storable a) =>-    Int -> SerialT m (Array a) -> SerialT m (Array 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, Storable a)-    => Int -> SerialT m (Array a) -> SerialT m (Array a)-compactGE n (SerialT xs) =-     SerialT $ D.toStreamK $ D.foldMany (compactGEFold n) (D.fromStreamK xs)
− src/Streamly/Internal/Data/Binary/Decode.hs 
@@ -1,278 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Binary.Decode--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Parsers for binary encoded basic Haskell data types.--module Streamly.Internal.Data.Binary.Decode-    ( unit-    , bool-    , ordering-    , eqWord8-    , word8-    , word16be-    , word16le-    , word32be-    , word32le-    , word64be-    , word64le-    , word64host-    )-where--import Control.Monad.Catch (MonadCatch, throwM)-import Control.Monad.IO.Class (MonadIO)-import Data.Bits ((.|.), unsafeShiftL)-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.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK---- | A value of type '()' is encoded as @0@ in binary encoding.------ @--- 0 ==> ()--- @------ /Pre-release/----{-# INLINE unit #-}-unit :: MonadCatch m => Parser m Word8 ()-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 :: MonadCatch m => Parser m Word8 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 :: MonadCatch m => Parser m Word8 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 :: MonadCatch m => Word8 -> Parser m Word8 Word8-eqWord8 b = PR.satisfy (== b)---- | Accept any byte.------ /Pre-release/----{-# INLINE word8 #-}-word8 :: MonadCatch m => Parser m Word8 Word8-word8 = PR.satisfy (const True)---- | Big endian (MSB first) Word16-{-# INLINE word16beD #-}-word16beD :: MonadCatch m => PRD.Parser m Word8 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 _ = throwM $ PRD.ParseError "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 :: MonadCatch m => Parser m Word8 Word16-word16be = PRK.toParserK word16beD---- | Little endian (LSB first) Word16-{-# INLINE word16leD #-}-word16leD :: MonadCatch m => PRD.Parser m Word8 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 _ = throwM $ PRD.ParseError "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 :: MonadCatch m => Parser m Word8 Word16-word16le = PRK.toParserK word16leD---- | Big endian (MSB first) Word32-{-# INLINE word32beD #-}-word32beD :: MonadCatch m => PRD.Parser m Word8 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 _ = throwM $ PRD.ParseError "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 :: MonadCatch m => Parser m Word8 Word32-word32be = PRK.toParserK word32beD---- | Little endian (LSB first) Word32-{-# INLINE word32leD #-}-word32leD :: MonadCatch m => PRD.Parser m Word8 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 _ = throwM $ PRD.ParseError "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 :: MonadCatch m => Parser m Word8 Word32-word32le = PRK.toParserK word32leD---- | Big endian (MSB first) Word64-{-# INLINE word64beD #-}-word64beD :: MonadCatch m => PRD.Parser m Word8 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 _ = throwM $ PRD.ParseError "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 :: MonadCatch m => Parser m Word8 Word64-word64be = PRK.toParserK word64beD---- | Little endian (LSB first) Word64-{-# INLINE word64leD #-}-word64leD :: MonadCatch m => PRD.Parser m Word8 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 _ = throwM $ PRD.ParseError "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 :: MonadCatch m => Parser m Word8 Word64-word64le = PRK.toParserK word64leD------------------------------------------------------------------------------------ Host byte order------------------------------------------------------------------------------------ | Parse eight bytes as a 'Word64' in the host byte order.------ /Pre-release/----{-# INLINE word64host #-}-word64host :: (MonadIO m, MonadCatch m) => Parser m Word8 Word64-word64host =-    fmap (A.unsafeIndex 0 . A.unsafeCast) $ PR.takeEQ 8 (A.writeN 8)
+ src/Streamly/Internal/Data/Channel.hs view
@@ -0,0 +1,30 @@+-- |+-- Module      : Streamly.Internal.Data.Channel+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- This module contains operations that are common for Stream and Fold+-- channels.++module Streamly.Internal.Data.Channel+    (+    -- * Channel Config & Stats+      module Streamly.Internal.Data.Channel.Types+    -- * Worker Dispatcher+    -- | Operations used by the consumer of the channel.+    , module Streamly.Internal.Data.Channel.Dispatcher+    -- * Channel Workers+    -- | Operations used by the workers (producers) of the channel. These+    -- operations are thread-safe, these can be called concurrently by workers+    -- working in independent Haskell threads, the shared channel data+    -- structures are read or updated atomically.+    , module Streamly.Internal.Data.Channel.Worker+    )+where++import Streamly.Internal.Data.Channel.Dispatcher+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Channel.Worker
+ src/Streamly/Internal/Data/Channel/Dispatcher.hs view
@@ -0,0 +1,324 @@+-- |+-- Module      : Streamly.Internal.Data.Channel.Dispatcher+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.Channel.Dispatcher+    (+    -- ** Latency collection+      minThreadDelay+    , collectLatency++    -- ** Thread accounting+    , addThread+    , delThread+    , modifyThread+    , allThreadsDone+    , recordMaxWorkers++    -- ** Diagnostics+    , dumpSVarStats+    )+where++import Data.Set (Set)+import Control.Concurrent (MVar, ThreadId)+import Control.Concurrent.MVar (tryPutMVar)+import Control.Exception (assert)+import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (IORef, modifyIORef, readIORef, writeIORef)+import Streamly.Internal.Data.Atomics+    (atomicModifyIORefCAS, writeBarrier, atomicModifyIORefCAS_)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units+       ( AbsTime, NanoSecond64(..), diffAbsTime64, showNanoSecond64+       , showRelTime64)++import qualified Data.Set as S++import Streamly.Internal.Data.Channel.Types++-------------------------------------------------------------------------------+-- Worker latency data processing+-------------------------------------------------------------------------------++-- | This is a magic number and it is overloaded, and used at several places to+-- achieve batching:+--+-- 1. If we have to sleep to slowdown this is the minimum period that we+--    accumulate before we sleep. Also, workers do not stop until this much+--    sleep time is accumulated.+-- 3. Collected latencies are computed and transferred to measured latency+--    after a minimum of this period.+minThreadDelay :: NanoSecond64+minThreadDelay = 1000000++-- | Every once in a while workers update the latencies and check the yield rate.+-- They return if we are above the expected yield rate. If we check too often+-- it may impact performance, if we check less often we may have a stale+-- picture. We update every minThreadDelay but we translate that into a yield+-- count based on latency so that the checking overhead is little.+--+-- XXX use a generation count to indicate that the value is updated. If the+-- value is updated an existing worker must check it again on the next yield.+-- Otherwise it is possible that we may keep updating it and because of the mod+-- worker keeps skipping it.+updateWorkerPollingInterval :: YieldRateInfo -> NanoSecond64 -> IO ()+updateWorkerPollingInterval yinfo latency = do+    let periodRef = workerPollingInterval yinfo+        -- This depends on the rate, if the rate is low, latencies are+        -- small, by the time we poll it might be too late and we may have+        -- yielded too many results.+        -- cnt = max 1 $ minThreadDelay `div` latency+        cnt = max 1 (latency `div` svarLatencyTarget yinfo)+        period = min cnt (fromIntegral magicMaxBuffer)++    writeIORef periodRef (fromIntegral period)++{-# INLINE recordMinMaxLatency #-}+recordMinMaxLatency :: SVarStats -> NanoSecond64 -> IO ()+recordMinMaxLatency ss new = do+    minLat <- readIORef (minWorkerLatency ss)+    when (new < minLat || minLat == 0) $+        writeIORef (minWorkerLatency ss) new++    maxLat <- readIORef (maxWorkerLatency ss)+    when (new > maxLat) $ writeIORef (maxWorkerLatency ss) new++recordAvgLatency :: SVarStats -> (Count, NanoSecond64) -> IO ()+recordAvgLatency ss (count, time) = do+    modifyIORef (avgWorkerLatency ss) $+        \(cnt, t) -> (cnt + count, t + time)++-- | Add the 'workerPendingLatency' to 'workerCollectedLatency' and reset it to+-- zeroes. Return the added counts.+{-# INLINE collectWorkerPendingLatency #-}+collectWorkerPendingLatency+    :: IORef (Count, Count, NanoSecond64) -- ^ 'workerPendingLatency'+    -> IORef (Count, Count, NanoSecond64) -- ^ 'workerCollectedLatency'+    -> IO (Count, Maybe (Count, NanoSecond64))+    -- ^ (total yield count, Maybe (total latency count, total latency time)).+    -- Latency count and time are reported only when both are non-zero to avoid+    -- arithemetic exceptions in calculations.+collectWorkerPendingLatency cur col = do+    (fcount, count, time) <- atomicModifyIORefCAS cur $ \v -> ((0,0,0), v)++    (fcnt, cnt, t) <- readIORef col+    let totalCount = fcnt + fcount+        latCount   = cnt + count+        latTime    = t + time+    writeIORef col (totalCount, latCount, latTime)++    assert (latCount == 0 || latTime /= 0) (return ())+    let latPair =+            if latCount > 0 && latTime > 0+            then Just (latCount, latTime)+            else Nothing+    return (totalCount, latPair)++{-# INLINE shouldUseCollectedBatch #-}+shouldUseCollectedBatch+    :: Count+    -> NanoSecond64+    -> NanoSecond64+    -> NanoSecond64+    -> Bool+shouldUseCollectedBatch collectedYields collectedTime newLat prevLat =+    let r = fromIntegral newLat / fromIntegral prevLat :: Double+    in     (collectedYields > fromIntegral magicMaxBuffer)+        || (collectedTime > minThreadDelay)+        || (prevLat > 0 && (r > 2 || r < 0.5))+        || (prevLat == 0)++-- CAUTION! keep it in sync with getWorkerLatency++-- | Always moves 'workerPendingLatency' to 'workerCollectedLatency':+--+--  * 'workerCollectedLatency' always incremented by 'workerPendingLatency'+--  * 'workerPendingLatency' always reset to 0+--+-- Moves 'workerCollectedLatency' to 'svarAllTimeLatency' periodically, when+-- the collected batch size hits a limit, or time limit is over, or latency+-- changes beyond a limit. Updates done when the batch is collected:+--+--  * 'svarAllTimeLatency' yield count updated+--  * 'workerMeasuredLatency' set to (new+prev)/2+--  * 'workerPollingInterval' set using max of new/prev worker latency+--  * 'workerCollectedLatency' reset to 0+--+-- See also 'getWorkerLatency'.+--+collectLatency ::+       Bool -- ^ stat inspection mode+    -> SVarStats -- ^ Channel stats+    -> YieldRateInfo -- ^ Channel rate control info+    -> Bool -- ^ Force batch collection+    -> IO (Count, AbsTime, NanoSecond64)+    -- ^ (channel yield count since beginning, beginning timestamp, 'workerMeasuredLatency')+collectLatency inspecting ss yinfo drain = do+    let cur      = workerPendingLatency yinfo+        col      = workerCollectedLatency yinfo+        longTerm = svarAllTimeLatency yinfo+        measured = workerMeasuredLatency yinfo++    (newCount, newLatPair) <- collectWorkerPendingLatency cur col+    (lcount, ltime) <- readIORef longTerm+    prevLat <- readIORef measured++    let newLcount = lcount + newCount+        retWith lat = return (newLcount, ltime, lat)++    case newLatPair of+        Nothing -> retWith prevLat+        Just (count, time) -> do+            let newLat = time `div` fromIntegral count+            when inspecting $ recordMinMaxLatency ss newLat+            -- When we have collected a significant sized batch we compute the+            -- new latency using that batch and return the new latency,+            -- otherwise we return the previous latency derived from the+            -- previous batch.+            if shouldUseCollectedBatch newCount time newLat prevLat || drain+            then do+                -- XXX make this NOINLINE?+                updateWorkerPollingInterval yinfo (max newLat prevLat)+                when inspecting $ recordAvgLatency ss (count, time)+                writeIORef col (0, 0, 0)+                writeIORef measured ((prevLat + newLat) `div` 2)+                modifyIORef longTerm $ \(_, t) -> (newLcount, t)+                retWith newLat+            else retWith prevLat++-------------------------------------------------------------------------------+-- Dumping the SVar for debug/diag+-------------------------------------------------------------------------------++dumpSVarStats :: Bool -> Maybe YieldRateInfo -> SVarStats -> IO String+dumpSVarStats inspecting rateInfo ss = do+    case rateInfo of+        Nothing -> return ()+        Just yinfo -> do+            _ <- liftIO $ collectLatency inspecting ss yinfo True+            return ()++    dispatches <- readIORef $ totalDispatches ss+    maxWrk <- readIORef $ maxWorkers ss+    maxOq <- readIORef $ maxOutQSize ss+    -- maxHp <- readIORef $ maxHeapSize ss+    minLat <- readIORef $ minWorkerLatency ss+    maxLat <- readIORef $ maxWorkerLatency ss+    (avgCnt, avgTime) <- readIORef $ avgWorkerLatency ss+    stopTime <- readIORef (svarStopTime ss)+    let stopReason =+            case stopTime of+                Nothing -> "stream abandoned"+                Just _ -> "stream finished"+    (svarCnt, svarGainLossCnt, svarLat, interval) <- case rateInfo of+        Nothing -> return (0, 0, 0, 0)+        Just yinfo -> do+            (cnt, startTime) <- readIORef $ svarAllTimeLatency yinfo+            interval <-+                case stopTime of+                    Nothing -> do+                        now <- getTime Monotonic+                        return (diffAbsTime64 now startTime)+                    Just t -> do+                        return (diffAbsTime64 t startTime)+            if cnt > 0+            then do+                gl <- readIORef (svarGainedLostYields yinfo)+                return (cnt, gl, interval `div` fromIntegral cnt, interval)+            else return (0, 0, 0, interval)++    return $ concat+        [ "stop reason = " <> stopReason+        ,  if interval > 0+           then "\nlife time = " <> showRelTime64 interval+           else ""+        , "\ntotal dispatches = " <> show dispatches+        , "\nmax workers = " <> show maxWrk+        , "\nmax outQSize = " <> show maxOq+        , if minLat > 0+          then "\nmin worker latency = " <> showNanoSecond64 minLat+          else ""+        , if maxLat > 0+          then "\nmax worker latency = " <> showNanoSecond64 maxLat+          else ""+        , if avgCnt > 0+          then let lat = avgTime `div` fromIntegral avgCnt+                in "\navg worker latency = " <> showNanoSecond64 lat+          else ""+        , if svarLat > 0+          then "\nchannel latency = " <> showRelTime64 svarLat+          else ""+        , if svarCnt > 0+          then "\nchannel yield count = " <> show svarCnt+          else ""+        , if svarGainLossCnt > 0+          then "\nchannel gain/loss yield count = " <> show svarGainLossCnt+          else ""+        ]++-------------------------------------------------------------------------------+-- Thread accounting+-------------------------------------------------------------------------------++-- Thread tracking is needed for two reasons:+--+-- 1) Killing threads on exceptions. Threads may not be left to go away by+-- themselves because they may run for significant times before going away or+-- worse they may be stuck in IO and never go away.+--+-- 2) To know when all threads are done and the stream has ended.++{-# NOINLINE addThread #-}+addThread :: MonadIO m => IORef (Set ThreadId) -> ThreadId -> m ()+addThread workerSet tid =+    liftIO $ atomicModifyIORefCAS_ workerSet (S.insert tid)++-- This is cheaper than modifyThread because we do not have to send a+-- outputDoorBell This can make a difference when more workers are being+-- dispatched.+{-# INLINE delThread #-}+delThread :: MonadIO m => IORef (Set ThreadId) -> ThreadId -> m ()+delThread workerSet tid =+    liftIO $ atomicModifyIORefCAS_ workerSet (S.delete tid)++-- If present then delete else add. This takes care of out of order add and+-- delete i.e. a delete arriving before we even added a thread.+-- This occurs when the forked thread is done even before the 'addThread' right+-- after the fork gets a chance to run.+{-# INLINE modifyThread #-}+modifyThread :: MonadIO m => IORef (Set ThreadId) -> MVar () -> ThreadId -> m ()+modifyThread workerSet bell tid = do+    changed <- liftIO $ atomicModifyIORefCAS workerSet $ \old ->+        if S.member tid old+        then let new = S.delete tid old in (new, new)+        else let new = S.insert tid old in (new, old)+    when (null changed) $+         liftIO $ do+            writeBarrier+            void $ tryPutMVar bell ()++-- | This is safe even if we are adding more threads concurrently because if+-- a child thread is adding another thread then anyway 'workerThreads' will+-- not be empty.+{-# INLINE allThreadsDone #-}+allThreadsDone :: MonadIO m => IORef (Set ThreadId) -> m Bool+allThreadsDone ref = liftIO $ S.null <$> readIORef ref++-------------------------------------------------------------------------------+-- Dispatching workers+-------------------------------------------------------------------------------++{-# NOINLINE recordMaxWorkers #-}+recordMaxWorkers :: MonadIO m => IORef Int -> SVarStats -> m ()+recordMaxWorkers countRef ss = liftIO $ do+    active <- readIORef countRef+    maxWrk <- readIORef (maxWorkers ss)+    when (active > maxWrk) $ writeIORef (maxWorkers ss) active+    modifyIORef (totalDispatches ss) (+1)
+ src/Streamly/Internal/Data/Channel/Types.hs view
@@ -0,0 +1,458 @@+-- |+-- Module      : Streamly.Internal.Data.Channel.Types+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- A Channel is a place where streams join and new streams start. This module+-- defines low level data structures and functions to build channels. For+-- concrete Channels see the Channel modules of specific stream types.+--+-- A Channel is a conduit to the output from multiple streams running+-- concurrently and asynchronously. A channel can be thought of as an+-- asynchronous IO handle. We can write any number of streams to a channel in a+-- non-blocking manner and then read them back at any time at any pace.  The+-- channel would run the streams asynchronously and accumulate results. A+-- channel may not really execute the stream completely and accumulate all the+-- results. However, it ensures that the reader can read the results at+-- whatever pace it wants to read. The channel monitors and adapts to the+-- consumer's pace.+--+-- A channel 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. An 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 channel by 'fromChannel' on demand if the output+-- produced is not keeping pace with the consumer. On bounded channels, 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.+--+module Streamly.Internal.Data.Channel.Types+    (+    -- ** Types+      Count (..)+    , Limit (..)+    , ThreadAbort (..)+    , ChildEvent (..)++    -- ** Stats+    , SVarStats (..)+    , newSVarStats++    -- ** Rate Control+    , WorkerInfo (..)+    , LatencyRange (..)+    , YieldRateInfo (..)++    -- ** Output queue+    , readOutputQRaw+    , readOutputQBasic+    , ringDoorBell++    -- ** Yield Limit+    , decrementYieldLimit+    , incrementYieldLimit++    -- ** Configuration+    , Rate (..)+    , StopWhen (..)+    , magicMaxBuffer++    -- ** Diagnostics+    , dumpCreator+    , dumpOutputQ+    , dumpDoorBell+    , dumpNeedDoorBell+    , dumpRunningThreads+    , dumpWorkerCount++    , withDiagMVar+    , printSVar+    )+where++import Control.Concurrent (ThreadId, MVar, tryReadMVar)+import Control.Concurrent.MVar (tryPutMVar)+import Control.Exception+    ( SomeException(..), Exception, catches, throwIO, Handler(..)+    , BlockedIndefinitelyOnMVar(..), BlockedIndefinitelyOnSTM(..))+import Control.Monad (void, when)+import Data.Int (Int64)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Streamly.Internal.Data.Atomics+    (atomicModifyIORefCAS, atomicModifyIORefCAS_, storeLoadBarrier)+import Streamly.Internal.Data.Time.Units (AbsTime, NanoSecond64(..))+import System.IO (hPutStrLn, stderr)++------------------------------------------------------------------------------+-- Common types+------------------------------------------------------------------------------++newtype Count = Count Int64+    deriving ( Eq+             , Read+             , Show+             , Enum+             , Bounded+             , Num+             , Real+             , Integral+             , Ord+             )++-- XXX We can use maxBound for unlimited?++-- 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++------------------------------------------------------------------------------+-- Parent child thread communication type+------------------------------------------------------------------------------++-- | Channel driver throws this exception to all active workers to clean up+-- the channel.+data ThreadAbort = ThreadAbort deriving Show++instance Exception ThreadAbort++-- XXX Use a ChildSingle event to speed up mapM?+-- | Events that a child thread may send to a parent thread.+data ChildEvent a =+      ChildYield a+    | ChildStopChannel+    | ChildStop ThreadId (Maybe SomeException)++-- | 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+    {+    -- | Yields allowed for this worker. 0 means unlimited.+      workerYieldMax   :: Count+    -- | total number of yields by the worker till now+    , workerYieldCount    :: IORef Count+    -- | (yield count at start of collection interval, collection start timestamp)+    , workerLatencyStart  :: IORef (Count, AbsTime)+    }++data LatencyRange = LatencyRange+    { minLatency :: NanoSecond64+    , maxLatency :: NanoSecond64+    } deriving Show++-- | Rate control.+data YieldRateInfo = YieldRateInfo+    { svarLatencyTarget    :: NanoSecond64+    , svarLatencyRange     :: LatencyRange++    -- | Number of yields beyond which we will not try to recover the rate.+    , svarRateBuffer :: Int++    -- | Yields that we have permanently gained or lost since the start of the+    -- channel i.e. we do not want to adjust the rate to make up for this+    -- deficit or gain.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread and snapshot+    -- read by the worker threads+    , svarGainedLostYields :: IORef Count++    -- XXX interval latency is enough, we can move this under diagnostics build++    -- | (channel yields from start till now, channel start timestamp) as+    -- recorded by the consumer side of the channel.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread, snapshot+    -- read by the worker threads.+    , svarAllTimeLatency :: IORef (Count, AbsTime)++    -- | TODO. Not yet implemented. Worker latency specified by the user to be+    -- used as a guide before the first actual measurement arrives.+    , workerBootstrapLatency :: Maybe NanoSecond64++    -- 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.++    -- | After how many yields the worker should update the latency+    -- information. If the 'workerMeasuredLatency' is high, this count is kept+    -- lower and vice-versa.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread and snapshot+    -- read by the worker threads+    , workerPollingInterval :: IORef Count++    -- | (total yields, measured yields, time taken by measured yields).+    -- This is first level collection bucket which is continuously updated by+    -- workers and periodically emptied and collected into+    -- 'workerCollectedLatency' by the consumer thread.+    --+    -- "Measured yields" are 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. Atomically 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.+    , workerPendingLatency   :: IORef (Count, Count, NanoSecond64)++    -- | 'workerPendingLatency' is periodically reset and aggregated into this+    -- by the consumer thread. This itself is reset periodically and+    -- 'svarAllTimeLatency', 'workerMeasuredLatency' are updated using it.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread and snapshot+    -- read by the worker threads+    , workerCollectedLatency :: IORef (Count, Count, NanoSecond64)++    -- | Weighted average of worker latencies in previous measurement periods.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread and snapshot+    -- 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)+}++-------------------------------------------------------------------------------+-- Config+-------------------------------------------------------------------------------++-- | 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 yield count gap becomes more than 'rateBuffer' (specified as+-- a yield count) 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.+--+data Rate = Rate+    { rateLow    :: Double -- ^ The lower rate limit (yields per sec)+    , rateGoal   :: Double -- ^ The target rate we want to achieve+    , rateHigh   :: Double -- ^ The upper rate limit+    , rateBuffer :: Int    -- ^ Maximum yield count slack from the goal+    }++-- | Specify when the 'Channel' should stop.+data StopWhen =+      FirstStops -- ^ Stop when the first stream ends.+    | AllStop    -- ^ Stop when all the streams end.+    | AnyStops   -- ^ Stop when any one stream ends.++-- | 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++newSVarStats :: IO SVarStats+newSVarStats = do+    disp   <- newIORef 0+    maxWrk <- newIORef 0+    maxOq  <- newIORef 0+    maxHs  <- newIORef 0+    maxWq  <- newIORef 0+    avgLat <- newIORef (0, NanoSecond64 0)+    maxLat <- newIORef (NanoSecond64 0)+    minLat <- newIORef (NanoSecond64 0)+    stpTime <- newIORef Nothing++    return SVarStats+        { totalDispatches  = disp+        , maxWorkers       = maxWrk+        , maxOutQSize      = maxOq+        , maxHeapSize      = maxHs+        , maxWorkQSize     = maxWq+        , avgWorkerLatency = avgLat+        , minWorkerLatency = minLat+        , maxWorkerLatency = maxLat+        , svarStopTime     = stpTime+        }++-------------------------------------------------------------------------------+-- Channel yield count+-------------------------------------------------------------------------------++-- XXX Can we make access to remainingWork and yieldRateInfo fields in sv+-- faster, along with the fields in sv required by send?+-- XXX make it noinline+--+-- XXX we may want to employ an increment and decrement in batches when the+-- througput is high or when the cost of synchronization is high. For example+-- if the application is distributed then inc/dec of a shared variable may be+-- very costly.++-- | A worker decrements the yield limit before it executes an action. However,+-- the action may not result in an element being yielded, in that case we have+-- to increment the yield limit.+--+-- Note that we need it to be an Int type so that we have the ability to undo a+-- decrement that takes it below zero.+{-# INLINE decrementYieldLimit #-}+decrementYieldLimit :: Maybe (IORef Count) -> IO Bool+decrementYieldLimit remaining =+    case remaining of+        Nothing -> return True+        Just ref -> do+            r <- atomicModifyIORefCAS ref $ \x -> (x - 1, x)+            return $ r >= 1++{-# INLINE incrementYieldLimit #-}+incrementYieldLimit :: Maybe (IORef Count) -> IO ()+incrementYieldLimit remaining =+    case remaining of+        Nothing -> return ()+        Just ref -> atomicModifyIORefCAS_ ref (+ 1)++-------------------------------------------------------------------------------+-- Output queue+-------------------------------------------------------------------------------++-- | Read the output queue of the channel. After reading set it to empty list+-- and 0 count.+{-# INLINE readOutputQBasic #-}+readOutputQBasic ::+       IORef ([a], Int) -- ^ The channel output queue+    -> IO ([a], Int) -- ^ (events, count)+readOutputQBasic q = atomicModifyIORefCAS q $ \x -> (([],0), x)++-- | Same as 'readOutputQBasic' but additionally update the max output queue+-- size channel stat if the new size is more than current max.+{-# INLINE readOutputQRaw #-}+readOutputQRaw ::+       IORef ([ChildEvent a], Int) -- ^ Channel output queue+    -> Maybe SVarStats -- ^ Channel stats+    -> IO ([ChildEvent a], Int) -- ^ (events, count)+readOutputQRaw q stats = do+    (list, len) <- readOutputQBasic q+    case stats of+        Just ss -> do+            let ref = maxOutQSize ss+            oqLen <- readIORef ref+            when (len > oqLen) $ writeIORef ref len+        Nothing -> return ()+    return (list, len)++-- | RingArray door bell. The IORef is read after adding a store-load barrier. If+-- the IORef was set to 'True' it is atomically reset to 'False'.+{-# INLINE ringDoorBell #-}+ringDoorBell ::+       IORef Bool -- ^ If 'True' only then ring the door bell+    -> MVar () -- ^ Door bell, put () to ring+    -> IO ()+ringDoorBell needBell bell = do+    storeLoadBarrier+    w <- readIORef needBell+    when w $ do+        -- Note: the sequence of operations is important for correctness here.+        -- We need to set the flag to false strictly before sending the+        -- outputDoorBell, otherwise the outputDoorBell may get processed too+        -- early and then we may set the flag to False to later making the+        -- consumer lose the flag, even without receiving a outputDoorBell.+        atomicModifyIORefCAS_ needBell (const False)+        void $ tryPutMVar bell ()++-------------------------------------------------------------------------------+-- Diagnostics+-------------------------------------------------------------------------------++dumpCreator :: Show a => a -> String+dumpCreator tid = "Creator tid = " <> show tid++dumpOutputQ :: (Foldable t, Show a1) => IORef (t a2, a1) -> IO String+dumpOutputQ q = do+    (oqList, oqLen) <- readIORef q+    return $ unlines+        [ "outputQueue length computed  = " <> show (length oqList)+        , "outputQueue length maintained = " <> show oqLen+        ]++dumpDoorBell :: Show a => MVar a -> IO String+dumpDoorBell mvar =  do+    db <- tryReadMVar mvar+    return $ "outputDoorBell = " <> show db++dumpNeedDoorBell :: Show a => IORef a -> IO String+dumpNeedDoorBell ref = do+    waiting <- readIORef ref+    return $ "needDoorBell = " <> show waiting++dumpRunningThreads :: Show a => IORef a -> IO String+dumpRunningThreads ref = do+    rthread <- readIORef ref+    return $ "running threads = " <> show rthread++dumpWorkerCount :: Show a => IORef a -> IO String+dumpWorkerCount ref = do+    workers <- readIORef ref+    return $ "running thread count = " <> show workers++{-# NOINLINE mvarExcHandler #-}+mvarExcHandler :: IO String -> String -> BlockedIndefinitelyOnMVar -> IO ()+mvarExcHandler dump label e@BlockedIndefinitelyOnMVar = do+    svInfo <- dump+    hPutStrLn stderr $ label <> " " <> "BlockedIndefinitelyOnMVar\n" <> svInfo+    throwIO e++{-# NOINLINE stmExcHandler #-}+stmExcHandler :: IO String -> String -> BlockedIndefinitelyOnSTM -> IO ()+stmExcHandler dump label e@BlockedIndefinitelyOnSTM = do+    svInfo <- dump+    hPutStrLn stderr $ label <> " " <> "BlockedIndefinitelyOnSTM\n" <> svInfo+    throwIO e++-- | MVar diagnostics has some overhead - around 5% on AsyncT null benchmark, we+-- can keep it on in production to debug problems quickly if and when they+-- happen, but it may result in unexpected output when threads are left hanging+-- until they are GCed because the consumer went away.+withDiagMVar :: Bool -> IO String -> String -> IO () -> IO ()+withDiagMVar inspecting dump label action =+    if inspecting+    then+        action `catches` [ Handler (mvarExcHandler dump label)+                         , Handler (stmExcHandler dump label)+                         ]+    else action++printSVar :: IO String -> String -> IO ()+printSVar dump how = do+    svInfo <- dump+    hPutStrLn stderr $ "\n" <> how <> "\n" <> svInfo
+ src/Streamly/Internal/Data/Channel/Worker.hs view
@@ -0,0 +1,442 @@+-- |+-- Module      : Streamly.Internal.Data.Channel.Worker+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Collecting results from child workers in a streamed fashion++module Streamly.Internal.Data.Channel.Worker+    (+    -- ** Worker Rate Control+      Work (..)+    , estimateWorkers+    , isBeyondMaxRate+    , incrWorkerYieldCount++    -- ** Workers Sending Events+    , sendEvent+    , sendYield+    , sendStop+    , sendException+    )+where++import Control.Concurrent (myThreadId)+import Control.Concurrent.MVar (MVar, tryPutMVar)+import Control.Exception (SomeException(..), assert)+import Control.Monad (when, void)+import Data.IORef (IORef, readIORef, writeIORef)+import Streamly.Internal.Data.Atomics+       (atomicModifyIORefCAS, atomicModifyIORefCAS_, writeBarrier)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units+       (AbsTime, NanoSecond64(..), diffAbsTime64, fromRelTime64)++import Streamly.Internal.Data.Channel.Types++-------------------------------------------------------------------------------+-- Yield control+-------------------------------------------------------------------------------++updateYieldCount :: WorkerInfo -> IO Count+updateYieldCount winfo = do+    cnt <- readIORef (workerYieldCount winfo)+    let cnt1 = cnt + 1+    writeIORef (workerYieldCount winfo) cnt1+    return cnt1++isBeyondMaxYield :: Count -> WorkerInfo -> Bool+isBeyondMaxYield cnt winfo =+    let ymax = workerYieldMax winfo+    in ymax /= 0 && cnt >= ymax++-------------------------------------------------------------------------------+-- Sending results from worker+-------------------------------------------------------------------------------++-- | Low level API to add an event on the channel's output queue. Atomically+-- adds the event to the queue and rings the doorbell if needed to wakeup the+-- consumer thread.+{-# INLINE sendEvent #-}+sendEvent ::+       IORef ([a], Int) -- ^ Queue where the event is added+    -> MVar () -- ^ Door bell to ring+    -> a -- ^ The event to be added+    -> IO Int -- ^ Length of the queue before adding this event+sendEvent q bell msg = do+    -- XXX can the access to outputQueue be made faster somehow?+    oldlen <- atomicModifyIORefCAS q $ \(es, n) ->+        ((msg : es, n + 1), n)+    when (oldlen <= 0) $ do+        -- The wake up must happen only after the store has finished otherwise+        -- we can have lost wakeup problems.+        writeBarrier+        -- Since multiple workers can try this at the same time, it is possible+        -- that we may put a spurious MVar after the consumer has already seen+        -- the output. But that's harmless, at worst it may cause the consumer+        -- to read the queue again and find it empty.+        -- The important point is that the consumer is guaranteed to receive a+        -- doorbell if something was added to the queue after it empties it.+        void $ tryPutMVar bell ()+    return oldlen++-------------------------------------------------------------------------------+-- Collect and update worker latency+-------------------------------------------------------------------------------++workerCollectLatency :: WorkerInfo -> IO (Maybe (Count, NanoSecond64))+workerCollectLatency winfo = do+    -- XXX make this unboxed IORef+    (cnt0, t0) <- readIORef (workerLatencyStart winfo)+    cnt1 <- readIORef (workerYieldCount winfo)+    let cnt = cnt1 - cnt0++    if cnt > 0+    then do+        t1 <- getTime Monotonic+        let period = fromRelTime64 $ diffAbsTime64 t1 t0+        writeIORef (workerLatencyStart winfo) (cnt1, t1)+        return $ Just (cnt, period)+    else return Nothing++-- XXX There are a number of gotchas in measuring latencies.+-- 1) We measure latencies only when a worker yields a value+-- 2) It is possible that a stream calls the stop continuation, in which case+-- the worker would not yield a value and we would not account that worker in+-- latencies. Even though this case should ideally be accounted we do not+-- account it because we cannot or do not distinguish it from the case+-- described next.+-- 3) It is possible that a worker returns without yielding anything because it+-- never got a chance to pick up work.+-- 4) If the system timer resolution is lower than the latency, the latency+-- computation turns out to be zero.+--+-- We can fix this if we measure the latencies by counting the work items+-- picked rather than based on the outputs yielded.+workerUpdateLatency :: YieldRateInfo -> WorkerInfo -> IO ()+workerUpdateLatency yinfo winfo = do+    r <- workerCollectLatency winfo+    case r of+        Just (cnt, period) -> do+        -- NOTE: On JS platform the timer resolution could be pretty low. When+        -- the timer resolution is low, measurement of latencies could be+        -- tricky. All the worker latencies will turn out to be zero if they+        -- are lower than the resolution. We only take into account those+        -- measurements which are more than the timer resolution.++            let ref = workerPendingLatency yinfo+                (cnt1, t1) = if period > 0 then (cnt, period) else (0, 0)+            atomicModifyIORefCAS_ ref $+                    \(fc, n, t) -> (fc + cnt, n + cnt1, t + t1)+        Nothing -> return ()++-------------------------------------------------------------------------------+-- Worker rate control+-------------------------------------------------------------------------------++-- | Describes how to pace the work based on current measurement estimates. If+-- the rate is higher than expected we may have to sleep for some time+-- ('BlockWait'), or send just one worker with limited yield count+-- ('PartialWorker') or send more than one workers with max yield count of each+-- limited to the total maximum target count.+data Work+    = BlockWait NanoSecond64 -- ^ Sleep required before next dispatch+    | PartialWorker Count -- ^ One worker is enough, total yields needed+    | ManyWorkers Int Count -- ^ Worker count, total yields needed overall+    deriving Show++-- | Another magic number! When we have to start more workers to cover up a+-- number of yields that we are lagging by then we cannot start one worker for+-- each yield because that may be a very big number and if the latency of the+-- workers is low these number of yields could be very high. We assume that we+-- run each extra worker for at least this much time.+rateRecoveryTime :: NanoSecond64+rateRecoveryTime = 1000000++-- CAUTION! keep it in sync with collectLatency++-- | Same as 'collectLatency' except that it does not update anything, this is+-- a readonly version of 'collectLatency'.+--+getWorkerLatency ::+       YieldRateInfo+    -> IO (Count, AbsTime, NanoSecond64)+    -- ^ (total yield count, base timestamp, 'workerMeasuredlatency')+getWorkerLatency yinfo  = do+    let cur      = workerPendingLatency yinfo+        col      = workerCollectedLatency yinfo+        longTerm = svarAllTimeLatency yinfo+        measured = workerMeasuredLatency yinfo++    (curTotalCount, curCount, curTime) <- readIORef cur+    (colTotalCount, colCount, colTime) <- readIORef col+    (lcount, ltime)     <- readIORef longTerm+    prevLat             <- readIORef measured++    let latCount = colCount + curCount+        latTime  = colTime + curTime+        totalCount = colTotalCount + curTotalCount+        newLat =+            if latCount > 0 && latTime > 0+            then let lat = latTime `div` fromIntegral latCount+                 -- XXX Give more weight to new?+                 in (lat + prevLat) `div` 2+            else prevLat+    return (lcount + totalCount, ltime, newLat)++-- XXX we can use phantom types to distinguish the duration/latency/expectedLat+-- XXX This should probably be inlined.+-- XXX Move this to the common Types module, since this is used by both+-- dispatcher and workers.++-- | Estimate how many workers and yield count ('Work') is required to maintian+-- the target yield rate of the channel.+--+-- This is used by the worker dispatcher to estimate how many workers to+-- dispatch. It is also used periodically by the workers to decide whether to+-- stop or continue working.+estimateWorkers+    :: Limit -- ^ Channel's max worker limit+    -> Count -- ^ Channel's yield count since start+    -> Count -- ^ 'svarGainedLostYields'+    -> NanoSecond64 -- ^ The up time of the channel+    -> NanoSecond64 -- ^ Current 'workerMeasuredLatency'+    -> NanoSecond64 -- ^ 'svarLatencyTarget'+    -> LatencyRange -- ^ 'svarLatencyRange'+    -> Work+estimateWorkers workerLimit svarYields gainLossYields+                svarElapsed wLatency targetLat range =+    -- XXX we can have a maxEfficiency combinator as well which runs the+    -- producer at the maximal efficiency i.e. the number of workers are chosen+    -- such that the latency is minimum or within a range. Or we can call it+    -- maxWorkerLatency.+    --+    let+        -- How many workers do we need to achieve the required rate?+        --+        -- When the workers are IO bound we can increase the throughput by+        -- increasing the number of workers as long as the IO device has enough+        -- capacity to process all the requests concurrently. If the IO+        -- bandwidth is saturated, increasing the workers won't help. Also, if+        -- the CPU utilization in processing all these requests exceeds the CPU+        -- bandwidth, then increasing the number of workers won't help.+        --+        -- When the workers are purely CPU bound, increasing the workers beyond+        -- the number of CPUs won't help.+        --+        -- TODO - measure the CPU and IO requirements of the workers. Have a+        -- way to specify the max bandwidth of the underlying IO mechanism and+        -- use that to determine the max rate of workers, and also take the CPU+        -- bandwidth into account. We can also discover the IO bandwidth if we+        -- know that we are not CPU bound, then how much steady state rate are+        -- we able to achieve. Design tests for CPU bound and IO bound cases.++        -- Calculate how many yields are we ahead or behind to match the exact+        -- required rate. Based on that we increase or decrease the effective+        -- workers.+        --+        -- When the worker latency is lower than required latency we begin with+        -- a yield and then wait rather than first waiting and then yielding.+        targetYields = (svarElapsed + wLatency + targetLat - 1) `div` targetLat+        effectiveYields = svarYields + gainLossYields+        deltaYields = fromIntegral targetYields - effectiveYields++        -- We recover the deficit by running at a higher/lower rate for a+        -- certain amount of time. To keep the effective rate in reasonable+        -- limits we use rateRecoveryTime, minLatency and maxLatency.+        in  if deltaYields > 0+            then+                let deltaYieldsFreq :: Double+                    deltaYieldsFreq =+                        fromIntegral deltaYields /+                            fromIntegral rateRecoveryTime+                    yieldsFreq = 1.0 / fromIntegral targetLat+                    totalYieldsFreq = yieldsFreq + deltaYieldsFreq+                    requiredLat = NanoSecond64 $ round $ 1.0 / totalYieldsFreq+                    adjustedLat = min (max requiredLat (minLatency range))+                                      (maxLatency range)+                in  assert (adjustedLat > 0) $+                    if wLatency <= adjustedLat+                    then PartialWorker deltaYields+                    else let workers = withLimit $ wLatency `div` adjustedLat+                             limited = min workers (fromIntegral deltaYields)+                         in ManyWorkers (fromIntegral limited) deltaYields+            else+                let expectedDuration = fromIntegral effectiveYields * targetLat+                    sleepTime = expectedDuration - svarElapsed+                    maxSleepTime = maxLatency range - wLatency+                    s = min sleepTime maxSleepTime+                in assert (sleepTime >= 0) $+                    -- if s is less than 0 it means our maxSleepTime is less+                    -- than the worker latency.+                    if s > 0 then BlockWait s else ManyWorkers 1 (Count 0)+    where+        withLimit n =+            case workerLimit of+                Unlimited -> n+                Limited x -> min n (fromIntegral x)++-- | Using the channel worker latency and channel yield count stats from the+-- current measurement interval, estimate how many workers are needed to+-- maintain the target rate and compare that with current number of workers.+-- Returns true if we have have more than required workers.+isBeyondMaxRate ::+       Limit -- ^ Channel's max worker limit+    -> IORef Int -- ^ Current worker count+    -> YieldRateInfo -- ^ Channel's rate control info+    -> IO Bool -- ^ True if we are exceeding the specified rate+isBeyondMaxRate workerLimit workerCount rateInfo = do+    (count, tstamp, wLatency) <- getWorkerLatency rateInfo+    now <- getTime Monotonic+    let duration = fromRelTime64 $ diffAbsTime64 now tstamp+    let targetLat = svarLatencyTarget rateInfo+    gainLoss <- readIORef (svarGainedLostYields rateInfo)+    let work = estimateWorkers workerLimit count gainLoss duration+                               wLatency targetLat (svarLatencyRange rateInfo)+    cnt <- readIORef workerCount+    return $ case work of+        -- XXX set the worker's maxYields or polling interval based on yields+        PartialWorker _yields -> cnt > 1+        ManyWorkers n _ -> cnt > n+        BlockWait _ -> True++-- XXX we should do rate control periodically based on the total yields rather+-- than based on the worker local yields as other workers may have yielded more+-- and we should stop based on the aggregate yields. However, latency update+-- period can be based on individual worker yields.++-- | Update the worker latency and check the channel yield rate. Updates and+-- checks only at specified multiples of yield count to keep the overhead low.+{-# NOINLINE updateLatencyAndCheckRate #-}+updateLatencyAndCheckRate ::+       Limit+    -> IORef Int+    -> YieldRateInfo+    -> WorkerInfo+    -> Count+    -> IO Bool+updateLatencyAndCheckRate workerLimit workerCount rateInfo workerInfo ycnt = do+    -- XXX make this an unboxed IORef+    i <- readIORef (workerPollingInterval rateInfo)+    -- XXX use generation count to check if the interval has been updated+    if i /= 0 && (ycnt `mod` i) == 0+    then do+        workerUpdateLatency rateInfo workerInfo+        -- XXX not required for parallel streams+        isBeyondMaxRate workerLimit workerCount rateInfo+    else return False++-- | Update the local yield count of the worker and check if:+--+-- * the channel yield rate is beyond max limit+-- * worker's yield count is beyond max limit+--+{-# NOINLINE incrWorkerYieldCount #-}+incrWorkerYieldCount ::+       Limit -- ^ Channel's max worker limit+    -> IORef Int -- ^ Current worker count+    -> YieldRateInfo -- ^ Channel's rate control info+    -> WorkerInfo -- ^ Worker's yield count info+    -> IO Bool -- ^ True means limits are ok and worker can continue+incrWorkerYieldCount workerLimit workerCount rateInfo workerInfo = do+    cnt <- updateYieldCount workerInfo+    beyondMaxRate <-+        updateLatencyAndCheckRate workerLimit workerCount rateInfo workerInfo cnt+    return $ not (isBeyondMaxYield cnt workerInfo || beyondMaxRate)++-------------------------------------------------------------------------------+-- Send a yield event+-------------------------------------------------------------------------------++-- XXX we should do rate control here but not latency update in case of ahead+-- streams. latency update must be done when we yield directly to outputQueue+-- or when we yield to heap.++-- | Add a 'ChildYield' event to the channel's output queue.+--+-- This is a wrapper over 'sendEvent', it does a few more things:+--+-- * performs a buffer limit check, returns False if exceeded+--+-- When rate control is enabled and 'WorkerInfo' is supplied::+--+-- * increments the worker yield count+-- * periodically pushes the worker latency stats to the channel+-- * performs a rate limit check, returns False if exceeded+{-# INLINE sendYield #-}+sendYield ::+       Limit -- ^ Channel's max buffer limit+    -> Limit -- ^ Channel's max worker limit+    -> IORef Int -- ^ Current worker count+    -> Maybe YieldRateInfo -- ^ Channel's rate control info+    -> IORef ([ChildEvent a], Int) -- ^ Queue where the output is added+    -> MVar () -- ^ Door bell to ring+    -> Maybe WorkerInfo -- ^ Worker's yield count info+    -> a -- ^ The output to be sent+    -> IO Bool -- ^ True means worker is allowed to continue working+sendYield bufferLimit workerLimit workerCount rateInfo q bell workerInfo msg =+    do+    oldlen <- sendEvent q bell (ChildYield msg)+    bufferSpaceOk <-+        case bufferLimit of+            Unlimited -> return True+            Limited lim -> do+                active <- readIORef workerCount+                return $ (oldlen + 1) < (fromIntegral lim - active)+    rateLimitOk <-+        case workerInfo of+            Just winfo ->+                case rateInfo of+                    Nothing -> return True+                    Just yinfo ->+                        incrWorkerYieldCount workerLimit workerCount yinfo winfo+            Nothing -> return True+    return $ bufferSpaceOk && rateLimitOk++-------------------------------------------------------------------------------+-- Send a Stop event+-------------------------------------------------------------------------------++{-# INLINE workerStopUpdate #-}+workerStopUpdate :: WorkerInfo -> YieldRateInfo -> IO ()+workerStopUpdate winfo info = do+    i <- readIORef (workerPollingInterval info)+    when (i /= 0) $ workerUpdateLatency info winfo++-- | Add a 'ChildStop' event to the channel's output queue. When rate control+-- is enabled, it pushes the worker latency stats to the channel.+{-# INLINABLE sendStop #-}+sendStop ::+       IORef Int -- ^ Channel's current worker count+    -> Maybe YieldRateInfo -- ^ Channel's rate control info+    -> IORef ([ChildEvent a], Int) -- ^ Queue where the stop event is added+    -> MVar () -- ^ Door bell to ring+    -> Maybe WorkerInfo -- ^ Worker's yield count info+    -> IO ()+sendStop workerCount rateInfo q bell workerInfo = do+    atomicModifyIORefCAS_ workerCount $ \n -> n - 1+    case (workerInfo, rateInfo) of+      (Just winfo, Just rinfo) ->+          workerStopUpdate winfo rinfo+      _ ->+          return ()+    tid <- myThreadId+    void $ sendEvent q bell (ChildStop tid Nothing)++-- XXX Shouldn't we perform a workerStopUpdate even in this case?++-- | Add a 'ChildStop' event with exception to the channel's output queue.+{-# NOINLINE sendException #-}+sendException ::+       IORef Int -- ^ Channel's current worker count+    -> IORef ([ChildEvent a], Int) -- ^ Queue where the event is added+    -> MVar () -- ^ Door bell to ring+    -> SomeException -- ^ The exception to send+    -> IO ()+sendException workerCount q bell e = do+    atomicModifyIORefCAS_ workerCount $ \n -> n - 1+    tid <- myThreadId+    void $ sendEvent q bell (ChildStop tid (Just e))
− src/Streamly/Internal/Data/Either/Strict.hs 
@@ -1,55 +0,0 @@--- |--- 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' (..)-    , 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 
@@ -1,1787 +0,0 @@--- |--- 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.Types" for design notes.------ IMPORTANT: keep the signatures consistent with the folds in Streamly.Prelude--module Streamly.Internal.Data.Fold-    (-    -- * Fold Type-      Step (..)-    , Fold (..)--    -- * Constructors-    , foldl'-    , foldlM'-    , foldl1'-    , foldr-    , foldrM-    , mkFold-    , mkFold_-    , mkFoldM-    , mkFoldM_--    -- * Folds-    -- ** Identity-    , fromPure-    , fromEffect--    -- ** Accumulators-    -- *** Semigroups and Monoids-    , sconcat-    , mconcat-    , foldMap-    , foldMapM--    -- *** Reducers-    , drain-    , drainBy-    , last-    , length-    , mean-    , variance-    , stdDev-    , rollingHash-    , 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--    -- ** Terminating Folds-    , drainN-    -- , lastN-    -- , (!!)-    , genericIndex-    , index-    , head-    -- , findM-    , find-    , lookup-    , findIndex-    , elemIndex-    , null-    , elem-    , notElem-    , all-    , any-    , and-    , or-    -- , the--    -- * Combinators-    -- ** Utilities-    , with--    -- ** Transforming the Monad-    , hoist-    , generally--    -- ** Mapping on output-    , rmapM--    -- ** Mapping on Input-    , transform-    , lmap-    --, lsequence-    , lmapM-    , scan-    , postscan-    , indexed--    -- ** Filtering-    , filter-    , filterM-    , sampleFromthen-    -- , ldeleteBy-    -- , luniq--    -- ** Mapping Filters-    , catMaybes-    , mapMaybe-    -- , mapMaybeM--    {--    -- ** Scanning Filters-    , findIndices-    , elemIndices--    -- ** Insertion-    -- | Insertion adds more elements to the stream.--    , insertBy-    , intersperseM--    -- ** Reordering-    , reverse-    -}--    -- ** Trimming-    , take--    -- By elements-    , takeEndBy-    , takeEndBy_-    -- , takeEndBySeq-    {--    , drop-    , dropWhile-    , dropWhileM-    -}--    -- ** Serial Append-    , serialWith-    , serial_-    -- , tail-    -- , init-    , splitAt -- spanN-    -- , splitIn -- sessionN--    -- ** Parallel Distribution-    , teeWith-    , tee-    , teeWithFst-    , teeWithMin-    , distribute-    -- , distributeFst-    -- , distributeMin--    -- ** Parallel Alternative-    , shortest-    , longest--    -- ** Partitioning-    , partitionByM-    , partitionByFstM-    , partitionByMinM-    , partitionBy-    , partition--    -- ** Demultiplexing-    -- | Direct values in the input stream to different folds using an n-ary-    -- fold selector.-    , demux        -- XXX rename this to demux_-    , demuxWith-    , demuxDefault -- XXX rename this to demux-    , demuxDefaultWith-    -- , demuxWithSel-    -- , demuxWithMin--    -- ** Classifying-    -- | In an input stream of key value pairs fold values for different keys-    -- in individual output buckets using the given fold.-    , classify-    , classifyWith-    -- , classifyWithSel-    -- , classifyWithMin--    -- ** Unzipping-    , unzip-    -- These two can be expressed using lmap/lmapM and unzip-    , unzipWith-    , unzipWithM-    , unzipWithFstM-    , unzipWithMinM--    -- ** Zipping-    , zipWithM-    , zip--    -- ** Splitting-    , many-    , chunksOf-    , chunksBetween--    -- ** Nesting-    , concatSequence-    , concatMap--    -- * Running A Fold-    -- | Normally you would run a fold to completion by supplying it a stream,-    -- e.g. using 'Stream.fold'. However, you could also run a fold partially-    -- by using 'duplicate' on it and then running it with a stream.-    -- Alternatively, 'initialize', 'snoc' and 'finish' can be used to run a-    -- fold incrementally, however, that may not be the most efficient way to-    -- run a fold.-    , initialize-    , snoc-    , duplicate-    , finish--    -- * Deprecated-    , sequence-    , mapM-    )-where--import Data.Bifunctor (first)-import Data.Either (isLeft, isRight)-import Data.Functor.Identity (Identity(..))-import Data.Int (Int64)-import Data.Map.Strict (Map)-import Data.Maybe (isJust, fromJust)-#if __GLASGOW_HASKELL__ < 804-import Data.Semigroup (Semigroup((<>)))-#endif-import Streamly.Internal.BaseCompat (fromLeft, fromRight)-import Streamly.Internal.Data.Either.Strict-    (Either'(..), fromLeft', fromRight', isLeft', isRight')-import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))--import qualified Data.Map.Strict as Map-import qualified Streamly.Internal.Data.Pipe.Type as Pipe--- import qualified Streamly.Internal.Data.Stream.IsStream.Enumeration as Stream-import qualified Prelude--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)-import Streamly.Internal.Data.Fold.Type---- $setup--- >>> :m--- >>> import Prelude hiding (break, map, span, splitAt)--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse, foldMany)--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold--- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import Streamly.Internal.Data.Stream.Serial (SerialT(..))--- >>> import Data.IORef (newIORef, readIORef, writeIORef)----------------------------------------------------------------------------------- hoist----------------------------------------------------------------------------------- | Change the underlying monad of a fold------ /Pre-release/-hoist :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b-hoist f (Fold step initial extract) =-    Fold (\x a -> f $ step x a) (f initial) (f . extract)---- | Adapt a pure fold to any monad------ > generally = Fold.hoist (return . runIdentity)------ /Pre-release/-generally :: Monad m => Fold Identity a b -> Fold m a b-generally = hoist (return . runIdentity)----------------------------------------------------------------------------------- Transformations on fold inputs----------------------------------------------------------------------------------- | Flatten the monadic output of a fold to pure output.------ @since 0.7.0-{-# 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.------ @since 0.7.0-{-# DEPRECATED mapM "Use rmapM instead" #-}-{-# INLINE mapM #-}-mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-mapM = rmapM---- | @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'.------ >>> 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]------ @since 0.8.0-{-# INLINE mapMaybe #-}-mapMaybe :: (Monad m) => (a -> Maybe b) -> Fold m b r -> Fold m a r-mapMaybe f = lmap f . filter isJust . lmap fromJust----------------------------------------------------------------------------------- Transformations on fold inputs----------------------------------------------------------------------------------- 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---- | Scan the input of a 'Fold' to change it in a stateful manner using another--- 'Fold'.--- /Pre-release/-{-# INLINE scan #-}-scan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-scan (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract--    where--    -- XXX It can be moved out and used for both scan and postscan-    {-# 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-        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---- | Postscan the input of a 'Fold' to change it in a stateful manner using--- another 'Fold'.--- /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----------------------------------------------------------------------------------- Left folds------------------------------------------------------------------------------------------------------------------------------------------------------------------ Run Effects----------------------------------------------------------------------------------- |--- > drainBy f = lmapM f drain--- > drainBy = Fold.foldMapM (void . f)------ Drain all input after passing it through a monadic function. This is the--- dual of mapM_ on stream producers.------ See also: 'Streamly.Prelude.mapM_'------ @since 0.7.0-{-# INLINE drainBy #-}-drainBy ::  Monad m => (a -> m b) -> Fold m a ()-drainBy f = lmapM f drain---- | Extract the last element of the input stream, if any.------ > last = fmap getLast $ Fold.foldMap (Last . Just)------ @since 0.7.0-{-# INLINE last #-}-last :: Monad m => Fold m a (Maybe a)-last = foldl1' (\_ x -> x)----------------------------------------------------------------------------------- To Summary----------------------------------------------------------------------------------- | Like 'length', except with a more general 'Num' return value------ > genericLength = fmap getSum $ foldMap (Sum . const  1)------ /Pre-release/-{-# INLINE genericLength #-}-genericLength :: (Monad m, Num b) => Fold m a b-genericLength = foldl' (\n _ -> n + 1) 0---- | Determine the length of the input stream.------ > length = fmap getSum $ Fold.foldMap (Sum . const  1)------ @since 0.7.0-{-# INLINE length #-}-length :: Monad m => Fold m a Int-length = genericLength---- | 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 = fmap getSum $ Fold.foldMap Sum------ @since 0.7.0-{-# INLINE sum #-}-sum :: (Monad m, Num a) => Fold m a a-sum =  foldl' (+) 0---- | 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.------ Compare with @Fold.foldMap Product@.------ @since 0.7.0--- /Since 0.8.0 (Added 'Eq' constraint)/-{-# INLINE product #-}-product :: (Monad m, Num a, Eq a) => Fold m a a-product =  mkFold_ step (Partial 1)--    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.------ @since 0.7.0-{-# 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---- |--- @--- maximum = Fold.maximumBy compare--- @------ Determine the maximum element in a stream.------ Compare with @Fold.foldMap Max@.------ @since 0.7.0-{-# 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------ @since 0.7.0-{-# 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.------ @--- minimum = 'minimumBy' compare--- @------ Compare with @Fold.foldMap Min@.------ @since 0.7.0-{-# 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.------ @since 0.7.0-{-# 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.------ @since 0.7.0-{-# 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.------ @since 0.7.0-{-# 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------ @since 0.8.0-{-# 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 defaultSalt------ @since 0.8.0-{-# 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 = Fold.take n Fold.rollingHash------ /Pre-release/-{-# INLINE rollingHashFirstN #-}-rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64-rollingHashFirstN n = take n rollingHash----------------------------------------------------------------------------------- Monoidal left folds----------------------------------------------------------------------------------- | Append the elements of an input stream to a provided starting value.------ >>> Stream.fold (Fold.sconcat 10) (Stream.map Data.Monoid.Sum $ Stream.enumerateFromTo 1 10)--- Sum {getSum = 65}------ @--- sconcat = Fold.foldl' (<>)--- @------ @since 0.8.0-{-# INLINE sconcat #-}-sconcat :: (Monad m, Semigroup a) => a -> Fold m a a-sconcat = foldl' (<>)---- | Fold an input stream consisting of monoidal elements using 'mappend'--- and 'mempty'.------ >>> Stream.fold Fold.mconcat (Stream.map Data.Monoid.Sum $ Stream.enumerateFromTo 1 10)--- Sum {getSum = 55}------ > mconcat = Fold.sconcat mempty------ @since 0.7.0-{-# INLINE mconcat #-}-mconcat ::-    ( Monad m-#if !MIN_VERSION_base(4,11,0)-    , Semigroup a-#endif-    , Monoid a) => Fold m a a-mconcat = sconcat mempty---- |--- > 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'.------ >>> Stream.fold (Fold.foldMap Data.Monoid.Sum) $ Stream.enumerateFromTo 1 10--- Sum {getSum = 55}------ @since 0.7.0-{-# INLINE foldMap #-}-foldMap :: (Monad m, Monoid b-#if !MIN_VERSION_base(4,11,0)-    , Semigroup b-#endif-    ) => (a -> b) -> Fold m a b-foldMap f = lmap f mconcat---- |--- > 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'.------ >>> Stream.fold (Fold.foldMapM (return . Data.Monoid.Sum)) $ Stream.enumerateFromTo 1 10--- Sum {getSum = 55}------ @since 0.7.0-{-# 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.------ > toListRev = Fold.foldl' (flip (:)) []------ /Warning!/ working on large lists accumulated as buffers in memory could be--- very inefficient, consider using "Streamly.Array" instead.------ @since 0.8.0----  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.------ > 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 genericIndex #-}-genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)-genericIndex i = mkFold step (Partial 0) (const Nothing)--    where--    step j a =-        if i == j-        then Done $ Just a-        else Partial (j + 1)---- | Lookup the element at the given index.------ See also: 'Streamly.Prelude.!!'------ @since 0.7.0-{-# INLINE index #-}-index :: Monad m => Int -> Fold m a (Maybe a)-index = genericIndex---- | Extract the first element of the stream, if any.------ @since 0.7.0-{-# INLINE head #-}-head :: Monad m => Fold m a (Maybe a)-head = mkFold_ (const (Done . Just)) (Partial Nothing)---- | Returns the first element that satisfies the given predicate.------ @since 0.7.0-{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-find predicate = mkFold step (Partial ()) (const Nothing)--    where--    step () a =-        if predicate a-        then Done (Just a)-        else Partial ()---- | 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@.------ > lookup = snd <$> Fold.find ((==) . fst)------ @since 0.7.0-{-# INLINE lookup #-}-lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)-lookup a0 = mkFold 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.------ @since 0.7.0-{-# INLINE findIndex #-}-findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)-findIndex predicate = mkFold step (Partial 0) (const Nothing)--    where--    step i a =-        if predicate a-        then Done $ Just i-        else Partial (i + 1)---- | Returns the first index where a given value is found in the stream.------ > elemIndex a = Fold.findIndex (== a)------ @since 0.7.0-{-# INLINE elemIndex #-}-elemIndex :: (Eq a, Monad m) => a -> Fold m a (Maybe Int)-elemIndex a = findIndex (a ==)----------------------------------------------------------------------------------- To Boolean----------------------------------------------------------------------------------- | Return 'True' if the input stream is empty.------ > null = fmap isJust Fold.head------ @since 0.7.0-{-# INLINE null #-}-null :: Monad m => Fold m a Bool-null = mkFold (\() _ -> Done False) (Partial ()) (const True)---- | Returns 'True' if any of the elements of a stream satisfies a predicate.------ >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]--- True------ > any p = Fold.lmap p Fold.or------ @since 0.7.0-{-# INLINE any #-}-any :: Monad m => (a -> Bool) -> Fold m a Bool-any predicate = mkFold_ step initial--    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.------ > elem a = Fold.any (== a)------ @since 0.7.0-{-# INLINE elem #-}-elem :: (Eq a, Monad m) => a -> Fold m a Bool-elem a = any (a ==)---- | Returns 'True' if all elements of a stream satisfy a predicate.------ >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]--- False------ > all p = Fold.lmap p Fold.and------ @since 0.7.0-{-# INLINE all #-}-all :: Monad m => (a -> Bool) -> Fold m a Bool-all predicate = mkFold_ step initial--    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.------ > notElem a = Fold.all (/= a)------ @since 0.7.0-{-# 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------ > and = Fold.all (== True)------ @since 0.7.0-{-# INLINE and #-}-and :: Monad m => Fold m Bool Bool-and = all (== True)---- | Returns 'True' if any element is 'True', 'False' otherwise------ > or = Fold.any (== True)------ @since 0.7.0-{-# 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.serialWith (,) (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 = serialWith (,) (take n fld)----------------------------------------------------------------------------------- Element Aware APIs-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Binary APIs----------------------------------------------------------------------------------- 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.------ | Like 'takeEndBy' but drops the element on which the predicate succeeds.------ >>> Stream.fold (Fold.takeEndBy_ (== '\n') Fold.toList) $ Stream.fromList "hello\nthere\n"--- "hello"------ >>> Stream.toList $ Stream.foldMany (Fold.takeEndBy_ (== '\n') Fold.toList) $ Stream.fromList "hello\nthere\n"--- ["hello","there"]------ > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)------ See 'Streamly.Prelude.splitOnSuffix' for more details on splitting a--- stream using 'takeEndBy_'.------ @since 0.8.0-{-# INLINE takeEndBy_ #-}-takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-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---- | Take the input, stop when the predicate succeeds taking the succeeding--- element as well.------ >>> Stream.fold (Fold.takeEndBy (== '\n') Fold.toList) $ Stream.fromList "hello\nthere\n"--- "hello\n"------ >>> Stream.toList $ Stream.foldMany (Fold.takeEndBy (== '\n') Fold.toList) $ Stream.fromList "hello\nthere\n"--- ["hello\n","there\n"]------ > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)------ See 'Streamly.Prelude.splitWithSuffix' for more details on splitting a--- stream using 'takeEndBy'.------ @since 0.8.0-{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-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---------------------------------------------------------------------------------{---- | Find the first occurrence of the specified sequence in the input stream--- and break the input stream into two parts, the first part consisting of the--- stream before the sequence and the second part consisting of the sequence--- and the rest of the stream.------ > let breakOn_ pat xs = S.fold (S.breakOn pat FL.toList FL.toList) $ S.fromList xs------ >>> breakOn_ "dear" "Hello dear world!"--- > ("Hello ","dear world!")----{-# INLINE breakOn #-}-breakOn :: Monad m => Array a -> Fold m a b -> Fold m a c -> Fold m a (b,c)-breakOn pat f m = undefined--}----------------------------------------------------------------------------------- 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--------|--- @--- >>> Stream.fold (Fold.tee Fold.sum Fold.length) (Stream.enumerateFromTo 1.0 100.0)--- (5050.0,100)------ > tee = teeWith (,)------ @since 0.7.0-{-# 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.------ @since 0.7.0-{-# 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--------|--- @------ Send input to either fold randomly:------ @--- > import System.Random (randomIO)--- > randomly a = randomIO >>= \\x -> return $ if x then Left a else Right a--- > Stream.fold (Fold.partitionByM randomly Fold.length Fold.length) (Stream.enumerateFromTo 1 100)--- (59,41)--- @------ 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---  f <- proportionately 2 1---  r <- Stream.fold (Fold.partitionByM f Fold.length Fold.length) (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.------ 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.------ > partition = partitionBy id------ @since 0.7.0-{-# 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--}---- 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. We also want to make sure that the Map contains--- only those types and the full set of those types.------ TODO Instead of the input Map it should probably be a lookup-table using an--- array and not in GC memory. The same applies to the output Map as well.--- However, that would only be helpful if we have a very large data structure,--- need to measure and see how it scales.------ This is the consumer side dual of the producer side 'mux' operation (XXX to--- be implemented).---- | Split the input stream based on a key field and fold each split using a--- specific fold collecting the results in a map from the keys to the results.--- Useful for cases like protocol handlers to handle different type of packets--- using different handlers.------ @------                             |-------Fold m a b--- -----stream m a-----Map-----|---                             |-------Fold m a b---                             |---                                       ...--- @------ Any input that does not map to a fold in the input Map is silently ignored.------ > demuxWith f kv = fmap fst $ demuxDefaultWith f kv drain------ /Pre-release/----{-# INLINE demuxWith #-}-demuxWith :: (Monad m, Ord k)-    => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a (Map k b)-demuxWith f kv = fmap fst $ demuxDefaultWith f kv drain---- | Fold a stream of key value pairs using a map of specific folds for each--- key into a map from keys to the results of fold outputs of the corresponding--- values.------ >>> import qualified Data.Map--- >>> :{---  let table = Data.Map.fromList [("SUM", Fold.sum), ("PRODUCT", Fold.product)]---      input = Stream.fromList [("SUM",1),("PRODUCT",2),("SUM",3),("PRODUCT",4)]---   in Stream.fold (Fold.demux table) input--- :}--- fromList [("PRODUCT",8),("SUM",4)]------ > demux = demuxWith id------ /Pre-release/-{-# INLINE demux #-}-demux :: (Monad m, Ord k)-    => Map k (Fold m a b) -> Fold m (k, a) (Map k b)-demux = demuxWith id--data DemuxState s b doneMap runMap =-      DemuxMapAndDefault !s !doneMap !runMap-    | DemuxOnlyMap b !doneMap !runMap-    | DemuxOnlyDefault s !doneMap---- | Like 'demuxWith' but uses a default catchall fold to handle inputs which--- do not have a specific fold in the map to handle them.------ If any fold in the map stops, inputs meant for that fold are sent to the--- catchall fold. If the catchall fold stops then inputs that do not match any--- fold are ignored.------ Stops when all the folds, including the catchall fold, stop.------ /Pre-release/----{-# INLINE demuxDefaultWith #-}-demuxDefaultWith :: (Monad m, Ord k)-    => (a -> (k, a'))-    -> Map k (Fold m a' b)-    -> Fold m (k, a') c-    -> Fold m a (Map k b, c)-demuxDefaultWith f kv (Fold dstep dinitial dextract) =-    Fold step initial extract--    where--    initial = do-        let runInit (Fold step1 initial1 done1) = do-                r <- initial1-                return-                    $ case r of-                          Partial _ -> Right' (Fold step1 (return r) done1)-                          Done b -> Left' b--        -- initialize folds in the kv map and separate the ones that are done-        -- from running ones-        kv1 <- Prelude.mapM runInit kv-        let runMap = Map.map fromRight' $ Map.filter isRight' kv1-            doneMap = Map.map fromLeft' $ Map.filter isLeft' kv1--        -- Run the default fold, and decide the next state based on its result-        dres <- dinitial-        return-            $ case dres of-                  Partial s ->-                      Partial-                          $ if Map.size runMap > 0-                            then DemuxMapAndDefault s doneMap runMap-                            else DemuxOnlyDefault s doneMap-                  Done b ->-                      if Map.size runMap > 0-                      then Partial $ DemuxOnlyMap b doneMap runMap-                      else Done (doneMap, b)--    {-# INLINE runFold #-}-    runFold fPartial fDone doneMap runMap (Fold step1 initial1 done1) k a1 = do-        resi <- initial1-        case resi of-            Partial st -> do-                res <- step1 st a1-                return $ case res of-                    Partial s ->-                        let fld = Fold step1 (return $ Partial s) done1-                            runMap1 = Map.insert k fld runMap-                         in Partial $ fPartial doneMap runMap1-                    Done b -> do-                        let runMap1 = Map.delete k runMap-                            doneMap1 = Map.insert k b doneMap-                        if Map.size runMap1 == 0-                        then fDone doneMap1-                        else Partial $ fPartial doneMap1 runMap1-            Done _ -> error "Bug: demuxDefaultWith: Done fold"--    step (DemuxMapAndDefault dacc doneMap runMap) a = do-        let (k, a1) = f a-        case Map.lookup k runMap of-            Nothing -> do-                res <- dstep dacc (k, a1)-                return-                    $ Partial-                    $ case res of-                          Partial s -> DemuxMapAndDefault s doneMap runMap-                          Done b -> DemuxOnlyMap b doneMap runMap-            Just fld ->-                runFold-                    (DemuxMapAndDefault dacc)-                    (Partial . DemuxOnlyDefault dacc)-                    doneMap runMap fld k a1--    step (DemuxOnlyMap dval doneMap runMap) a = do-        let (k, a1) = f a-        case Map.lookup k runMap of-            Nothing -> return $ Partial $ DemuxOnlyMap dval doneMap runMap-            Just fld ->-                runFold-                    (DemuxOnlyMap dval)-                    (Done . (, dval))-                    doneMap runMap fld k a1-    step (DemuxOnlyDefault dacc doneMap) a = do-        let (k, a1) = f a-        res <- dstep dacc (k, a1)-        return-            $ case res of-                  Partial s -> Partial $ DemuxOnlyDefault s doneMap-                  Done b -> Done (doneMap, b)--    runExtract (Fold _ initial1 done1) = do-        res <- initial1-        case res of-            Partial s -> done1 s-            Done b -> return b--    extract (DemuxMapAndDefault dacc doneMap runMap) = do-        b <- dextract dacc-        runMap1 <- Prelude.mapM runExtract runMap-        return (doneMap `Map.union` runMap1, b)-    extract (DemuxOnlyMap dval doneMap runMap) = do-        runMap1 <- Prelude.mapM runExtract runMap-        return (doneMap `Map.union` runMap1, dval)-    extract (DemuxOnlyDefault dacc doneMap) = do-        b <- dextract dacc-        return (doneMap, b)---- |--- > demuxDefault = demuxDefaultWith id------ /Pre-release/-{-# INLINE demuxDefault #-}-demuxDefault :: (Monad m, Ord k)-    => Map k (Fold m a b) -> Fold m (k, a) b -> Fold m (k, a) (Map k b, b)-demuxDefault = demuxDefaultWith id---- TODO If the data is large we may need a map/hashmap in pinned memory instead--- of a regular Map. That may require a serializable constraint though. We can--- have another API for that.------ | 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.------ >>> :{---  let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]---   in Stream.fold (Fold.classifyWith fst (Fold.map snd Fold.toList)) input--- :}--- fromList [("ONE",[1.0,1.1]),("TWO",[2.0,2.2])]------ If the classifier fold stops for a particular key any further inputs in that--- bucket are ignored.------ /Stops: never/------ /Pre-release/----{-# INLINE classifyWith #-}-classifyWith :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)-classifyWith f (Fold step1 initial1 extract1) =-    rmapM extract $ foldlM' step initial--    where--    initial = return Map.empty--    step kv a =-        case Map.lookup k kv of-            Nothing -> do-                x <- initial1-                case x of-                      Partial s -> do-                        r <- step1 s a-                        return-                            $ flip (Map.insert k) kv-                            $ case r of-                                  Partial s1 -> Left' s1-                                  Done b -> Right' b-                      Done b -> return $ Map.insert k (Right' b) kv-            Just x -> do-                case x of-                    Left' s -> do-                        r <- step1 s a-                        return-                            $ flip (Map.insert k) kv-                            $ case r of-                                  Partial s1 -> Left' s1-                                  Done b -> Right' b-                    Right' _ -> return kv--        where--        k = f a--    extract =-        Prelude.mapM-            (\case-                 Left' s -> extract1 s-                 Right' b -> return b)---- | 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.------ >>> :{---  let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]---   in Stream.fold (Fold.classify Fold.toList) input--- :}--- fromList [("ONE",[1.0,1.1]),("TWO",[2.0,2.2])]------ Same as:------ > classify fld = Fold.classifyWith fst (lmap snd fld)------ /Pre-release/-{-# INLINE classify #-}-classify :: (Monad m, Ord k) => Fold m a b -> Fold m (k, a) (Map k b)-classify fld = classifyWith fst (lmap snd fld)----------------------------------------------------------------------------------- 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.------ @unzipWithM k f1 f2 = lmapM k (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.------ @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--------|------ @------ > unzip = Fold.unzipWith id------ This is the consumer side dual of the producer side 'zip' operation.------ @since 0.7.0-{-# 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----------------------------------------------------------------------------------- | Zip a stream with the input of a fold using the supplied function.------ /Unimplemented/----{-# INLINE zipWithM #-}-zipWithM :: -- Monad m =>-    (a -> b -> m c) -> t m a -> Fold m c x -> Fold m b x-zipWithM = undefined---- | Zip a stream with the input of a fold.------ /Unimplemented/----{-# INLINE zip #-}-zip :: Monad m => t m a -> Fold m (a, b) x -> Fold m b x-zip = zipWithM (curry return)---- | Pair each element of a fold input with its index, starting from index 0.------ /Unimplemented/-{-# INLINE indexed #-}-indexed :: -- forall m a b. Monad m =>-    Fold m (Int, a) b -> Fold m a b-indexed = undefined -- zip (Stream.enumerateFrom 0 :: SerialT m Int)---- | 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 = with indexed 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---- | @sampleFromthen offset stride@ samples the element at @offset@ index and--- then every element at strides of @stride@.------ /Unimplemented/-{-# 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 SerialT Fold.toStreamK------ /Pre-release/-{-# INLINE toStream #-}-toStream :: Monad m => Fold m a (SerialT n a)-toStream = fmap SerialT toStreamK---- 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 SerialT Fold.toStreamKRev------ /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 => Fold m a (SerialT n a)-toStreamRev = fmap SerialT toStreamKRev
− src/Streamly/Internal/Data/Fold/Async.hs 
@@ -1,119 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Fold.Async--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Fold.Async-    (-    -- * Trimming-      takeInterval--    -- * Splitting-    , intervalsOf-    )-where--import Control.Concurrent (threadDelay, forkIO, killThread)-import Control.Concurrent.MVar (MVar, newMVar, swapMVar, readMVar)-import Control.Exception (SomeException(..), catch, mask)-import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Internal.Control.Concurrent (MonadAsync, withRunInIO)-import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))--import Streamly.Internal.Data.Fold.Type---- $setup--- >>> :m--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold.Async as Fold---- XXX We can use asyncClock here. A parser can be used to return an input that--- arrives after the timeout.--- XXX If n is 0 return immediately in initial.--- XXX we should probably discard the input received after the timeout like--- takeEndBy_.------ | @takeInterval n fold@ uses @fold@ to fold the input items arriving within--- a window of first @n@ seconds.------ >>> input = Stream.delay 0.1 $ Stream.fromList [1..]--- >>> Stream.fold (Fold.takeInterval 1.0 Fold.toList) input--- [1,2,3,4,5,6,7,8,9,10,11]------ Stops when @fold@ stops or when the timeout occurs. Note that the fold needs--- an input after the timeout to stop. For example, if no input is pushed to--- the fold until one hour after the timeout had occurred, then the fold will--- be done only after consuming that input.------ /Pre-release/----{-# INLINE takeInterval #-}-takeInterval :: MonadAsync m => Double -> Fold m a b -> Fold m a b-takeInterval n (Fold step initial done) = Fold step' initial' done'--    where--    initial' = do-        res <- initial-        case res of-            Partial s -> do-                mv <- liftIO $ newMVar False-                t <--                    withRunInIO $ \run ->-                        mask $ \restore -> do-                            tid <--                                forkIO-                                  $ catch-                                        (restore $ void $ run (timerThread mv))-                                        (handleChildException mv)-                            run (return tid)-                return $ Partial $ Tuple3' s mv t-            Done b -> return $ Done b--    step' (Tuple3' s mv t) a = do-        val <- liftIO $ readMVar mv-        if val-        then do-            res <- step s a-            case res of-                Partial sres -> Done <$> done sres-                Done bres -> return $ Done bres-        else do-            res <- step s a-            case res of-                Partial fs -> return $ Partial $ Tuple3' fs mv t-                Done b -> liftIO (killThread t) >> return (Done b)--    done' (Tuple3' s _ _) = done s--    timerThread mv = do-        liftIO $ threadDelay (round $ n * 1000000)-        -- Use IORef + CAS? instead of MVar since its a Bool?-        liftIO $ void $ swapMVar mv True--    handleChildException :: MVar Bool -> SomeException -> IO ()-    handleChildException mv _ = void $ swapMVar mv True---- For example, we can copy and distribute a stream to multiple folds where--- each fold can group the input differently e.g. by one second, one minute and--- one hour windows respectively and fold each resulting stream of folds.---- | Group the input stream into windows of n second each using the first fold--- and then fold the resulting groups using the second fold.------ >>> intervals = Fold.intervalsOf 0.5 Fold.toList Fold.toList--- >>> Stream.fold intervals $ Stream.delay 0.2 $ Stream.fromList [1..10]--- [[1,2,3,4],[5,6,7],[8,9,10]]------ > intervalsOf n split = many (takeInterval n split)------ /Pre-release/----{-# INLINE intervalsOf #-}-intervalsOf :: MonadAsync m => Double -> Fold m a b -> Fold m b c -> Fold m a c-intervalsOf n split = many (takeInterval n split)
+ src/Streamly/Internal/Data/Fold/Channel.hs view
@@ -0,0 +1,15 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Channel+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Fold.Channel+    (+      module Streamly.Internal.Data.Fold.Channel.Type+    )+where++import Streamly.Internal.Data.Fold.Channel.Type
+ src/Streamly/Internal/Data/Fold/Channel/Type.hs view
@@ -0,0 +1,652 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Channel.Type+-- Copyright   : (c) 2017, 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Fold.Channel.Type+    (+    -- ** Type+      Channel (..)+    , OutEvent (..)++    -- ** Configuration+    , Config+    , defaultConfig+    , maxBuffer+    , boundThreads+    , inspect++    -- ** Operations+    , newChannelWith+    , newChannelWithScan+    , newChannel+    , newScanChannel+    , sendToWorker+    , sendToWorker_+    , checkFoldStatus -- XXX collectFoldOutput+    , dumpChannel+    , cleanup+    , finalize+    )+where++#include "inline.hs"++import Control.Concurrent (ThreadId, myThreadId, tryPutMVar)+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar)+import Control.Exception (SomeException(..))+import Control.Monad (void, when)+import Control.Monad.Catch (throwM)+import Control.Monad.IO.Class (MonadIO(..))+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.List (intersperse)+import Streamly.Internal.Control.Concurrent+    (MonadAsync, MonadRunInIO, askRunInIO)+import Streamly.Internal.Control.ForkLifted (doForkWith)+import Streamly.Internal.Data.Atomics (writeBarrier)+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.Scanl (Scanl(..))+import Streamly.Internal.Data.Channel.Dispatcher (dumpSVarStats)+import Streamly.Internal.Data.Channel.Worker (sendEvent)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)++import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as D++import Streamly.Internal.Data.Channel.Types++-- XXX We can make the fold evaluation concurrent by using a monoid for the+-- accumulator. It will then work in the same way as the stream evaluation, in+-- stream evaluation we dequeue the head and queue the tail, in folds we will+-- queue the accumulator and it will be picked by the next worker to accumulate+-- the next value.++data OutEvent b =+      FoldException ThreadId SomeException+    | FoldPartial b+    | FoldDone ThreadId b+    | FoldEOF ThreadId++-- | The fold driver thread queues the input of the fold in the 'inputQueue'+-- The driver rings the doorbell when the queue transitions from empty to+-- non-empty state.+--+-- The fold consumer thread dequeues the input items from the 'inputQueue' and+-- supplies them to the fold. When the fold is done the output of the fold is+-- placed in 'inputQueue' and 'outputDoorBell' is rung.+--+-- The fold driver thread keeps watching the 'outputQueue', if the fold has+-- terminated, it stops queueing the input to the 'inputQueue'+--+-- If the fold driver runs out of input it stops and waits for the fold to+-- drain the buffered input.+--+-- Driver thread ------>------Input Queue and Doorbell ----->-----Fold thread+--+-- Driver thread ------<------Output Queue and Doorbell-----<-----Fold thread+--+data Channel m a b = Channel+    {+    -- FORWARD FLOW: Flow of data from the driver to the consuming fold++    -- XXX Use a different type than ChildEvent. We can do with a simpler type+    -- in folds.++    -- | Input queue (messages, length).+    --+    -- [LOCKING] Frequent, locked access. Input is queued frequently by the+    -- driver and infrequently dequeued in chunks by the fold.+    --+      inputQueue :: IORef ([ChildEvent a], Int)++      -- | The maximum size of the inputQueue allowed.+    , maxInputBuffer :: Limit++    -- | Doorbell is rung by the driver when 'inputQueue' transitions from+    -- empty to non-empty.+    --+    -- [LOCKING] Infrequent, MVar.+    , inputItemDoorBell :: MVar ()+    , closedForInput :: IORef Bool++    -- | Doorbell to tell the driver that there is now space available in the+    -- 'inputQueue' and more items can be queued.+    , inputSpaceDoorBell :: MVar ()++    , readInputQ :: m [ChildEvent a]++    -- | Final output and exceptions, if any, queued by the fold and read by+    -- the fold driver.+    --+    -- [LOCKING] atomicModifyIORef. Output is queued infrequently by the fold+    -- and read frequently by the driver.+    , outputQueue :: IORef ([OutEvent b], Int)++    -- | Doorbell for the 'outputQueue', rung by the fold when the queue+    -- transitions from empty to non-empty.+    --+    -- [LOCKING] Infrequent, MVar.+    , outputDoorBell :: MVar ()++    -- cleanup: to track garbage collection of SVar --+    , svarRef :: Maybe (IORef ())++    -- Stats --+    , svarStats :: SVarStats++    -- Diagnostics --+    , svarInspectMode :: Bool+    , svarCreator :: ThreadId+    }++-------------------------------------------------------------------------------+-- Config+-------------------------------------------------------------------------------++-- | An abstract type for specifying the configuration parameters of a+-- 'Channel'. Use @Config -> Config@ modifier functions to modify the default+-- configuration. See the individual modifier documentation for default values.+--+data Config = Config+    {+      _bufferHigh :: Limit+    , _inspect    :: Bool+    , _bound :: Bool+    }++-------------------------------------------------------------------------------+-- State defaults and reset+-------------------------------------------------------------------------------++defaultMaxBuffer :: Limit+defaultMaxBuffer = Limited magicMaxBuffer++-- | The fields prefixed by an _ are not to be accessed or updated directly but+-- via smart accessor APIs. Use get/set routines instead of directly accessing+-- the Config fields+defaultConfig :: Config+defaultConfig = Config+    {+      _bufferHigh = defaultMaxBuffer+    , _inspect = False+    , _bound = False+    }++-------------------------------------------------------------------------------+-- Smart get/set routines for State+-------------------------------------------------------------------------------++-- | Specify the maximum size of the buffer for storing the results from+-- concurrent computations. If the buffer becomes full we stop spawning more+-- concurrent tasks until there is space in the buffer.+-- A value of 0 resets the buffer size to default, a negative value means+-- there is no limit. The default value is 1500.+--+-- CAUTION! using an unbounded 'maxBuffer' value (i.e. a negative value)+-- coupled with an unbounded 'maxThreads' value is a recipe for disaster in+-- presence of infinite streams, or very large streams.  Especially, it must+-- not be used when 'pure' is used in 'ZipAsyncM' streams as 'pure' in+-- applicative zip streams generates an infinite stream causing unbounded+-- concurrent generation with no limit on the buffer or threads.+--+maxBuffer :: Int -> Config -> Config+maxBuffer n st =+    st { _bufferHigh =+            if n < 0+            then Unlimited+            else if n == 0+                 then defaultMaxBuffer+                 else Limited (fromIntegral n)+       }++getMaxBuffer :: Config -> Limit+getMaxBuffer = _bufferHigh++-- | Print debug information about the 'Channel' when the stream ends. When the+-- stream does not end normally, the channel debug information is printed when+-- the channel is garbage collected. If you are expecting but not seeing the+-- debug info try adding a 'performMajorGC' before the program ends.+--+inspect :: Bool -> Config -> Config+inspect flag st = st { _inspect = flag }++getInspectMode :: Config -> Bool+getInspectMode = _inspect++-- | Spawn bound threads (i.e., spawn threads using 'forkOS' instead of+-- 'forkIO'). The default value is 'False'.+--+-- Currently, this only takes effect only for concurrent folds.+boundThreads :: Bool -> Config -> Config+boundThreads flag st = st { _bound = flag }++getBound :: Config -> Bool+getBound = _bound++-------------------------------------------------------------------------------+-- Inspection+-------------------------------------------------------------------------------++-- | Dump the channel stats for diagnostics. Used when 'inspect' option is+-- enabled.+{-# NOINLINE dumpChannel #-}+dumpChannel :: Channel m a b -> IO String+dumpChannel sv = do+    xs <- sequence $ intersperse (return "\n")+        [ return (dumpCreator (svarCreator sv))+        , return "---------CURRENT STATE-----------"+        , dumpOutputQ (inputQueue sv)+        -- XXX print the types of events in the outputQueue, first 5+        , dumpDoorBell (inputItemDoorBell sv)+        , return "---------STATS-----------\n"+        , dumpSVarStats (svarInspectMode sv) Nothing (svarStats sv)+        ]+    return $ concat xs++-------------------------------------------------------------------------------+-- Support for running folds concurrently+-------------------------------------------------------------------------------++-- $concurrentFolds+--+-- To run folds concurrently, we need to decouple the fold execution from the+-- stream production. We use the SVar to do that, we have a single worker+-- pushing the stream elements to the SVar and on the consumer side a fold+-- driver pulls the values and folds them.+--+-- @+--+-- Fold worker <------Channel<------Fold driver+--     |  exceptions  |+--     --------------->+--+-- @+--+-- We need a channel for pushing exceptions from the fold worker to the fold+-- driver. The stream may be pushed to multiple folds at the same time. For+-- that we need one Channel per fold:+--+-- @+--+-- Fold worker <------Channel--+--                    |        |+-- Fold worker <------Channel------Driver+--                    |        |+-- Fold worker <------Channel--+--+-- @+--+-- Note: If the stream pusher terminates due to an exception, we do not+-- actively terminate the fold. It gets cleaned up by the GC.++-------------------------------------------------------------------------------+-- Process events received by a fold worker from a fold driver+-------------------------------------------------------------------------------++sendToDriver :: Channel m a b -> OutEvent b -> IO Int+sendToDriver sv msg = do+    -- In case the producer stream is blocked on pushing to the fold buffer+    -- then wake it up so that it can check for the stop event or exception+    -- being sent to it otherwise we will be deadlocked.+    -- void $ tryPutMVar (pushBufferMVar sv) ()+    sendEvent (outputQueue sv)+                     (outputDoorBell sv) msg++sendYieldToDriver :: MonadIO m => Channel m a b -> b -> m ()+sendYieldToDriver sv res = liftIO $ do+    tid <- myThreadId+    void $ sendToDriver sv (FoldDone tid res)++sendPartialToDriver :: MonadIO m => Channel m a b -> b -> m ()+sendPartialToDriver sv res = liftIO $ do+    void $ sendToDriver sv (FoldPartial res)++sendEOFToDriver :: MonadIO m => Channel m a b -> m ()+sendEOFToDriver sv = liftIO $ do+    tid <- myThreadId+    void $ sendToDriver sv (FoldEOF tid)++{-# NOINLINE sendExceptionToDriver #-}+sendExceptionToDriver :: Channel m a b -> SomeException -> IO ()+sendExceptionToDriver sv e = do+    tid <- myThreadId+    writeIORef (closedForInput sv) True+    -- Should ring the doorbell after sending the message+    void $ sendToDriver sv (FoldException tid e)+    void $ tryPutMVar (inputSpaceDoorBell sv) ()++data FromSVarState m a b =+      FromSVarRead (Channel m a b)+    | FromSVarLoop (Channel m a b) [ChildEvent a]++{-# INLINE_NORMAL fromInputQueue #-}+fromInputQueue :: MonadIO m => Channel m a b -> D.Stream m a+fromInputQueue svar = D.Stream step (FromSVarRead svar)++    where++    {-# INLINE_LATE step #-}+    step _ (FromSVarRead sv) = do+        list <- readInputQ sv+        -- Reversing the output is important to guarantee that we process the+        -- outputs in the same order as they were generated by the constituent+        -- streams.+        return $ D.Skip $ FromSVarLoop sv (Prelude.reverse list)++    step _ (FromSVarLoop sv []) = return $ D.Skip $ FromSVarRead sv+    step _ (FromSVarLoop sv (ev : es)) = do+        case ev of+            -- XXX Separate input and output events. Input events cannot have+            -- Stop event and output events cannot have ChildStopChannel+            -- event.+            ChildYield a -> return $ D.Yield a (FromSVarLoop sv es)+            ChildStopChannel -> return D.Stop+            _ -> undefined++{-# INLINE readInputQChan #-}+readInputQChan :: Channel m a b -> IO ([ChildEvent a], Int)+readInputQChan chan = do+    let ss = if svarInspectMode chan then Just (svarStats chan) else Nothing+    r@(_, n) <- readOutputQRaw (inputQueue chan) ss+    if n <= 0+    then do+        liftIO+            $ withDiagMVar+                (svarInspectMode chan)+                (dumpChannel chan)+                "readInputQChan: nothing to do"+            $ takeMVar (inputItemDoorBell chan)+        readOutputQRaw (inputQueue chan) ss+    else return r++{-# INLINE readInputQWithDB #-}+readInputQWithDB :: Channel m a b -> IO ([ChildEvent a], Int)+readInputQWithDB chan = do+    r <- readInputQChan chan+    -- XXX We can do this only if needed, if someone sleeps because of buffer+    -- then they can set a flag and we ring the doorbell only if the flag is+    -- set. Like we do in sendWorkerWait for streams.+    _ <- tryPutMVar (inputSpaceDoorBell chan) ()+    return r++mkNewChannelWith :: forall m a b. MonadIO m =>+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> Config+    -> IO (Channel m a b)+mkNewChannelWith outQRev outQMvRev cfg = do+    outQ <- newIORef ([], 0)+    outQMv <- newEmptyMVar+    bufferMv <- newEmptyMVar+    ref <- newIORef False++    stats <- newSVarStats+    tid <- myThreadId++    let getSVar :: Channel m a b -> Channel m a b+        getSVar sv = Channel+            { inputQueue      = outQ+            , inputItemDoorBell   = outQMv+            , outputQueue = outQRev+            , outputDoorBell = outQMvRev+            , inputSpaceDoorBell = bufferMv+            , closedForInput = ref+            , maxInputBuffer   = getMaxBuffer cfg+            , readInputQ      = liftIO $ fmap fst (readInputQWithDB sv)+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode cfg+            , svarCreator      = tid+            , svarStats        = stats+            }++    let sv = getSVar sv in return sv++{-# INLINABLE newChannelWith #-}+{-# SPECIALIZE newChannelWith ::+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> (Config -> Config)+    -> Fold IO a b+    -> IO (Channel IO a b, ThreadId) #-}+newChannelWith :: (MonadRunInIO m) =>+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> (Config -> Config)+    -> Fold m a b+    -> m (Channel m a b, ThreadId)+newChannelWith outq outqDBell modifier f = do+    let config = modifier defaultConfig+    sv <- liftIO $ mkNewChannelWith outq outqDBell config+    mrun <- askRunInIO+    tid <- doForkWith+        (getBound config) (work sv) mrun (sendExceptionToDriver sv)+    return (sv, tid)++    where++    {-# NOINLINE work #-}+    work chan =+        let f1 = Fold.rmapM (void . sendYieldToDriver chan) f+         in D.fold f1 $ fromInputQueue chan++-- | Returns True if the fold terminated due to completion and False when due+-- to end-of-stream.+{-# INLINE scanToChannel #-}+scanToChannel :: MonadIO m => Channel m a b -> Scanl m a b -> Fold m a Bool+scanToChannel chan (Scanl step initial extract final) =+    Fold step1 initial1 extract1 final1++    where++    initial1 = do+        r <- initial+        case r of+            Fold.Partial s -> do+                b <- extract s+                void $ sendPartialToDriver chan b+                return $ Fold.Partial s+            Fold.Done b -> do+                sendYieldToDriver chan b+                return $ Fold.Done True++    step1 st x = do+        r <- step st x+        case r of+            Fold.Partial s -> do+                b <- extract s+                void $ sendPartialToDriver chan b+                return $ Fold.Partial s+            Fold.Done b -> do+                sendYieldToDriver chan b+                return $ Fold.Done True++    extract1 _ = error "extract: not supported by folds"++    -- XXX Should we not discard the result?+    final1 st = do+        void (final st)+        return False++{-# INLINABLE newChannelWithScan #-}+{-# SPECIALIZE newChannelWithScan ::+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> (Config -> Config)+    -> Scanl IO a b+    -> IO (Channel IO a b, ThreadId) #-}+newChannelWithScan :: (MonadRunInIO m) =>+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> (Config -> Config)+    -> Scanl m a b+    -> m (Channel m a b, ThreadId)+newChannelWithScan outq outqDBell modifier f = do+    let config = modifier defaultConfig+    sv <- liftIO $ mkNewChannelWith outq outqDBell config+    mrun <- askRunInIO+    tid <- doForkWith+        (getBound config) (work sv) mrun (sendExceptionToDriver sv)+    return (sv, tid)++    where++    {-# NOINLINE work #-}+    work chan = do+        completed <- D.fold (scanToChannel chan f) (fromInputQueue chan)+        -- We check for only one item in the outputqueue, for example in+        -- parTeeWith, multiple messages can make that complicated. Therefore,+        -- we first check if we already sent a FoldDone.+        when (not completed) $ sendEOFToDriver chan+        liftIO $ writeIORef (closedForInput chan) True+        liftIO writeBarrier+        void $ liftIO $ tryPutMVar (inputSpaceDoorBell chan) ()++{-# INLINABLE newChannel #-}+{-# SPECIALIZE newChannel ::+    (Config -> Config) -> Fold IO a b -> IO (Channel IO a b) #-}+newChannel :: (MonadRunInIO m) =>+    (Config -> Config) -> Fold m a b -> m (Channel m a b)+newChannel modifier f = do+    outQRev <- liftIO $ newIORef ([], 0)+    outQMvRev <- liftIO newEmptyMVar+    fmap fst (newChannelWith outQRev outQMvRev modifier f)++{-# INLINABLE newScanChannel #-}+{-# SPECIALIZE newScanChannel ::+    (Config -> Config) -> Scanl IO a b -> IO (Channel IO a b) #-}+newScanChannel :: (MonadRunInIO m) =>+    (Config -> Config) -> Scanl m a b -> m (Channel m a b)+newScanChannel modifier f = do+    outQRev <- liftIO $ newIORef ([], 0)+    outQMvRev <- liftIO newEmptyMVar+    fmap fst (newChannelWithScan outQRev outQMvRev modifier f)++-------------------------------------------------------------------------------+-- Process events received by the driver thread from the fold worker side+-------------------------------------------------------------------------------++-- XXX currently only one event is sent by a fold consumer to the stream+-- producer. But we can potentially have multiple events e.g. the fold step can+-- generate exception more than once and the producer can ignore those+-- exceptions or handle them and still keep driving the fold.++-- XXX In case of scan this could be a stream.++-- | Poll for events sent by the fold worker to the fold driver. The fold+-- consumer can send a "Stop" event or an exception. When a "Stop" is received+-- this function returns 'True'. If an exception is recieved then it throws the+-- exception.+--+{-# NOINLINE checkFoldStatus #-}+checkFoldStatus :: MonadAsync m => Channel m a b -> m (Maybe b)+checkFoldStatus sv = do+    (list, _) <- liftIO $ readOutputQBasic (outputQueue sv)+    -- Reversing the output is important to guarantee that we process the+    -- outputs in the same order as they were generated by the constituent+    -- streams.+    processEvents $ reverse list++    where++    {-# INLINE processEvents #-}+    processEvents [] = return Nothing+    processEvents (ev : _) = do+        case ev of+            FoldException _ e -> throwM e+            FoldDone _ b -> return (Just b)+            FoldPartial _ ->+                error "checkFoldStatus: FoldPartial can occur only for scans"+            FoldEOF _ ->+                error "checkFoldStatus: FoldEOF can occur only for scans"++{-# INLINE isBufferAvailable #-}+isBufferAvailable :: MonadIO m => Channel m a b -> m Bool+isBufferAvailable sv = do+    let limit = maxInputBuffer sv+    case limit of+        Unlimited -> return True+        Limited lim -> do+            (_, n) <- liftIO $ readIORef (inputQueue sv)+            return $ fromIntegral lim > n++-- | Push values from a driver to a fold worker via a Channel. Blocks if no+-- space is available in the buffer. Before pushing a value to the Channel it+-- polls for events received from the fold worker.  If a stop event is received+-- then it returns 'True' otherwise false.  Propagates exceptions received from+-- the fold worker.+--+{-# INLINE sendToWorker #-}+sendToWorker :: MonadAsync m => Channel m a b -> a -> m (Maybe b)+sendToWorker chan a = go++    where++    -- Recursive function, should we use SPEC?+    go = do+        let qref = outputQueue chan+        status <- do+            (_, n) <- liftIO $ readIORef qref+            if n > 0+            then checkFoldStatus chan+            else return Nothing+        case status of+            Just _ -> return status+            Nothing -> do+                    r <- isBufferAvailable chan+                    if r+                    then do+                        liftIO+                            $ void+                            $ sendEvent+                                (inputQueue chan)+                                (inputItemDoorBell chan)+                                (ChildYield a)+                        return Nothing+                    else do+                        () <- liftIO $ takeMVar (inputSpaceDoorBell chan)+                        go++-- | Like sendToWorker but only sends, does not receive any events from the+-- fold.+{-# INLINE sendToWorker_ #-}+sendToWorker_ :: MonadAsync m => Channel m a b -> a -> m ()+sendToWorker_ chan a = go++    where++    -- Recursive function, should we use SPEC?+    go = do+        r <- isBufferAvailable chan+        if r+        then do+            liftIO+                $ void+                $ sendEvent+                    (inputQueue chan)+                    (inputItemDoorBell chan)+                    (ChildYield a)+        else do+            -- Block for space+            () <- liftIO $ takeMVar (inputSpaceDoorBell chan)+            closed <- liftIO $ readIORef (closedForInput chan)+            when (not closed) go++-- XXX Cleanup the fold if the stream is interrupted. Add a GC hook.++cleanup :: MonadIO m => Channel m a b -> m ()+cleanup chan = do+    when (svarInspectMode chan) $ liftIO $ do+        t <- getTime Monotonic+        writeIORef (svarStopTime (svarStats chan)) (Just t)+        printSVar (dumpChannel chan) "Scan channel done"++finalize :: MonadIO m => Channel m a b -> m ()+finalize chan = do+    liftIO $ void+        $ sendEvent+            (inputQueue chan)+            (inputItemDoorBell chan)+            ChildStopChannel
+ src/Streamly/Internal/Data/Fold/Concurrent.hs view
@@ -0,0 +1,593 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Concurrent+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- = Asynchronous Evaluation+--+-- Using 'parBuffered' a fold can be decoupled from the driver and evaluated+-- concurrently with the driver. The driver just pushes an element to the+-- fold's buffer and waits for async evaluation to finish.+--+-- Stages in a fold pipeline can be made concurrent using 'parBuffered'.+--+-- = Concurrent Fold Combinators+--+-- The 'demux' combinator can be made concurrent by using 'parBuffered' on the fold+-- returned by the fold-generating function. Thus, we can fold values for each+-- key in the input stream concurrently.+--+-- Similarly, we can use 'parBuffered' with other cobminators like 'toMap',+-- 'demuxToMap', 'classify', 'tee', 'distribute', 'partition' etc. Basically,+-- any combinator that composes multiple folds or multiple instances of a fold+-- is a good candidate for running folds concurrently.+--+-- = Finalization+--+-- Before a fold returns "done" it has to drain the child folds. For example,+-- consider a "take" operation on a `parBuffered` fold, the take should return as+-- soon as it has taken required number of elements but we have to ensure that+-- any asynchronous child folds finish before it returns. This is achieved by+-- calling the "final" operation of the fold.++-- = TODO+--+-- Use multiple worker folds to fold serial chunks of a stream and collect the+-- results using another fold, combine using a monoid. The results can be+-- collected out-of-order or in-order. This would be easier if each input+-- element is a streamable chunk and each fold consumes one chunk at a time.+-- This is like parConcatMap in streams.+--+-- Concurrent append: if one fold's buffer becomes full then use the next one+-- Concurrent interleave/partition: Round robin to n folds.+-- Concurrent distribute to multiple folds.++module Streamly.Internal.Data.Fold.Concurrent+    (+      parBuffered+    , parLmapM+    , parTeeWith+    , parTee+    , parDistribute+    , parPartition+    , parUnzipWithM+    , parUnzip+    , parDistributeScan+    , parDemuxScan++    -- Deprecated+    , parEval+    )+where++#include "inline.hs"+#include "deprecation.h"++import Control.Concurrent (newEmptyMVar, takeMVar, throwTo)+import Control.Monad.Catch (throwM)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (newIORef, readIORef)+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Channel.Worker (sendEvent)+import Streamly.Internal.Data.Fold (Fold(..), Step (..))+import Streamly.Internal.Data.Stream (Stream(..), Step(..))+import Streamly.Internal.Data.SVar.Type (adaptState)++import qualified Data.Map.Strict as Map+import qualified Streamly.Internal.Data.Fold as Fold++import Streamly.Internal.Data.Fold.Channel.Type+import Streamly.Internal.Data.Channel.Types++-- $setup+-- >>> :set -fno-warn-deprecations+-- >>> import Control.Concurrent (threadDelay)+-- >>> import qualified Streamly.Internal.Data.Stream as Stream+-- >>> import qualified Streamly.Internal.Data.Stream.Prelude as Stream+-- >>> import qualified Streamly.Internal.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Fold.Concurrent as Fold++-------------------------------------------------------------------------------+-- Evaluating a Fold+-------------------------------------------------------------------------------++-- | 'parBuffered' introduces a concurrent stage at the input of the fold. The+-- inputs are asynchronously queued in a buffer and evaluated concurrently with+-- the evaluation of the source stream. On finalization, 'parBuffered' waits for+-- the asynchronous fold to complete before it returns.+--+-- In the following example both the stream and the fold have a 1 second delay,+-- but the delay is not compounded because both run concurrently.+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+--+-- >>> src = Stream.delay 1 (Stream.enumerateFromTo 1 3)+-- >>> dst = Fold.parBuffered id (Fold.lmapM delay Fold.sum)+-- >>> Stream.fold dst src+-- ...+--+-- Another example:+--+-- >>> Stream.toList $ Stream.groupsOf 4 dst src+-- ...+--+{-# INLINABLE parBuffered #-}+parBuffered, parEval+    :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+parBuffered modifier f =+    Fold step initial extract final++    where++    -- XXX Supply an output channel to the fold. The fold would send the result+    -- from each step (i.e. scan result) to the channel. The Partial and Done+    -- constructors are sent to the channel. We then draw the resulting stream+    -- from that channel. Kind of concurrrent mapping on the stream but with a+    -- fold/scan.+    --+    -- There can also be a model where multiple folds pick input from the same+    -- channel.+    --+    -- We can also run parsers this way. So instead of sending output on each+    -- step it can send once it is done.+    initial = Partial <$> newChannel modifier f++    -- XXX This is not truly asynchronous. If the fold is done we only get to+    -- know when we send the next input unless the stream ends. We could+    -- potentially throw an async exception to the driver to inform it+    -- asynchronously. Alternatively, the stream should not block forever, it+    -- should keep polling the fold status. We can insert a timer tick in the+    -- input stream to do that.+    --+    -- A polled stream abstraction may be useful, it would consist of normal+    -- events and tick events, latter are guaranteed to arrive.+    --+    -- XXX We can use the config to indicate if the fold is a scanning type or+    -- one-shot, or use a separate parBufferedScan for scanning. For a scanning+    -- type fold the worker would always send the intermediate values back to+    -- the driver. An intermediate value can be returned on an input, or the+    -- driver can poll even without input, if we have the Skip input support.+    -- When the buffer is full we can return "Skip" and then the next step+    -- without input can wait for an output to arrive. Similarly, when "final"+    -- is called it can return "Skip" to continue or "Done" to indicate+    -- termination.+    step chan a = do+        status <- sendToWorker chan a+        return $ case status of+            Nothing -> Partial chan+            Just b -> Done b++    extract _ = error "Concurrent folds do not support scanning"++    -- XXX depending on the use case we may want to either wait for the result+    -- or cancel the ongoing work. We can use the config to control that?+    -- Currently it waits for the work to complete.+    final chan = do+        liftIO $ void+            $ sendEvent+                (inputQueue chan)+                (inputItemDoorBell chan)+                ChildStopChannel+        status <- checkFoldStatus chan+        case status of+            Nothing -> do+                liftIO+                    $ withDiagMVar+                        (svarInspectMode chan)+                        (dumpChannel chan)+                        "parBuffered: waiting to drain"+                    $ takeMVar (outputDoorBell chan)+                -- XXX remove recursion+                final chan+            Just b -> do+                cleanup chan+                return b+RENAME(parEval,parBuffered)++-- XXX We can have a lconcatMap (unfoldMany) to expand the chunks in the input+-- to streams before folding. This will require an input Skip constructor. In+-- fact, parLmapM can be implemented in terms of this like in streams.++-- | Evaluate the mapped actions concurrently with respect to each other. The+-- results may be unordered or ordered depending on the configuration.+--+-- /Unimplemented/+{-# INLINABLE parLmapM #-}+parLmapM :: -- MonadAsync m =>+    (Config -> Config) -> (a -> m b) -> Fold m b r -> Fold m a r+parLmapM = undefined++-- | Execute both the folds in a tee concurrently.+--+-- Definition:+--+-- >>> parTeeWith cfg f c1 c2 = Fold.teeWith f (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.length+-- >>> dst = Fold.parTeeWith id (,) c1 c2+-- >>> Stream.fold dst src+-- ...+--+{-# INLINABLE parTeeWith #-}+parTeeWith :: MonadAsync m =>+       (Config -> Config)+    -> (a -> b -> c)+    -> Fold m x a+    -> Fold m x b+    -> Fold m x c+parTeeWith cfg f c1 c2 = Fold.teeWith f (parBuffered cfg c1) (parBuffered cfg c2)++-- | Execute both the folds in a tee concurrently.+--+-- Definition:+--+-- >>> parTee cfg c1 c2 = Fold.teeWith (,) (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.length+-- >>> dst = Fold.parTee id c1 c2+-- >>> Stream.fold dst src+-- ...+--+{-# INLINABLE parTee #-}+parTee :: MonadAsync m =>+       (Config -> Config)+    -> Fold m x a+    -> Fold m x b+    -> Fold m x (a, b)+parTee cfg c1 c2 = Fold.teeWith (,) (parBuffered cfg c1) (parBuffered cfg c2)++-- | Distribute the input to all the folds in the supplied list concurrently.+--+-- Definition:+--+-- >>> parDistribute cfg = Fold.distribute . fmap (Fold.parBuffered cfg)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c = Fold.lmapM delay Fold.sum+-- >>> dst = Fold.parDistribute id [c,c,c]+-- >>> Stream.fold dst src+-- ...+--+{-# INLINABLE parDistribute #-}+parDistribute :: MonadAsync m =>+    (Config -> Config) -> [Fold m a b] -> Fold m a [b]+parDistribute cfg = Fold.distribute . fmap (parBuffered cfg)++-- | Select first fold for Left input and second for Right input. Both folds+-- run concurrently.+--+-- Definition+--+-- >>> parPartition cfg c1 c2 = Fold.partition (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.sum+-- >>> dst = Fold.parPartition id c1 c2+-- >>> Stream.fold dst $ (fmap (\x -> if even x then Left x else Right x)) src+-- ...+--+{-# INLINABLE parPartition #-}+parPartition :: MonadAsync m =>+    (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)+parPartition cfg c1 c2 = Fold.partition (parBuffered cfg c1) (parBuffered cfg c2)++-- | Split and distribute the output to two different folds and then zip the+-- results. Both the consumer folds run concurrently.+--+-- Definition+--+-- >>> parUnzipWithM cfg f c1 c2 = Fold.unzipWithM f (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.sum+-- >>> dst = Fold.parUnzipWithM id (pure . id) c1 c2+-- >>> Stream.fold dst $ (fmap (\x -> (x, x* x))) src+-- ...+--+{-# INLINABLE parUnzipWithM #-}+parUnzipWithM :: MonadAsync m+    => (Config -> Config) -> (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)+parUnzipWithM cfg f c1 c2 = Fold.unzipWithM f (parBuffered cfg c1) (parBuffered cfg c2)++-- | Split and distribute the output to two different folds and then zip the+-- results. Both the consumer folds run concurrently.+--+-- Definition+--+-- >>> parUnzip cfg c1 c2 = Fold.unzip (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.sum+-- >>> dst = Fold.parUnzip id c1 c2+-- >>> Stream.fold dst $ (fmap (\x -> (x, x * x))) src+-- ...+--+{-# INLINABLE parUnzip #-}+parUnzip :: MonadAsync m+    => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (b,c) (x,y)+parUnzip cfg c1 c2 = Fold.unzip (parBuffered cfg c1) (parBuffered cfg c2)++-- There are two ways to implement a concurrent scan.+--+-- 1. Make the scan itself asynchronous, add the input to the queue, and then+-- extract the output. Extraction will have to be asynchronous, which will+-- require changes to the scan driver. This will require a different Scanl+-- type.+--+-- 2. A monolithic implementation of concurrent Stream->Stream scan, using a+-- custom implementation of the scan and the driver.++{-# ANN type ScanState Fuse #-}+data ScanState s q db f =+      ScanInit+    | ScanGo s q db [f]+    | ScanDrain q db [f]+    | ScanStop++-- XXX return [b] or just b?+-- XXX We can use a one way mailbox type abstraction instead of using an IORef+-- for adding new folds dynamically.++-- | Evaluate a stream and send its outputs to zero or more dynamically+-- generated folds. It checks for any new folds at each input generation step.+-- Any new fold is added to the list of folds which are currently running. If+-- there are no folds available, the input is discarded. If a fold completes+-- its output is emitted in the output of the scan.+--+-- >>> import Data.IORef+-- >>> ref <- newIORef [Fold.take 2 Fold.sum, Fold.take 2 Fold.length :: Fold.Fold IO Int Int]+-- >>> gen = atomicModifyIORef ref (\xs -> ([], xs))+-- >>> Stream.toList $ Fold.parDistributeScan id gen (Stream.enumerateFromTo 1 10)+-- ...+--+{-# INLINE parDistributeScan #-}+parDistributeScan :: MonadAsync m =>+    (Config -> Config) -> m [Fold m a b] -> Stream m a -> Stream m [b]+parDistributeScan cfg getFolds (Stream sstep state) =+    Stream step ScanInit++    where++    -- XXX can be written as a fold+    processOutputs chans events done = do+        case events of+            [] -> return (chans, done)+            (x:xs) ->+                case x of+                    FoldException _tid ex -> do+                        -- XXX report the fold that threw the exception+                        liftIO $ mapM_ (`throwTo` ThreadAbort) (fmap snd chans)+                        mapM_ cleanup (fmap fst chans)+                        liftIO $ throwM ex+                    FoldDone tid b ->+                        let ch = filter (\(_, t) -> t /= tid) chans+                         in processOutputs ch xs (b:done)+                    FoldPartial _ ->+                        error "parDistributeScan: cannot occur for folds"+                    FoldEOF _ ->+                        error+                            "parDistributeScan: FoldEOF cannot occur for folds"++    collectOutputs qref chans = do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then do+            r <- fmap fst $ liftIO $ readOutputQBasic qref+            processOutputs chans r []+        else return (chans, [])++    step _ ScanInit = do+        q <- liftIO $ newIORef ([], 0)+        db <- liftIO newEmptyMVar+        return $ Skip (ScanGo state q db [])++    step gst (ScanGo st q db chans) = do+        -- merge any new channels added since last input+        fxs <- getFolds+        newChans <- Prelude.mapM (newChannelWith q db cfg) fxs+        let allChans = chans ++ newChans++        -- Collect outputs from running channels+        (running, outputs) <- collectOutputs q allChans++        -- Send input to running folds+        res <- sstep (adaptState gst) st+        next <- case res of+            Yield x s -> do+                -- XXX We might block forever if some folds are already+                -- done but we have not read the output queue yet. To+                -- avoid that we have to either (1) precheck if space+                -- is available in the input queues of all folds so+                -- that this does not block, or (2) we have to use a+                -- non-blocking read and track progress so that we can+                -- restart from where we left.+                --+                -- If there is no space available then we should block+                -- on doorbell db or inputSpaceDoorBell of the relevant+                -- channel. To avoid deadlock the output space can be+                -- kept unlimited. However, the blocking will delay the+                -- processing of outputs. We should yield the outputs+                -- before blocking.+                Prelude.mapM_ (`sendToWorker_` x) (fmap fst running)+                return $ ScanGo s q db running+            Skip s -> do+                return $ ScanGo s q db running+            Stop -> do+                Prelude.mapM_ finalize (fmap fst running)+                return $ ScanDrain q db running+        if null outputs+        then return $ Skip next+        else return $ Yield outputs next+    step _ (ScanDrain q db chans) = do+        (running, outputs) <- collectOutputs q chans+        case running of+            [] -> return $ Yield outputs ScanStop+            _ -> do+                if null outputs+                then do+                    liftIO $ takeMVar db+                    return $ Skip (ScanDrain q db running)+                else return $ Yield outputs (ScanDrain q db running)+    step _ ScanStop = return Stop++{-# ANN type DemuxState Fuse #-}+data DemuxState s q db f =+      DemuxInit+    | DemuxGo s q db f+    | DemuxDrain q db f+    | DemuxStop++-- XXX We need to either (1) remember a key when done so that we do not add the+-- fold again because some inputs would be lost in between, or (2) have a+-- FoldYield constructor to yield repeatedly so that we can restart the+-- existing fold itself when it is done. But in that case we cannot change the+-- fold once it is started. Also the Map would keep on increasing in size as we+-- never delete a key. Whatever we do we should keep the non-concurrent fold as+-- well consistent with that.++-- | Evaluate a stream and send its outputs to the selected fold. The fold is+-- dynamically selected using a key at the time of the first input seen for+-- that key. Any new fold is added to the list of folds which are currently+-- running. If there are no folds available for a given key, the input is+-- discarded. If a fold completes its output is emitted in the output of the+-- scan.+--+-- >>> import qualified Data.Map.Strict as Map+-- >>> import Data.Maybe (fromJust)+-- >>> f1 = ("even", Fold.take 2 Fold.sum)+-- >>> f2 = ("odd", Fold.take 2 Fold.sum)+-- >>> kv = Map.fromList [f1, f2]+-- >>> getFold k = return (fromJust $ Map.lookup k kv)+-- >>> getKey x = if even x then "even" else "odd"+-- >>> input = Stream.enumerateFromTo 1 10+-- >>> Stream.toList $ Fold.parDemuxScan id getKey getFold input+-- ...+--+{-# INLINE parDemuxScan #-}+parDemuxScan :: (MonadAsync m, Ord k) =>+       (Config -> Config)+    -> (a -> k)+    -> (k -> m (Fold m a b))+    -> Stream m a+    -> Stream m [(k, b)]+parDemuxScan cfg getKey getFold (Stream sstep state) =+    Stream step DemuxInit++    where++    -- XXX can be written as a fold+    processOutputs keyToChan events done = do+        case events of+            [] -> return (keyToChan, done)+            (x:xs) ->+                case x of+                    FoldException _tid ex -> do+                        -- XXX report the fold that threw the exception+                        let chans = fmap snd $ Map.toList keyToChan+                        liftIO $ mapM_ (`throwTo` ThreadAbort) (fmap snd chans)+                        mapM_ cleanup (fmap fst chans)+                        liftIO $ throwM ex+                    FoldDone _tid o@(k, _) ->+                        let ch = Map.delete k keyToChan+                         in processOutputs ch xs (o:done)+                    FoldPartial _ ->+                        error "parDemuxScan: cannot occur for folds"+                    FoldEOF _ ->+                        error "parDemuxScan: FoldEOF cannot occur for folds"++    collectOutputs qref keyToChan = do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then do+            r <- fmap fst $ liftIO $ readOutputQBasic qref+            processOutputs keyToChan r []+        else return (keyToChan, [])++    step _ DemuxInit = do+        q <- liftIO $ newIORef ([], 0)+        db <- liftIO newEmptyMVar+        return $ Skip (DemuxGo state q db Map.empty)++    step gst (DemuxGo st q db keyToChan) = do+        -- Collect outputs from running channels+        (keyToChan1, outputs) <- collectOutputs q keyToChan++        -- Send input to the selected fold+        res <- sstep (adaptState gst) st++        next <- case res of+            Yield x s -> do+                -- XXX If the fold for a particular key is done and we see that+                -- key again. If we have not yet collected the done event we+                -- cannot restart the fold because the previous key is already+                -- installed. Thererfore, restarting the fold for the same key+                -- fraught with races.+                let k = getKey x+                (keyToChan2, ch) <-+                    case Map.lookup k keyToChan1 of+                        Nothing -> do+                            fld <- getFold k+                            r@(chan, _) <- newChannelWith q db cfg (fmap (k,) fld)+                            return (Map.insert k r keyToChan1, chan)+                        Just (chan, _) -> return (keyToChan1, chan)+                -- XXX We might block forever if some folds are already+                -- done but we have not read the output queue yet. To+                -- avoid that we have to either (1) precheck if space+                -- is available in the input queues of all folds so+                -- that this does not block, or (2) we have to use a+                -- non-blocking read and track progress so that we can+                -- restart from where we left.+                --+                -- If there is no space available then we should block+                -- on doorbell db or inputSpaceDoorBell of the relevant+                -- channel. To avoid deadlock the output space can be+                -- kept unlimited. However, the blocking will delay the+                -- processing of outputs. We should yield the outputs+                -- before blocking.+                sendToWorker_ ch x+                return $ DemuxGo s q db keyToChan2+            Skip s ->+                return $ DemuxGo s q db keyToChan1+            Stop -> do+                let chans = fmap (fst . snd) $ Map.toList keyToChan1+                Prelude.mapM_ finalize chans+                return $ DemuxDrain q db keyToChan1+        if null outputs+        then return $ Skip next+        else return $ Yield outputs next+    step _ (DemuxDrain q db keyToChan) = do+        (keyToChan1, outputs) <- collectOutputs q keyToChan+        if Map.null keyToChan1+        -- XXX null outputs case+        then return $ Yield outputs DemuxStop+        else do+            if null outputs+            then do+                liftIO $ takeMVar db+                return $ Skip (DemuxDrain q db keyToChan1)+            else return $ Yield outputs (DemuxDrain q db keyToChan1)+    step _ DemuxStop = return Stop
+ src/Streamly/Internal/Data/Fold/Prelude.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Fold.Prelude+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Fold.Prelude+    (+    -- * Channel+      module Streamly.Internal.Data.Fold.Channel+    -- * Concurrency+    , module Streamly.Internal.Data.Fold.Concurrent+    -- * Time+    , module Streamly.Internal.Data.Fold.Time+    -- * Deprecated+    , module Streamly.Internal.Data.Fold.SVar+    )+where++import Streamly.Internal.Data.Fold.Channel+import Streamly.Internal.Data.Fold.Concurrent+import Streamly.Internal.Data.Fold.SVar+import Streamly.Internal.Data.Fold.Time
src/Streamly/Internal/Data/Fold/SVar.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module      : Streamly.Internal.Data.Fold.SVar -- Copyright   : (c) 2017 Composewell Technologies@@ -8,6 +9,7 @@ -- -- module Streamly.Internal.Data.Fold.SVar+    {-# DEPRECATED "The functionality is moved to Fold.Concurrent" #-}     (       write     , writeLimited@@ -18,9 +20,9 @@  import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(liftIO))-import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Fold (Fold(..)) -import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Fold as FL (Step(Done, Partial))  import Streamly.Internal.Data.SVar @@ -33,7 +35,7 @@ -- {-# INLINE write #-} write :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()-write svar winfo = Fold step initial extract+write svar winfo = Fold step initial return final      where @@ -47,14 +49,14 @@             void $ send svar (ChildYield x)             return $ FL.Partial () -    extract () = liftIO $ sendStop svar winfo+    final () = liftIO $ sendStop svar winfo  -- | Like write, but applies a yield limit. -- {-# INLINE writeLimited #-} writeLimited :: MonadIO m     => SVar t m a -> Maybe WorkerInfo -> Fold m a ()-writeLimited svar winfo = Fold step initial extract+writeLimited svar winfo = Fold step initial (const (return ())) final      where @@ -74,5 +76,5 @@                 return $ FL.Done ()     step False _ = return $ FL.Done () -    extract True = liftIO $ sendStop svar winfo-    extract False = return ()+    final True = liftIO $ sendStop svar winfo+    final False = return ()
− src/Streamly/Internal/Data/Fold/Step.hs 
@@ -1,83 +0,0 @@--- |--- 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 
@@ -1,157 +0,0 @@--- |--- 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(..)-    )-where--import Control.Applicative (liftA2)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif-import Streamly.Internal.Data.Fold.Type (Fold)--import qualified Streamly.Internal.Data.Fold.Type as Fold---- | @Tee@ is a newtype wrapper over the 'Fold' type providing distributing--- 'Applicative', 'Semigroup', 'Monoid', 'Num', 'Floating' and 'Fractional'--- instances.------ @since 0.8.0-newtype Tee m a b =-    Tee { toFold :: Fold m a b }-    deriving (Functor)---- | '<*>' 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 ($) (toFold a) (toFold 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/Time.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Fold.Time+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Fold.Time+    (+      takeInterval+    , intervalsOf+    )+where++import Control.Concurrent (threadDelay, forkIO, killThread)+import Control.Concurrent.MVar (MVar, newMVar, swapMVar, readMVar)+import Control.Exception (SomeException(..), catch, mask)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(..))+import Streamly.Data.Fold (many)+import Streamly.Internal.Data.Fold (Fold(..), Step (..))+import Streamly.Internal.Control.Concurrent (MonadAsync, withRunInIO)+import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))++#include "DocTestDataFold.hs"++-- XXX We can use asyncClock here. A parser can be used to return an input that+-- arrives after the timeout.+-- XXX If n is 0 return immediately in initial.+-- XXX we should probably discard the input received after the timeout like+-- takeEndBy_.++-- XXX The foldMany doctest is important for consistency with the "many" fold,+-- and intervalsOf. We should put it in tests.++-- | @takeInterval n fold@ uses @fold@ to fold the input items arriving within+-- a window of first @n@ seconds.+--+-- >>> input = Stream.delay 0.2 $ Stream.fromList [1..10]+-- >>> Stream.fold (Fold.takeInterval 1.0 Fold.toList) input+-- [1,2,3,4,5,6]+--+-- >>> f = Fold.takeInterval 0.5 Fold.toList+-- >>> Stream.fold Fold.toList $ Stream.foldMany f input+-- [[1,2,3,4],[5,6,7],[8,9,10]]+--+-- Stops when @fold@ stops or when the timeout occurs. Note that the fold needs+-- an input after the timeout to stop. For example, if no input is pushed to+-- the fold until one hour after the timeout had occurred, then the fold will+-- be done only after consuming that input.+--+-- /Pre-release/+--+{-# INLINE takeInterval #-}+takeInterval :: MonadAsync m => Double -> Fold m a b -> Fold m a b+takeInterval n (Fold step initial done final) =+    Fold step' initial' done' final'++    where++    initial' = do+        res <- initial+        case res of+            Partial s -> do+                mv <- liftIO $ newMVar False+                t <-+                    withRunInIO $ \run ->+                        mask $ \restore -> do+                            tid <-+                                forkIO+                                  $ catch+                                        (restore $ void $ run (timerThread mv))+                                        (handleChildException mv)+                            run (return tid)+                return $ Partial $ Tuple3' s mv t+            Done b -> return $ Done b++    step' (Tuple3' s mv t) a = do+        val <- liftIO $ readMVar mv+        if val+        then do+            res <- step s a+            case res of+                Partial sres -> Done <$> final sres+                Done bres -> return $ Done bres+        else do+            res <- step s a+            case res of+                Partial fs -> return $ Partial $ Tuple3' fs mv t+                Done b -> liftIO (killThread t) >> return (Done b)++    done' (Tuple3' s _ _) = done s++    final' (Tuple3' s _ _) = final s++    timerThread mv = do+        liftIO $ threadDelay (round $ n * 1000000)+        -- Use IORef + CAS? instead of MVar since its a Bool?+        liftIO $ void $ swapMVar mv True++    handleChildException :: MVar Bool -> SomeException -> IO ()+    handleChildException mv _ = void $ swapMVar mv True++-- For example, we can copy and distribute a stream to multiple folds where+-- each fold can group the input differently e.g. by one second, one minute and+-- one hour windows respectively and fold each resulting stream of folds.++-- XXX This needs to be fixed like intervalsOf in Data.Stream.Time.++-- | Group the input stream into windows of n second each using the first fold+-- and then fold the resulting groups using the second fold.+--+-- >>> intervals = Fold.intervalsOf 0.5 Fold.toList Fold.toList+-- >>> Stream.fold intervals $ Stream.delay 0.2 $ Stream.fromList [1..10]+-- [[1,2,3,4],[5,6,7],[8,9,10]]+--+-- > intervalsOf n split = many (takeInterval n split)+--+-- /Pre-release/+--+{-# INLINE intervalsOf #-}+intervalsOf :: MonadAsync m => Double -> Fold m a b -> Fold m b c -> Fold m a c+intervalsOf n split = many (takeInterval n split)
− src/Streamly/Internal/Data/Fold/Type.hs 
@@ -1,1415 +0,0 @@--- |--- 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------ These are the simplest folds that never fail and never terminate, they--- accumulate the input values forever and can always accept new inputs (never--- terminate) and always have a valid result value.  A--- 'Streamly.Internal.Data.Fold.sum' operation is an example of an accumulator.--- Traditional Haskell left folds like 'foldl' are accumulators.------ We can distribute an input stream to two or more accumulators using a @tee@--- style composition.  Accumulators cannot be applied on a stream one after the--- other, which we call a @serial@ append style composition of folds. This is--- because accumulators never terminate, since the first accumulator in a--- series will never terminate, the next one will never get to run.------ == Terminating Folds------ Terminating folds are accumulators that can terminate. Once a fold--- terminates it no longer accepts any more inputs.  Terminating folds can be--- used in a @serial@ append style composition where one fold can be applied--- after the other on an input stream. We can apply a terminating fold--- repeatedly on an input stream, splitting the stream and consuming it in--- fragments.  Terminating folds never fail, therefore, 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 split and process the stream into--- chunks of fixed size.------ == Terminating Folds with Leftovers------ The next upgrade after terminating folds is terminating folds with leftover--- inputs.  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 unconsumed input to the fold driver.------ Single element leftover case is the most common and its easy to implement it--- in terminating folds using 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 'many' combinator  requires--- a @Partial1@ ('Partial' with leftover) to handle a @Done1@ from the top--- level fold, for efficient implementation.  If the collecting fold in "many"--- returns a @Partial1@ or @Done1@ then what to do with all the elements that--- have been consumed?------ Similarly, in distribute, if one fold consumes a value and others say its a--- leftover then what do we do?  Folds like "many" require the leftover to be--- fed to it again. So in a distribute operation those folds which gave a--- leftover will have to be fed the leftover while the folds that consumed will--- have to be fed the next input.  This is very complicated to implement. We--- have the same issue in backtracking parsers being used in a distribute--- operation.------ To avoid these issues we want to enforce by typing that the collecting folds--- can never return a leftover. So we need a fold type without @Done1@ or--- @Partial1@. This leads us to design folds to never return a leftover and the--- use cases of single leftover are 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.--- "take 0" can implemented as a fold if we make initial return @Step@ type.--- "takeInterval" can be implemented without @Done1@.------ == 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.------ = Types for Stream Consumers------ In streamly, there is no 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 @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.------ = Accumulators and Terminating Folds------ Folds in this module can be classified in two categories viz. accumulators--- and terminating folds. Accumulators do not have a terminating condition,--- they run forever and consume the entire stream, for example the 'length'--- fold. Terminating folds have a terminating condition and can terminate--- without consuming the entire stream, for example, the 'head' fold.------ = 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.------ = Performance Notes------ 'Streamly.Prelude' module provides fold functions to directly fold streams--- e.g.  Streamly.Prelude/'Streamly.Prelude.sum' serves the same purpose as--- Fold/'sum'.  However, the functions in Streamly.Prelude cannot be--- efficiently combined together e.g. we cannot drive the input stream through--- @sum@ and @length@ fold functions simultaneously.  Using the 'Fold' type we--- can efficiently split the stream across multiple folds because it allows the--- compiler to perform stream fusion optimizations.----module Streamly.Internal.Data.Fold.Type-    (-    -- * Types-      Step (..)-    , Fold (..)--    -- * Constructors-    , foldl'-    , foldlM'-    , foldl1'-    , foldr-    , foldrM-    , mkFold-    , mkFold_-    , mkFoldM-    , mkFoldM_--    -- * Folds-    , fromPure-    , fromEffect-    , fromRefold-    , drain-    , toList-    , toStreamK-    , toStreamKRev--    -- * Combinators--    -- ** Mapping output-    , rmapM--    -- ** Mapping Input-    , lmap-    , lmapM--    -- ** Filtering-    , filter-    , filterM-    , catMaybes--    -- ** Trimming-    , take--    -- ** Serial Append-    , serialWith -- rename to "append"-    , serial_--    -- ** Parallel Distribution-    , teeWith-    , teeWithFst-    , teeWithMin--    -- ** Parallel Alternative-    , shortest-    , longest--    -- ** Splitting-    , ManyState-    , many-    , manyPost-    , chunksOf-    , refoldMany-    , refoldMany1-    , refold--    -- ** Nesting-    , concatMap--    -- * Running A Fold-    , initialize-    , snoc-    , duplicate-    , finish-    )-where--import Control.Monad ((>=>))-import Data.Bifunctor (Bifunctor(..))-import Data.Maybe (isJust, fromJust)-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)---- $setup--- >>> :m--- >>> :set -XFlexibleContexts--- >>> import Streamly.Data.Fold (Fold)--- >>> import Prelude hiding (concatMap, filter, map)--- >>> import Streamly.Prelude (SerialT)--- >>> import qualified Data.Foldable as Foldable--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold--- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream--- >>> import qualified Streamly.Internal.Data.Stream.StreamK as StreamK----------------------------------------------------------------------------------- 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 exposed via exposed modules, smart--- constructors are provided to create folds.  If you think you need the--- constructor of this type please consider using the smart constructors in--- "Streamly.Internal.Data.Fold" instead.------ /since 0.8.0 (type changed)/------ @since 0.7.0--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.------ @since 0.8.0-{-# 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)--- @------ See also: @Streamly.Prelude.foldl'@------ @since 0.8.0----{-# 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)--- @------ See also: @Streamly.Prelude.foldlM'@------ @since 0.8.0----{-# 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.------ See also: @Streamly.Prelude.foldl1'@------ /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----------------------------------------------------------------------------------- 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 this is strict fold, it can only be useful for constructing strict--- structures in memory. For reductions this will be very inefficient.------ For example,------ > toList = foldr (:) []------ See also: 'Streamly.Prelude.foldr'------ @since 0.8.0-{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b-foldr g z = fmap ($ z) $ foldl' (\f x -> f . g x) id---- 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.------ For example,------ > toList = foldrM (\a xs -> return $ a : xs) (return [])------ See also: 'Streamly.Prelude.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 mkFold #-}-mkFold :: Monad m => (s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b-mkFold step initial extract =-    Fold (\s a -> return $ step s a) (return initial) (return . extract)---- | Similar to 'mkFold' but the final state extracted is identical to the--- intermediate state.------ @--- mkFold_ step initial = mkFold step initial id--- @------ /Pre-release/----{-# INLINE mkFold_ #-}-mkFold_ :: Monad m => (b -> a -> Step b b) -> Step b b -> Fold m a b-mkFold_ step initial = mkFold step initial id---- | Make a terminating fold with an effectful step function and initial state,--- and a state extraction function.------ > mkFoldM = Fold------  We can just use 'Fold' but it is provided for completeness.------ /Pre-release/----{-# INLINE mkFoldM #-}-mkFoldM :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b-mkFoldM = Fold---- | Similar to 'mkFoldM' but the final state extracted is identical to the--- intermediate state.------ @--- mkFoldM_ step initial = mkFoldM step initial return--- @------ /Pre-release/----{-# INLINE mkFoldM_ #-}-mkFoldM_ :: Monad m => (b -> a -> m (Step b b)) -> m (Step b b) -> Fold m a b-mkFoldM_ step initial = mkFoldM step initial return----------------------------------------------------------------------------------- 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 = drainBy (const (return ()))------ @since 0.7.0-{-# 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.Foreign"--- instead.------ > toList = foldr (:) []------ @since 0.7.0-{-# 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.Stream 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.Stream 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)---- This is the dual of stream "fromPure".------ | A fold that always yields a pure value without consuming any input.------ /Pre-release/----{-# INLINE fromPure #-}-fromPure :: Applicative m => b -> Fold m a b-fromPure b = Fold undefined (pure $ Done b) pure---- This is the dual of stream "fromEffect".------ | A fold that always yields the result of an effectful action without--- consuming any 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.------ >>> f = Fold.serialWith (,) (Fold.take 8 Fold.toList) (Fold.takeEndBy (== '\n') Fold.toList)--- >>> Stream.fold f $ Stream.fromList "header: hello\n"--- ("header: ","hello\n")------ Note: This is dual to appending streams using 'Streamly.Prelude.serial'.------ 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.------ /Time: O(n^2) where n is the number of compositions./------ @since 0.8.0----{-# INLINE serialWith #-}-serialWith :: Monad m =>-    (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-serialWith 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--{-# 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 serialWith, but the current benchmarks show that it has the same--- performance. So do not expose it unless some benchmark shows benefit.----{-# INLINE serial_ #-}-serial_ :: Monad m => Fold m x a -> Fold m x b -> Fold m x b-serial_ (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--{-# 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@.------ >>> avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)--- >>> Stream.fold avg $ Stream.fromList [1.0..100.0]--- 50.5------ > teeWith k f1 f2 = fmap (uncurry k) ((Fold.tee f1 f2)------ For applicative composition using this combinator see--- "Streamly.Internal.Data.Fold.Tee".------ See also: "Streamly.Internal.Data.Fold.Tee"------ @since 0.8.0----{-# 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)---- Compare with foldIterate.------ | 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.head--- >>> total n = Fold.take n Fold.sum--- >>> Stream.fold (Fold.concatMap total count) $ Stream.fromList [10,9..1]--- 45------ /Time: O(n^2) where @n@ is the number of compositions./------ See also: 'Streamly.Internal.Data.Stream.IsStream.foldIterateM'------ @since 0.8.0----{-# 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.------ >>> Stream.fold (Fold.lmap (\x -> x * x) Fold.sum) (Stream.enumerateFromTo 1 100)--- 338350------ > lmap = Fold.lmapM return------ @since 0.8.0-{-# 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.------ @since 0.8.0-{-# 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----------------------------------------------------------------------------------- Filtering----------------------------------------------------------------------------------- | Include only those elements that pass a predicate.------ >>> Stream.fold (Fold.filter (> 5) Fold.sum) $ Stream.fromList [1..10]--- 40------ > filter f = Fold.filterM (return . f)------ @since 0.8.0-{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r-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.------ @since 0.8.0-{-# 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---- | Modify a fold to receive a 'Maybe' input, the 'Just' values are unwrapped--- and sent to the original fold, 'Nothing' values are discarded.------ @since 0.8.0-{-# INLINE catMaybes #-}-catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b-catMaybes = filter isJust . lmap fromJust----------------------------------------------------------------------------------- Parsing----------------------------------------------------------------------------------- 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.------ >>> Stream.fold (Fold.take 2 Fold.toList) $ Stream.fromList [1..10]--- [1,2]------ @since 0.8.0-{-# INLINE take #-}-take :: Monad m => Int -> Fold m a b -> Fold m a b-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----------------------------------------------------------------------------------- | '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.------ We can append a stream to a fold as follows:------ >>> :{--- foldAppend :: Monad m => Fold m a b -> SerialT m a -> m (Fold m a b)--- foldAppend f = Stream.fold (Fold.duplicate f)--- :}------ >>> :{--- do---  sum1 <- foldAppend Fold.sum (Stream.enumerateFromTo 1 10)---  sum2 <- foldAppend sum1 (Stream.enumerateFromTo 11 20)---  Stream.fold sum2 (Stream.enumerateFromTo 21 30)--- :}--- 465------ '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---- | Run the initialization effect of a fold. The returned fold would use the--- value returned by this effect as its initial value.------ /Pre-release/-{-# INLINE initialize #-}-initialize :: Monad m => Fold m a b -> m (Fold m a b)-initialize (Fold step initial extract) = do-    i <- initial-    return $ Fold step (return i) extract---- | Append a singleton value to the fold.------ >>> import qualified Data.Foldable as Foldable--- >>> Foldable.foldlM Fold.snoc Fold.toList [1..3] >>= Fold.finish--- [1,2,3]------ Compare with 'duplicate' which allows appending a stream to the fold.------ /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---- | Finish the fold to extract the current value of the fold.------ >>> Fold.finish Fold.toList--- []------ /Pre-release/-{-# INLINE finish #-}-finish :: Monad m => Fold m a b -> m b-finish (Fold _ initial extract) = do-    res <- initial-    case res of-          Partial fs -> extract fs-          Done b -> return b----------------------------------------------------------------------------------- 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 split collect@ applies--- the @split@ fold repeatedly on the input stream and accumulates zero or more--- fold results using @collect@.------ >>> 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 @collect@ stops.------ See also: 'Streamly.Prelude.concatMap', 'Streamly.Prelude.foldMany'------ @since 0.8.0----{-# 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 inner fold emits an output at the end even if no input is--- received.------ /Internal/------ /See also: 'Streamly.Prelude.concatMap', 'Streamly.Prelude.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---- | @chunksOf 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.------ >>> twos = Fold.chunksOf 2 Fold.toList Fold.toList--- >>> Stream.fold twos $ Stream.fromList [1..10]--- [[1,2],[3,4],[5,6],[7,8],[9,10]]------ > chunksOf n split = many (take n split)------ Stops when @collect@ stops.------ @since 0.8.0----{-# INLINE chunksOf #-}-chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c-chunksOf 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'.------ /Internal/-{-# INLINE refold #-}-refold :: Monad m => Fold m a b -> Refold m b a b -> Fold m a b-refold f (Refold step inject extract) = Fold step (finish f >>= inject) extract
− src/Streamly/Internal/Data/IOFinalizer.hs 
@@ -1,102 +0,0 @@--- |--- 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)-import Streamly.Internal.Control.Concurrent (MonadRunInIO, askRunInIO, runInIO, withRunInIO)---- | 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 ())))---- | Make a finalizer from a monadic action @m a@ that can run in IO monad.-mkIOFinalizer :: MonadRunInIO m => m b -> m (IO ())-mkIOFinalizer f = do-    mrun <- askRunInIO-    return $-        void $ do-            _ <- runInIO mrun f-            return ()---- | 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 :: MonadRunInIO m => m a -> m IOFinalizer-newIOFinalizer finalizer = do-    f <- mkIOFinalizer finalizer-    ref <- liftIO $ newIORef $ Just f-    _ <- liftIO $ 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 :: MonadRunInIO m => IOFinalizer -> m a -> m a-clearingIOFinalizer (IOFinalizer ref) action = do-    withRunInIO $ \runinio ->-        mask_ $ do-            writeIORef ref Nothing-            runinio action
+ src/Streamly/Internal/Data/IOFinalizer/Lifted.hs view
@@ -0,0 +1,74 @@+-- |+-- Module      : Streamly.Internal.Data.IOFinalizer.Lifted+-- 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.Lifted+    (+      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)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, askRunInIO, runInIO, withRunInIO)+import Streamly.Internal.Data.IOFinalizer (IOFinalizer(..), runIOFinalizer)++-- | Make a finalizer from a monadic action @m a@ that can run in IO monad.+mkIOFinalizer :: MonadRunInIO m => m b -> m (IO ())+mkIOFinalizer f = do+    mrun <- askRunInIO+    return $+        void $ do+            _ <- runInIO mrun f+            return ()++-- | 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 :: MonadRunInIO m => m a -> m IOFinalizer+newIOFinalizer finalizer = do+    f <- mkIOFinalizer finalizer+    ref <- liftIO $ newIORef $ Just f+    _ <- liftIO $ mkWeakIORef ref (runFinalizerGC ref)+    return $ IOFinalizer ref++-- | Run an action clearing the finalizer atomically wrt async exceptions. The+-- action is run with async exceptions masked.+--+-- /Pre-release/+clearingIOFinalizer :: MonadRunInIO m => IOFinalizer -> m a -> m a+clearingIOFinalizer (IOFinalizer ref) action = do+    withRunInIO $ \runinio ->+        mask_ $ do+            writeIORef ref Nothing+            runinio action
− src/Streamly/Internal/Data/IORef/Prim.hs 
@@ -1,100 +0,0 @@-{-# LANGUAGE UnboxedTuples #-}---- |--- Module      : Streamly.Internal.Data.IORef.Prim--- 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 'Prim'--- 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.Prim-    (-      IORef-    , Prim--    -- * Construction-    , newIORef--    -- * Write-    , writeIORef-    , modifyIORef'--    -- * Read-    , readIORef-    , toStreamD-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Primitive (primitive_)-import Data.Primitive.Types (Prim, sizeOf#, readByteArray#, writeByteArray#)-import GHC.Exts (MutableByteArray#, newByteArray#, RealWorld)-import GHC.IO (IO(..))--import qualified Streamly.Internal.Data.Stream.StreamD.Type as D---- | An 'IORef' holds a single 'Prim' value.-data IORef a = IORef (MutableByteArray# RealWorld)---- | Create a new 'IORef'.------ /Pre-release/-{-# INLINE newIORef #-}-newIORef :: forall a. Prim a => a -> IO (IORef a)-newIORef x = IO (\s# ->-      case newByteArray# (sizeOf# (undefined :: a)) s# of-        (# s1#, arr# #) ->-            case writeByteArray# arr# 0# x s1# of-                s2# -> (# s2#, IORef arr# #)-    )---- | Write a value to an 'IORef'.------ /Pre-release/-{-# INLINE writeIORef #-}-writeIORef :: Prim a => IORef a -> a -> IO ()-writeIORef (IORef arr#) x = primitive_ (writeByteArray# arr# 0# x)---- | Read a value from an 'IORef'.------ /Pre-release/-{-# INLINE readIORef #-}-readIORef :: Prim a => IORef a -> IO a-readIORef (IORef arr#) = IO (readByteArray# arr# 0#)---- | Modify the value of an 'IORef' using a function with strict application.------ /Pre-release/-{-# INLINE modifyIORef' #-}-modifyIORef' :: Prim a => IORef a -> (a -> a) -> IO ()-modifyIORef' (IORef arr#) g = primitive_ $ \s# ->-  case readByteArray# arr# 0# s# of-    (# s'#, a #) -> let a' = g a in a' `seq` writeByteArray# arr# 0# a' s'#---- | Generate a stream by continuously reading the IORef.------ /Pre-release/-{-# INLINE_NORMAL toStreamD #-}-toStreamD :: (MonadIO m, Prim 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/HashMap.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-}++{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module      : Streamly.Internal.Data.IsMap.HashMap+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Adds an orphan HashMap instance for the IsMap type class from streamly-core+-- package. This is useful for various combinators that use a map type. We+-- cannot define this in streamly-core as it adds several non-boot library+-- dependencies on streamly-core.++module Streamly.Internal.Data.IsMap.HashMap () where++import Data.Hashable (Hashable)+import Streamly.Internal.Data.IsMap (IsMap(..))++import qualified Data.HashMap.Strict as HashMap++#if MIN_VERSION_hashable(1,4,0)+instance (Hashable k) => IsMap (HashMap.HashMap k) where+#else+instance (Hashable k, Eq k) => IsMap (HashMap.HashMap k) where+#endif+    type Key (HashMap.HashMap k) = k++    mapEmpty = HashMap.empty+    mapAlterF = HashMap.alterF+    mapLookup = HashMap.lookup+    mapInsert = HashMap.insert+    mapDelete = HashMap.delete+    mapUnion = HashMap.union+    mapNull = HashMap.null+    mapTraverseWithKey = HashMap.traverseWithKey
− src/Streamly/Internal/Data/List.hs 
@@ -1,193 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.List--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Lists are just a special case of monadic streams. The stream type @SerialT--- Identity a@ can be used as a replacement for @[a]@.  The 'List' type in this--- module is just a newtype wrapper around @SerialT 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) $ toSerial (1 \`Cons\` Nil)--- @------ To convert a 'List' to regular lists, you can use any of the following:------ * @toList . toSerial@ and @toSerial . 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)--    -- 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 Control.DeepSeq (NFData(..))-#if MIN_VERSION_deepseq(1,4,3)-import Control.DeepSeq (NFData1(..))-#endif-import Data.Functor.Identity (Identity, runIdentity)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif-import GHC.Exts (IsList(..), IsString(..))--import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Stream.Zip (ZipSerialM(..))--import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K---- We implement list as a newtype instead of a type synonym to make type--- inference easier when using -XOverloadedLists and -XOverloadedStrings. When--- using a stream type the programmer needs to specify the Monad otherwise the--- type remains ambiguous.------ XXX once we separate consM from IsStream or remove the MonadIO and--- MonadBaseControlIO dependency from it, then we can make this an instance of--- IsStream and use the regular polymorphic functions on Lists as well. Once--- that happens we can change the Show and Read instances as well to use "1 >:--- 2 >: nil" etc. or should we use a separate constructor indicating the "List"--- type ":>" for better inference?------ | @List a@ is a replacement for @[a]@.------ @since 0.6.0-newtype List a = List { toSerial :: SerialT Identity a }-    deriving (Show, Read, Eq, Ord, NFData-#if MIN_VERSION_deepseq(1,4,3)-    , NFData1-#endif-             , Semigroup, Monoid, Functor, Foldable-             , Applicative, Traversable, Monad)--instance (a ~ Char) => IsString (List a) where-    {-# INLINE fromString #-}-    fromString = List . fromList---- GHC versions 8.0 and below cannot derive IsList-instance IsList (List a) where-    type (Item (List a)) = a-    {-# INLINE fromList #-}-    fromList = List . fromList-    {-# INLINE toList #-}-    toList = toList . toSerial----------------------------------------------------------------------------------- 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.------ @since 0.6.0-pattern Nil :: List a-pattern Nil <- (runIdentity . K.null . getSerialT . toSerial -> True) where-    Nil = List $ SerialT K.nil--infixr 5 `Cons`---- | A list constructor and pattern that deconstructs a 'List' into its head--- and tail. Corresponds to ':' for Haskell lists.------ @since 0.6.0-pattern Cons :: a -> List a -> List a-pattern Cons x xs <--    (fmap (second (List . SerialT))-        . runIdentity . K.uncons . getSerialT . toSerial-            -> Just (x, xs)-    )--    where--    Cons x xs = List $ Serial.cons x (toSerial xs)--#if __GLASGOW_HASKELL__ >= 802-{-# COMPLETE Nil, Cons #-}-#endif----------------------------------------------------------------------------------- ZipList----------------------------------------------------------------------------------- | Just like 'List' except that it has a zipping 'Applicative' instance--- and no 'Monad' instance.------ @since 0.6.0-newtype ZipList a = ZipList { toZipSerial :: ZipSerialM Identity a }-    deriving (Show, Read, Eq, Ord, NFData-#if MIN_VERSION_deepseq(1,4,3)-    , NFData1-#endif-             , Semigroup, Monoid, Functor, Foldable-             , Applicative, Traversable)--instance (a ~ Char) => IsString (ZipList a) where-    {-# INLINE fromString #-}-    fromString = ZipList . fromList---- GHC versions 8.0 and below cannot derive IsList-instance IsList (ZipList a) where-    type (Item (ZipList a)) = a-    {-# INLINE fromList #-}-    fromList = ZipList . fromList-    {-# INLINE toList #-}-    toList = toList . toZipSerial---- | Convert a 'ZipList' to a regular 'List'------ @since 0.6.0-fromZipList :: ZipList a -> List a-fromZipList (ZipList zs) = List $ SerialT $ getZipSerialM zs---- | Convert a regular 'List' to a 'ZipList'------ @since 0.6.0-toZipList :: List a -> ZipList a-toZipList = ZipList . ZipSerialM . getSerialT . toSerial
− src/Streamly/Internal/Data/Maybe/Strict.hs 
@@ -1,48 +0,0 @@--- |--- 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.----module Streamly.Internal.Data.Maybe.Strict-    ( Maybe' (..)-    , toMaybe-    , 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 
@@ -1,1180 +0,0 @@-{-# OPTIONS_GHC -Wno-orphans  #-}---- |--- Module      : Streamly.Internal.Data.Parser--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Fast backtracking parsers with stream fusion and native streaming--- capability.------ '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 'Parser' type. However, there are two--- important differences between @parser-combinators@ and the equivalent ones--- provided in this module in terms of performance:------ 1) @parser-combinators@ 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', thus providing a scalability--- and a composable consumer.------ 2) Several combinators in this module can be many times faster 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.------ = Errors------ Failing parsers in this module throw the 'D.ParseError' exception.------ = 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-    (-      K.Parser (..)-    , D.ParseError (..)-    , D.Step (..)--    -- * Downgrade to Fold-    , toFold--    -- First order parsers-    -- * Accumulators-    , fromFold-    , fromPure-    , fromEffect-    , die-    , dieM--    -- * Element parsers-    , peek-    , eof-    , satisfy-    , next-    , maybe-    , either--    -- * Sequence parsers-    ---    -- | Parsers chained in series, if one parser terminates the composition-    -- terminates.--    -- | Grab a sequence of input elements without inspecting them-    , takeBetween-    -- , take   -- takeBetween 0 n-    , takeEQ -- takeBetween n n-    , takeGE -- takeBetween n maxBound--    -- Grab a sequence of input elements by inspecting them-    , takeP-    , lookAhead-    , takeWhileP-    , takeWhile-    -- $takeWhile-    , takeWhile1-    , drainWhile--    , sliceSepByP-    , sliceBeginWith-    , sliceSepWith-    , escapedSliceSepBy-    , escapedFrameBy-    , wordBy-    , groupBy-    , groupByRolling-    , groupByRollingEither-    , eqBy-    -- | Unimplemented-    ---    -- @-    -- , prefixOf -- match any prefix of a given string-    -- , suffixOf -- match any suffix of a given string-    -- , infixOf -- match any substring of a given string-    -- @--    -- Second order parsers (parsers using parsers)-    -- * Binary Combinators--    -- ** Sequential Applicative-    , serialWith-    , split_--    -- ** Parallel Applicatives-    , teeWith-    , teeWithFst-    , teeWithMin-    -- , teeTill -- like manyTill but parallel--    -- ** Sequential Interleaving-    -- Use two folds, run a primary parser, its rejected values go to the-    -- secondary parser.-    , deintercalate--    -- ** Sequential Alternative-    , alt--    -- ** Parallel Alternatives-    , shortest-    , longest-    -- , fastest--    -- * N-ary Combinators-    -- ** Sequential Collection-    , concatSequence-    , concatMap--    -- ** Sequential Repetition-    , count-    , countBetween--    , manyP-    , many-    , some-    , manyTillP-    , manyTill-    , manyThen--    -- ** 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-    -- , sepBy-    -- , sepEndBy-    -- , beginBy-    -- , sepBeginBy-    -- , sepAroundBy-    -- @--    -- * 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--    -- ** 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-    )-where--import Control.Monad.Catch (MonadCatch, MonadThrow)-import Prelude-       hiding (any, all, take, takeWhile, sequence, concatMap, maybe, either)--import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Parser.ParserK.Type (Parser)--import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Parser.ParserD as D-import qualified Streamly.Internal.Data.Parser.ParserK.Type as K------- $setup--- >>> :m--- >>> import Prelude hiding (any, all, take, takeWhile, sequence, concatMap, maybe, either)--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse, parseMany)--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Parser as Parser------------------------------------------------------------------------------------ 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 :: MonadThrow m => Parser m a b -> Fold m a b-toFold p = D.toFold $ K.fromParserK p------------------------------------------------------------------------------------ Upgrade folds to parses-------------------------------------------------------------------------------------- | Make a 'Parser' from a 'Fold'.------ /Pre-release/----{-# INLINE fromFold #-}-fromFold :: MonadCatch m => Fold m a b -> Parser m a b-fromFold = K.toParserK . D.fromFold------------------------------------------------------------------------------------ Terminating but not failing folds-------------------------------------------------------------------------------------- This is the dual of stream "fromPure".------ | A parser that always yields a pure value without consuming any input.------ /Pre-release/----{-# INLINE [3] fromPure #-}-fromPure :: MonadCatch m => b -> Parser m a b-fromPure = K.toParserK . D.fromPure-{-# RULES "fromPure fallback to CPS" [2]-    forall a. K.toParserK (D.fromPure a) = K.fromPure a #-}---- This is the dual of stream "fromEffect".------ | A parser that always yields the result of an effectful action without--- consuming any input.------ /Pre-release/----{-# INLINE fromEffect #-}-fromEffect :: MonadCatch m => m b -> Parser m a b-fromEffect = K.fromEffect -- K.toParserK . D.fromEffect---- This is the dual of "nil".------ | A parser that always fails with an error message without consuming--- any input.------ /Pre-release/----{-# INLINE [3] die #-}-die :: MonadCatch m => String -> Parser m a b-die = K.toParserK . D.die-{-# RULES "die fallback to CPS" [2]-    forall a. K.toParserK (D.die a) = K.die a #-}---- This is the dual of "nilM".------ | A parser that always fails with an effectful error message and without--- consuming any input.------ /Pre-release/----{-# INLINE dieM #-}-dieM :: MonadCatch m => m String -> Parser m a b-dieM = K.toParserK . D.dieM------------------------------------------------------------------------------------ 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]--- (1,1)------ @--- peek = lookAhead (satisfy True)--- @------ /Pre-release/----{-# INLINE peek #-}-peek :: MonadCatch m => Parser m a a-peek = K.toParserK D.peek---- | Succeeds if we are at the end of input, fails otherwise.------ >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]--- (1,())------ /Pre-release/----{-# INLINE eof #-}-eof :: MonadCatch m => Parser m a ()-eof = K.toParserK D.eof---- | Returns the next element if it passes the predicate, fails otherwise.------ >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]--- 1------ /Pre-release/----{-# INLINE satisfy #-}-satisfy :: MonadCatch m => (a -> Bool) -> Parser m a a-satisfy = K.toParserK . D.satisfy---- | Return the next element of the input. Returns 'Nothing'--- on end of input. Also known as 'head'.------ /Pre-release/----{-# INLINE next #-}-next :: MonadCatch m => Parser m a (Maybe a)-next = K.toParserK D.next---- | 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.------ /Pre-release/----{-# INLINE maybe #-}-maybe :: MonadCatch m => (a -> Maybe b) -> Parser m a b-maybe = K.toParserK . D.maybe---- | 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 :: MonadCatch m => (a -> Either String b) -> Parser m a b-either = K.toParserK . D.either------------------------------------------------------------------------------------ Taking elements------------------------------------------------------------------------------------ | @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]--- [1,2,3,4]------ >>> takeBetween' 2 4 [1, 2]--- [1,2]------ >>> takeBetween' 2 4 [1]--- *** Exception: ParseError "takeBetween: Expecting alteast 2 elements, got 1"------ >>> takeBetween' 0 0 [1, 2]--- []------ >>> takeBetween' 0 1 []--- []------ @takeBetween@ is the most general take operation, other take operations can--- be defined in terms of takeBetween. For example:------ @--- take = takeBetween 0 n  -- equivalent of take--- take1 = takeBetween 1 n -- equivalent of takeLE1--- takeEQ = takeBetween n n--- takeGE = takeBetween n maxBound--- @------ /Pre-release/----{-# INLINE takeBetween #-}-takeBetween ::  MonadCatch m =>-    Int -> Int -> Fold m a b -> Parser m a b-takeBetween m n = K.toParserK . D.takeBetween m n---- | 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 4 Fold.toList) $ Stream.fromList [1,0,1]--- *** Exception: ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3"------ /Pre-release/----{-# INLINE takeEQ #-}-takeEQ :: MonadCatch m => Int -> Fold m a b -> Parser m a b-takeEQ n = K.toParserK . D.takeEQ n---- | 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]--- *** Exception: 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]--- [1,0,1,0,1]------ /Pre-release/----{-# INLINE takeGE #-}-takeGE :: MonadCatch m => Int -> Fold m a b -> Parser m a b-takeGE n = K.toParserK . D.takeGE n---- $takeWhile--- Note: This is called @takeWhileP@ and @munch@ in some parser libraries.---- | 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.------ This is a generalized version of takeWhile, for example 'takeWhile1' can be--- implemented in terms of this:------ @--- takeWhile1 cond p = takeWhile cond (takeBetween 1 maxBound p)--- @------ Stops: when the condition fails or the collecting parser stops.--- Fails: when the collecting parser fails.------ /Unimplemented/----{-# INLINE takeWhileP #-}-takeWhileP :: -- MonadCatch m =>-    (a -> Bool) -> Parser m a b -> Parser m a b-takeWhileP _cond = undefined -- K.toParserK . D.takeWhileP cond---- | 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]--- [0,0]------ We can implement a @breakOn@ using 'takeWhile':------ @--- breakOn p = takeWhile (not p)--- @------ /Pre-release/----{-# INLINE takeWhile #-}-takeWhile :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b-takeWhile cond = K.toParserK . D.takeWhile cond---- | Like 'takeWhile' but takes at least one element otherwise fails.------ /Pre-release/----{-# INLINE takeWhile1 #-}-takeWhile1 :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b-takeWhile1 cond = K.toParserK . D.takeWhile1 cond---- | 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.------ /Pre-release/----{-# INLINE drainWhile #-}-drainWhile :: MonadCatch m => (a -> Bool) -> Parser m a ()-drainWhile p = takeWhile p FL.drain---- | @sliceSepByP cond parser@ parses a slice of the input using @parser@ until--- @cond@ succeeds or the parser stops.------ This is a generalized slicing parser which can be used to implement other--- parsers e.g.:------ @--- sliceSepByMax cond n p = sliceSepByP cond (take n p)--- sliceSepByBetween cond m n p = sliceSepByP cond (takeBetween m n p)--- @------ /Pre-release/----{-# INLINE sliceSepByP #-}-sliceSepByP ::-    MonadCatch m =>-    (a -> Bool) -> Parser m a b -> Parser m a b-sliceSepByP cond = K.toParserK . D.sliceSepByP cond . K.fromParserK---- | Like 'sliceSepBy' but does not drop the separator element, instead--- separator is emitted as a separate element in the output.------ /Unimplemented/-{-# INLINE sliceSepWith #-}-sliceSepWith :: -- MonadCatch m =>-    (a -> Bool) -> Fold m a b -> Parser m a b-sliceSepWith _cond = undefined -- K.toParserK . D.sliceSepBy cond---- | Collect stream elements until an elements passes the predicate, return the--- last element on which the predicate succeeded back to the input stream.  If--- the predicate succeeds on the first element itself then the parser does not--- terminate there. The succeeding element in the leading position--- is treated as a prefix separator which is kept in the output segment.------ * Stops - when the predicate succeeds in non-leading position.--- * Fails - never.------ S.splitWithPrefix pred f = S.parseMany (PR.sliceBeginWith pred f)------ Examples: ------- >>> :{---  sliceBeginWithOdd ls = Stream.parse prsr (Stream.fromList ls)---      where prsr = Parser.sliceBeginWith odd Fold.toList--- :}--------- >>> sliceBeginWithOdd [2, 4, 6, 3]--- *** Exception: sliceBeginWith : slice begins with an element which fails the predicate--- ...------ >>> sliceBeginWithOdd [3, 5, 7, 4]--- [3]------ >>> sliceBeginWithOdd [3, 4, 6, 8, 5]--- [3,4,6,8]------ >>> sliceBeginWithOdd []--- []------ /Pre-release/----{-# INLINE sliceBeginWith #-}-sliceBeginWith ::-    MonadCatch m =>-    (a -> Bool) -> Fold m a b -> Parser m a b-sliceBeginWith cond = K.toParserK . D.sliceBeginWith cond---- | Like 'sliceSepBy' but the separator elements can be escaped using an--- escape char determined by the second predicate.------ /Unimplemented/-{-# INLINE escapedSliceSepBy #-}-escapedSliceSepBy :: -- MonadCatch m =>-    (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b-escapedSliceSepBy _cond _esc = undefined-    -- K.toParserK . D.escapedSliceSepBy cond esc---- | @escapedFrameBy begin end escape@ parses a string framed using @begin@ and--- @end@ as the frame begin and end marker elements and @escape@ as an escaping--- element to escape the occurrence of the framing elements within the frame.--- Nested frames are allowed, but nesting is removed when parsing.------ For example,------ @--- > Stream.parse (Parser.escapedFrameBy (== '{') (== '}') (== '\\') Fold.toList) $ Stream.fromList "{hello}"--- "hello"------ > Stream.parse (Parser.escapedFrameBy (== '{') (== '}') (== '\\') Fold.toList) $ Stream.fromList "{hello {world}}"--- "hello world"------ > Stream.parse (Parser.escapedFrameBy (== '{') (== '}') (== '\\') Fold.toList) $ Stream.fromList "{hello \\{world\\}}"--- "hello {world}"------ > Stream.parse (Parser.escapedFrameBy (== '{') (== '}') (== '\\') Fold.toList) $ Stream.fromList "{hello {world}"--- ParseError "Unterminated '{'"------ @------ /Unimplemented/-{-# INLINE escapedFrameBy #-}-escapedFrameBy :: -- MonadCatch m =>-    (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b-escapedFrameBy _begin _end _escape _p = undefined-    -- K.toParserK . D.frameBy begin end escape p---- | 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.------ @--- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)--- @----{-# INLINE wordBy #-}-wordBy :: MonadCatch m => (a -> Bool) -> Fold m a b -> Parser m a b-wordBy f = K.toParserK . D.wordBy f---- | 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.toList---          . Stream.parseMany (Parser.groupBy eq Fold.toList)---          . Stream.fromList--- :}------ >>> runGroupsBy (<) []--- []------ >>> runGroupsBy (<) [1]--- [[1]]------ >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]--- [[3,5,4],[1,2],[0]]------ /Pre-release/----{-# INLINE groupBy #-}-groupBy :: MonadCatch m => (a -> a -> Bool) -> Fold m a b -> Parser m a b-groupBy eq = K.toParserK . D.groupBy eq---- | Unlike 'groupBy' this combinator performs a rolling comparison of two--- successive elements in the input stream.  Assuming the input stream to the--- parser 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.toList---          . Stream.parseMany (Parser.groupByRolling eq Fold.toList)---          . Stream.fromList--- :}------ >>> runGroupsByRolling (<) []--- []------ >>> runGroupsByRolling (<) [1]--- [[1]]------ >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]--- [[3,5],[4],[1,2],[0]]------ /Pre-release/----{-# INLINE groupByRolling #-}-groupByRolling :: MonadCatch m => (a -> a -> Bool) -> Fold m a b -> Parser m a b-groupByRolling eq = K.toParserK . D.groupByRolling eq---- | 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'.------ /Unimplemented/-{-# INLINE groupByRollingEither #-}-groupByRollingEither :: MonadCatch m =>-    (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (Either b c)-groupByRollingEither eq f1 = K.toParserK . D.groupByRollingEither eq f1---- | Match the given sequence of elements using the given comparison function.------ >>> Stream.parse (Parser.eqBy (==) "string") $ Stream.fromList "string"------ >>> Stream.parse (Parser.eqBy (==) "mismatch") $ Stream.fromList "match"--- *** Exception: ParseError "eqBy: failed, yet to match 7 elements"------ /Pre-release/----{-# INLINE eqBy #-}-eqBy :: MonadCatch m => (a -> a -> Bool) -> [a] -> Parser m a ()-eqBy cmp = K.toParserK . D.eqBy cmp------------------------------------------------------------------------------------ nested parsers------------------------------------------------------------------------------------ | Sequential parser application. 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. If both the parsers--- succeed their outputs are combined using the supplied function. The--- operation fails if any of the parsers fail.------ Note: This is a parsing dual of appending streams using--- 'Streamly.Prelude.serial', it splits the streams using two parsers and zips--- the results.------ This implementation is strict in the second argument, therefore, the--- following will fail:------ >>> Stream.parse (Parser.serialWith const (Parser.satisfy (> 0)) undefined) $ Stream.fromList [1]--- *** Exception: Prelude.undefined--- ...------ Compare with 'Applicative' instance method '<*>'. This implementation allows--- stream fusion but has quadratic complexity. This can fuse with other--- operations and can be faster than 'Applicative' instance for small number--- (less than 8) of compositions.------ Many combinators can be expressed using @serialWith@ and other parser--- primitives. Some common idioms are described below,------ @--- span :: (a -> Bool) -> Fold m a b -> Fold m a b -> Parser m a b--- span pred f1 f2 = serialWith (,) ('takeWhile' pred f1) ('fromFold' f2)--- @------ @--- spanBy :: (a -> a -> Bool) -> Fold m a b -> Fold m a b -> Parser m a b--- spanBy eq f1 f2 = serialWith (,) ('groupBy' eq f1) ('fromFold' f2)--- @------ @--- spanByRolling :: (a -> a -> Bool) -> Fold m a b -> Fold m a b -> Parser m a b--- spanByRolling eq f1 f2 = serialWith (,) ('groupByRolling' eq f1) ('fromFold' f2)--- @------ /Pre-release/----{-# INLINE serialWith #-}-serialWith :: MonadCatch m-    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c-serialWith f p1 p2 =-    K.toParserK $ D.serialWith f (K.fromParserK p1) (K.fromParserK p2)---- | 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--- ...------ Compare with 'Applicative' instance method '*>'. This implementation allows--- stream fusion but has quadratic complexity. This can fuse with other--- operations, and can be faster than 'Applicative' instance for small--- number (less than 8) of compositions.------ /Pre-release/----{-# INLINE split_ #-}-split_ :: MonadCatch m => Parser m x a -> Parser m x b -> Parser m x b-split_ p1 p2 = K.toParserK $ D.split_ (K.fromParserK p1) (K.fromParserK p2)---- | @teeWith f p1 p2@ distributes its input to both @p1@ and @p2@ until both--- of them succeed or anyone of them fails and combines their output using @f@.--- The parser succeeds if both the parsers succeed.------ /Pre-release/----{-# INLINE teeWith #-}-teeWith :: MonadCatch m-    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c-teeWith f p1 p2 =-    K.toParserK $ D.teeWith f (K.fromParserK p1) (K.fromParserK p2)---- | Like 'teeWith' but ends parsing and zips the results, if available,--- whenever the first parser ends.------ /Pre-release/----{-# INLINE teeWithFst #-}-teeWithFst :: MonadCatch m-    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c-teeWithFst f p1 p2 =-    K.toParserK $ D.teeWithFst f (K.fromParserK p1) (K.fromParserK p2)---- | Like 'teeWith' but ends parsing and zips the results, if available,--- whenever any of the parsers ends or fails.------ /Unimplemented/----{-# INLINE teeWithMin #-}-teeWithMin :: MonadCatch m-    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c-teeWithMin f p1 p2 =-    K.toParserK $ D.teeWithMin f (K.fromParserK p1) (K.fromParserK p2)---- | Sequential alternative. Apply the input to the first parser and return the--- result if the parser succeeds. If the first parser fails then backtrack and--- apply the same input to the second parser and return the result.------ 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]--- 1------ Compare with 'Alternative' instance method '<|>'. This implementation allows--- stream fusion but has quadratic complexity. This can fuse with other--- operations and can be much faster than 'Alternative' instance for small--- number (less than 8) of alternatives.------ /Pre-release/----{-# INLINE alt #-}-alt :: MonadCatch m => Parser m x a -> Parser m x a -> Parser m x a-alt p1 p2 = K.toParserK $ D.alt (K.fromParserK p1) (K.fromParserK p2)---- | Shortest alternative. Apply both parsers in parallel but choose the result--- from the one which consumed least input i.e. take the shortest succeeding--- parse.------ /Pre-release/----{-# INLINE shortest #-}-shortest :: MonadCatch m-    => Parser m x a -> Parser m x a -> Parser m x a-shortest p1 p2 = K.toParserK $ D.shortest (K.fromParserK p1) (K.fromParserK p2)---- | Longest alternative. Apply both parsers in parallel but choose the result--- from the one which consumed more input i.e. take the longest succeeding--- parse.------ /Pre-release/----{-# INLINE longest #-}-longest :: MonadCatch m-    => Parser m x a -> Parser m x a -> Parser m x a-longest p1 p2 = K.toParserK $ D.longest (K.fromParserK p1) (K.fromParserK p2)---- | Run a parser without consuming the input.------ /Pre-release/----{-# INLINE lookAhead #-}-lookAhead :: MonadCatch m => Parser m a b -> Parser m a b-lookAhead p = K.toParserK $ D.lookAhead $ K.fromParserK p---- | 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]--- [1,2]------ >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]--- *** Exception: ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4"------ /Internal/-{-# INLINE takeP #-}-takeP :: MonadCatch m => Int -> Parser m a b -> Parser m a b-takeP i p = K.toParserK $ D.takeP i $ K.fromParserK p------------------------------------------------------------------------------------ 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.------ | 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.------ This undoes a "gintercalate" of two streams.------ /Unimplemented/----{-# INLINE deintercalate #-}-deintercalate ::-    -- Monad m =>-       Fold m a y -> Parser m x a-    -> Fold m b z -> Parser m x b-    -> Parser m x (y, z)-deintercalate = undefined------------------------------------------------------------------------------------ Sequential Collection-------------------------------------------------------------------------------------- | @concatSequence f t@ collects sequential parses of parsers in the--- container @t@ using the fold @f@. Fails if the input ends or any of the--- parsers fail.------ This is same as 'Data.Traversable.sequence' but more efficient.------ /Unimplemented/----{-# INLINE concatSequence #-}-concatSequence ::-    -- Foldable t =>-    Fold m b c -> t (Parser m a b) -> Parser m a c-concatSequence _f _p = undefined---- | Map a 'Parser' returning function on the result of a 'Parser'.------ Compare with 'Monad' instance method '>>='. This implementation allows--- stream fusion but has quadratic complexity. This can fuse with other--- operations and can be much faster than 'Monad' instance for small number--- (less than 8) of compositions.------ /Pre-release/----{-# INLINE concatMap #-}-concatMap :: MonadCatch m-    => (b -> Parser m a c) -> Parser m a b -> Parser m a c-concatMap f p = K.toParserK $ D.concatMap (K.fromParserK . f) (K.fromParserK p)------------------------------------------------------------------------------------ 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 ::-       (Functor t, Foldable t, MonadCatch m) => t (Parser m a b) -> Parser m a b-choice ps = K.toParserK $ D.choice $ K.fromParserK <$> ps------------------------------------------------------------------------------------ Sequential Repetition-------------------------------------------------------------------------------------- $many--- TODO "many" is essentially a Fold because it cannot fail. So it can be--- downgraded to a Fold. Or we can make the return type a Fold instead and--- upgrade that to a parser when needed.---- | 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 m a b -> Parser m b c -> Parser m a c-manyP _p _f = undefined -- K.toParserK $ D.manyP (K.fromParserK p) f---- | 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.------ Compare with 'Control.Applicative.many'.------ /Pre-release/----{-# INLINE many #-}-many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c-many p f = K.toParserK $ D.many (K.fromParserK p) f--- 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 fld parser = manyP (takeGE 1 fld) parser@------ Compare with 'Control.Applicative.some'.------ /Pre-release/----{-# INLINE some #-}-some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c-some p f = K.toParserK $ D.some (K.fromParserK p) f--- some p f = manyP p (takeGE 1 f)--- many = 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.------ /Unimplemented/----{-# INLINE countBetween #-}-countBetween ::-    -- MonadCatch m =>-    Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c-countBetween _m _n _p = undefined--- countBetween m n p f = manyP (takeBetween m n f) p---- | @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.------ /Unimplemented/----{-# INLINE count #-}-count ::-    -- MonadCatch m =>-    Int -> Parser m a b -> Fold m b c -> Parser m a c-count n = countBetween n n--- count n p f = manyP (takeEQ n f) p---- | 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 :: -- MonadCatch m =>-    Parser m a b -> Parser m a x -> Parser m b c -> Parser m a c-manyTillP _p1 _p2 _f = undefined-    -- K.toParserK $ D.manyTillP (K.fromParserK p1) (K.fromParserK p2) f---- | @manyTill f collect test@ 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 accumulated by the--- supplied fold. The parser fails if @collect@ fails.------ Stops when the fold @f@ stops.------ /Pre-release/----{-# INLINE manyTill #-}-manyTill :: MonadCatch m-    => Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c-manyTill p1 p2 f =-    K.toParserK $ D.manyTill f (K.fromParserK p1) (K.fromParserK p2)---- | @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, MonadCatch m) =>-    Parser m a b -> Parser m a x -> Fold m b c -> Parser m a c-manyThen _parser _recover _f = undefined------------------------------------------------------------------------------------ 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, MonadCatch m) =>-    t (Parser m a b) -> Fold m b c -> Parser m a c-roundRobin _ps _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 :: -- (MonadCatch m) =>-    Int -> Parser m a b -> Fold m b c -> Parser m a c-retryMaxTotal _n _p _f  = undefined---- | Like 'retryMaxTotal' but aborts after @n@ successive failures.------ /Unimplemented/----{-# INLINE retryMaxSuccessive #-}-retryMaxSuccessive :: -- (MonadCatch m) =>-    Int -> Parser m a b -> Fold m b c -> Parser m a 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 :: -- (MonadCatch m) =>-    Parser m a b -> Parser m a b-retry _p = undefined
− src/Streamly/Internal/Data/Parser/ParserD.hs 
@@ -1,1249 +0,0 @@-#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Parser.ParserD--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Direct style parser implementation with stream fusion.--module Streamly.Internal.Data.Parser.ParserD-    (-      Parser (..)-    , ParseError (..)-    , Step (..)-    , Initial (..)-    , rmapM--    -- * Downgrade to Fold-    , toFold--    -- First order parsers-    -- * Accumulators-    , fromFold-    , fromPure-    , fromEffect-    , die-    , dieM--    -- * Element parsers-    , peek-    , eof-    , satisfy-    , next-    , maybe-    , either--    -- * Sequence parsers-    ---    -- 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:-    ---    -- sliceSepByMax cond n p = sliceBy cond (take n p)-    -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)-    -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)-    ---    -- Grab a sequence of input elements without inspecting them-    , takeBetween-    -- , take -- take   -- takeBetween 0 n-    -- , takeLE1 -- take1 -- takeBetween 1 n-    , takeEQ -- takeBetween n n-    , takeGE -- takeBetween n maxBound--    -- Grab a sequence of input elements by inspecting them-    , takeP-    , lookAhead-    , takeWhile-    , takeWhile1-    , sliceSepByP-    -- , sliceSepByBetween-    , sliceBeginWith-    -- , sliceSepWith-    ---    -- , frameSepBy -- parse frames escaped by an escape char/sequence-    -- , frameEndWith-    ---    , wordBy-    , groupBy-    , groupByRolling-    , groupByRollingEither-    , eqBy-    -- , 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-    , serialWith-    , split_--    -- ** Parallel Applicatives-    , teeWith-    , teeWithFst-    , teeWithMin-    -- , teeTill -- like manyTill but parallel--    -- ** Sequential Interleaving-    -- Use two folds, run a primary parser, its rejected values go to the-    -- secondary parser.-    , deintercalate--    -- ** Sequential Alternative-    , alt--    -- ** Parallel Alternatives-    , shortest-    , longest-    -- , fastest--    -- * N-ary Combinators-    -- ** Sequential Collection-    , sequence-    , concatMap--    -- ** Sequential Repetition-    , count-    , countBetween-    -- , countBetweenTill--    , many-    , some-    , manyTill--    -- -- ** Special cases-    -- XXX 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-    -- , sepBy-    -- , sepEndBy-    -- , beginBy-    -- , sepBeginBy-    -- , sepAroundBy--    -- -- * 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-    -- Round robin-    -- Priority based-    -- -- ** 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-    -- , shortestN-    -- , longestN-    -- , fastestN -- first N successful in time-    -- , choiceN  -- first N successful in position-    , choice   -- first successful in position--    -- -- ** Repeated Alternatives-    -- , retryMax    -- try N times-    -- , retryUntil  -- try until successful-    -- , retryUntilN -- try until successful n times-    )-where--import Control.Exception (assert, Exception)-import Control.Monad (when)-import Control.Monad.Catch (MonadCatch, MonadThrow(..))-import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))--import qualified Streamly.Internal.Data.Fold.Type as FL--import Prelude hiding-       (any, all, take, takeWhile, sequence, concatMap, maybe, either, span)-import Streamly.Internal.Data.Parser.ParserD.Tee-import Streamly.Internal.Data.Parser.ParserD.Type------- $setup--- >>> :m--- >>> import Prelude hiding ()--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Parser as Parser------------------------------------------------------------------------------------ Downgrade a parser to a Fold----------------------------------------------------------------------------------data ParserToFoldError =-      InitialError String-    | PartialError Int-    | ContinueError Int-    | DoneError Int-    | ErrorError String-    deriving Show--instance Exception ParserToFoldError---- | See 'Streamly.Internal.Data.Parser.toFold'.------ /Internal/----{-# INLINE toFold #-}-toFold :: MonadThrow m => Parser m a b -> Fold m a b-toFold (Parser pstep pinitial pextract) = Fold step initial pextract--    where--    initial = do-        r <- pinitial-        case r of-            IPartial s -> return $ FL.Partial s-            IDone b -> return $ FL.Done b-            IError err -> throwM $ InitialError 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 _ -> throwM $ PartialError n-            Continue n _ -> throwM $ ContinueError n-            Done n _ -> throwM $ DoneError n-            Error err -> throwM $ ErrorError err------------------------------------------------------------------------------------ Upgrade folds to parses-------------------------------------------------------------------------------------- | See 'Streamly.Internal.Data.Parser.fromFold'.------ /Pre-release/----{-# INLINE fromFold #-}-fromFold :: Monad m => Fold m a b -> Parser m a b-fromFold (Fold fstep finitial fextract) = Parser step initial fextract--    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------------------------------------------------------------------------------------ Failing Parsers------------------------------------------------------------------------------------ | See 'Streamly.Internal.Data.Parser.peek'.------ /Pre-release/----{-# INLINE peek #-}-peek :: MonadThrow m => Parser m a a-peek = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $ Done 1 a--    extract () = throwM $ ParseError "peek: end of input"---- | See 'Streamly.Internal.Data.Parser.eof'.------ /Pre-release/----{-# INLINE eof #-}-eof :: Monad m => Parser m a ()-eof = Parser step initial return--    where--    initial = return $ IPartial ()--    step () _ = return $ Error "eof: not at end of input"---- | See 'Streamly.Internal.Data.Parser.satisfy'.------ /Pre-release/----{-# INLINE satisfy #-}-satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a-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 _ = throwM $ ParseError "satisfy: end of input"---- | See 'Streamly.Internal.Data.Parser.next'.------ /Pre-release/----{-# INLINE next #-}-next :: Monad m => Parser m a (Maybe a)-next = Parser step initial extract-  where-  initial = pure $ IPartial ()-  step _ a = pure $ Done 0 (Just a)-  extract _ = pure Nothing---- | See 'Streamly.Internal.Data.Parser.maybe'.------ /Pre-release/----{-# INLINE maybe #-}-maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b-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 _ = throwM $ ParseError "maybe: end of input"---- | See 'Streamly.Internal.Data.Parser.either'.------ /Pre-release/----{-# INLINE either #-}-either :: MonadThrow m => (a -> Either String b) -> Parser m a b-either parserF = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $-        case parserF a of-            Right b -> Done 0 b-            Left err -> Error $ "either: " ++ err--    extract _ = throwM $ ParseError "either: end of input"------------------------------------------------------------------------------------ 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---- | See 'Streamly.Internal.Data.Parser.takeBetween'.------ /Pre-release/----{-# INLINE takeBetween #-}-takeBetween :: MonadCatch m => Int -> Int -> Fold m a b -> Parser m a 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 IDone <$> extract 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)-            $ throwM $ ParseError 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 Done 0 <$> 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 = fextract s-        | otherwise = throwM $ ParseError (f i)---- | See 'Streamly.Internal.Data.Parser.takeEQ'.------ /Pre-release/----{-# INLINE takeEQ #-}-takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b-takeEQ n (Fold fstep finitial fextract) = Parser step initial extract--    where--    cnt = max n 0--    initial = do-        res <- finitial-        return $ case res of-            FL.Partial s -> IPartial $ Tuple' 0 s-            FL.Done b ->-                if cnt == 0-                then IDone b-                else IError-                         $ "takeEQ: Expecting exactly " ++ show cnt-                             ++ " elements, fold terminated without"-                             ++ " consuming any elements"--    step (Tuple' i r) a-        | i1 < cnt = do-            res <- fstep r a-            return-                $ case res of-                    FL.Partial s -> Continue 0 $ Tuple' i1 s-                    FL.Done _ ->-                        Error-                            $ "takeEQ: Expecting exactly " ++ show cnt-                                ++ " elements, fold terminated on " ++ show i1-        | i1 == cnt = do-            res <- fstep r a-            Done 0-                <$> case res of-                        FL.Partial s -> fextract s-                        FL.Done b -> return b-        -- XXX we should not reach here when initial returns Step type-        -- reachable only when n == 0-        | otherwise = Done 1 <$> fextract r--        where--        i1 = i + 1--    extract (Tuple' i r)-        | i == 0 && cnt == 0 = fextract r-        | otherwise =-            throwM-                $ ParseError-                $ "takeEQ: Expecting exactly " ++ show cnt-                    ++ " elements, input terminated on " ++ show i---- | See 'Streamly.Internal.Data.Parser.takeGE'.------ /Pre-release/----{-# INLINE takeGE #-}-takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b-takeGE n (Fold fstep finitial fextract) = Parser step initial extract--    where--    cnt = max n 0-    initial = do-        res <- finitial-        return $ case res of-            FL.Partial s -> IPartial $ Tuple' 0 s-            FL.Done b ->-                if cnt == 0-                then IDone b-                else IError-                         $ "takeGE: Expecting at least " ++ show cnt-                             ++ " elements, fold terminated without"-                             ++ " consuming any elements"--    step (Tuple' i r) a-        | i1 < cnt = do-            res <- fstep r a-            return-                $ case res of-                      FL.Partial s -> Continue 0 $ Tuple' i1 s-                      FL.Done _ ->-                        Error-                            $ "takeGE: Expecting at least " ++ show cnt-                                ++ " elements, fold terminated on " ++ show i1-        | otherwise = do-            res <- fstep r a-            return-                $ case res of-                      FL.Partial s -> Partial 0 $ Tuple' i1 s-                      FL.Done b -> Done 0 b--        where--        i1 = i + 1--    extract (Tuple' i r)-        | i >= cnt = fextract r-        | otherwise =-            throwM-                $ ParseError-                $ "takeGE: Expecting at least " ++ show cnt-                    ++ " elements, input terminated on " ++ show i---- | See 'Streamly.Internal.Data.Parser.takeWhile'.------ /Pre-release/----{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b-takeWhile predicate (Fold fstep finitial fextract) =-    Parser step initial fextract--    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---- | See 'Streamly.Internal.Data.Parser.takeWhile1'.------ /Pre-release/----{-# INLINE takeWhile1 #-}-takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b-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 _) = throwM $ ParseError "takeWhile1: end of input"-    extract (Right s) = fextract s---- | See 'Streamly.Internal.Data.Parser.sliceSepByP'.------ /Pre-release/----sliceSepByP :: MonadCatch m =>-    (a -> Bool) -> Parser m a b -> Parser m a b-sliceSepByP cond (Parser pstep pinitial pextract) =--    Parser step initial pextract--    where--    initial = pinitial--    step s a =-        if cond a-        then do-            res <- pextract s-            return $ Done 0 res-        else pstep s a---- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.------ /Pre-release/----data SliceBeginWithState s = Left' s | Right' s--{-# INLINE sliceBeginWith #-}-sliceBeginWith :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b-sliceBeginWith 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 "sliceBeginWith : bad finitial"--    {-# 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 error $ "sliceBeginWith : slice begins with an element which "-                        ++ "fails the predicate"-    step (Right' s) a =-        if not (cond a)-        then process s a-        else Done 1 <$> fextract s--    extract (Left' s) = fextract s-    extract (Right' s) = fextract s--data WordByState s b = WBLeft !s | WBWord !s | WBRight !b---- | See 'Streamly.Internal.Data.Parser.wordBy'.-------{-# INLINE wordBy #-}-wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a 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) = fextract s-    extract (WBWord s) = fextract s-    extract (WBRight b) = return b--{-# ANN type GroupByState Fuse #-}-data GroupByState a s-    = GroupByInit !s-    | GroupByGrouping !a !s---- | See 'Streamly.Internal.Data.Parser.groupBy'.----{-# INLINE groupBy #-}-groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a 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) = fextract s-    extract (GroupByGrouping _ s) = fextract s---- | See 'Streamly.Internal.Data.Parser.groupByRolling'.----{-# INLINE groupByRolling #-}-groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser m a 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) = fextract s-    extract (GroupByGrouping _ s) = 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--{-# INLINE groupByRollingEither #-}-groupByRollingEither :: MonadCatch m =>-    (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser m a (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 _) = Left <$> fextract1 s1-    extract (GroupByGroupingPairL _ s1 _) = Left <$> fextract1 s1-    extract (GroupByGroupingPairR _ _ s2) = Right <$> fextract2 s2-    extract (GroupByGroupingPair a s1 _) = do-                res <- fstep1 s1 a-                case res of-                    FL.Done b -> return $ Left b-                    FL.Partial s11 -> Left <$> fextract1 s11---- XXX use an Unfold instead of a list?--- XXX custom combinators for matching list, array and stream?------ | See 'Streamly.Internal.Data.Parser.eqBy'.------ /Pre-release/----{-# INLINE eqBy #-}-eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()-eqBy cmp str = Parser step initial extract--    where--    initial = return $ IPartial str--    step [] _ = return $ Done 0 ()-    step [x] a =-        return-            $ if x `cmp` a-              then Done 0 ()-              else Error "eqBy: failed, yet to match the last element"-    step (x:xs) a =-        return-            $ if x `cmp` a-              then Continue 0 xs-              else Error-                       $ "eqBy: failed, yet to match "-                       ++ show (length xs + 1) ++ " elements"--    extract xs =-        throwM-            $ ParseError-            $ "eqBy: end of input, yet to match "-            ++ show (length xs) ++ " elements"-------------------------------------------------------------------------------------- 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 m a (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 m a (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 m a (b, c)-spanByRolling eq f1 f2 =-    noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)------------------------------------------------------------------------------------ nested parsers------------------------------------------------------------------------------------ | See 'Streamly.Internal.Data.Parser.takeP'.------ /Internal/-{-# INLINE takeP #-}-takeP :: Monad m => Int -> Parser m a b -> Parser m a 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 IDone <$> pextract s-            IDone b -> return $ IDone b-            IError e -> return $ IError e--    step (Tuple' cnt r) a = do-        assert (cnt < lim) (return ())-        res <- pstep r a-        let cnt1 = cnt + 1-        case res of-            Partial 0 s -> do-                assert (cnt1 >= 0) (return ())-                if cnt1 < lim-                then return $ Partial 0 $ Tuple' cnt1 s-                else Done 0 <$> pextract s-            Continue 0 s -> do-                assert (cnt1 >= 0) (return ())-                if cnt1 < lim-                then return $ Continue 0 $ Tuple' cnt1 s-                -- XXX This should error out?-                -- If designed properly, this will probably error out.-                -- "pextract" should error out-                ---                -- By Harendra,-                ---                -- This is a tricky case, we have the following options:-                --   1. Done 0 with extract as you have written-                --   2. Done n, will require buffering elements-                --   3. Use a backtracking fold and not a parser, once we have-                --      backtracking in folds-                else Done 0 <$> pextract s-            Partial n s -> do-                let taken = cnt1 - n-                assert (taken >= 0) (return ())-                return $ Partial n $ Tuple' taken s-            Continue n s -> do-                let taken = cnt1 - n-                assert (taken >= 0) (return ())-                return $ Continue n $ Tuple' taken s-            Done n b -> return $ Done n b-            Error str -> return $ Error str--    extract (Tuple' _ r) = pextract r---- | See 'Streamly.Internal.Data.Parser.lookahead'.------ /Pre-release/----{-# INLINE lookAhead #-}-lookAhead :: MonadThrow m => Parser m a b -> Parser m a b-lookAhead (Parser step1 initial1 _) = Parser step initial extract--    where--    initial = do-        res <- initial1-        return $ case res of-            IPartial s -> IPartial (Tuple' 0 s)-            IDone b -> IDone b-            IError e -> IError e--    step (Tuple' cnt st) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        return-            $ case r of-                  Partial n s -> Continue n (Tuple' (cnt1 - n) s)-                  Continue n s -> Continue n (Tuple' (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' n _) =-        throwM-            $ ParseError-            $ "lookAhead: end of input after consuming "-            ++ show n ++ " elements"------------------------------------------------------------------------------------ Interleaving-------------------------------------------------------------------------------------- | See 'Streamly.Internal.Data.Parser.deintercalate'.------ /Unimplemented/----{-# INLINE deintercalate #-}-deintercalate ::-    -- Monad m =>-       Fold m a y -> Parser m x a-    -> Fold m b z -> Parser m x b-    -> Parser m x (y, z)-deintercalate = undefined------------------------------------------------------------------------------------ Sequential Collection-------------------------------------------------------------------------------------- | See 'Streamly.Internal.Data.Parser.sequence'.------ /Unimplemented/----{-# INLINE sequence #-}-sequence ::-    -- Foldable t =>-    Fold m b c -> t (Parser m a b) -> Parser m a c-sequence _f _p = undefined------------------------------------------------------------------------------------ Alternative Collection------------------------------------------------------------------------------------ | See 'Streamly.Internal.Data.Parser.choice'.------ /Broken/----{-# INLINE choice #-}-choice :: (MonadCatch m, Foldable t) => t (Parser m a b) -> Parser m a b-choice = foldl1 shortest------------------------------------------------------------------------------------ Sequential Repetition-------------------------------------------------------------------------------------- | See 'Streamly.Internal.Data.Parser.many'.------ /Pre-release/----{-# INLINE many #-}-many :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c-many = splitMany--- many = countBetween 0 maxBound---- | See 'Streamly.Internal.Data.Parser.some'.------ /Pre-release/----{-# INLINE some #-}-some :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a c-some = splitSome--- some f p = many (takeGE 1 f) p--- many = countBetween 1 maxBound---- | See 'Streamly.Internal.Data.Parser.countBetween'.------ /Unimplemented/----{-# INLINE countBetween #-}-countBetween ::-    -- MonadCatch m =>-    Int -> Int -> Parser m a b -> Fold m b c -> Parser m a c-countBetween _m _n _p = undefined--- countBetween m n p f = many (takeBetween m n f) p---- | See 'Streamly.Internal.Data.Parser.count'.------ /Unimplemented/----{-# INLINE count #-}-count ::-    -- MonadCatch m =>-    Int -> Parser m a b -> Fold m b c -> Parser m a c-count n = countBetween n n--- count n f p = many (takeEQ n f) p--data ManyTillState fs sr sl-    = ManyTillR Int fs sr-    | ManyTillL Int fs sl---- | See 'Streamly.Internal.Data.Parser.manyTill'.------ /Pre-release/----{-# INLINE manyTill #-}-manyTill :: MonadCatch m-    => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c-manyTill (Fold fstep finitial fextract)-         (Parser stepL initialL extractL)-         (Parser stepR initialR _) =-    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 0 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-                assert (cnt + 1 - n >= 0) (return ())-                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 0 fs sl)-                    IDone bl -> do-                        fr <- fstep fs bl-                        let cnt1 = cnt + 1-                            p = Partial cnt-                            c = Continue cnt-                            d = Done cnt-                        case fr of-                            FL.Partial fs1 -> scrutR fs1 p c d Error-                            FL.Done fb -> return $ Done cnt1 fb-                    IError err -> return $ Error err-    -- XXX the cnt is being used only by the assert-    step (ManyTillL cnt fs st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Partial n (ManyTillL 0 fs s)-            Continue n s -> do-                assert (cnt + 1 - n >= 0) (return ())-                return $ Continue n (ManyTillL (cnt + 1 - n) 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 >>= fstep fs-        case res of-            FL.Partial s -> fextract s-            FL.Done b -> return b-    extract (ManyTillR _ fs _) = fextract fs
− src/Streamly/Internal/Data/Parser/ParserD/Tee.hs 
@@ -1,613 +0,0 @@-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Parser.ParserD.Tee--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Parallel parsers. Distributing the input to multiple parsers at the same--- time.------ For simplicity, we are using code where a particular state is unreachable--- but it is not prevented by types.  Somehow uni-pattern match using "let"--- produces better optimized code compared to using @case@ match and using--- explicit error messages in unreachable cases.------ There seem to be no way to silence individual warnings so we use a global--- incomplete uni-pattern match warning suppression option for the file.--- Disabling the warning for other code as well  has the potential to mask off--- some legit warnings, therefore, we have segregated only the code that uses--- uni-pattern matches in this module.--module Streamly.Internal.Data.Parser.ParserD.Tee-    (-    -- Parallel zipped-      teeWith-    , teeWithFst-    , teeWithMin--    -- Parallel alternatives-    , shortest-    , longest-    )-where--import Control.Exception (assert)-import Control.Monad.Catch (MonadCatch, try)-import Prelude-       hiding (any, all, takeWhile)--import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Parser.ParserD.Type-       (Initial(..), Parser(..), Step(..), ParseError)------------------------------------------------------------------------------------ Distribute input to two parsers and collect both results------------------------------------------------------------------------------------ When the input stream is distributed to two parsers, both the parsers can--- backtrack independently. Therefore, we need separate buffer state for each--- parser.------ ParserK------ We can keep the state of each parser in the zipper and pass around that--- zipper to the parsers. Each parser can consume from the zipper and then pass--- around the zipper to the other parser.------ ParserD------ In the approach we have taken here, the driver pushes one element at a time--- to the tee and each of the parsers in the tee may buffer it independently--- for backtracking. So they do not need to depend on the original stream--- source for individual parser backtracking. Problem arises when both the--- parsers backtrack and they do not need any input from the driver rather they--- must consume from their buffers. For such situation we may need a--- "Continue" style driver command from the tee so that the driver runs--- the tee without providing it any input. Or we may need a local driver loop--- until new input is to be demanded from the input stream.------ When the tee errors out or stops, the tee driver may have to backtrack by--- the specified amount (or the tee must return the leftover input). Therefore,--- the tee driver also has to buffer, this leads to triple buffering.------ When the tee stops we need to determine the backtracking amount from the--- leftover of both the parsers. Since both the parsers may have consumed--- different lengths of the stream we consider the maximum of the two as--- consumed.----  -- XXX We can use Initial instead of StepState-{-# ANN type StepState Fuse #-}-data StepState s a = StepState s | StepResult a---- | State of the pair of parsers in a tee composition--- Note: strictness annotation is important for fusing the constructors-{-# ANN type TeeState Fuse #-}-data TeeState sL sR x a b =--- @TeePair (past buffer, parser state, future-buffer1, future-buffer2) ...@-    TeePair !([x], StepState sL a, [x], [x]) !([x], StepState sR b, [x], [x])--{-# ANN type Res Fuse #-}-data Res = Yld Int | Stp Int | Skp | Err String---- | See 'Streamly.Internal.Data.Parser.teeWith'.------ /Broken/----{-# INLINE teeWith #-}-teeWith :: Monad m-    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x 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 m x a -> Parser m x b -> Parser m x 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 m x a -> Parser m x b -> Parser m x 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 m x a -> Parser m x a -> Parser m x 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 m x a -> Parser m x a -> Parser m x a-longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where---    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        return $ case resL of-            IPartial sl ->-                case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])-                                                    ([], StepResult br, [], [])-                     IError _ ->-                         IPartial $ TeePair ([], StepState sl, [], [])-                                            ([], StepResult undefined, [], [])-            IDone bl ->-                case resR of-                     IPartial sr ->-                         IPartial $ TeePair ([], StepResult bl, [], [])-                                            ([], StepState sr, [], [])-                     IDone _ -> IDone bl-                     IError _ -> IDone bl-            IError _ ->-                case resR of-                     IPartial sr ->-                         IPartial $ TeePair ([], StepResult undefined, [], [])-                                            ([], StepState sr, [], [])-                     IDone br -> IDone br-                     IError err -> IError err--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n _ -> return (undefined, Yld n) -- Not implemented-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case (stL,stR) of-            (Yld n1, Yld n2) -> Partial (min n1 n2) next-            (Yld n1, Stp n2) -> Partial (min n1 n2) next-            (Stp n1, Yld n2) -> Partial (min n1 n2) next-            (Stp n1, Stp n2) ->-                let (_, StepResult rL, _, _) = l-                    (_, StepResult rR, _, _) = r-                 in Done (max n1 n2) (if n1 >= n2 then rL else rR)-            (Err err, _) -> Error err-            (_, Err err) -> Error err-            _ -> Continue 0 next--    -- XXX the parser that finishes last may not be the longest because it may-    -- return a lot of unused input which makes it shorter. Our current-    -- criterion of deciding longest is based on whoever decides to finish-    -- last and not whoever consumed more input.-    ---    -- To actually know who made more progress we need to keep an account of-    -- how many items are unconsumed since the last yield.-    ---    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                r@(_, StepResult _, _, _)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        let next = TeePair l r-        return $ case stL of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rL, _, _) = l-                 in Done n rL-            Skp -> Continue 0 next-            Err err -> Error err--    step (TeePair l@(_, StepResult _, _, _)-                    (bufR, StepState sR, inpR1, inpR2)) x = do-        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case stR of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rR, _, _) = r-                 in Done n rR-            Skp -> Continue 0 next-            Err err -> Error err--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        -- XXX When results are partial we may not be able to precisely compare-        -- which parser has made more progress till now.  One way to do that is-        -- to figure out the actually consumed input up to the last yield.-        ---        case st of-            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do-                r <- try $ extractL sL-                case r of-                    Left (_ :: ParseError) -> extractR sR-                    Right b -> return b-            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do-                r <- try $ extractL sL-                case r of-                    Left (_ :: ParseError) -> return rR-                    Right b -> return b-            TeePair (_, StepResult rL, _, _) (_, StepState sR, _, _) -> do-                r <- try $ extractR sR-                case r of-                    Left (_ :: ParseError) -> return rL-                    Right b -> return b-            TeePair (_, StepResult _, _, _) (_, StepResult _, _, _) ->-                error "unreachable"
− src/Streamly/Internal/Data/Parser/ParserD/Type.hs 
@@ -1,1178 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-#include "inline.hs"---- |--- 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 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.------ = 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).--module Streamly.Internal.Data.Parser.ParserD.Type-    (-    -- * Types-      Initial (..)-    , Step (..)-    , Parser (..)-    , ParseError (..)-    , rmapM--    -- * Constructors-    , parser-    , parserM--    , fromPure-    , fromEffect-    , serialWith-    , split_--    , die-    , dieM-    , splitSome -- parseSome?-    , splitMany -- parseMany?-    , splitManyPost-    , alt-    , concatMap--    , noErrorUnsafeSplit_-    , noErrorUnsafeSplitWith-    , noErrorUnsafeConcatMap-    )-where--import Control.Applicative (Alternative(..), liftA2)-import Control.Exception (assert, Exception(..))-import Control.Monad (MonadPlus(..), (>=>))-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader.Class (MonadReader, ask, local)-import Control.Monad.State.Class (MonadState, get, put)-import Control.Monad.Catch (MonadCatch, try, throwM, MonadThrow)-import Data.Bifunctor (Bifunctor(..))-import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Fold.Type (Fold(..), toList)-import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))--import qualified Streamly.Internal.Data.Fold.Type as FL--import Prelude hiding (concatMap)------ $setup--- >>> :m--- >>> import Control.Applicative ((<|>))--- >>> import Prelude hiding (concatMap)--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse)--- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import qualified Streamly.Internal.Data.Parser.ParserD as ParserD---- 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--    {-# INLINE first #-}-    first f (IPartial a) = IPartial (f a)-    first _ (IDone x) = IDone x-    first _ (IError err) = IError err--    {-# INLINE second #-}-    second _ (IPartial x) = IPartial x-    second f (IDone a) = IDone (f a)-    second _ (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--- serveral 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 result with an optional backtrack request.-    ---    -- @Partial count state@ means a partial result is available which-    -- can be extracted successfully, @state@ is the opaque state of the-    -- parser to be supplied to the next invocation of the step operation.-    -- The current input position is reset to @count@ elements back and any-    -- input before that is dropped from the backtrack buffer.--    | Continue Int s-    -- ^ Need more input with an optional backtrack request.-    ---    -- @Continue count state@ means the parser has consumed the current input-    -- but no new result is generated, @state@ is the next state of the parser.-    -- The current input is retained in the backtrack buffer and the input-    -- position is reset to @count@ elements back.--    | 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.--instance Functor (Step s) where-    {-# INLINE fmap #-}-    fmap _ (Partial n s) = Partial n s-    fmap _ (Continue n s) = Continue n s-    fmap f (Done n b) = Done n (f b)-    fmap _ (Error err) = 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 m a b =-    forall s. Parser (s -> a -> m (Step s b)) (m (Initial s b)) (s -> m b)---- | This exception is used for two purposes:------ * When a parser ultimately fails, the user of the parser is intimated via---    this exception.--- * When the "extract" function of a parser needs to throw an error.------ /Pre-release/----newtype ParseError = ParseError String-    deriving Show--instance Exception ParseError where-    displayException (ParseError err) = err--instance Functor m => Functor (Parser m a) where-    {-# INLINE fmap #-}-    fmap f (Parser step1 initial1 extract) =-        Parser step initial (fmap2 f extract)--        where--        initial = fmap2 f initial1-        step s b = fmap2 f (step1 s b)-        fmap2 g = fmap (fmap g)----------------------------------------------------------------------------------- General parser constructors----------------------------------------------------------------------------------- | Make a parser using a parsing step and a starting value.------ /Pre-release/----{-# INLINE parser #-}-parser :: Monad m => (b -> a -> Step b b) -> Initial b b -> Parser m a b-parser step initial =-    Parser (\s a -> return $ step s a) (return initial) return---- | Like 'parser' but with a monadic step function.------ >>> parserM step initial = ParserD.Parser step initial return------ /Pre-release/----{-# INLINE parserM #-}-parserM ::-    Monad m => (b -> a -> m (Step b b)) -> m (Initial b b) -> Parser m a b-parserM step initial = Parser step initial return----------------------------------------------------------------------------------- Mapping on the output----------------------------------------------------------------------------------- | Map a monadic function on the output of a parser.------ /Pre-release/-{-# INLINE rmapM #-}-rmapM :: Monad m => (b -> m c) -> Parser m a b -> Parser m a c-rmapM f (Parser step initial extract) = Parser step1 initial1 (extract >=> f)--    where--    initial1 = do-        res <- initial-        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---- | See 'Streamly.Internal.Data.Parser.fromPure'.------ /Pre-release/----{-# INLINE_NORMAL fromPure #-}-fromPure :: Monad m => b -> Parser m a b-fromPure b = Parser undefined (pure $ IDone b) undefined---- | See 'Streamly.Internal.Data.Parser.fromEffect'.------ /Pre-release/----{-# INLINE fromEffect #-}-fromEffect :: Monad m => m b -> Parser m a b-fromEffect b = Parser undefined (IDone <$> b) undefined------------------------------------------------------------------------------------ Sequential applicative----------------------------------------------------------------------------------{-# ANN type SeqParseState Fuse #-}-data SeqParseState sl f sr = SeqParseL sl | SeqParseR f sr---- | See 'Streamly.Internal.Data.Parser.serialWith'.------ Note: this implementation of serialWith 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.------ /Pre-release/----{-# INLINE serialWith #-}-serialWith :: MonadThrow m-    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c-serialWith func (Parser stepL initialL extractL)-               (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqParseL sl-            IDone bl -> do-                resR <- initialR-                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.-        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-                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 = do-        resR <- stepR st a-        return $ case resR of-            Partial n s -> Partial n (SeqParseR f s)-            Continue n s -> Continue n (SeqParseR f s)-            Done n b -> Done n (f b)-            Error err -> Error err--    extract (SeqParseR f sR) = fmap f (extractR sR)-    extract (SeqParseL sL) = do-        rL <- extractL sL-        res <- initialR-        case res of-            IPartial sR -> do-                rR <- extractR sR-                return $ func rL rR-            IDone rR -> return $ func rL rR-            IError err -> throwM $ ParseError err---- | Works correctly only if the first parser is guaranteed to never fail.-{-# INLINE noErrorUnsafeSplitWith #-}-noErrorUnsafeSplitWith :: Monad m-    => (a -> b -> c) -> Parser m x a -> Parser m x b -> Parser m x c-noErrorUnsafeSplitWith func (Parser stepL initialL extractL)-               (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqParseL sl-            IDone bl -> do-                resR <- initialR-                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-        r <- stepL st a-        case r of-            -- Assume that the first 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 -> Error err-            Error err -> return $ Error err--    step (SeqParseR f st) a = do-        r <- stepR st a-        return $ case r of-            Partial n s -> Partial n (SeqParseR f s)-            Continue n s -> Continue n (SeqParseR f s)-            Done n b -> Done n (f b)-            Error err -> Error err--    extract (SeqParseR f sR) = fmap f (extractR sR)-    extract (SeqParseL sL) = do-        rL <- extractL sL-        res <- initialR-        case res of-            IPartial sR -> do-                rR <- extractR sR-                return $ func rL rR-            IDone rR -> return $ func rL rR-            IError err -> error $ "noErrorUnsafeSplitWith: cannot use a "-                ++ "failing parser. Parser failed with: " ++ err--{-# ANN type SeqAState Fuse #-}-data SeqAState sl sr = SeqAL sl | SeqAR sr---- This turns out to be slightly faster than serialWith--- | See 'Streamly.Internal.Data.Parser.split_'.------ /Pre-release/----{-# INLINE split_ #-}-split_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x 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 $ case resR of-                    IPartial sr -> IPartial $ SeqAR sr-                    IDone br -> IDone 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 (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 =-        (\case-            Partial n s -> Partial n (SeqAR s)-            Continue n s -> Continue n (SeqAR s)-            Done n b -> Done n b-            Error err -> Error err) <$> stepR st a--    extract (SeqAR sR) = extractR sR-    extract (SeqAL sL) = do-        _ <- extractL sL-        res <- initialR-        case res of-            IPartial sR -> extractR sR-            IDone rR -> return rR-            IError err -> throwM $ ParseError err--{-# INLINE noErrorUnsafeSplit_ #-}-noErrorUnsafeSplit_ :: MonadThrow m => Parser m x a -> Parser m x b -> Parser m x b-noErrorUnsafeSplit_ (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 $ case resR of-                    IPartial sr -> IPartial $ SeqAR sr-                    IDone br -> IDone 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 (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 -> Error err-            Error err -> return $ Error err--    step (SeqAR st) a =-        (\case-            Partial n s -> Partial n (SeqAR s)-            Continue n s -> Continue n (SeqAR s)-            Done n b -> Done n b-            Error err -> Error err) <$> stepR st a--    extract (SeqAR sR) = extractR sR-    extract (SeqAL sL) = do-        _ <- extractL sL-        res <- initialR-        case res of-            IPartial sR -> extractR sR-            IDone rR -> return rR-            IError err -> throwM $ ParseError err---- | 'Applicative' form of 'serialWith'.-instance MonadThrow m => Applicative (Parser m a) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = serialWith id--    {-# INLINE (*>) #-}-    (*>) = split_--#if MIN_VERSION_base(4,10,0)-    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)-#endif------------------------------------------------------------------------------------ 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------ | See 'Streamly.Internal.Data.Parser.alt'.------ /Pre-release/----{-# INLINE alt #-}-alt :: Monad m => Parser m x a -> Parser m x a -> Parser m x 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.-    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-                assert (cnt + 1 - n >= 0) (return ())-                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) = extractR sR-    extract (AltParseL _ sL) = extractL sL---- | See documentation of 'Streamly.Internal.Data.Parser.many'.------ /Pre-release/----{-# INLINE splitMany #-}-splitMany :: MonadCatch m =>  Parser m a b -> Fold m b c -> Parser m a 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 $ Tuple3' 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 (Tuple3' st cnt fs) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assert (cnt1 - n >= 0) (return ())-                return $ Continue n (Tuple3' s (cnt1 - n) fs)-            Continue n s -> do-                assert (cnt1 - n >= 0) (return ())-                return $ Continue n (Tuple3' s (cnt1 - n) fs)-            Done n b -> do-                assert (cnt1 - n >= 0) (return ())-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    extract (Tuple3' _ 0 fs) = fextract fs-    -- XXX The "try" may impact performance if this parser is used as a scan-    extract (Tuple3' s _ fs) = do-        r <- try $ extract1 s-        case r of-            Left (_ :: ParseError) -> fextract fs-            Right b -> do-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fextract s1-                    FL.Done b1 -> return b1---- | Like splitMany, but inner fold emits an output at the end even if no input--- is received.------ /Internal/----{-# INLINE splitManyPost #-}-splitManyPost :: MonadCatch m =>  Parser m a b -> Fold m b c -> Parser m a 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 $ Tuple3' 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 (Tuple3' st cnt fs) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assert (cnt1 - n >= 0) (return ())-                return $ Continue n (Tuple3' s (cnt1 - n) fs)-            Continue n s -> do-                assert (cnt1 - n >= 0) (return ())-                return $ Continue n (Tuple3' s (cnt1 - n) fs)-            Done n b -> do-                assert (cnt1 - n >= 0) (return ())-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    -- XXX The "try" may impact performance if this parser is used as a scan-    extract (Tuple3' s _ fs) = do-        r <- try $ extract1 s-        case r of-            Left (_ :: ParseError) -> fextract fs-            Right b -> do-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fextract s1-                    FL.Done b1 -> return b1---- | See documentation of 'Streamly.Internal.Data.Parser.some'.------ /Pre-release/----{-# INLINE splitSome #-}-splitSome :: MonadCatch m => Parser m a b -> Fold m b c -> Parser m a 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 $ Tuple3' 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 $ Tuple3' 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 (Tuple3' 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-                assert (cnt1 - n >= 0) (return ())-                return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))-            Continue n s -> do-                assert (cnt1 - n >= 0) (return ())-                return $ Continue n (Tuple3' s (cnt1 - n) (Left fs))-            Done n b -> do-                assert (cnt1 - n >= 0) (return ())-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error err -> return $ Error err-    step (Tuple3' st cnt (Right fs)) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assert (cnt1 - n >= 0) (return ())-                return $ Partial n (Tuple3' s (cnt1 - n) (Right fs))-            Continue n s -> do-                assert (cnt1 - n >= 0) (return ())-                return $ Continue n (Tuple3' s (cnt1 - n) (Right fs))-            Done n b -> do-                assert (cnt1 - n >= 0) (return ())-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> Done cnt1 <$> fextract fs--    -- XXX The "try" may impact performance if this parser is used as a scan-    extract (Tuple3' s _ (Left fs)) = do-        b <- extract1 s-        fs1 <- fstep fs b-        case fs1 of-            FL.Partial s1 -> fextract s1-            FL.Done b1 -> return b1-    extract (Tuple3' s _ (Right fs)) = do-        r <- try $ extract1 s-        case r of-            Left (_ :: ParseError) -> fextract fs-            Right b -> do-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fextract s1-                    FL.Done b1 -> return b1---- | See 'Streamly.Internal.Data.Parser.die'.------ /Pre-release/----{-# INLINE_NORMAL die #-}-die :: MonadThrow m => String -> Parser m a b-die err = Parser undefined (pure (IError err)) undefined---- | See 'Streamly.Internal.Data.Parser.dieM'.------ /Pre-release/----{-# INLINE dieM #-}-dieM :: MonadThrow m => m String -> Parser m a 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.---- | 'Alternative' instance using 'alt'.------ 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]--- 1----instance MonadCatch m => Alternative (Parser m a) 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 b)---- | See 'Streamly.Internal.Data.Parser.concatMap'.------ /Pre-release/----{-# INLINE concatMap #-}-concatMap :: MonadThrow m =>-    (b -> Parser m a c) -> Parser m a b -> Parser m a 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 (Parser _ initialR extractR) = do-        res <- initialR-        case res of-            IPartial s -> extractR s-            IDone b -> return b-            IError err -> throwM $ ParseError err--    extract (ConcatParseR _ s extractR) = extractR s-    extract (ConcatParseL sL) = extractL sL >>= extractP . func--{-# INLINE noErrorUnsafeConcatMap #-}-noErrorUnsafeConcatMap :: MonadThrow m =>-    (b -> Parser m a c) -> Parser m a b -> Parser m a 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 (Parser _ initialR extractR) = do-        res <- initialR-        case res of-            IPartial s -> extractR s-            IDone b -> return b-            IError err -> throwM $ ParseError err--    extract (ConcatParseR _ s extractR) = extractR s-    extract (ConcatParseL sL) = extractL sL >>= extractP . func---- 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'.----instance MonadThrow m => Monad (Parser m a) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip concatMap--    {-# INLINE (>>) #-}-    (>>) = (*>)---- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.----instance MonadCatch m => MonadPlus (Parser m a) where-    {-# INLINE mzero #-}-    mzero = die "mzero"--    {-# INLINE mplus #-}-    mplus = alt--instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where-    {-# INLINE ask #-}-    ask = fromEffect ask-    {-# INLINE local #-}-    local f (Parser step init' extract) =-      Parser ((local f .) . step)-             (local f init')-             (local f . extract)---instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where-    {-# INLINE get #-}-    get = fromEffect get-    {-# INLINE put #-}-    put = fromEffect . put---instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) where-    {-# INLINE liftIO #-}-    liftIO = fromEffect . liftIO
− src/Streamly/Internal/Data/Parser/ParserK/Type.hs 
@@ -1,494 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-#include "inline.hs"---- |--- 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, sequenceA,--- Monad, sequence, and Alternative, choice operations compared to the--- quadratic complexity of the corresponding direct style operations. However,--- direct style operations allow fusion with ~10x better performance than CPS.------ The direct style representation does not allow for recursive definitions of--- "some" and "many" whereas CPS allows that.--module Streamly.Internal.Data.Parser.ParserK.Type-    (-      Parser (..)-    , fromPure-    , fromEffect-    , die--    -- * Conversion-    , toParserK-    , fromParserK-    )-where--import Control.Applicative (Alternative(..), liftA2)-import Control.Exception (assert, Exception(..))-import Control.Monad (MonadPlus(..), ap)-import Control.Monad.Catch (MonadCatch, MonadThrow(..), try)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader.Class (MonadReader, ask, local)-import Control.Monad.State.Class (MonadState, get, put)-#if MIN_VERSION_base(4,9,0)-import qualified Control.Monad.Fail as Fail-#endif-#if !(MIN_VERSION_base(4,10,0))-import Data.Semigroup ((<>))-#endif-import Streamly.Internal.Control.Exception--import qualified Streamly.Internal.Data.Parser.ParserD.Type as D---- | The parse driver result. The driver may stop with a final result, pause--- with a continuation to resume, or fail with an error.------ /Pre-release/----data Driver m a r =-      Stop !Int r-      -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.-      -- measure if that works any better.-    | Partial !Int (Maybe a -> m (Driver m a r))-    | Continue !Int (Maybe a -> m (Driver m a r))-    | Failed String--instance Functor m => Functor (Driver m a) where-    fmap f (Stop n r) = Stop n (f r)-    fmap f (Partial n yld) = Partial n (fmap (fmap f) . yld)-    fmap f (Continue n yld) = Continue n (fmap (fmap f) . yld)-    fmap _ (Failed e) = Failed e---- The parser's result.------ /Pre-release/----data Parse b =-      Done !Int !b      -- Done, no more input needed-    | Error !String     -- Failed--instance Functor Parse where-    fmap f (Done n b) = Done n (f b)-    fmap _ (Error e) = Error e---- | A continuation passing style parser representation.-newtype Parser m a b = MkParser-    { runParser :: forall r.-           -- The number of elements that were not used by the previous-           -- consumer and should be carried forward.-           Int-           -- (nesting level, used elem count). Nesting level is increased-           -- whenever we enter an Alternative composition and decreased when-           -- it is done. The used element count is a count of elements-           -- consumed by the Alternative. If the Alternative fails we need to-           -- backtrack by this amount.-           ---           -- The nesting level is used in parseDToK to optimize the case when-           -- we are not in an alternative, in that case we do not need to-           -- maintain the element count for backtracking.-        -> (Int, Int)-           -- The first argument is the (nest level, used count) tuple as-           -- described above. The leftover element count is carried as part of-           -- 'Done' constructor of 'Parse'.-        -> ((Int, Int) -> Parse b -> m (Driver m a r))-        -> m (Driver m a r)-    }------------------------------------------------------------------------------------ Convert direct style 'D.Parser' to CPS style 'Parser'------------------------------------------------------------------------------------ XXX Unlike the direct style folds/parsers, the initial action in CPS parsers--- is not performed when the fold is initialized. It is performed when the--- first element is processed by the fold or if no elements are processed then--- at the extraction. We should either make the direct folds like this or make--- the CPS folds behavior also like the direct ones.------ | Convert a direct style parser ('D.Parser') to a CPS style parser--- ('Parser').----{-# INLINE_NORMAL parseDToK #-}-parseDToK-    :: MonadCatch m-    => (s -> a -> m (D.Step s b))-    -> m (D.Initial s b)-    -> (s -> m b)-    -> Int-    -> (Int, Int)-    -> ((Int, Int) -> Parse b -> m (Driver m a r))-    -> m (Driver m a r)--parseDToK pstep initial extract leftover (0, _) cont = do-    res <- initial-    case res of-        D.IPartial r -> return $ Continue leftover (parseCont (return r))-        D.IDone b -> cont (0,0) (Done 0 b)-        D.IError err -> cont (0,0) (Error err)--    where--    parseCont pst (Just x) = do-        r <- pst-        pRes <- pstep r x-        case pRes of-            D.Done n b -> cont (0,0) (Done n b)-            D.Error err -> cont (0,0) (Error err)-            D.Partial n pst1 -> return $ Partial n (parseCont (return pst1))-            D.Continue n pst1 -> return $ Continue n (parseCont (return pst1))--    parseCont acc Nothing = do-        pst <- acc-        r <- try $ extract pst-        case r of-            Left (e :: D.ParseError) -> cont (0,0) (Error (displayException e))-            Right b -> cont (0,0) (Done 0 b)--parseDToK pstep initial extract leftover (level, count) cont = do-    res <- initial-    case res of-        D.IPartial r -> return $ Continue leftover (parseCont count (return r))-        D.IDone b -> cont (level,count) (Done 0 b)-        D.IError err -> cont (level,count) (Error err)--    where--    parseCont !cnt pst (Just x) = do-        let !cnt1 = cnt + 1-        r <- pst-        pRes <- pstep r x-        case pRes of-            D.Done n b -> do-                assert (n <= cnt1) (return ())-                cont (level, cnt1 - n) (Done n b)-            D.Error err ->-                cont (level, cnt1) (Error err)-            D.Partial n pst1 -> do-                assert (n <= cnt1) (return ())-                return $ Partial n (parseCont (cnt1 - n) (return pst1))-            D.Continue n pst1 -> do-                assert (n <= cnt1) (return ())-                return $ Continue n (parseCont (cnt1 - n) (return pst1))-    parseCont cnt acc Nothing = do-        pst <- acc-        r <- try $ extract pst-        let s = (level, cnt)-        case r of-            Left (e :: D.ParseError) -> cont s (Error (displayException e))-            Right b -> cont s (Done 0 b)---- | Convert a direct style 'D.Parser' to a CPS style 'Parser'.------ /Pre-release/----{-# INLINE_LATE toParserK #-}-toParserK :: MonadCatch m => D.Parser m a b -> Parser m a b-toParserK (D.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 => (Int, Int) -> Parse b -> m (Driver m a b)-parserDone (0,_) (Done n b) = return $ Stop n b-parserDone st (Done _ _) =-    error $ "Bug: fromParserK: inside alternative: " ++ show st-parserDone _ (Error e) = return $ Failed e---- | When there is no more input to feed, extract the result from the Parser.------ /Pre-release/----extractParse :: MonadThrow m => (Maybe a -> m (Driver m a b)) -> m b-extractParse cont = do-    r <- cont Nothing-    case r of-        Stop _ b -> return b-        Partial _ _ -> error "Bug: extractParse got Partial"-        Continue _ cont1 -> extractParse cont1-        Failed e -> throwM $ D.ParseError e--data FromParserK b c = FPKDone !Int !b | FPKCont c---- | Convert a CPS style 'Parser' to a direct style 'D.Parser'.------ "initial" returns a continuation which can be called one input at a time--- using the "step" function.------ /Pre-release/----{-# INLINE_LATE fromParserK #-}-fromParserK :: MonadThrow m => Parser m a b -> D.Parser m a b-fromParserK parser = D.Parser step initial extract--    where--    initial = do-        r <- runParser parser 0 (0,0) parserDone-        return $ case r of-            Stop n b -> D.IPartial $ FPKDone n b-            Failed e -> D.IError e-            Partial _ cont -> D.IPartial $ FPKCont cont -- XXX can we get this?-            Continue _ cont -> D.IPartial $ FPKCont cont--    -- Note, we can only reach FPKDone and FPKError from "initial". FPKCont-    -- always transitions to only FPKCont.  The input remains unconsumed in-    -- this case so we use "n + 1".-    step (FPKDone n b) _ = do-        assertM (n == 0)-        return $ D.Done (n + 1) b-    step (FPKCont cont) a = do-        r <- cont (Just a)-        return $ case r of-            Stop n b -> D.Done n b-            Failed e -> D.Error e-            Partial n cont1 -> D.Partial n (FPKCont cont1)-            Continue n cont1 -> D.Continue n (FPKCont cont1)--    -- Note, we can only reach FPKDone and FPKError from "initial".-    extract (FPKDone _ b) = return b-    extract (FPKCont cont) = extractParse cont--#ifndef DISABLE_FUSION-{-# RULES "fromParserK/toParserK fusion" [2]-    forall s. toParserK (fromParserK s) = s #-}-{-# RULES "toParserK/fromParserK fusion" [2]-    forall s. fromParserK (toParserK s) = s #-}-#endif------------------------------------------------------------------------------------ Functor------------------------------------------------------------------------------------ | Maps a function over the output of the parser.----instance Functor m => Functor (Parser m a) where-    {-# INLINE fmap #-}-    fmap f parser = MkParser $ \lo st yieldk ->-        let yld s res = yieldk s (fmap f res)-         in runParser parser lo st yld------------------------------------------------------------------------------------ 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 -> Parser m a b-fromPure b = MkParser $ \lo st yieldk -> yieldk st (Done lo b)---- | See 'Streamly.Internal.Data.Parser.fromEffect'.------ /Pre-release/----{-# INLINE fromEffect #-}-fromEffect :: Monad m => m b -> Parser m a b-fromEffect eff = MkParser $ \lo st yieldk -> eff >>= \b -> yieldk st (Done lo b)---- | 'Applicative' form of 'Streamly.Internal.Data.Parser.serialWith'. Note that--- this operation does not fuse, use 'Streamly.Internal.Data.Parser.serialWith'--- when fusion is important.----instance Monad m => Applicative (Parser m a) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = ap--    {-# INLINE (*>) #-}-    m1 *> m2 = MkParser $ \lo st yieldk ->-        let yield1 s (Done n _) = runParser m2 n s yieldk-            yield1 s (Error e) = yieldk s (Error e)-        in runParser m1 lo st yield1--    {-# INLINE (<*) #-}-    m1 <* m2 = MkParser $ \lo st yieldk ->-        let yield1 s (Done n b) =-                let yield2 s1 (Done n1 _) = yieldk s1 (Done n1 b)-                    yield2 s1 (Error e) = yieldk s1 (Error e)-                in runParser m2 n s yield2-            yield1 s (Error e) = yieldk s (Error e)-        in runParser m1 lo st yield1--#if MIN_VERSION_base(4,10,0)-    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)-#endif------------------------------------------------------------------------------------ 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 -> Parser m a b-die err = MkParser (\_ st yieldk -> yieldk st (Error err))---- | 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 m Char 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 m Char 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 (Parser m a) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    m >>= k = MkParser $ \lo st yieldk ->-        let yield1 s (Done n b) = runParser (k b) n s yieldk-            yield1 s (Error e) = yieldk s (Error e)-         in runParser m lo st yield1--    {-# 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--#if MIN_VERSION_base(4,9,0)-instance Monad m => Fail.MonadFail (Parser m a) where-    {-# INLINE fail #-}-    fail = die-#endif--instance (MonadThrow m, MonadReader r m, MonadCatch m) => MonadReader r (Parser m a) where-    {-# INLINE ask #-}-    ask = fromEffect ask-    {-# INLINE local #-}-    local f (fromParserK -> dp) =-      toParserK $ local f dp---instance (MonadThrow m, MonadState s m) => MonadState s (Parser m a) where-    {-# INLINE get #-}-    get = fromEffect get-    {-# INLINE put #-}-    put = fromEffect . put---instance (MonadThrow m, MonadIO m) => MonadIO (Parser m a) 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 (Parser m a) where-    {-# INLINE empty #-}-    empty = die "empty"--    {-# INLINE (<|>) #-}-    m1 <|> m2 = MkParser $ \lo (level, _) yieldk ->-        let yield1 (0, _) _ = error "0 nest level in Alternative"-            yield1 (lvl, _) (Done n b) = yieldk (lvl - 1, 0) (Done n b)-            yield1 (lvl, cnt) (Error _) = runParser m2 cnt (lvl - 1, 0) yieldk-        in runParser m1 lo (level + 1, 0) yield1--    -- 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.------ /Pre-release/----instance Monad m => MonadPlus (Parser m a) where-    {-# INLINE mzero #-}-    mzero = die "mzero"--    {-# INLINE mplus #-}-    mplus = (<|>)
− src/Streamly/Internal/Data/Pipe.hs 
@@ -1,1968 +0,0 @@--- |--- 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.Prelude"), 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.Prelude (MonadAsync, parallel)--- import Streamly.Data.Fold.Types (Fold(..))-import Streamly.Internal.Data.Pipe.Type-       (Pipe(..), PipeState(..), Step(..), zipWith, tee, map, compose)--- import Streamly.Internal.Data.Array.Foreign.Type (Array)--- import Streamly.Internal.Data.Ring.Foreign (Ring)--- import Streamly.Internal.Data.Stream.Serial (SerialT)--- import Streamly.Internal.Data.Stream.StreamK (IsStream())--- import Streamly.Internal.Data.Time.Units--- (AbsTime, MilliSecond64(..), addToAbsTime, diffAbsTime, toRelTime,--- toAbsTime)---- import Streamly.Internal.Data.Strict---- import qualified Streamly.Internal.Data.Array.Foreign.Type as A--- import qualified Streamly.Prelude 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.Prelude 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 ())-{----------------------------------------------------------------------------------- Filtering----------------------------------------------------------------------------------- | Include only those elements that pass a predicate.------ >>> FL.foldl (lfilter (> 5) FL.sum) [1..10]--- 40------ @since 0.7.0-{-# INLINABLE lfilter #-}-lfilter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r-lfilter f (Fold step begin done) = Fold step' begin done-  where-    step' x a = if f a then step x a else return x---- | Like 'lfilter' but with a monadic predicate.------ @since 0.7.0-{-# INLINABLE lfilterM #-}-lfilterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r-lfilterM 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 x---- | Take first 'n' elements from the stream and discard the rest.------ @since 0.7.0-{-# INLINABLE ltake #-}-ltake :: Monad m => Int -> Fold m a b -> Fold m a b-ltake n (Fold step initial done) = Fold step' initial' done'-    where-    initial' = fmap (Tuple' 0) initial-    step' (Tuple' i r) a = do-        if i < n-        then do-            res <- step r a-            return $ Tuple' (i + 1) res-        else return $ Tuple' i r-    done' (Tuple' _ r) = done r---- | Takes elements from the input as long as the predicate succeeds.------ @since 0.7.0-{-# INLINABLE ltakeWhile #-}-ltakeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-ltakeWhile predicate (Fold step initial done) = Fold step' initial' done'-    where-    initial' = fmap Left' initial-    step' (Left' r) a = do-        if predicate a-        then fmap Left' $ step r a-        else return (Right' r)-    step' r _ = return r-    done' (Left' r) = done r-    done' (Right' r) = done r----------------------------------------------------------------------------------- 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 sent to fold @f1@ and the rest of the stream is--- sent to fold @f2@.------ > let splitAt_ n xs = FL.foldl' (FL.splitAt n FL.toList FL.toList) $ S.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],[])------ This can be considered as a two-fold version of 'ltake' where we take both--- the segments instead of discarding the leftover.------ @since 0.7.0-{-# INLINE splitAt #-}-splitAt-    :: Monad m-    => Int-    -> Fold m a b-    -> Fold m a c-    -> Fold m a (b, c)-splitAt n (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step init extract-    where-      init  = Tuple3' <$> return n <*> initialL <*> initialR--      step (Tuple3' i xL xR) input =-        if i > 0-        then stepL xL input >>= (\a -> return (Tuple3' (i - 1) a xR))-        else stepR xR input >>= (\b -> return (Tuple3' i xL b))--      extract (Tuple3' _ a b) = (,) <$> extractL a <*> extractR b----------------------------------------------------------------------------------- N-ary APIs------------------------------------------------------------------------------------------------------------------------------------------------------------------ Generalized grouping----------------------------------------------------------------------------------- This combinator is the most general grouping combinator and can be used to--- implement all other grouping combinators.------ XXX check if this can implement the splitOn combinator i.e. we can slide in--- new elements, slide out old elements and incrementally compute the hash.--- Also, can we implement the windowed classification combinators using this?------ In fact this is a parse. Instead of using a special return value in the fold--- we are using a mapping function.------ Note that 'scanl'' (usually followed by a map to extract the desired value--- from the accumulator) can be used to realize many implementations e.g. a--- sliding window implementation. A scan followed by a mapMaybe is also a good--- pattern to express many problems where we want to emit a filtered output and--- not emit an output on every input.------ Passing on of the initial accumulator value to the next fold is equivalent--- to returning the leftover concept.--{---- | @groupScan splitter fold stream@ folds the input stream using @fold@.--- @splitter@ is applied on the accumulator of the fold every time an item is--- consumed by the fold. The fold continues until @splitter@ returns a 'Just'--- value.  A 'Just' result from the @splitter@ specifies a result to be emitted--- in the output stream and the initial value of the accumulator for the next--- group's fold. This allows us to control whether to start fresh for the next--- fold or to continue from the previous fold's output.----{-# INLINE groupScan #-}-groupScan-    :: (IsStream t, Monad m)-    => (x -> m (Maybe (b, x))) -> Fold m a x -> t m a -> t m b-groupScan split fold m = undefined--}---- | Group the input stream into groups of @n@ elements each and then fold each--- group using the provided fold function.------ >> S.toList $ FL.chunksOf 2 FL.sum (S.enumerateFromTo 1 10)--- > [3,7,11,15,19]------ This can be considered as an n-fold version of 'ltake' where we apply--- 'ltake' repeatedly on the leftover stream until the stream exhausts.------ @since 0.7.0-{-# INLINE chunksOf #-}-chunksOf-    :: (IsStream t, Monad m)-    => Int -> Fold m a b -> t m a -> t m b-chunksOf n f m = D.fromStreamD $ D.groupsOf n f (D.toStreamD m)---- | Transform a fold from a pure input to a 'Maybe' input, consuming only--- 'Just' values.-{-# INLINE lcatMaybes #-}-lcatMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b-lcatMaybes = lfilter isJust . lmap fromJust---- XXX we can implement this by repeatedly applying the 'lrunFor' fold.--- XXX add this example after fixing the serial stream rate control--- >>> S.toList $ S.take 5 $ sessionsOf 1 FL.sum $ constRate 2 $ S.enumerateFrom 1--- > [3,7,11,15,19]------ | Group the input stream into windows of @n@ second each and then fold each--- group using the provided fold function.------ @since 0.7.0-{-# INLINE sessionsOf #-}-sessionsOf-    :: (IsStream t, MonadAsync m)-    => Double -> Fold m a b -> t m a -> t m b-sessionsOf n f xs =-    splitSuffixBy' isNothing (lcatMaybes f)-        (S.intersperseByTime n (return Nothing) (S.map Just xs))----------------------------------------------------------------------------------- Element Aware APIs-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Binary APIs----------------------------------------------------------------------------------- | 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.----_spanBy-    :: Monad m-    => (a -> a -> Bool)-    -> Fold m a b-    -> Fold m a c-    -> Fold m a (b, c)-_spanBy cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step init extract--    where-      init = Tuple3' <$> initialL <*> initialR <*> return (Tuple' Nothing True)--      step (Tuple3' a b (Tuple' (Just frst) isFirstG)) input =-        if cmp frst input && isFirstG-        then stepL a input-              >>= (\a' -> return (Tuple3' a' b (Tuple' (Just frst) isFirstG)))-        else stepR b input-              >>= (\a' -> return (Tuple3' a a' (Tuple' Nothing False)))--      step (Tuple3' a b (Tuple' Nothing isFirstG)) input =-        if isFirstG-        then stepL a input-              >>= (\a' -> return (Tuple3' a' b (Tuple' (Just input) isFirstG)))-        else stepR b input-              >>= (\a' -> return (Tuple3' a a' (Tuple' Nothing False)))--      extract (Tuple3' a b _) = (,) <$> extractL a <*> extractR b---- | Span as long as the predicate is 'True'. @span p f1 f2@ composes folds--- @f1@ and @f2@ such that the composed fold continues sending the input to--- @f1@ as long as the predicate @p@ is 'True'.  The rest of the input is sent--- to @f2@.------ > let span_ p xs = FL.foldl' (FL.span p FL.toList FL.toList) $ S.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],[])------ This can be considered as a two-fold version of 'ltakeWhile' where we take--- both the segments instead of discarding the leftover.------ @since 0.7.0-{-# INLINE span #-}-span-    :: Monad m-    => (a -> Bool)-    -> Fold m a b-    -> Fold m a c-    -> Fold m a (b, c)-span p (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step init extract--    where-      init = Tuple3' <$> initialL <*> initialR <*> return True--      step (Tuple3' a b isFirstG) input =-        if isFirstG && p input-        then stepL a input >>= (\a' -> return (Tuple3' a' b True))-        else stepR b input >>= (\a' -> return (Tuple3' a a' False))--      extract (Tuple3' a b _) = (,) <$> extractL a <*> extractR b---- |--- > break p = span (not . p)------ Break as soon as the predicate becomes 'True'. @break p f1 f2@ composes--- folds @f1@ and @f2@ such that @f1@ stops receiving input as soon as the--- predicate @p@ becomes 'True'. The rest of the input is sent to @f2@.------ This is the binary version of 'splitBy'.------ > let break_ p xs = FL.foldl' (FL.break p FL.toList FL.toList) $ S.fromList xs------ >>> break_ (< 1) [3,2,1]--- > ([3,2,1],[])------ >>> break_ (< 2) [3,2,1]--- > ([3,2],[1])------ >>> break_ (< 4) [3,2,1]--- > ([],[3,2,1])------ @since 0.7.0-{-# INLINE break #-}-break-    :: Monad m-    => (a -> Bool)-    -> Fold m a b-    -> Fold m a c-    -> Fold m a (b, c)-break p = span (not . p)---- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.--- predicate is applied to the previous and the next input elements.-{-# INLINE _spanRollingBy #-}-_spanRollingBy-    :: Monad m-    => (a -> a -> Bool)-    -> Fold m a b-    -> Fold m a c-    -> Fold m a (b, c)-_spanRollingBy cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step init extract--  where-    init = Tuple3' <$> initialL <*> initialR <*> return Nothing--    step (Tuple3' a b (Just frst)) input =-      if cmp input frst-      then stepL a input >>= (\a' -> return (Tuple3' a' b (Just input)))-      else stepR b input >>= (\b' -> return (Tuple3' a b' (Just input)))--    step (Tuple3' a b Nothing) input =-      stepL a input >>= (\a' -> return (Tuple3' a' b (Just input)))--    extract (Tuple3' a b _) = (,) <$> extractL a <*> extractR b----------------------------------------------------------------------------------- N-ary APIs------------------------------------------------------------------------------------- | @groupsBy cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the--- first group, if @a \`cmp` b@ is 'True' then @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 a new group is started. Each--- group is folded using the fold @f@.------ >>> S.toList $ FL.groupsBy (>) FL.toList $ S.fromList [1,3,7,0,2,5]--- > [[1,3,7],[0,2,5]]------ @since 0.7.0-{-# INLINE groupsBy #-}-groupsBy-    :: (IsStream t, Monad m)-    => (a -> a -> Bool)-    -> Fold m a b-    -> t m a-    -> t m b-groupsBy cmp f m = D.fromStreamD $ D.groupsBy cmp f (D.toStreamD m)---- | Unlike @groupsBy@ this function performs a rolling comparison of two--- successive elements in the input stream. @groupsRollingBy cmp f $ S.fromList--- [a,b,c,...]@ assigns the element @a@ to the first group, if @a \`cmp` b@ is--- 'True' then @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 a new group is started. Each group is folded using the fold--- @f@.------ >>> S.toList $ FL.groupsRollingBy (\a b -> a + 1 == b) FL.toList $ S.fromList [1,2,3,7,8,9]--- > [[1,2,3],[7,8,9]]------ @since 0.7.0-{-# INLINE groupsRollingBy #-}-groupsRollingBy-    :: (IsStream t, Monad m)-    => (a -> a -> Bool)-    -> Fold m a b-    -> t m a-    -> t m b-groupsRollingBy cmp f m =  D.fromStreamD $ D.groupsRollingBy cmp f (D.toStreamD m)---- |--- > groups = groupsBy (==)--- > groups = groupsRollingBy (==)------ Groups a contiguous span of equal elements together in one group.------ >>> S.toList $ FL.groups FL.toList $ S.fromList [1,1,2,2]--- > [[1,1],[2,2]]------ @since 0.7.0-groups :: (IsStream t, Monad m, Eq a) => Fold m a b -> t m a -> t m b-groups = groupsBy (==)----------------------------------------------------------------------------------- Binary splitting on a separator---------------------------------------------------------------------------------{---- | Find the first occurrence of the specified sequence in the input stream--- and break the input stream into two parts, the first part consisting of the--- stream before the sequence and the second part consisting of the sequence--- and the rest of the stream.------ > let breakOn_ pat xs = FL.foldl' (FL.breakOn pat FL.toList FL.toList) $ S.fromList xs------ >>> breakOn_ "dear" "Hello dear world!"--- > ("Hello ","dear world!")----{-# INLINE breakOn #-}-breakOn :: Monad m => Array a -> Fold m a b -> Fold m a c -> Fold m a (b,c)-breakOn pat f m = undefined--}----------------------------------------------------------------------------------- N-ary split on a predicate----------------------------------------------------------------------------------- TODO: Use a Splitter configuration similar to the "split" package to make it--- possible to express all splitting combinations. In general, we can have--- infix/suffix/prefix/condensing of separators, dropping both leading/trailing--- separators. We can have a single split operation taking the splitter config--- as argument.---- | Split a stream on separator elements determined by a predicate, dropping--- the separator.  Separators are not considered part of stream segments on--- either side of it instead they are treated as infixed between two stream--- segments. For example, with @.@ as separator, @"a.b.c"@ would be parsed as--- @["a","b","c"]@. When @.@ is in leading or trailing position it is still--- considered as infixed, treating the first or the last segment as empty.  For--- example, @".a."@ would be parsed as @["","a",""]@.  This operation is--- opposite of 'intercalate'.------ Let's use the following definition for illustration:------ > splitBy_ p xs = S.toList $ FL.splitBy p (FL.toList) (S.fromList xs)------ >>> splitBy_ (== '.') ""--- [""]------ >>> splitBy_ (== '.') "."--- ["",""]------ >>> splitBy_ (== '.') ".a"--- > ["","a"]------ >>> splitBy_ (== '.') "a."--- > ["a",""]------ >>> splitBy_ (== '.') "a.b"--- > ["a","b"]------ >>> splitBy_ (== '.') "a..b"--- > ["a","","b"]------ This can be considered as an n-fold version of 'break' where we apply--- 'break' successively on the input stream, dropping the first element--- of the second segment after each break.------ @since 0.7.0-{-# INLINE splitBy #-}-splitBy-    :: (IsStream t, Monad m)-    => (a -> Bool) -> Fold m a b -> t m a -> t m b-splitBy predicate f m =-    D.fromStreamD $ D.splitBy predicate f (D.toStreamD m)---- | Like 'splitBy' but the separator is treated as part of the previous--- stream segment (suffix).  Therefore, when the separator is in trailing--- position, no empty segment is considered to follow it. For example, @"a.b."@--- would be parsed as @["a","b"]@ instead of @["a","b",""]@ as in the case of--- 'splitBy'.------ > splitSuffixBy_ p xs = S.toList $ FL.splitSuffixBy p (FL.toList) (S.fromList xs)------ >>> splitSuffixBy_ (== '.') ""--- []------ >>> splitSuffixBy_ (== '.') "."--- [""]------ >>> splitSuffixBy_ (== '.') "a"--- ["a"]------ >>> splitSuffixBy_ (== '.') ".a"--- > ["","a"]------ >>> splitSuffixBy_ (== '.') "a."--- > ["a"]------ >>> splitSuffixBy_ (== '.') "a.b"--- > ["a","b"]------ >>> splitSuffixBy_ (== '.') "a.b."--- > ["a","b"]------ >>> splitSuffixBy_ (== '.') "a..b.."--- > ["a","","b",""]------ > lines = splitSuffixBy (== '\n')------ This can be considered as an n-fold version of 'breakPost' where we apply--- 'breakPost' successively on the input stream, dropping the first element--- of the second segment after each break.------ @since 0.7.0-{-# INLINE splitSuffixBy #-}-splitSuffixBy-    :: (IsStream t, Monad m)-    => (a -> Bool) -> Fold m a b -> t m a -> t m b-splitSuffixBy predicate f m =-    D.fromStreamD $ D.splitSuffixBy predicate f (D.toStreamD m)---- | Like 'splitBy' but ignores repeated separators or separators in leading--- or trailing position. Therefore, @"..a..b.."@ would be parsed as--- @["a","b"]@.  In other words, it treats the input like words separated by--- whitespace elements determined by the predicate.------ > wordsBy' p xs = S.toList $ FL.wordsBy p (FL.toList) (S.fromList xs)------ >>> wordsBy' (== ',') ""--- > []------ >>> wordsBy' (== ',') ","--- > []------ >>> wordsBy' (== ',') ",a,,b,"--- > ["a","b"]------ > words = wordsBy isSpace------ @since 0.7.0-{-# INLINE wordsBy #-}-wordsBy-    :: (IsStream t, Monad m)-    => (a -> Bool) -> Fold m a b -> t m a -> t m b-wordsBy predicate f m =-    D.fromStreamD $ D.wordsBy predicate f (D.toStreamD m)---- XXX we should express this using the Splitter config.------ We can get splitSuffixBy' by appending the suffix to the output segments--- produced by splitSuffixBy. However, it may add an additional suffix if the last--- fragment did not have a suffix in the first place.---- | Like 'splitSuffixBy' but keeps the suffix in the splits.------ > splitSuffixBy'_ p xs = S.toList $ FL.splitSuffixBy' p (FL.toList) (S.fromList xs)------ >>> splitSuffixBy'_ (== '.') ""--- []------ >>> splitSuffixBy'_ (== '.') "."--- ["."]------ >>> splitSuffixBy'_ (== '.') "a"--- ["a"]------ >>> splitSuffixBy'_ (== '.') ".a"--- > [".","a"]------ >>> splitSuffixBy'_ (== '.') "a."--- > ["a."]------ >>> splitSuffixBy'_ (== '.') "a.b"--- > ["a.","b"]------ >>> splitSuffixBy'_ (== '.') "a.b."--- > ["a.","b."]------ >>> splitSuffixBy'_ (== '.') "a..b.."--- > ["a.",".","b.","."]------ This can be considered as an n-fold version of 'breakPost' where we apply--- 'breakPost' successively on the input stream.------ @since 0.7.0-{-# INLINE splitSuffixBy' #-}-splitSuffixBy'-    :: (IsStream t, Monad m)-    => (a -> Bool) -> Fold m a b -> t m a -> t m b-splitSuffixBy' predicate f m =-    D.fromStreamD $ D.splitSuffixBy' predicate f (D.toStreamD m)----------------------------------------------------------------------------------- Split on a delimiter sequence----------------------------------------------------------------------------------- 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]--- > [[],[]]---- | Split the stream on both sides of a separator sequence, dropping the--- separator.------ For illustration, let's define a function that operates on pure lists:------ @--- splitOn_ pat xs = S.toList $ FL.splitOn (A.fromList pat) (FL.toList) (S.fromList xs)--- @------ >>> splitOn_ "" "hello"--- > ["h","e","l","l","o"]------ >>> splitOn_ "hello" ""--- > [""]------ >>> splitOn_ "hello" "hello"--- > ["",""]------ >>> splitOn_ "x" "hello"--- > ["hello"]------ >>> splitOn_ "h" "hello"--- > ["","ello"]------ >>> splitOn_ "o" "hello"--- > ["hell",""]------ >>> splitOn_ "e" "hello"--- > ["h","llo"]------ >>> splitOn_ "l" "hello"--- > ["he","","o"]------ >>> splitOn_ "ll" "hello"--- > ["he","o"]------ 'splitOn' is an inverse of 'intercalate'. The following law always holds:------ > intercalate . splitOn == id------ The following law holds when the separator is non-empty and contains none of--- the elements present in the input lists:------ > splitOn . intercalate == id------ The following law always holds:------ > concat . splitOn . intercalate == concat------ @since 0.7.0-{-# INLINE splitOn #-}-splitOn-    :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)-    => Array a -> Fold m a b -> t m a -> t m b-splitOn patt f m = D.fromStreamD $ D.splitOn patt f (D.toStreamD m)--{---- This can be implemented easily using Rabin Karp--- | Split on any one of the given patterns.-{-# INLINE splitOnAny #-}-splitOnAny-    :: (IsStream t, Monad m, Storable a, Integral a)-    => [Array a] -> Fold m a b -> t m a -> t m b-splitOnAny subseq f m = undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)--}---- | Like 'splitSuffixBy' but the separator is a sequence of elements, instead--- of a predicate for a single element.------ > splitSuffixOn_ pat xs = S.toList $ FL.splitSuffixOn (A.fromList pat) (FL.toList) (S.fromList xs)------ >>> splitSuffixOn_ "." ""--- [""]------ >>> splitSuffixOn_ "." "."--- [""]------ >>> splitSuffixOn_ "." "a"--- ["a"]------ >>> splitSuffixOn_ "." ".a"--- > ["","a"]------ >>> splitSuffixOn_ "." "a."--- > ["a"]------ >>> splitSuffixOn_ "." "a.b"--- > ["a","b"]------ >>> splitSuffixOn_ "." "a.b."--- > ["a","b"]------ >>> splitSuffixOn_ "." "a..b.."--- > ["a","","b",""]------ > lines = splitSuffixOn "\n"------ @since 0.7.0-{-# INLINE splitSuffixOn #-}-splitSuffixOn-    :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)-    => Array a -> Fold m a b -> t m a -> t m b-splitSuffixOn patt f m =-    D.fromStreamD $ D.splitSuffixOn False patt f (D.toStreamD m)--{---- | Like 'splitOn' but drops any empty splits.----{-# INLINE wordsOn #-}-wordsOn-    :: (IsStream t, Monad m, Storable a, Eq a)-    => Array a -> Fold m a b -> t m a -> t m b-wordsOn subseq f m = undefined -- D.fromStreamD $ D.wordsOn f subseq (D.toStreamD m)--}---- XXX use a non-monadic intersperse to remove the MonadAsync constraint.------ | Like 'splitOn' but splits the separator as well, as an infix token.------ > splitOn'_ pat xs = S.toList $ FL.splitOn' (A.fromList pat) (FL.toList) (S.fromList xs)------ >>> splitOn'_ "" "hello"--- > ["h","","e","","l","","l","","o"]------ >>> splitOn'_ "hello" ""--- > [""]------ >>> splitOn'_ "hello" "hello"--- > ["","hello",""]------ >>> splitOn'_ "x" "hello"--- > ["hello"]------ >>> splitOn'_ "h" "hello"--- > ["","h","ello"]------ >>> splitOn'_ "o" "hello"--- > ["hell","o",""]------ >>> splitOn'_ "e" "hello"--- > ["h","e","llo"]------ >>> splitOn'_ "l" "hello"--- > ["he","l","","l","o"]------ >>> splitOn'_ "ll" "hello"--- > ["he","ll","o"]------ @since 0.7.0-{-# INLINE splitOn' #-}-splitOn'-    :: (IsStream t, MonadAsync m, Storable a, Enum a, Eq a)-    => Array a -> Fold m a b -> t m a -> t m b-splitOn' patt f m = S.intersperseM (foldl' f (A.read patt)) $ splitOn patt f m---- | Like 'splitSuffixOn' but keeps the suffix intact in the splits.------ > splitSuffixOn'_ pat xs = S.toList $ FL.splitSuffixOn' (A.fromList pat) (FL.toList) (S.fromList xs)------ >>> splitSuffixOn'_ "." ""--- [""]------ >>> splitSuffixOn'_ "." "."--- ["."]------ >>> splitSuffixOn'_ "." "a"--- ["a"]------ >>> splitSuffixOn'_ "." ".a"--- > [".","a"]------ >>> splitSuffixOn'_ "." "a."--- > ["a."]------ >>> splitSuffixOn'_ "." "a.b"--- > ["a.","b"]------ >>> splitSuffixOn'_ "." "a.b."--- > ["a.","b."]------ >>> splitSuffixOn'_ "." "a..b.."--- > ["a.",".","b.","."]------ @since 0.7.0-{-# INLINE splitSuffixOn' #-}-splitSuffixOn'-    :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)-    => Array a -> Fold m a b -> t m a -> t m b-splitSuffixOn' patt f m =-    D.fromStreamD $ D.splitSuffixOn True patt f (D.toStreamD m)--{---- This can be implemented easily using Rabin Karp--- | Split post any one of the given patterns.-{-# INLINE splitSuffixOnAny #-}-splitSuffixOnAny-    :: (IsStream t, Monad m, Storable a, Integral a)-    => [Array a] -> Fold m a b -> t m a -> t m b-splitSuffixOnAny subseq f m = undefined-    -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)--}----------------------------------------------------------------------------------- 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.-{-# INLINE reassembleBy #-}-reassembleBy-    :: (IsStream t, Monad m)-    => Fold m a b-    -> (a -> a -> Int)-    -> t m a-    -> t m b-reassembleBy = undefined--}----------------------------------------------------------------------------------- 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--------|--- @--- >>> FL.foldl' (FL.tee FL.sum FL.length) (S.enumerateFromTo 1.0 100.0)--- (5050.0,100)------ @since 0.7.0-{-# INLINE tee #-}-tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)-tee f1 f2 = (,) <$> f1 <*> f2--{-# INLINE foldNil #-}-foldNil :: Monad m => Fold m a [b]-foldNil = Fold step begin done  where-  begin = return []-  step _ _ = return []-  done = return--{-# INLINE foldCons #-}-foldCons :: Monad m => Fold m a b -> Fold m a [b] -> Fold m a [b]-foldCons (Fold stepL beginL doneL) (Fold stepR beginR doneR) =-    Fold step begin done--    where--    begin = Tuple' <$> beginL <*> beginR-    step (Tuple' xL xR) a = Tuple' <$> stepL xL a <*> stepR xR a-    done (Tuple' xL xR) = (:) <$> (doneL xL) <*> (doneR xR)---- XXX use "List" instead of "[]"?, use Array for output to scale it to a large--- number of consumers?------ | 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--------|---                 |                         |---                            ...--- @------ >>> FL.foldl' (FL.distribute [FL.sum, FL.length]) (S.enumerateFromTo 1 5)--- [15,5]------ This is the consumer side dual of the producer side 'sequence' operation.------ @since 0.7.0-{-# INLINE distribute #-}-distribute :: Monad m => [Fold m a b] -> Fold m a [b]-distribute [] = foldNil-distribute (x:xs) = foldCons x (distribute xs)----------------------------------------------------------------------------------- Partitioning------------------------------------------------------------------------------------- | 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--------|--- @------ Send input to either fold randomly:------ >>> import System.Random (randomIO)--- >>> randomly a = randomIO >>= \x -> return $ if x then Left a else Right a--- >>> FL.foldl' (FL.partitionByM randomly FL.length FL.length) (S.enumerateFromTo 1 100)--- (59,41)------ Send input to the two folds in a proportion of 2:1:------ @--- import Data.IORef (newIORef, readIORef, writeIORef)--- 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 $ head r a------ main = do---  f <- proportionately 2 1---  r <- FL.foldl' (FL.partitionByM f FL.length FL.length) (S.enumerateFromTo (1 :: Int) 100)---  print r--- @--- @--- (67,33)--- @------ This is the consumer side dual of the producer side 'mergeBy' operation.------ @since 0.7.0-{-# INLINE partitionByM #-}-partitionByM :: Monad m-    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionByM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =--    Fold step begin done--    where--    begin = Tuple' <$> beginL <*> beginR-    step (Tuple' xL xR) a = do-        r <- f a-        case r of-            Left b -> Tuple' <$> stepL xL b <*> return xR-            Right c -> Tuple' <$> return xL <*> stepR xR c-    done (Tuple' xL xR) = (,) <$> doneL xL <*> doneR xR---- 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.------ Count even and odd numbers in a stream:------ @--- >>> let f = FL.partitionBy (\\n -> if even n then Left n else Right n)---                       (fmap (("Even " ++) . show) FL.length)---                       (fmap (("Odd "  ++) . show) FL.length)---   in FL.foldl' f (S.enumerateFromTo 1 100)--- ("Even 50","Odd 50")--- @------ @since 0.7.0-{-# 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.------ > partition = partitionBy id------ @since 0.7.0-{-# 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--}---- 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. We also want to make sure that the Map contains only--- those types and the full set of those types.  Instead of Map it should--- probably be a lookup-table using an array and not in GC memory.------ This is the consumer side dual of the producer side 'mux' operation (XXX to--- be implemented).---- | Split the input stream based on a key field and fold each split using a--- specific fold collecting the results in a map from the keys to the results.--- Useful for cases like protocol handlers to handle different type of packets--- using different handlers.------ @------                             |-------Fold m a b--- -----stream m a-----Map-----|---                             |-------Fold m a b---                             |---                                       ...--- @------ @since 0.7.0-{-# INLINE demuxWith #-}-demuxWith :: (Monad m, Ord k)-    => (a -> k) -> Map k (Fold m a b) -> Fold m a (Map k b)-demuxWith f kv = Fold step initial extract--    where--    initial = return kv-    step mp a =-        -- XXX should we raise an exception in Nothing case?-        -- Ideally we should enforce that it is a total map over k so that look-        -- up never fails-        -- XXX we could use a monadic update function for a single lookup and-        -- update in the map.-        let k = f a-        in case Map.lookup k mp of-            Nothing -> return mp-            Just (Fold step' acc extract') -> do-                !r <- acc >>= \x -> step' x a-                return $ Map.insert k (Fold step' (return r) extract') mp-    extract = Prelude.mapM (\(Fold _ acc e) -> acc >>= e)---- | Fold a stream of key value pairs using a map of specific folds for each--- key into a map from keys to the results of fold outputs of the corresponding--- values.------ @--- > let table = Data.Map.fromList [(\"SUM", FL.sum), (\"PRODUCT", FL.product)]---       input = S.fromList [(\"SUM",1),(\"PRODUCT",2),(\"SUM",3),(\"PRODUCT",4)]---   in FL.foldl' (FL.demux table) input--- One 1--- Two 2--- @------ @since 0.7.0-{-# INLINE demux #-}-demux :: (Monad m, Ord k)-    => Map k (Fold m a b) -> Fold m (k, a) (Map k b)-demux fs = demuxWith fst (Map.map (lmap snd) fs)---- | Split the input stream based on a key field and fold each split using a--- specific fold without collecting the results. Useful for cases like protocol--- handlers to handle different type of packets.------ @------                             |-------Fold m a ()--- -----stream m a-----Map-----|---                             |-------Fold m a ()---                             |---                                       ...--- @--------- @since 0.7.0---- demuxWith_ can be slightly faster than demuxWith because we do not need to--- update the Map in this case. This may be significant only if the map is--- large.-{-# INLINE demuxWith_ #-}-demuxWith_ :: (Monad m, Ord k)-    => (a -> k) -> Map k (Fold m a b) -> Fold m a ()-demuxWith_ f kv = Fold step initial extract--    where--    initial = do-        Prelude.mapM (\(Fold s i e) ->-            i >>= \r -> return (Fold s (return r) e)) kv-    step mp a =-        -- XXX should we raise an exception in Nothing case?-        -- Ideally we should enforce that it is a total map over k so that look-        -- up never fails-        case Map.lookup (f a) mp of-            Nothing -> return mp-            Just (Fold step' acc _) -> do-                _ <- acc >>= \x -> step' x a-                return mp-    extract mp = Prelude.mapM (\(Fold _ acc e) -> acc >>= e) mp >> return ()---- | Given a stream of key value pairs and a map from keys to folds, fold the--- values for each key using the corresponding folds, discarding the outputs.------ @--- > let prn = FL.drainBy print--- > let table = Data.Map.fromList [(\"ONE", prn), (\"TWO", prn)]---       input = S.fromList [(\"ONE",1),(\"TWO",2)]---   in FL.foldl' (FL.demux_ table) input--- One 1--- Two 2--- @------ @since 0.7.0-{-# INLINE demux_ #-}-demux_ :: (Monad m, Ord k) => Map k (Fold m a ()) -> Fold m (k, a) ()-demux_ fs = demuxWith_ fst (Map.map (lmap snd) fs)---- XXX instead of a Map we could yield the results as a pure stream as they--- complete. We could then concatMap the fold results to implement the--- windowing combinators.------ | 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.------ @--- > let input = S.fromList [(\"ONE",1),(\"ONE",1.1),(\"TWO",2), (\"TWO",2.2)]---   in FL.foldl' (FL.classify FL.toListRev) input--- fromList [(\"ONE",[1.1,1.0]),(\"TWO",[2.2,2.0])]--- @------ @since 0.7.0-{-# INLINE classifyWith #-}-classifyWith :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)-classifyWith f (Fold step initial extract) = Fold step' initial' extract'--    where--    initial' = return Map.empty-    step' kv a =-        let k = f a-        in case Map.lookup k kv of-            Nothing -> do-                x <- initial-                r <- step x a-                return $ Map.insert k r kv-            Just x -> do-                r <- step x a-                return $ Map.insert k r kv-    extract' = Prelude.mapM extract---- | 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.------ @--- > let input = S.fromList [(\"ONE",1),(\"ONE",1.1),(\"TWO",2), (\"TWO",2.2)]---   in FL.foldl' (FL.classify FL.toListRev) input--- fromList [(\"ONE",[1.1,1.0]),(\"TWO",[2.2,2.0])]--- @------ Same as:------ > classify fld = classifyWith fst (lmap snd fld)------ @since 0.7.0-{-# INLINE classify #-}-classify :: (Monad m, Ord k) => Fold m a b -> Fold m (k, a) (Map k b)-classify fld = classifyWith fst (lmap snd fld)----------------------------------------------------------------------------------- Unzipping------------------------------------------------------------------------------------- | Like 'unzipWith' but with a monadic splitter function.------ @since 0.7.0-{-# INLINE unzipWithM #-}-unzipWithM :: Monad m-    => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)-unzipWithM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =-    Fold step begin done--    where--    step (Tuple' xL xR) a = do-        (b,c) <- f a-        Tuple' <$> stepL xL b <*> stepR xR c-    begin = Tuple' <$> beginL <*> beginR-    done (Tuple' xL xR) = (,) <$> doneL xL <*> doneR xR---- | 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.------ @since 0.7.0-{-# 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 a x--------|--- -----Stream m x----(a,b)--|                       |----m (x,y)---                           |-------Fold b y--------|------ @------ This is the consumer side dual of the producer side 'zip' operation.------ @since 0.7.0-{-# INLINE unzip #-}-unzip :: Monad m => Fold m a x -> Fold m b y -> Fold m (a,b) (x,y)-unzip = unzipWith id----------------------------------------------------------------------------------- Nesting------------------------------------------------------------------------------------- | Modify the fold such that when the fold is done, instead of returning the--- accumulator, it returns a fold. The returned fold starts from where we left--- i.e. it uses the last accumulator value as the initial value of the--- accumulator. Thus we can resume the fold later and feed it more input.------ >> do--- >    more <- FL.foldl (FL.duplicate FL.sum) (S.enumerateFromTo 1 10)--- >    evenMore <- FL.foldl (FL.duplicate more) (S.enumerateFromTo 11 20)--- >    FL.foldl evenMore (S.enumerateFromTo 21 30)--- > 465------ @since 0.7.0-{-# INLINABLE duplicate #-}-duplicate :: Applicative m => Fold m a b -> Fold m a (Fold m a b)-duplicate (Fold step begin done) =-    Fold step begin (\x -> pure (Fold step (pure x) done))--{---- All the stream flattening transformations can also be applied to a fold--- input stream.---- | This can be used to apply all the stream generation operations on folds.-lconcatMap ::(IsStream t, Monad m) => (a -> t m b)-    -> Fold m b c-    -> Fold m a c-lconcatMap s f1 f2 = undefined--}---- All the grouping transformation that we apply to a stream can also be--- applied to a fold input stream.--{---- | 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.------ @------ XXX we should be able to implement it with parsers/terminating folds.----{-# INLINE lchunksInRange #-}-lchunksInRange :: Monad m-    => Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c-lchunksInRange low high (Fold step1 initial1 extract1)-                        (Fold step2 initial2 extract2) = undefined--}---- | Group the input stream into groups of @n@ elements each and then fold each--- group using the provided fold function.------ @------ -----Fold m a b----|-Fold n a c-|-Fold n a c-|-...-|----Fold m a c------ @----{-# INLINE lchunksOf #-}-lchunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c-lchunksOf n (Fold step1 initial1 extract1) (Fold step2 initial2 extract2) =-    Fold step' initial' extract'--    where--    initial' = (Tuple3' 0) <$> initial1 <*> initial2-    step' (Tuple3' i r1 r2) a = do-        if i < n-        then do-            res <- step1 r1 a-            return $ Tuple3' (i + 1) res r2-        else do-            res <- extract1 r1-            acc2 <- step2 r2 res--            i1 <- initial1-            acc1 <- step1 i1 a-            return $ Tuple3' 1 acc1 acc2-    extract' (Tuple3' _ _ r) = extract2 r---- | Group the input stream into windows of n second each and then fold each--- group using the provided fold function.------ For example, we can copy and distribute a stream to multiple folds where--- each fold can group the input differently e.g. by one second, one minute and--- one hour windows respectively and fold each resulting stream of folds.------ @------ -----Fold m a b----|-Fold n a c-|-Fold n a c-|-...-|----Fold m a c------ @-{-# INLINE lsessionsOf #-}-lsessionsOf :: MonadAsync m => Double -> Fold m a b -> Fold m b c -> Fold m a c-lsessionsOf n (Fold step1 initial1 extract1) (Fold step2 initial2 extract2) =-    Fold step' initial' extract'--    where--    -- XXX MVar may be expensive we need a cheaper synch mechanism here-    initial' = do-        i1 <- initial1-        i2 <- initial2-        mv1 <- liftIO $ newMVar i1-        mv2 <- liftIO $ newMVar (Right i2)-        t <- control $ \run ->-            mask $ \restore -> do-                tid <- forkIO $ catch (restore $ void $ run (timerThread mv1 mv2))-                                      (handleChildException mv2)-                run (return tid)-        return $ Tuple3' t mv1 mv2-    step' acc@(Tuple3' _ mv1 _) a = do-            r1 <- liftIO $ takeMVar mv1-            res <- step1 r1 a-            liftIO $ putMVar mv1 res-            return acc-    extract' (Tuple3' tid _ mv2) = do-        r2 <- liftIO $ takeMVar mv2-        liftIO $ killThread tid-        case r2 of-            Left e -> throwM e-            Right x -> extract2 x--    timerThread mv1 mv2 = do-        liftIO $ threadDelay (round $ n * 1000000)--        r1 <- liftIO $ takeMVar mv1-        i1 <- initial1-        liftIO $ putMVar mv1 i1--        res1 <- extract1 r1-        r2 <- liftIO $ takeMVar mv2-        res <- case r2 of-                    Left _ -> return r2-                    Right x -> fmap Right $ step2 x res1-        liftIO $ putMVar mv2 res-        timerThread mv1 mv2--    handleChildException ::-        MVar (Either SomeException a) -> SomeException -> IO ()-    handleChildException mv2 e = do-        r2 <- takeMVar mv2-        let r = case r2 of-                    Left _ -> r2-                    Right _ -> Left e-        putMVar mv2 r----------------------------------------------------------------------------------- Windowed classification----------------------------------------------------------------------------------- We divide the stream into windows or chunks in space or time and 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 can be split into--- windows by size or by using a split predicate on the elements in the stream.--- For example, when we receive a closing flag, we can close the window.------ A "chunk" is a space window and a "session" is a time window. Are there any--- other better short words to describe them. An alternative is to use--- "swindow" and "twindow". Another word for "session" could be "spell".------ TODO: To mark the position in space or time we can have Indexed or--- TimeStamped types. That can make it easy to deal with the position indices--- or timestamps.----------------------------------------------------------------------------------- Keyed Sliding Windows---------------------------------------------------------------------------------{--{-# INLINABLE classifySlidingChunks #-}-classifySlidingChunks-    :: (IsStream t, MonadAsync m, Ord k)-    => Int              -- ^ window size-    -> Int              -- ^ window slide-    -> Fold m a b       -- ^ Fold to be applied to window events-    -> t m (k, a, Bool) -- ^ window key, data, close event-    -> t m (k, b)-classifySlidingChunks wsize wslide (Fold step initial extract) str-    = undefined---- XXX Another variant could be to slide the window on an event, e.g. in TCP we--- slide the send window when an ack is received and we slide the receive--- window when a sequence is complete. Sliding is stateful in case of TCP,--- sliding releases the send buffer or makes data available to the user from--- the receive buffer.-{-# INLINABLE classifySlidingSessions #-}-classifySlidingSessions-    :: (IsStream t, MonadAsync m, Ord k)-    => Double         -- ^ timer tick in seconds-    -> Double         -- ^ time window size-    -> Double         -- ^ window slide-    -> Fold m a b     -- ^ Fold to be applied to window events-    -> t m (k, a, Bool, AbsTime) -- ^ window key, data, close flag, timestamp-    -> t m (k, b)-classifySlidingSessions tick interval slide (Fold step initial extract) str-    = undefined--}----------------------------------------------------------------------------------- Sliding Window Buffers----------------------------------------------------------------------------------- These buffered versions could be faster than concurrent incremental folds of--- all overlapping windows as in many cases we may not need all the values to--- compute the fold, we can just compute the result using the old value and new--- value.  However, we may need the buffer once in a while, for example for--- string search we usually compute the hash incrementally but when the hash--- matches the hash of the pattern we need to compare the whole string.------ XXX we should be able to implement sequence based splitting combinators--- using this combinator.--{---- | Buffer n elements of the input in a ring buffer. When t new elements are--- collected, slide the window to remove the same number of oldest elements,--- insert the new elements, and apply an incremental fold on the sliding--- window, supplying the outgoing elements, the new ring buffer as arguments.-slidingChunkBuffer-    :: (IsStream t, Monad m, Ord a, Storable a)-    => Int -- window size-    -> Int -- window slide-    -> Fold m (Ring a, Array a) b-    -> t m a-    -> t m b-slidingChunkBuffer = undefined---- Buffer n seconds worth of stream elements of the input in a radix tree.--- Every t seconds, remove the items that are older than n seconds, and apply--- an incremental fold on the sliding window, supplying the outgoing elements,--- and the new radix tree buffer as arguments.-slidingSessionBuffer-    :: (IsStream t, Monad m, Ord a, Storable a)-    => Int    -- window size-    -> Int    -- tick size-    -> Fold m (RTree a, Array a) b-    -> t m a-    -> t m b-slidingSessionBuffer = undefined--}----------------------------------------------------------------------------------- Keyed Session Windows---------------------------------------------------------------------------------{---- | Keyed variable size space windows. Close the window if we do not receive a--- window event in the next "spaceout" elements.-{-# INLINABLE classifyChunksBy #-}-classifyChunksBy-    :: (IsStream t, MonadAsync m, Ord k)-    => Int   -- ^ window spaceout (spread)-    -> Bool  -- ^ reset the spaceout when a chunk window element is received-    -> Fold m a b       -- ^ Fold to be applied to chunk window elements-    -> t m (k, a, Bool) -- ^ chunk key, data, last element-    -> t m (k, b)-classifyChunksBy spanout reset (Fold step initial extract) str = undefined---- | Like 'classifyChunksOf' but the chunk size is reset if an element is--- received within the chunk size window. The chunk gets closed only if no--- element is received within the chunk window.----{-# INLINABLE classifyKeepAliveChunks #-}-classifyKeepAliveChunks-    :: (IsStream t, MonadAsync m, Ord k)-    => Int   -- ^ window spaceout (spread)-    -> Fold m a b       -- ^ Fold to be applied to chunk window elements-    -> t m (k, a, Bool) -- ^ chunk key, data, last element-    -> t m (k, b)-classifyKeepAliveChunks spanout = classifyChunksBy spanout True--}---- | @classifySessionsBy tick timeout reset f stream@ groups together all input--- stream elements that belong to the same session. @timeout@ is the maximum--- lifetime of a session in seconds. All elements belonging to a session are--- purged after this duration.  If "reset" is 'Ture' then the timeout is reset--- after every event received in the session. Session duration is measured--- using the timestamp of the first element seen for that session.  To detect--- session timeouts, a monotonic event time clock is maintained using the--- timestamps seen in the inputs and a timer with a tick duration specified by--- @tick@.------ @session key@ is a key that uniquely identifies the session for the given--- element, @timestamp@ characterizes the time when the input element was--- generated, this is an absolute time measured from some @Epoch@. @session--- close@ is a boolean indicating whether this element marks the closing of the--- session. When an input element with @session close@ set to @True@ is seen--- the session is purged immediately.------ All the input elements belonging to a session are collected using the fold--- @f@.  The session key and the fold result are emitted in the output stream--- when the session is purged either via the session close event or via the--- session lifetime timeout.------ @since 0.7.0-{-# INLINABLE classifySessionsBy #-}-classifySessionsBy-    :: (IsStream t, MonadAsync m, Ord k)-    => Double         -- ^ timer tick in seconds-    -> Double         -- ^ session timeout-    -> Bool           -- ^ reset the timeout when an event is received-    -> Fold m a b     -- ^ Fold to be applied to session events-    -> t m (k, a, Bool, AbsTime) -- ^ session key, timestamp, close event, data-    -> t m (k, b)-classifySessionsBy tick timeout reset (Fold step initial extract) str =-    S.concatMap (\(Tuple4' _ _ _ s) -> s) $ S.scanlM' sstep szero stream--    where--    timeoutMs = toRelTime (round (timeout * 1000) :: MilliSecond64)-    tickMs = toRelTime (round (tick * 1000) :: MilliSecond64)-    szero = Tuple4' (toAbsTime (0 :: MilliSecond64)) H.empty Map.empty S.nil--    -- Got a new stream input element-    sstep (Tuple4' evTime hp mp _) (Just (key, a, closing, ts)) =-        -- XXX we should use a heap in pinned memory to scale it to a large-        -- size-        ---        -- deleting a key from the heap is expensive, so we never delete a-        -- key, we just purge it from the Map and it gets purged from the-        -- heap on timeout. We just need an extra lookup in the Map when-        -- the key is purged from the heap, that should not be expensive.-        ---        -- To detect session inactivity we keep a timestamp of the latest event-        -- in the Map along with the fold result.  When we purge the session-        -- from the heap we match the timestamp in the heap with the timestamp-        -- in the Map, if the latest timestamp is newer and has not expired we-        -- reinsert the key in the heap.-        ---        -- XXX if the key is an Int, we can also use an IntMap for slightly-        -- better performance.-        ---        let accumulate v = do-                Tuple' _ old <- maybe (initial >>= return . Tuple' ts) return v-                new <- step old a-                return $ Tuple' ts new-        in if closing-           then do-                let (r, mp') = Map.updateLookupWithKey (\_ _ -> Nothing) key mp-                Tuple' _ acc <- accumulate r-                res <- extract acc-                return $ Tuple4' evTime hp mp' (S.fromPure (key, res))-           else do-                    let r = Map.lookup key mp-                    acc <- accumulate r-                    let mp' = Map.insert key acc mp-                    let hp' =-                            case r of-                                Nothing ->-                                    let expiry = addToAbsTime ts timeoutMs-                                    in H.insert (Entry expiry key) hp-                                Just _ -> hp-                    -- Event time is maintained as monotonically increasing-                    -- time. If we have lagged behind any of the timestamps-                    -- seen then we increase it to match the latest time seen-                    -- in the timestamps. We also increase it on timer ticks.-                    return $ Tuple4' (max evTime ts) hp' mp' S.nil--    -- Got a timer tick event-    -- XXX can we yield the entries without accumulating them?-    sstep (Tuple4' evTime heap sessions _) Nothing = do-        (hp', mp', out) <- go heap sessions S.nil-        return $ Tuple4' curTime hp' mp' out--        where--        curTime = addToAbsTime evTime tickMs-        go hp mp out = do-            let hres = H.uncons hp-            case hres of-                Just (Entry ts key, hp') -> do-                    let duration = diffAbsTime curTime ts-                    if duration >= timeoutMs-                    then do-                        let (r, mp') = Map.updateLookupWithKey-                                            (\_ _ -> Nothing) key mp-                        case r of-                            Nothing -> go hp' mp' out-                            Just (Tuple' latestTS acc) -> do-                                let dur = diffAbsTime curTime latestTS-                                if dur >= timeoutMs || not reset-                                then do-                                    sess <- extract acc-                                    go hp' mp' ((key, sess) `S.cons` out)-                                else-                                    -- reset the session timeout-                                    let expiry = addToAbsTime latestTS timeoutMs-                                        hp'' = H.insert (Entry expiry key) hp'-                                        mp'' = Map.insert key (Tuple' latestTS acc) mp'-                                    in go hp'' mp'' out-                    else return (hp, mp, out)-                Nothing -> return (hp, mp, out)--    -- merge timer events in the stream-    stream = S.map Just str `parallel` S.repeatM timer-    timer = do-        liftIO $ threadDelay (round $ tick * 1000000)-        return Nothing---- | Like 'classifySessionsOf' but the session is kept alive if an event is--- received within the session window. The session times out and gets closed--- only if no event is received within the specified session window size.------ @since 0.7.0-{-# INLINABLE classifyKeepAliveSessions #-}-classifyKeepAliveSessions-    :: (IsStream t, MonadAsync m, Ord k)-    => Double         -- ^ session inactive timeout-    -> Fold m a b     -- ^ Fold to be applied to session payload data-    -> t m (k, a, Bool, AbsTime) -- ^ session key, data, close flag, timestamp-    -> t m (k, b)-classifyKeepAliveSessions timeout = classifySessionsBy 1 timeout True----------------------------------------------------------------------------------- Keyed tumbling windows----------------------------------------------------------------------------------- Tumbling windows is a special case of sliding windows where the window slide--- is the same as the window size. Or it can be a special case of session--- windows where the reset flag is set to False.---- XXX instead of using the early termination flag in the stream, we can use an--- early terminating fold instead.--{---- | Split the stream into fixed size chunks of specified size. Within each--- such chunk fold the elements in buckets identified by the keys. A particular--- bucket fold can be terminated early if a closing flag is encountered in an--- element for that key.------ @since 0.7.0-{-# INLINABLE classifyChunksOf #-}-classifyChunksOf-    :: (IsStream t, MonadAsync m, Ord k)-    => Int              -- ^ window size-    -> Fold m a b       -- ^ Fold to be applied to window events-    -> t m (k, a, Bool) -- ^ window key, data, close event-    -> t m (k, b)-classifyChunksOf wsize = classifyChunksBy wsize False--}---- | Split the stream into fixed size time windows of specified interval in--- seconds. Within each such window, fold the elements in buckets identified by--- the keys. A particular bucket fold can be terminated early if a closing flag--- is encountered in an element for that key. Once a fold is terminated the key--- and value for that bucket are emitted in the output stream.------ Session @timestamp@ in the input stream is an absolute time from some epoch,--- characterizing the time when the input element was generated.  To detect--- session window end, a monotonic event time clock is maintained synced with--- the timestamps with a clock resolution of 1 second.------ @since 0.7.0-{-# INLINABLE classifySessionsOf #-}-classifySessionsOf-    :: (IsStream t, MonadAsync m, Ord k)-    => Double         -- ^ time window size-    -> Fold m a b     -- ^ Fold to be applied to window events-    -> t m (k, a, Bool, AbsTime) -- ^ window key, data, close flag, timestamp-    -> t m (k, b)-classifySessionsOf interval = classifySessionsBy 1 interval False--}
− src/Streamly/Internal/Data/Pipe/Type.hs 
@@ -1,446 +0,0 @@-#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)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif-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 
@@ -1,88 +0,0 @@--- |--- 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 
@@ -1,237 +0,0 @@--- |--- 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 Control.Monad.Catch (MonadThrow, throwM)-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 parseD #-}-parseD-    :: MonadThrow m-    => ParserD.Parser m a b-    -> Producer m (Source s a) a-    -> Source s a-    -> m (b, Source s a)-parseD-    (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 (b, seed)-        ParserD.IError err -> throwM $ ParseError err--    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 (b, unread src s1)-                    Error err -> throwM $ ParseError err-            Skip s -> go SPEC s buf pst-            Stop   -> do-                b <- extract pst-                return (b, unread (reverse $ getList buf) (source Nothing))--    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 (b, unread src s1)-            Error err -> throwM $ ParseError err---- | Parse a buffered source using a parser, returning the parsed value and the--- remaining source.------ /Pre-release/-{-# INLINE [3] parse #-}-parse-    :: MonadThrow m-    => ParserK.Parser m a b-    -> Producer m (Source s a) a-    -> Source s a-    -> m (b, Source s a)-parse = parseD . ParserK.fromParserK------------------------------------------------------------------------------------ Nested parsing----------------------------------------------------------------------------------{-# INLINE parseManyD #-}-parseManyD :: MonadThrow m =>-       ParserD.Parser m a b-    -> Producer m (Source x a) a-    -> Producer m (Source x a) 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) <- parseD parser reader src-            return $ Yield b s1---- | Apply a parser repeatedly on a buffered source producer to generate a--- producer of parsed values.------ /Pre-release/-{-# INLINE parseMany #-}-parseMany :: MonadThrow m =>-       ParserK.Parser m a b-    -> Producer m (Source x a) a-    -> Producer m (Source x a) b-parseMany parser = parseManyD (ParserK.fromParserK parser)
− src/Streamly/Internal/Data/Producer/Type.hs 
@@ -1,186 +0,0 @@--- |--- 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 
@@ -1,254 +0,0 @@--- |--- 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 ((>=>))-#if __GLASGOW_HASKELL__ < 804-import Data.Semigroup (Semigroup((<>)))-#endif-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.IsStream 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.Prelude.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 = Stream.map 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 
@@ -1,44 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Ring--- Copyright   : (c) 2021 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC-----module Streamly.Internal.Data.Ring-    ( Ring(..)-    , createRing-    , unsafeInsertRing-    ) where--import Control.Monad.Primitive (PrimMonad(PrimState))-import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef, IORef)-import Data.Primitive.Array (newArray, writeArray, MutableArray)--data Ring a = Ring-    { arr :: MutableArray (PrimState IO) a-    , ringHead :: IORef Int -- current index to be over-written-    , ringMax :: !Int       -- first index beyond allocated memory-    }--{-# INLINE createRing #-}-createRing :: Int -> IO (Ring a)-createRing count = do-    arr' <- newArray count (undefined :: a)-    head' <- newIORef 0-    return (Ring-        { arr = arr'-        , ringHead = head'-        , ringMax = count-        })--{-# INLINE unsafeInsertRing #-}-unsafeInsertRing :: Ring a -> Int -> a -> IO ()-unsafeInsertRing Ring{..} idx x = do-    writeArray arr (mod idx ringMax) x-    ref <- readIORef ringHead-    if (ref+1) < ringMax-    then modifyIORef' ringHead ( + 1)-    else writeIORef ringHead 0
− src/Streamly/Internal/Data/Ring/Foreign.hs 
@@ -1,558 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Ring.Foreign--- 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.Foreign-    ( 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-    ) where--#include "ArrayMacros.h"-#include "inline.hs"--import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Foreign.Ptr (plusPtr, minusPtr, castPtr)-import Foreign.Storable (Storable(..))-import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)-import GHC.Ptr (Ptr(..))-import Streamly.Internal.Data.Array.Foreign.Mut.Type (Array, memcmp)-import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (unsafeInlineIO)--import qualified Streamly.Internal.Data.Array.Foreign.Type as A--import Prelude hiding (length, concat, read)---- $setup--- >>> :m--- >>> import qualified Streamly.Internal.Data.Ring.Foreign 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 * SIZE_OF(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 = 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 :: Array 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------------------------------------------------------------------------------------ | Unfold a ring array into a stream.------ /Unimplemented/-{-# INLINE_NORMAL read #-}-read :: -- forall m a. (MonadIO m, Storable a) =>-    Unfold m (Ring a) a-read = undefined---- | Unfold a ring array into a stream in reverse order.------ /Unimplemented/-{-# INLINE_NORMAL readRev #-}-readRev :: -- forall m a. (MonadIO m, Storable a) =>-    Unfold m (Array 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 -> SerialT m a -> SerialT m (Array 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` 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{..} n =-    let !res = unsafeInlineIO $ do-            let rs = unsafeForeignPtrToPtr ringStart-                as = arrStart-            assert (aEnd `minusPtr` as >= ringBound `minusPtr` rs) (return ())-            let len = ringBound `minusPtr` rh-            r1 <- memcmp (castPtr rh) (castPtr as) (min len n)-            r2 <- if n > len-                then memcmp (castPtr rs) (castPtr (as `plusPtr` len))-                              (min (rh `minusPtr` rs) (n - len))-                else return True-            -- XXX enable these, check perf impact-            -- touchForeignPtr ringStart-            -- touchForeignPtr aStart-            return (r1 && r2)-    in res---- | 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{..} =-    let !res = unsafeInlineIO $ do-            let rs = unsafeForeignPtrToPtr ringStart-            let as = arrStart-            assert (aEnd `minusPtr` as >= ringBound `minusPtr` rs)-                   (return ())-            let len = ringBound `minusPtr` rh-            r1 <- memcmp (castPtr rh) (castPtr as) len-            r2 <- memcmp (castPtr rs) (castPtr (as `plusPtr` len))-                           (rh `minusPtr` rs)-            -- XXX enable these, check perf impact-            -- touchForeignPtr ringStart-            -- touchForeignPtr aStart-            return (r1 && r2)-    in res------------------------------------------------------------------------------------ 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---- | @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 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)-    => Int -> Fold m (a, Maybe a) b -> Fold m a b-slidingWindow n (Fold step1 initial1 extract1)= Fold step initial extract--    where--    initial = 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--    step (Tuple4' rb rh i st) a-        | i < n = do-            rh1 <- liftIO $ unsafeInsert rb rh a-            liftIO $ touchForeignPtr (ringStart rb)-            r <- step1 st (a, Nothing)-            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)-            return $-                case r of-                    Partial s -> Partial $ Tuple4' rb rh1 (i + 1) s-                    Done b -> Done b--    extract (Tuple4' _ _ _ st) = extract1 st
src/Streamly/Internal/Data/SVar.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.SVar -- Copyright   : (c) 2017 Composewell Technologies@@ -8,6 +10,7 @@ -- -- module Streamly.Internal.Data.SVar+    {-# DEPRECATED "SVar is replaced by Channel." #-}     (       module Streamly.Internal.Data.SVar.Type     , module Streamly.Internal.Data.SVar.Worker@@ -47,8 +50,7 @@ import Data.Heap (Heap, Entry(..)) import Data.IORef (newIORef, readIORef) import Data.IORef (IORef, atomicModifyIORef)-import Streamly.Internal.Control.Concurrent-    (MonadAsync, askRunInIO, RunInIO)+import Streamly.Internal.Control.Concurrent (MonadAsync, askRunInIO) import Streamly.Internal.Data.Atomics        (atomicModifyIORefCAS, atomicModifyIORefCAS_, writeBarrier) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)
src/Streamly/Internal/Data/SVar/Dispatch.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.SVar.Dispatch -- Copyright   : (c) 2017 Composewell Technologies@@ -8,6 +10,7 @@ -- -- module Streamly.Internal.Data.SVar.Dispatch+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (     -- * Latency collection       collectLatency@@ -46,9 +49,6 @@ import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Maybe (fromJust, fromMaybe) import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef)-#if __GLASGOW_HASKELL__ < 804-import Data.Semigroup ((<>))-#endif import Streamly.Internal.Control.Concurrent (MonadAsync, askRunInIO) import Streamly.Internal.Control.ForkLifted (doFork) import Streamly.Internal.Data.Atomics
src/Streamly/Internal/Data/SVar/Pull.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.SVar.Pull -- Copyright   : (c) 2017 Composewell Technologies@@ -8,6 +10,7 @@ -- -- module Streamly.Internal.Data.SVar.Pull+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (     -- * Read Output       readOutputQBasic
− src/Streamly/Internal/Data/SVar/Type.hs 
@@ -1,531 +0,0 @@--- |--- 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 (..)-    , 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)-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(..))-import Streamly.Internal.Control.Concurrent (RunInIO)--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)---- | 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/SVar/Worker.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.SVar.Worker -- Copyright   : (c) 2017 Composewell Technologies@@ -8,6 +10,7 @@ -- -- module Streamly.Internal.Data.SVar.Worker+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (     -- * Adjusting Limits       decrementYieldLimit
+ src/Streamly/Internal/Data/Scanl/Concurrent.hs view
@@ -0,0 +1,425 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Scanl.Concurrent+-- Copyright   : (c) 2024 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Scanl.Concurrent+    (+      parTeeWith+    , parDistributeScanM+    , parDistributeScan+    , parDemuxScanM+    , parDemuxScan+    )+where++#include "inline.hs"++import Control.Concurrent (newEmptyMVar, takeMVar, throwTo)+import Control.Monad.Catch (throwM)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (newIORef, readIORef, atomicModifyIORef)+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS)+import Streamly.Internal.Data.Fold (Step (..))+import Streamly.Internal.Data.Scanl (Scanl(..))+import Streamly.Internal.Data.Stream (Stream(..), Step(..))+import Streamly.Internal.Data.SVar.Type (adaptState)+import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))++import qualified Data.Map.Strict as Map+import qualified Streamly.Internal.Data.Stream as Stream++import Streamly.Internal.Data.Fold.Channel.Type+import Streamly.Internal.Data.Channel.Types++#include "DocTestDataScanl.hs"++-------------------------------------------------------------------------------+-- Concurrent scans+-------------------------------------------------------------------------------++-- | Execute both the scans in a tee concurrently.+--+-- Example:+--+-- >>> src = Stream.delay 1 (Stream.enumerateFromTo 1 3)+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Scanl.lmapM delay Scanl.sum+-- >>> c2 = Scanl.lmapM delay Scanl.length+-- >>> dst = Scanl.parTeeWith id (,) c1 c2+-- >>> Stream.toList $ Stream.scanl dst src+-- ...+--+{-# INLINABLE parTeeWith #-}+parTeeWith :: MonadAsync m =>+       (Config -> Config)+    -> (a -> b -> c)+    -> Scanl m x a+    -> Scanl m x b+    -> Scanl m x c+parTeeWith cfg f c1 c2 = Scanl step initial extract final++    where++    getResponse ch1 ch2 = do+        -- NOTE: We do not need a queue and doorbell mechanism for this, a single+        -- MVar should be enough. Also, there is only one writer and it writes+        -- only once before we read it.+        let db1 = outputDoorBell ch1+        let q1 = outputQueue ch1+        (xs1, _) <- liftIO $ atomicModifyIORefCAS q1 $ \x -> (([],0), x)+        case xs1 of+            [] -> do+                liftIO $ takeMVar db1+                getResponse ch1 ch2+            x1 : [] -> do+                case x1 of+                    FoldException _tid ex -> do+                        -- XXX+                        -- liftIO $ throwTo ch2Tid ThreadAbort+                        cleanup ch1+                        cleanup ch2+                        liftIO $ throwM ex+                    FoldDone _tid b -> return (Left b)+                    FoldPartial b -> return (Right b)+                    FoldEOF _ -> error "parTeeWith: FoldEOF cannot occur here"+            _ -> error "parTeeWith: not expecting more than one msg in q"++    processResponses ch1 ch2 r1 r2 =+        return $ case r1 of+            Left b1 -> do+                case r2 of+                    Left b2 -> Done (f b1 b2)+                    Right b2 -> Done (f b1 b2)+            Right b1 -> do+                case r2 of+                    Left b2 -> Done (f b1 b2)+                    Right b2 -> Partial $ Tuple3' ch1 ch2 (f b1 b2)++    initial = do+        ch1 <- newScanChannel cfg c1+        ch2 <- newScanChannel cfg c2+        r1 <- getResponse ch1 ch2+        r2 <- getResponse ch2 ch1+        processResponses ch1 ch2 r1 r2++    step (Tuple3' ch1 ch2 _) x = do+        sendToWorker_ ch1 x+        sendToWorker_ ch2 x+        r1 <- getResponse ch1 ch2+        r2 <- getResponse ch2 ch1+        processResponses ch1 ch2 r1 r2++    extract (Tuple3' _ _ x) = return x++    final (Tuple3' ch1 ch2 x) = do+        finalize ch1+        finalize ch2+        -- XXX generate the final value?+        return x++-- There are two ways to implement a concurrent scan.+--+-- 1. Make the scan itself asynchronous, add the input to the queue, and then+-- extract the output. Extraction will have to be asynchronous, which will+-- require changes to the scan driver. This will require a different Scanl+-- type.+--+-- 2. A monolithic implementation of concurrent Stream->Stream scan, using a+-- custom implementation of the scan and the driver.++{-# ANN type ScanState Fuse #-}+data ScanState s q db f =+      ScanInit+    | ScanGo s q db [f]+    | ScanDrain q db [f]+    | ScanStop++-- XXX return [b] or just b?+-- XXX We can use a one way mailbox type abstraction instead of using an IORef+-- for adding new folds dynamically.++-- | Evaluate a stream by distributing its inputs across zero or more+-- concurrently running scans. New scans can be generated dynamically. Use+-- 'parDistributeScan' for an eaiser to use interface, if you do not need the+-- power of 'parDistributeScanM'.+--+-- Before processing each input element, the supplied action is executed to+-- produce additional scans. These scans are appended to the set of currently+-- active scans. If you do not want the same scan to be added repeatedly,+-- ensure that the action only generates it once (see the example below).+--+-- If there are no scans currently active, the input element is discarded.+-- The results from all active scans are collected and lattened into the+-- the output stream.+--+-- Concurrency and buffering:+--+-- If the input buffer (see 'maxBuffer') is bounded, a scan may block until+-- space becomes available. If any scan is blocked on buffer, all scans are+-- blocked. Processing continues only when all scans have buffer space+-- available.+--+-- Example:+--+-- >>> import Data.IORef+-- >>> ref <- newIORef [Scanl.take 5 Scanl.sum, Scanl.take 5 Scanl.length :: Scanl.Scanl IO Int Int]+-- >>> gen = atomicModifyIORef ref (\xs -> ([], xs))+-- >>> Stream.toList $ Scanl.parDistributeScanM id gen (Stream.enumerateFromTo 1 10)+-- ...+--+{-# INLINE parDistributeScanM #-}+parDistributeScanM :: MonadAsync m =>+    (Config -> Config) -> m [Scanl m a b] -> Stream m a -> Stream m [b]+parDistributeScanM cfg getFolds (Stream sstep state) =+    Stream step ScanInit++    where++    -- XXX can be written as a fold+    processOutputs chans events done = do+        case events of+            [] -> return (chans, done)+            (x:xs) ->+                case x of+                    FoldException _tid ex -> do+                        -- XXX report the fold that threw the exception+                        liftIO $ mapM_ (`throwTo` ThreadAbort) (fmap snd chans)+                        mapM_ cleanup (fmap fst chans)+                        liftIO $ throwM ex+                    FoldDone tid b ->+                        let ch = filter (\(_, t) -> t /= tid) chans+                         in processOutputs ch xs (b:done)+                    FoldEOF tid -> do+                        let ch = filter (\(_, t) -> t /= tid) chans+                         in processOutputs ch xs done+                    FoldPartial b ->+                         processOutputs chans xs (b:done)++    collectOutputs qref chans = do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then do+            r <- fmap fst $ liftIO $ readOutputQBasic qref+            processOutputs chans r []+        else return (chans, [])++    step _ ScanInit = do+        q <- liftIO $ newIORef ([], 0)+        db <- liftIO newEmptyMVar+        return $ Skip (ScanGo state q db [])++    step gst (ScanGo st q db chans) = do+        -- merge any new channels added since last input+        fxs <- getFolds+        newChans <- Prelude.mapM (newChannelWithScan q db cfg) fxs+        let allChans = chans ++ newChans++        -- Collect outputs from running channels+        (running, outputs) <- collectOutputs q allChans++        -- Send input to running folds+        res <- sstep (adaptState gst) st+        next <- case res of+            Yield x s -> do+                -- XXX The blocking will delay the processing of outputs.+                -- Should we yield the outputs before blocking?+                Prelude.mapM_ (`sendToWorker_` x) (fmap fst running)+                return $ ScanGo s q db running+            Skip s -> do+                return $ ScanGo s q db running+            Stop -> do+                Prelude.mapM_ finalize (fmap fst running)+                return $ ScanDrain q db running+        if null outputs+        then return $ Skip next+        else return $ Yield outputs next+    step _ (ScanDrain q db chans) = do+        (running, outputs) <- collectOutputs q chans+        case running of+            [] -> return $ Yield outputs ScanStop+            _ -> do+                if null outputs+                then do+                    liftIO $ takeMVar db+                    return $ Skip (ScanDrain q db running)+                else return $ Yield outputs (ScanDrain q db running)+    step _ ScanStop = return Stop++-- | A pure variant of 'parDistributeScanM' that uses a fixed list of scans.+--+-- The provided scans are started once and run concurrently for the duration+-- of the stream. Each input element is distributed to all active scans, and+-- their outputs are collected and emitted together.+--+-- Example:+--+-- >>> xs = [Scanl.take 5 Scanl.sum, Scanl.take 5 Scanl.length :: Scanl.Scanl IO Int Int]+-- >>> Stream.toList $ Scanl.parDistributeScan id xs (Stream.enumerateFromTo 1 10)+-- ...+{-# INLINE parDistributeScan #-}+parDistributeScan :: MonadAsync m =>+    (Config -> Config) -> [Scanl m a b] -> Stream m a -> Stream m [b]+parDistributeScan cfg getFolds stream =+    Stream.concatEffect $ do+        ref <- liftIO $ newIORef getFolds+        let action = liftIO $ atomicModifyIORef ref (\xs -> ([], xs))+        return $ parDistributeScanM cfg action stream++{-# ANN type DemuxState Fuse #-}+data DemuxState s q db f =+      DemuxInit+    | DemuxGo s q db f+    | DemuxDrain q db f+    | DemuxStop++-- XXX We need to either (1) remember a key when done so that we do not add the+-- fold again because some inputs would be lost in between, or (2) have a+-- FoldYield constructor to yield repeatedly so that we can restart the+-- existing fold itself when it is done. But in that case we cannot change the+-- fold once it is started. Also the Map would keep on increasing in size as we+-- never delete a key. Whatever we do we should keep the non-concurrent fold as+-- well consistent with that.++-- | Evaluate a stream by routing each input to a scan determined by a key.+--+-- For each distinct key, the first input encountered triggers the creation+-- of a new scan (via the supplied key-to-scan function). This scan is then+-- added to the set of currently active scans. Subsequent inputs with the+-- same key are directed to the same scan.+--+-- If no scan can be created for a key, the input element is discarded.+--+-- When a constituent scan completes, its final output is emitted as part of+-- the composed output stream. The output of 'parDemuxScanM' is a stream of+-- key–value pairs, where each value is the output produced by the scan+-- corresponding to that key.+--+-- For a simpler interface, use 'parDemuxScan' if you do not need the full+-- flexibility of 'parDemuxScanM'.+--+-- Example:+--+-- >>> import qualified Data.Map.Strict as Map+-- >>> import Data.Maybe (fromJust)+-- >>> f1 = ("even", Scanl.take 5 Scanl.sum)+-- >>> f2 = ("odd",  Scanl.take 5 Scanl.sum)+-- >>> kv = Map.fromList [f1, f2]+-- >>> getScan k = return (fromJust $ Map.lookup k kv)+-- >>> getKey x = if even x then "even" else "odd"+-- >>> input = Stream.enumerateFromTo 1 10+-- >>> Stream.toList $ Scanl.parDemuxScanM id getKey getScan input+-- ...+--+{-# INLINE parDemuxScanM #-}+parDemuxScanM :: (MonadAsync m, Ord k) =>+       (Config -> Config)+    -> (a -> k)+    -> (k -> m (Scanl m a b))+    -> Stream m a+    -> Stream m [(k, b)]+parDemuxScanM cfg getKey getFold (Stream sstep state) =+    Stream step DemuxInit++    where++    -- XXX can be written as a fold+    processOutputs keyToChan events done = do+        case events of+            [] -> return (keyToChan, done)+            (x:xs) ->+                case x of+                    FoldException _tid ex -> do+                        -- XXX report the fold that threw the exception+                        let chans = fmap snd $ Map.toList keyToChan+                        liftIO $ mapM_ (`throwTo` ThreadAbort) (fmap snd chans)+                        mapM_ cleanup (fmap fst chans)+                        liftIO $ throwM ex+                    FoldDone _tid o@(k, _) ->+                        let ch = Map.delete k keyToChan+                         in processOutputs ch xs (o:done)+                    FoldEOF tid ->+                        let chans = Map.toList keyToChan+                            ch = filter (\(_, (_, t)) -> t /= tid) chans+                         in processOutputs (Map.fromList ch) xs done+                    FoldPartial b ->+                         processOutputs keyToChan xs (b:done)++    collectOutputs qref keyToChan = do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then do+            r <- fmap fst $ liftIO $ readOutputQBasic qref+            processOutputs keyToChan r []+        else return (keyToChan, [])++    step _ DemuxInit = do+        q <- liftIO $ newIORef ([], 0)+        db <- liftIO newEmptyMVar+        return $ Skip (DemuxGo state q db Map.empty)++    step gst (DemuxGo st q db keyToChan) = do+        -- Collect outputs from running channels+        (keyToChan1, outputs) <- collectOutputs q keyToChan++        -- Send input to the selected fold+        res <- sstep (adaptState gst) st++        next <- case res of+            Yield x s -> do+                -- XXX If the fold for a particular key is done and we see that+                -- key again. If we have not yet collected the done event we+                -- cannot restart the fold because the previous key is already+                -- installed. Thererfore, restarting the fold for the same key+                -- fraught with races.+                let k = getKey x+                (keyToChan2, ch) <-+                    case Map.lookup k keyToChan1 of+                        Nothing -> do+                            fld <- getFold k+                            r@(chan, _) <- newChannelWithScan q db cfg (fmap (k,) fld)+                            return (Map.insert k r keyToChan1, chan)+                        Just (chan, _) -> return (keyToChan1, chan)+                sendToWorker_ ch x+                return $ DemuxGo s q db keyToChan2+            Skip s ->+                return $ DemuxGo s q db keyToChan1+            Stop -> do+                let chans = fmap (fst . snd) $ Map.toList keyToChan1+                Prelude.mapM_ finalize chans+                return $ DemuxDrain q db keyToChan1+        if null outputs+        then return $ Skip next+        else return $ Yield outputs next+    step _ (DemuxDrain q db keyToChan) = do+        (keyToChan1, outputs) <- collectOutputs q keyToChan+        if Map.null keyToChan1+        -- XXX null outputs case+        then return $ Yield outputs DemuxStop+        else do+            if null outputs+            then do+                liftIO $ takeMVar db+                return $ Skip (DemuxDrain q db keyToChan1)+            else return $ Yield outputs (DemuxDrain q db keyToChan1)+    step _ DemuxStop = return Stop++-- | A pure variant of 'parDemuxScanM' where the key-to-scan mapping is+-- static and does not require monadic effects.+--+-- Each distinct key is deterministically mapped to a scan using the provided+-- function. The behavior is otherwise the same as 'parDemuxScanM'.+{-# INLINE parDemuxScan #-}+parDemuxScan :: (MonadAsync m, Ord k) =>+       (Config -> Config)+    -> (a -> k)+    -> (k -> Scanl m a b)+    -> Stream m a+    -> Stream m [(k, b)]+parDemuxScan cfg getKey getFold = parDemuxScanM cfg getKey (pure . getFold)
+ src/Streamly/Internal/Data/Scanl/Prelude.hs view
@@ -0,0 +1,19 @@+-- |+-- Module      : Streamly.Internal.Data.Scanl.Prelude+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Scanl.Prelude+    (+    -- * Channel+      module Streamly.Internal.Data.Fold.Channel+    -- * Concurrency+    , module Streamly.Internal.Data.Scanl.Concurrent+    )+where++import Streamly.Internal.Data.Fold.Channel+import Streamly.Internal.Data.Scanl.Concurrent
− src/Streamly/Internal/Data/Sink.hs 
@@ -1,245 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Sink--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--------- The 'Sink' type is a just a special case of 'Fold' and we can do without--- it. However, in some cases 'Sink' is a simpler type and may provide better--- performance than 'Fold' because it does not maintain any state. Folds can--- be used for both pure and monadic computations. Sinks are not applicable to--- pure computations.--module Streamly.Internal.Data.Sink-    (-      Sink (..)--    -- * Upgrading-    , toFold--    -- * Composing Sinks-    -- ** Distribute-    , tee-    , distribute--    -- ** Demultiplex-    , demux--    -- ** Unzip-    , unzipM-    , unzip--    -- -- ** Group-    -- , grouped--    -- -- ** Nest-    -- , concatFold--    -- -- * Comonad-    -- , duplicate--    -- * Input Transformation-    -- | These are contravariant operations i.e. they apply on the input of the-    -- 'Sink', for this reason they are prefixed with 'l' for 'left'.-    , lmap-    , lmapM-    , lfilter-    , lfilterM--    -- * Sinks-    , drain-    , drainM-    -- , drainN-    -- , drainWhile-    )-where--import Control.Monad ((>=>), when, void)-import Data.Map.Strict (Map)-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)--import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..))-import Streamly.Internal.Data.Sink.Type (Sink(..))--import qualified Data.Map.Strict as Map----------------------------------------------------------------------------------- Conversion----------------------------------------------------------------------------------- | Convert a 'Sink' to a 'Fold'. When you want to compose sinks and folds--- together, upgrade a sink to a fold before composing.-toFold :: Monad m => Sink m a -> Fold m a ()-toFold (Sink f) = Fold step begin done-    where-    begin = return $ Partial ()-    step _ a = Partial <$> f a-    done _ = return ()----------------------------------------------------------------------------------- Composing with sinks----------------------------------------------------------------------------------- | Distribute one copy each of the input to both the sinks.------ @---                 |-------Sink m a--- ---stream m a---|---                 |-------Sink m a--- @--- @--- > let pr x = Sink.drainM (putStrLn . ((x ++ " ") ++) . show)--- > sink (Sink.tee (pr \"L") (pr \"R")) (S.enumerateFromTo 1 2)--- L 1--- R 1--- L 2--- R 2--- @----tee :: Monad m => Sink m a -> Sink m a -> Sink m a-tee (Sink fL) (Sink fR) = Sink (\a -> fL a >> fR a)---- | Distribute copies of the input to all the sinks in a container.------ @---                 |-------Sink m a--- ---stream m a---|---                 |-------Sink m a---                 |---                       ...--- @--- @--- > let pr x = Sink.drainM (putStrLn . ((x ++ " ") ++) . show)--- > sink (Sink.distribute [(pr \"L"), (pr \"R")]) (S.enumerateFromTo 1 2)--- L 1--- R 1--- L 2--- R 2--- @------ This is the consumer side dual of the producer side 'sequence_' operation.-{-# INLINE distribute #-}-distribute :: Monad m => [Sink m a] -> Sink m a-distribute ss = Sink (\a -> Prelude.mapM_ (\(Sink f) -> f a) ss)---- | Demultiplex to multiple consumers without collecting the results. Useful--- to run different effectful computations depending on the value of the stream--- elements, for example handling network packets of different types using--- different handlers.------ @------                             |-------Sink m a--- -----stream m a-----Map-----|---                             |-------Sink m a---                             |---                                       ...--- @------ @--- > let pr x = Sink.drainM (putStrLn . ((x ++ " ") ++) . show)--- > let table = Data.Map.fromList [(1, pr \"One"), (2, pr \"Two")]---   in Sink.sink (Sink.demux id table) (S.enumerateFromTo 1 100)--- One 1--- Two 2--- @-{--demux :: (Monad m, Ord k) => (a -> k) -> Map k (Sink m a) -> Sink m a-demux f kv = Sink step--    where--    step a =-        -- XXX should we raise an exception in Nothing case?-        -- Ideally we should enforce that it is a total map over k so that look-        -- up never fails-        case Map.lookup (f a) kv of-            Nothing -> return ()-            Just (Sink g) -> g a--}--demux :: (Monad m, Ord k) => Map k (Sink m a) -> Sink m (a, k)-demux kv = Sink step--    where--    step (a, k) =-        -- XXX should we raise an exception in Nothing case?-        -- Ideally we should enforce that it is a total map over k so that look-        -- up never fails-        case Map.lookup k kv of-            Nothing -> return ()-            Just (Sink g) -> g a---- | Split elements in the input stream into two parts using a monadic unzip--- function, direct each part to a different sink.------ @------                           |-------Sink m b--- -----Stream m a----(b,c)--|---                           |-------Sink m c--- @--- @--- > let pr x = Sink.drainM (putStrLn . ((x ++ " ") ++) . show)---   in Sink.sink (Sink.unzip return (pr \"L") (pr \"R")) (S.fromPure (1,2))--- L 1--- R 2--- @-{-# INLINE unzipM #-}-unzipM :: Monad m => (a -> m (b,c)) -> Sink m b -> Sink m c -> Sink m a-unzipM f (Sink stepB) (Sink stepC) =-    Sink (f >=> (\(b, c) -> stepB b >> stepC c))---- | Same as 'unzipM' but with a pure unzip function.-{-# INLINE unzip #-}-unzip :: Monad m => (a -> (b,c)) -> Sink m b -> Sink m c -> Sink m a-unzip f = unzipM (return . f)----------------------------------------------------------------------------------- Input transformation----------------------------------------------------------------------------------- | Map a pure function on the input of a 'Sink'.-{-# INLINABLE lmap #-}-lmap :: (a -> b) -> Sink m b -> Sink m a-lmap f (Sink step) = Sink (step . f)---- | Map a monadic function on the input of a 'Sink'.-{-# INLINABLE lmapM #-}-lmapM :: Monad m => (a -> m b) -> Sink m b -> Sink m a-lmapM f (Sink step) = Sink (f >=> step)---- | Filter the input of a 'Sink' using a pure predicate function.-{-# INLINABLE lfilter #-}-lfilter :: Monad m => (a -> Bool) -> Sink m a -> Sink m a-lfilter f (Sink step) = Sink (\a -> when (f a) $ step a)---- | Filter the input of a 'Sink' using a monadic predicate function.-{-# INLINABLE lfilterM #-}-lfilterM :: Monad m => (a -> m Bool) -> Sink m a -> Sink m a-lfilterM f (Sink step) = Sink (\a -> f a >>= \use -> when use $ step a)----------------------------------------------------------------------------------- Sinks----------------------------------------------------------------------------------- | Drain all input, running the effects and discarding the results.-drain :: Monad m => Sink m a-drain = Sink (\_ -> return ())---- |--- > drainM f = lmapM f drain------ Drain all input after passing it through a monadic function.-{-# INLINABLE drainM #-}-drainM ::  Monad m => (a -> m b) -> Sink m a-drainM f = Sink (void . f)
− src/Streamly/Internal/Data/Sink/Type.hs 
@@ -1,24 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Sink.Type--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Sink.Type-    (-      Sink (..)-    )-where----------------------------------------------------------------------------------- Sink----------------------------------------------------------------------------------- | A 'Sink' is a special type of 'Fold' that does not accumulate any value,--- but runs only effects. A 'Sink' has no state to maintain therefore can be a--- bit more efficient than a 'Fold' with '()' as the state, especially when--- 'Sink's are composed with other operations. A Sink can be upgraded to a--- 'Fold', but a 'Fold' cannot be converted into a Sink.-newtype Sink m a = Sink (a -> m ())
src/Streamly/Internal/Data/SmallArray.hs view
@@ -28,9 +28,9 @@   , toStreamD   , toStreamDRev -  , toStream-  , toStreamRev   , read+  , readRev+  , reader    , fromListN   , fromStreamDN@@ -48,16 +48,17 @@ import GHC.IO (unsafePerformIO) import Data.Functor.Identity (runIdentity) -import Streamly.Internal.Data.SmallArray.Type-+import Streamly.Data.Fold (Fold)+import Streamly.Data.Stream (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))+import Streamly.Internal.Data.Unfold (Unfold(..)) -import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.Fold as FL+    (Fold (..), Step (Done, Partial)) +import Streamly.Internal.Data.SmallArray.Type+ {-# NOINLINE bottomElement #-} bottomElement :: a bottomElement = undefined@@ -102,10 +103,10 @@ -- 'SmallArray'. -- -- Since we are folding to a 'SmallArray' @n@ should be <= 128, for larger number--- of elements use an 'Array' from either "Streamly.Data.Array" or "Streamly.Data.Array.Foreign".+-- of elements use an 'Array' from either "Streamly.Data.Array.Generic" or "Streamly.Data.Array.Foreign". {-# INLINE_NORMAL writeN #-} writeN :: MonadIO m => Int -> Fold m a (SmallArray a)-writeN len = Fold step initial extract+writeN len = FL.Fold step initial extract extract      where @@ -160,30 +161,30 @@ -- -- For optimal performance use this with @n@ <= 128. {-# INLINE fromStreamN #-}-fromStreamN :: MonadIO m => Int -> SerialT m a -> m (SmallArray a)-fromStreamN n (SerialT m) = do+fromStreamN :: MonadIO m => Int -> Stream m a -> m (SmallArray a)+fromStreamN n m = do     when (n < 0) $ error "fromStreamN: negative write count specified"-    fromStreamDN n $ D.fromStreamK m+    fromStreamDN n m -{-# INLINE_EARLY toStream #-}-toStream :: Monad m => SmallArray a -> SerialT m a-toStream = SerialT . D.toStreamK . toStreamD+{-# INLINE_EARLY read #-}+read :: Monad m => SmallArray a -> Stream m a+read = toStreamD -{-# INLINE_EARLY toStreamRev #-}-toStreamRev :: Monad m => SmallArray a -> SerialT m a-toStreamRev = SerialT . D.toStreamK . toStreamDRev+{-# INLINE_EARLY readRev #-}+readRev :: Monad m => SmallArray a -> Stream m a+readRev = toStreamDRev  {-# INLINE fold #-} fold :: Monad m => Fold m a b -> SmallArray a -> m b fold f arr = D.fold f (toStreamD arr)  {-# INLINE streamFold #-}-streamFold :: Monad m => (SerialT m a -> m b) -> SmallArray a -> m b-streamFold f arr = f (toStream arr)+streamFold :: Monad m => (Stream m a -> m b) -> SmallArray a -> m b+streamFold f arr = f (read arr) -{-# INLINE_NORMAL read #-}-read :: Monad m => Unfold m (SmallArray a) a-read = Unfold step inject+{-# INLINE_NORMAL reader #-}+reader :: Monad m => Unfold m (SmallArray a) a+reader = Unfold step inject   where     inject arr = return (arr, 0)     step (arr, i)
src/Streamly/Internal/Data/SmallArray/Type.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonoLocalBinds #-}  -- | -- Module : Data.Primitive.SmallArray@@ -56,12 +58,8 @@  import GHC.Exts hiding (toList) import qualified GHC.Exts- import Control.Applicative import Control.Monad-#if MIN_VERSION_base(4,9,0)-import qualified Control.Monad.Fail as Fail-#endif import Control.Monad.Fix import Control.Monad.Primitive import Control.Monad.ST@@ -69,28 +67,16 @@ import Data.Data import Data.Foldable as Foldable import Data.Functor.Identity-#if !(MIN_VERSION_base(4,10,0))-import Data.Monoid-#endif-#if MIN_VERSION_base(4,9,0)-import qualified GHC.ST as GHCST-import qualified Data.Semigroup as Sem-#endif-import Text.ParserCombinators.ReadP+import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),Read1(..)) -#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,10,0)-import GHC.Base (runRW#)-#endif+import qualified Control.Monad.Fail as Fail+import qualified GHC.ST as GHCST -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)-import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),Read1(..))-#endif+import Text.ParserCombinators.ReadP  data SmallArray a = SmallArray (SmallArray# a)-  deriving Typeable  data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a)-  deriving Typeable  -- | Create a new small mutable array. newSmallArray@@ -318,14 +304,6 @@       let !y = f x       writeSmallArray smb i y *> go (i+1) {-# INLINE mapSmallArray' #-}--#if !MIN_VERSION_base(4,9,0)-runSmallArray-  :: (forall s. ST s (SmallMutableArray s a))-  -> SmallArray a-runSmallArray m = runST $ m >>= unsafeFreezeSmallArray--#else -- This low-level business is designed to work with GHC's worker-wrapper -- transformation. A lot of the time, we don't actually need an Array -- constructor. By putting it on the outside, and being careful about@@ -348,8 +326,6 @@ unST :: ST s a -> State# s -> (# State# s, a #) unST (GHCST.ST f) = f -#endif- -- See the comment on runSmallArray for why we use emptySmallArray#. createSmallArray   :: Int@@ -393,20 +369,11 @@     | (# x #) <- indexSmallArray## sa1 i     , (# y #) <- indexSmallArray## sa2 i     = p x y && loop (i-1)--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)--- | @since 0.6.4.0 instance Eq1 SmallArray where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftEq = smallArrayLiftEq-#else-  eq1 = smallArrayLiftEq (==)-#endif-#endif  instance Eq a => Eq (SmallArray a) where   sa1 == sa2 = smallArrayLiftEq (==) sa1 sa2- instance Eq (SmallMutableArray s a) where   SmallMutableArray sma1# == SmallMutableArray sma2# =     isTrue# (sameSmallMutableArray# sma1# sma2#)@@ -422,15 +389,8 @@     = elemCompare x1 x2 `mappend` loop (i+1)     | otherwise = compare (length a1) (length a2) -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)--- | @since 0.6.4.0 instance Ord1 SmallArray where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftCompare = smallArrayLiftCompare-#else-  compare1 = smallArrayLiftCompare compare-#endif-#endif  -- | Lexicographic ordering. Subject to change between major versions. instance Ord a => Ord (SmallArray a) where@@ -668,11 +628,8 @@ #if !(MIN_VERSION_base(4,13,0)) && MIN_VERSION_base(4,9,0)   fail = Fail.fail #endif--#if MIN_VERSION_base(4,9,0) instance Fail.MonadFail SmallArray where   fail _ = emptySmallArray-#endif  instance MonadPlus SmallArray where   mzero = empty@@ -715,24 +672,19 @@       sz = sizeofSmallArray (f err)       err = error "mfix for Data.Primitive.SmallArray applied to strict function." -#if MIN_VERSION_base(4,9,0) -- | @since 0.6.3.0-instance Sem.Semigroup (SmallArray a) where+instance Semigroup (SmallArray a) where   (<>) = (<|>)-  sconcat = mconcat . toList-#endif  instance Monoid (SmallArray a) where   mempty = empty-#if !(MIN_VERSION_base(4,11,0))-  mappend = (<|>)-#endif+  mappend = (<>)   mconcat l = createSmallArray n (die "mconcat" "impossible") $ \ma ->     let go !_  [    ] = return ()         go off (a:as) =           copySmallArray ma off a 0 (sizeofSmallArray a) >> go (off + sizeofSmallArray a) as-     in go 0 l-   where n = sum . fmap length $ l+      in go 0 l+    where n = sum . fmap length $ l  instance IsList (SmallArray a) where   type Item (SmallArray a) = a@@ -751,16 +703,8 @@  instance Show a => Show (SmallArray a) where   showsPrec = smallArrayLiftShowsPrec showsPrec showList--#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)--- | @since 0.6.4.0 instance Show1 SmallArray where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftShowsPrec = smallArrayLiftShowsPrec-#else-  showsPrec1 = smallArrayLiftShowsPrec showsPrec showList-#endif-#endif  smallArrayLiftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a) smallArrayLiftReadsPrec _ listReadsPrec p = readParen (p > 10) . readP_to_S $ do@@ -774,17 +718,8 @@ instance Read a => Read (SmallArray a) where   readsPrec = smallArrayLiftReadsPrec readsPrec readList -#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,4,0)--- | @since 0.6.4.0 instance Read1 SmallArray where-#if MIN_VERSION_base(4,9,0) || MIN_VERSION_transformers(0,5,0)   liftReadsPrec = smallArrayLiftReadsPrec-#else-  readsPrec1 = smallArrayLiftReadsPrec readsPrec readList-#endif-#endif--  smallArrayDataType :: DataType smallArrayDataType =
src/Streamly/Internal/Data/Stream/Ahead.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  -- | -- Module      : Streamly.Internal.Data.Stream.Ahead@@ -20,7 +22,7 @@ --      return n                    -- IO Int -- :} ---module Streamly.Internal.Data.Stream.Ahead+module Streamly.Internal.Data.Stream.Ahead {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream.Concurrent\" from streamly package instead." #-}     (       AheadT(..)     , Ahead@@ -32,30 +34,34 @@ import Control.Concurrent.MVar (putMVar, takeMVar) import Control.Exception (assert) import Control.Monad (void, when)+#if !(MIN_VERSION_transformers(0,6,0)) import Control.Monad.Base (MonadBase(..), liftBaseDefault)+#endif import Control.Monad.Catch (MonadThrow, throwM) -- import Control.Monad.Error.Class   (MonadError(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader.Class (MonadReader(..)) import Control.Monad.State.Class (MonadState(..))+#if !(MIN_VERSION_transformers(0,6,0)) import Control.Monad.Trans.Class (MonadTrans(lift))+#endif import Data.Heap (Heap, Entry(..)) import Data.IORef (IORef, readIORef, atomicModifyIORef, writeIORef) import Data.Maybe (fromJust)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif import GHC.Exts (inline)  import qualified Data.Heap as H  import Streamly.Internal.Control.Concurrent-    (MonadRunInIO, MonadAsync, RunInIO(..), askRunInIO, restoreM)-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+    (MonadRunInIO, MonadAsync, askRunInIO, restoreM)+import Streamly.Internal.Data.StreamK (Stream) -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.StreamK as K+    (foldStreamShared, cons, mkStream, foldStream, fromEffect+    , nil, concatMapWith, fromPure, bindWith)+import qualified Streamly.Internal.Data.Stream as D+    (mapM, fromStreamK, toStreamK)+import qualified Streamly.Internal.Data.Stream.Serial as Stream (toStreamK)  import Streamly.Internal.Data.Stream.SVar.Generate import Streamly.Internal.Data.SVar@@ -64,6 +70,7 @@ #include "Instances.hs"  -- $setup+-- >>> :set -fno-warn-deprecations -- >>> import qualified Streamly.Prelude as Stream -- >>> import Control.Concurrent (threadDelay) -- >>> :{@@ -73,6 +80,14 @@ --      return n                    -- IO Int -- :} +{-# INLINABLE withLocal #-}+withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a+withLocal f m =+    K.mkStream $ \st yld sng stp ->+        let single = local f . sng+            yieldk a r = local f $ yld a (withLocal f r)+        in K.foldStream st yieldk single (local f stp) m+ ------------------------------------------------------------------------------- -- Ahead -------------------------------------------------------------------------------@@ -606,7 +621,7 @@ forkSVarAhead m1 m2 = K.mkStream $ \st yld sng stp -> do         sv <- newAheadVar st (concurrently m1 m2)                           workLoopAhead-        K.foldStream st yld sng stp $ getSerialT (fromSVar sv)+        K.foldStream st yld sng stp $ Stream.toStreamK (fromSVar sv)     where     concurrently ma mb = K.mkStream $ \st yld sng stp -> do         runInIO <- askRunInIO@@ -681,8 +696,13 @@ -- -- @since 0.8.0 newtype AheadT m a = AheadT {getAheadT :: Stream m a}-    deriving (MonadTrans) +#if !(MIN_VERSION_transformers(0,6,0))+instance MonadTrans AheadT where+    {-# INLINE lift #-}+    lift = AheadT . K.fromEffect+#endif+ -- | A serial IO stream of elements of type @a@ with concurrent lookahead.  See -- 'AheadT' documentation for more details. --@@ -718,7 +738,7 @@ {-# INLINE apAhead #-} apAhead :: MonadAsync m => AheadT m (a -> b) -> AheadT m a -> AheadT m b apAhead (AheadT m1) (AheadT m2) =-    let f x1 = K.concatMapWith aheadK (pure . x1) m2+    let f x1 = K.concatMapWith aheadK (K.fromPure . x1) m2     in AheadT $ K.concatMapWith aheadK f m1  instance (Monad m, MonadAsync m) => Applicative (AheadT m) where@@ -747,5 +767,10 @@ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------++#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m, MonadAsync m) => MonadBase b (AheadT m) where+    liftBase = liftBaseDefault+#endif  MONAD_COMMON_INSTANCES(AheadT, MONADPARALLEL)
src/Streamly/Internal/Data/Stream/Async.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  #include "inline.hs" @@ -22,7 +24,7 @@ --      return n                    -- IO Int -- :} ---module Streamly.Internal.Data.Stream.Async+module Streamly.Internal.Data.Stream.Async {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream.Concurrent\" from streamly package instead." #-}     (       AsyncT(..)     , Async@@ -39,41 +41,45 @@ where  import Control.Concurrent (myThreadId)+#if !(MIN_VERSION_transformers(0,6,0)) import Control.Monad.Base (MonadBase(..), liftBaseDefault)+#endif import Control.Monad.Catch (MonadThrow, throwM) import Control.Concurrent.MVar (newEmptyMVar) -- import Control.Monad.Error.Class   (MonadError(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader.Class (MonadReader(..)) import Control.Monad.State.Class (MonadState(..))+#if !(MIN_VERSION_transformers(0,6,0)) import Control.Monad.Trans.Class (MonadTrans(lift))+#endif import Data.Concurrent.Queue.MichaelScott (LinkedQueue, newQ, nullQ, tryPopR, pushL) import Data.IORef (IORef, newIORef, readIORef) import Data.Maybe (fromJust)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif  import Prelude hiding (map) import qualified Data.Set as S  import Streamly.Internal.Control.Concurrent-    (MonadRunInIO, MonadAsync, RunInIO(..), askRunInIO, restoreM)+    (MonadRunInIO, MonadAsync, askRunInIO, restoreM) import Streamly.Internal.Data.Atomics     (atomicModifyIORefCAS, atomicModifyIORefCAS_)-import Streamly.Internal.Data.Stream.Serial (SerialT (..))-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream) import Streamly.Internal.Data.Stream.SVar.Generate (fromSVar, fromSVarD) -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.StreamK as K+    (foldStreamShared, mkStream, foldStream, fromEffect+    , nil, concatMapWith, fromPure, bindWith)+import qualified Streamly.Internal.Data.Stream as D+    (Stream(..), Step(..), mapM, toStreamK, fromStreamK)+import qualified Streamly.Internal.Data.Stream.Serial as Stream (toStreamK) -import Streamly.Internal.Data.SVar.Type import Streamly.Internal.Data.SVar  #include "Instances.hs"  -- $setup+-- >>> :set -fno-warn-deprecations -- >>> import qualified Streamly.Prelude as Stream -- >>> import Control.Concurrent (threadDelay) -- >>> :{@@ -84,6 +90,14 @@ -- :} -- +{-# INLINABLE withLocal #-}+withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a+withLocal f m =+    K.mkStream $ \st yld sng stp ->+        let single = local f . sng+            yieldk a r = local f $ yld a (withLocal f r)+        in K.foldStream st yieldk single (local f stp) m+ ------------------------------------------------------------------------------- -- Async -------------------------------------------------------------------------------@@ -545,7 +559,7 @@ mkAsyncK :: MonadAsync m => Stream m a -> Stream m a mkAsyncK m = K.mkStream $ \st yld sng stp -> do     sv <- newAsyncVar (adaptState st) m-    K.foldStream st yld sng stp $ getSerialT $ fromSVar sv+    K.foldStream st yld sng stp $ Stream.toStreamK $ fromSVar sv  -- -- This is slightly faster than the CPS version above@@ -649,7 +663,7 @@         AsyncVar -> newAsyncVar st (concurrently m1 m2)         WAsyncVar -> newWAsyncVar st (concurrently m1 m2)         _ -> error "illegal svar type"-    K.foldStream st yld sng stp $ getSerialT $ fromSVar sv+    K.foldStream st yld sng stp $ Stream.toStreamK $ fromSVar sv     where     concurrently ma mb = K.mkStream $ \st yld sng stp -> do         runInIO <- askRunInIO@@ -734,8 +748,13 @@ -- -- @since 0.8.0 newtype AsyncT m a = AsyncT {getAsyncT :: Stream m a}-    deriving (MonadTrans) +#if !(MIN_VERSION_transformers(0,6,0))+instance MonadTrans AsyncT where+    {-# INLINE lift #-}+    lift = AsyncT . K.fromEffect+#endif+ -- | A demand driven left biased parallely composing IO stream of elements of -- type @a@.  See 'AsyncT' documentation for more details. --@@ -774,7 +793,7 @@ {-# SPECIALIZE apAsync :: AsyncT IO (a -> b) -> AsyncT IO a -> AsyncT IO b #-} apAsync :: MonadAsync m => AsyncT m (a -> b) -> AsyncT m a -> AsyncT m b apAsync (AsyncT m1) (AsyncT m2) =-    let f x1 = K.concatMapWith asyncK (pure . x1) m2+    let f x1 = K.concatMapWith asyncK (K.fromPure . x1) m2     in AsyncT $ K.concatMapWith asyncK f m1  instance (Monad m, MonadAsync m) => Applicative (AsyncT m) where@@ -806,6 +825,11 @@ -- Other instances ------------------------------------------------------------------------------ +#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m, MonadAsync m) => MonadBase b (AsyncT m) where+    liftBase = liftBaseDefault+#endif+ MONAD_COMMON_INSTANCES(AsyncT, MONADPARALLEL)  ------------------------------------------------------------------------------@@ -957,8 +981,13 @@ -- @ -- newtype WAsyncT m a = WAsyncT {getWAsyncT :: Stream m a}-    deriving (MonadTrans) +#if !(MIN_VERSION_transformers(0,6,0))+instance MonadTrans WAsyncT where+    {-# INLINE lift #-}+    lift = WAsyncT . K.fromEffect+#endif+ -- | A round robin parallely composing IO stream of elements of type @a@. -- See 'WAsyncT' documentation for more details. --@@ -996,7 +1025,7 @@     WAsyncT IO (a -> b) -> WAsyncT IO a -> WAsyncT IO b #-} apWAsync :: MonadAsync m => WAsyncT m (a -> b) -> WAsyncT m a -> WAsyncT m b apWAsync (WAsyncT m1) (WAsyncT m2) =-    let f x1 = K.concatMapWith wAsyncK (pure . x1) m2+    let f x1 = K.concatMapWith wAsyncK (K.fromPure . x1) m2     in WAsyncT $ K.concatMapWith wAsyncK f m1  -- GHC: if we specify arguments in the definition of (<*>) we see a significant@@ -1026,5 +1055,10 @@ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------++#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m, MonadAsync m) => MonadBase b (WAsyncT m) where+    liftBase = liftBaseDefault+#endif  MONAD_COMMON_INSTANCES(WAsyncT, MONADPARALLEL)
+ src/Streamly/Internal/Data/Stream/Channel.hs view
@@ -0,0 +1,213 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Channel+    (+      module Streamly.Internal.Data.Stream.Channel.Type++    -- ** Allocation+    , module Streamly.Internal.Data.Stream.Channel.Append+    , module Streamly.Internal.Data.Stream.Channel.Interleave+    , newChannel++    -- ** Event Processing Loop+    , module Streamly.Internal.Data.Stream.Channel.Dispatcher+    , module Streamly.Internal.Data.Stream.Channel.Consumer+    , module Streamly.Internal.Data.Stream.Channel.Operations+    , chanConcatMapK++    -- ** Evaluation+    , withChannelK+    , withChannel+    -- quiesceChannel -- wait for running tasks but do not schedule any more.+    )+where++import Streamly.Internal.Control.Concurrent (MonadAsync)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Control.Concurrent (askRunInIO)+import Streamly.Internal.Data.SVar.Type (adaptState)++import qualified Streamly.Internal.Data.StreamK as K++import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel.Type+import Streamly.Internal.Data.Stream.Channel.Operations+import Streamly.Internal.Data.Stream.Channel.Append+import Streamly.Internal.Data.Stream.Channel.Interleave+import Streamly.Internal.Data.Stream.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Channel.Consumer++-------------------------------------------------------------------------------+--  Channel allocation+-------------------------------------------------------------------------------++-- | Create a new concurrent stream evaluation channel. The monad+-- state used to run the stream actions is captured from the call site of+-- newChannel.+{-# INLINE newChannel #-}+newChannel :: MonadAsync m =>+    (Config -> Config) -> m (Channel m a)+newChannel modifier =+    let cfg = modifier defaultConfig+     in if getInterleaved cfg+        then newInterleaveChannel modifier+        else newAppendChannel modifier++-- | Allocate a channel and evaluate the stream concurrently using the channel+-- and the supplied evaluator function. The evaluator is run in a worker+-- thread.+{-# INLINE withChannelK #-}+withChannelK :: MonadAsync m =>+       (Config -> Config) -- ^ config modifier+    -> K.StreamK m a -- ^ input stream+    -> (Channel m b -> K.StreamK m a -> K.StreamK m b) -- ^ stream evaluator+    -> K.StreamK m b -- ^ output stream+withChannelK modifier input evaluator = K.concatEffect action++    where++    action = do+        chan <- newChannel modifier+        toChannelK chan (evaluator chan input)+        let cfg = modifier defaultConfig+        return $ fromChannelK (getCleanup cfg) chan++-- | A wrapper over 'withChannelK', converts 'Stream' to 'StreamK' and invokes+-- 'withChannelK'.+{-# INLINE withChannel #-}+withChannel :: MonadAsync m =>+       (Config -> Config)+    -> Stream m a+    -> (Channel m b -> Stream m a -> Stream m b)+    -> Stream m b+withChannel modifier input evaluator =+    let f chan stream = K.fromStream $ evaluator chan (K.toStream stream)+     in K.toStream $ withChannelK modifier (K.fromStream input) f++-------------------------------------------------------------------------------+-- Evaluator+-------------------------------------------------------------------------------++-- | @concatMapHeadK consumeTail mapHead stream@, maps a stream generation+-- function on the head element and performs a side effect on the tail.+--+-- Used for concurrent evaluation of streams using a Channel. A worker+-- evaluating the stream would queue the tail and go on to evaluate the head.+-- The tail is picked up by another worker which does the same.+{-# INLINE concatMapHeadK #-}+concatMapHeadK :: Monad m =>+       (K.StreamK m a -> m ()) -- ^ Queue the tail+    -> (a -> K.StreamK m b) -- ^ Generate a stream from the head+    -> K.StreamK m a+    -> K.StreamK m b+concatMapHeadK consumeTail mapHead stream =+    K.mkStream $ \st yld sng stp -> do+        let foldShared = K.foldStreamShared st yld sng stp+            single a = foldShared $ mapHead a+            yieldk a r = consumeTail r >> single a+         in K.foldStreamShared (adaptState st) yieldk single stp stream++-------------------------------------------------------------------------------+-- concat streams+-------------------------------------------------------------------------------++-- | 'mkEnqueue chan f returns a queuing function @enq@. @enq@ takes a+-- @stream@ and enqueues @f enq stream@ on the channel. One example of @f@ is+-- 'concatMapHeadK'. When the enqueued value with 'concatMapHeadK' as @f@ is+-- evaluated, it generates an output stream from the head and enqueues @f enq+-- tail@ on the channel. Thus whenever the enqueued stream is evaluated it+-- generates a stream from the head and queues the tail on the channel.+--+-- Note that @enq@ and runner are mutually recursive, mkEnqueue ties the+-- knot between the two.+--+{-# INLINE mkEnqueue #-}+mkEnqueue :: MonadAsync m =>+    Channel m b+    -- | @divider enq stream@+    -> ((K.StreamK m a -> m ()) -> K.StreamK m a -> K.StreamK m b)+    -- | Queuing function @enq@+    -> m (K.StreamK m a -> m ())+mkEnqueue chan runner = do+    runInIO <- askRunInIO+    return+        $ let f stream = do+                liftIO $ enqueue chan (runInIO, runner f stream)+                -- XXX In case of eager dispatch we can just directly dispatch+                -- a worker with the tail stream here rather than first queuing+                -- and then dispatching a worker which dequeues the work. The+                -- older implementation did a direct dispatch here and its perf+                -- characterstics looked much better.+                eagerDispatch chan+           in f++{-# INLINE parConcatMapChanKAll #-}+parConcatMapChanKAll :: MonadAsync m =>+    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b+parConcatMapChanKAll chan f stream =+   let run q = concatMapHeadK q f+    in K.concatMapEffect (`run` stream) (mkEnqueue chan run)+    -- K.parConcatMap (_appendWithChanK chan) f stream++{-# INLINE parConcatMapChanKAny #-}+parConcatMapChanKAny :: MonadAsync m =>+    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b+parConcatMapChanKAny chan f stream =+   let done = K.nilM (shutdown chan)+       run q = concatMapHeadK q (\x -> K.append (f x) done)+    in K.concatMapEffect (`run` stream) (mkEnqueue chan run)++{-# INLINE parConcatMapChanKFirst #-}+parConcatMapChanKFirst :: MonadAsync m =>+    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b+parConcatMapChanKFirst chan f stream =+   let done = K.nilM (shutdown chan)+       run q = concatMapHeadK q f+    in K.concatEffect $ do+        res <- K.uncons stream+        case res of+            Nothing -> return K.nil+            Just (h, t) -> do+                q <- mkEnqueue chan run+                q t+                return $ K.append (f h) done++-- | Make a concurrent stream evaluator from a stream, to be used in+-- 'withChannelK' or 'toChannelK'. Maps a stream generation function on each+-- element of the stream, the evaluation of the map on each element happens+-- concurrently. All the generated streams are merged together in the output of+-- the channel. The scheduling and termination behavior depends on the channel+-- settings.+--+-- Note that if you queue a stream on the channel using 'toChannelK', it will+-- be picked up by a worker and the worker would evaluate the entire stream+-- serially and emit the results on the channel. However, if you transform the+-- stream using 'parConcatMapChanK' and queue it on the channel, it+-- parallelizes the function map on each element of the stream. The simplest+-- example is @parConcatMapChanK id id@ which is equivalent to evaluating each+-- element of the stream concurrently.+--+-- A channel worker evaluating this function would enqueue the tail on the+-- channel's work queue and go on to evaluate the head generating an output+-- stream. The tail is picked up by another worker which does the same and so+-- on.+{-# INLINE chanConcatMapK #-}+chanConcatMapK :: MonadAsync m =>+       (Config -> Config)+    -> Channel m b+    -> (a -> K.StreamK m b)+    -> K.StreamK m a+    -> K.StreamK m b+chanConcatMapK modifier chan f stream = do+        let cfg = modifier defaultConfig+        case getStopWhen cfg of+            AllStop -> parConcatMapChanKAll chan f stream+            FirstStops -> parConcatMapChanKFirst chan f stream+            AnyStops -> parConcatMapChanKAny chan f stream
+ src/Streamly/Internal/Data/Stream/Channel/Append.hs view
@@ -0,0 +1,1102 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Append+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- The functions in this module are separated from the combinators using+-- these because of a GHC issue. We need to have newAppendChannel specialized but+-- not inlined. If we keep it in the same module as its users we cannot achieve+-- that and the code becomes bloated. But if it is in a separate module we can+-- use INLINABLE and SPECIALIZE on it which makes it specialized but it is not+-- actually inlined.++module Streamly.Internal.Data.Stream.Channel.Append+    (+      newAppendChannel+    )+where++import Control.Concurrent (myThreadId)+import Control.Concurrent.MVar (newEmptyMVar, newMVar, putMVar, takeMVar)+import Control.Exception (assert)+import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Heap (Heap, Entry(..))+import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef, writeIORef)+import GHC.Exts (inline)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, RunInIO(..), askRunInIO, restoreM)+import Streamly.Internal.Data.Atomics+    (atomicModifyIORefCAS, atomicModifyIORefCAS_)+import Streamly.Internal.Data.Channel.Dispatcher (modifyThread)++import qualified Data.Heap as H+import qualified Data.Set as Set+import qualified Streamly.Internal.Data.StreamK as K++import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Channel.Worker+import Streamly.Internal.Data.Stream.Channel.Consumer+import Streamly.Internal.Data.Stream.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Channel.Type++------------------------------------------------------------------------------+-- Concurrent streams with first-come-first serve results+------------------------------------------------------------------------------++{-# INLINE enqueueLIFO #-}+enqueueLIFO ::+      Channel m a+   -> IORef [(RunInIO m, K.StreamK m a)]+   -> (RunInIO m, K.StreamK m a)+   -> IO ()+enqueueLIFO sv q m = do+    atomicModifyIORefCAS_ q (m :)+    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)++{-# INLINE dequeue #-}+dequeue :: MonadIO m =>+       IORef [(RunInIO m, K.StreamK m a)]+    -> m (Maybe (RunInIO m, K.StreamK m a))+dequeue qref =+    liftIO+        $ atomicModifyIORefCAS qref+        $ \case+            (x : xs) -> (xs, Just x)+            x -> (x, Nothing)++data WorkerStatus = Continue | Suspend++{-# INLINE workLoopLIFO #-}+workLoopLIFO+    :: MonadRunInIO m+    => IORef [(RunInIO m, K.StreamK m a)]+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopLIFO qref sv winfo = run++    where++    run = do+        work <- dequeue qref+        case work of+            Nothing -> return ()+            Just (RunInIO runin, m) -> process runin m++    process runin m = do+        -- XXX when we finish we need to send the monadic state back to+        -- the parent so that the state can be merged back. We capture+        -- and return the state in the stop continuation.+        --+        -- Instead of using the run function we can just restore the+        -- monad state here. That way it can work easily for+        -- distributed case as well.+        r <- liftIO $ runin $+                K.foldStreamShared+                    undefined+                    yieldk+                    single+                    (return Continue)+                    m+        res <- restoreM r+        case res of+            Continue -> run+            Suspend -> return ()++        where++        single a = do+            res <- liftIO $ yieldWith winfo sv a+            return $ if res then Continue else Suspend++        yieldk a r = do+            res <- liftIO $ yieldWith winfo sv a+            if res+            then K.foldStreamShared undefined yieldk single (return Continue) r+            else do+                runInIO <- askRunInIO+                liftIO $ enqueueLIFO sv qref (runInIO, r)+                return Suspend++-- We duplicate workLoop for yield limit and no limit cases because it has+-- around 40% performance overhead in the worst case.+--+-- XXX we can pass yinfo directly as an argument here so that we do not have to+-- make a check every time.+{-# INLINE workLoopLIFOLimited #-}+workLoopLIFOLimited+    :: forall m a. MonadRunInIO m+    => IORef [(RunInIO m, K.StreamK m a)]+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopLIFOLimited qref sv winfo = run++    where++    incrContinue =+        liftIO (incrementYieldLimit (remainingWork sv)) >> return Continue++    run = do+        work <- dequeue qref+        {- HLINT ignore "Use forM_" -}+        case work of+            Nothing -> return ()+            Just item -> process item++    process item@(RunInIO runin, m) = do+        -- XXX This is just a best effort minimization of concurrency+        -- to the yield limit. If the stream is made of concurrent+        -- streams we do not reserve the yield limit in the constituent+        -- streams before executing the action. This can be done+        -- though, by sharing the yield limit ref with downstream+        -- actions via state passing. Just a todo.+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        if yieldLimitOk+        then do+            r <- liftIO $ runin $+                    K.foldStreamShared+                        undefined+                        yieldk+                        single+                        incrContinue+                        m+            res <- restoreM r+            case res of+                Continue -> run+                Suspend -> return ()+        -- Avoid any side effects, undo the yield limit decrement if we+        -- never yielded anything.+        else liftIO $ do+            enqueueLIFO sv qref item+            incrementYieldLimit (remainingWork sv)++        where++        single a = do+            res <- liftIO $ yieldWith winfo sv a+            return $ if res then Continue else Suspend++        -- XXX can we pass on the yield limit downstream to limit the+        -- concurrency of constituent streams.+        yieldk a r = do+            res <- liftIO $ yieldWith winfo sv a+            yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+            if res && yieldLimitOk+            then K.foldStreamShared undefined yieldk single incrContinue r+            else do+                runInIO <- askRunInIO+                liftIO $ incrementYieldLimit (remainingWork sv)+                liftIO $ enqueueLIFO sv qref (runInIO, r)+                return Suspend++-------------------------------------------------------------------------------+-- Ahead Channel Data Structures+-------------------------------------------------------------------------------++-- XXX Left associated ahead expressions are expensive. We start a new SVar for+-- each left associative expression. The queue is used only for right+-- associated expression, we queue the right expression and execute the left.+-- Therefore the queue never has more than one item in it. However, in case of+-- parIterateConcatMap the iteration may add more items at the end of the+-- queue.+--+-- XXX we can fix this. When we queue more than one item on the queue we can+-- mark the previously queued item as not-runnable. The not-runnable item is+-- not dequeued until the already running one has finished and at that time we+-- would also know the exact sequence number of the already queued item.+--+-- we can even run the already queued items but they will have to be sorted in+-- layers in the heap. We can use a list of heaps for that.+{-# ANN enqueueAhead "HLint: ignore" #-}+{-# INLINE enqueueAhead #-}+enqueueAhead ::+       Channel m a+    -> IORef ([K.StreamK m a], Int)+    -> (RunInIO m, K.StreamK m a)+    -> IO ()+enqueueAhead sv q m = do+    -- XXX The queue is LIFO. When parConcatIterate queues more than one items+    -- to the queue it will perform a DFS style traversal. For BFS we will have+    -- to use a FIFO data structure here. That would require another Config+    -- option.+    atomicModifyIORefCAS_ q $ \(xs, n) -> (snd m:xs, n)+    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)++-- Normally the thread that has the token should never go away. The token gets+-- handed over to another thread, but someone or the other has the token at any+-- point of time. But if the task that has the token finds that the outputQueue+-- is full, in that case it can go away without even handing over the token to+-- another thread. In that case it sets the nextSequence number in the heap its+-- own sequence number before going away. To handle this case, any task that+-- does not have the token tries to dequeue from the heap first before+-- dequeuing from the work queue. If it finds that the task at the top of the+-- heap is the one that owns the current sequence number then it grabs the+-- token and starts with that.+--+-- XXX instead of queueing just the head element and the remaining computation+-- on the heap, evaluate as many as we can and place them on the heap. But we+-- need to give higher priority to the lower sequence numbers so that lower+-- priority tasks do not fill up the heap making higher priority tasks block+-- due to full heap. Maybe we can have a weighted space for them in the heap.+-- The weight is inversely proportional to the sequence number.+--+-- XXX review for livelock++{-# INLINE dequeueAhead #-}+dequeueAhead :: MonadIO m+    => IORef ([K.StreamK m a], Int) -> m (Maybe (K.StreamK m a, Int))+dequeueAhead q = liftIO $+    atomicModifyIORefCAS q $ \case+            ([], n) -> (([], n), Nothing)+            (x : xs, n) -> ((xs, n + 1), Just (x, n + 1))++-- Dequeue only if the seq number matches the expected seq number.+{-# INLINE dequeueAheadSeqCheck #-}+dequeueAheadSeqCheck :: MonadIO m+    => IORef ([K.StreamK m a], Int) -> Int -> m (Maybe (K.StreamK m a))+dequeueAheadSeqCheck q seqNo = liftIO $+    atomicModifyIORefCAS q $ \case+            ([], n) -> (([], n), Nothing)+            (x : xs, n) ->+                if n + 1 == seqNo+                then ((xs, n + 1), Just x)+                else ((x : xs, n), Nothing)++-------------------------------------------------------------------------------+-- Heap manipulation+-------------------------------------------------------------------------------++withIORef :: IORef a -> (a -> IO b) -> IO b+withIORef ref f = readIORef ref >>= f++atomicModifyIORef_ :: IORef a -> (a -> a) -> IO ()+atomicModifyIORef_ ref f =+    atomicModifyIORef ref $ \x -> (f x, ())++data AheadHeapEntry m a =+      AheadEntryNull -- ^ an empty result, required for sequencing+    | AheadEntryPure a -- ^ a yielded value+    -- ^ A stream with its head possibly evaluated, and tail unevaluated+    | AheadEntryStream (RunInIO m, Maybe a, K.StreamK m a)++data HeapDequeueResult m a =+    -- | Not dequeued because someone is processing the heap. This is indicated+    -- by the second component of the heap IORef tuple being set to 'Nothing'.+      Clearing+    -- | Not dequeued because the seq no. of the top entry is not the next one+    -- expected in seqeunce, we have to wait.+    | Waiting Int+    -- | dequeued successfully, the seq no. of the top entry is the next one+    -- expected in sequence.+    | Ready (Entry Int (AheadHeapEntry m a))++-- | The heap is stored in an IORef along with a sequence number. When the+-- sequence number is set to 'Nothing' it means we are processing the heap. The+-- type of the dequeued entry would be 'Clearing' in this case. When the+-- sequence number in the IORef is set to 'Just' then it is the next expected+-- sequence number. If the dequeued entry matches with this expected sequence+-- number then it is 'Ready' and dequeued otherwise it is 'Waiting'. When we+-- return 'Clearing' or 'Waiting', the heap is not modified i.e. nothing is+-- dequeued.+--+-- Note, when we have n streams each consisting of multiple items composed with+-- "ordered" execution then the entire stream is treated as one item with the+-- given sequence number and all of its elements are yielded serially.+{-# INLINE dequeueFromHeap #-}+dequeueFromHeap+    :: IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -- ^ (heap, Maybe sequence-no).+    -> IO (HeapDequeueResult m a)+dequeueFromHeap hpVar =+    atomicModifyIORef hpVar $ \pair@(hp, snum) ->+        case snum of+            Nothing -> (pair, Clearing)+            Just n -> do+                let r = H.uncons hp+                case r of+                    Just (ent@(Entry seqNo _ev), hp') ->+                            if seqNo == n+                            then ((hp', Nothing), Ready ent)+                            else assert (seqNo >= n) (pair, Waiting n)+                    Nothing -> (pair, Waiting n)++-- | Called only when the heap is being processed to transfer entries to output+-- queue. Matches the sequence number of the dequeued entry with the supplied+-- sequence number to determine if the entry is 'Ready' or 'Waiting'. Heap is+-- not modified if we return 'Waiting' i.e. entry is not dequeued.+{-# INLINE dequeueFromHeapSeq #-}+dequeueFromHeapSeq+    :: IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Int+    -> IO (HeapDequeueResult m a)+dequeueFromHeapSeq hpVar i =+    atomicModifyIORef hpVar $ \(hp, snum) ->+        case snum of+            Nothing -> do+                let r = H.uncons hp+                case r of+                    Just (ent@(Entry seqNo _ev), hp') ->+                        if seqNo == i+                        then ((hp', Nothing), Ready ent)+                        else assert (seqNo >= i) ((hp, Just i), Waiting i)+                    Nothing -> ((hp, Just i), Waiting i)+            Just _ -> error "dequeueFromHeapSeq: unreachable"++heapIsSane :: Maybe Int -> Int -> Bool+heapIsSane snum seqNo =+    case snum of+        Nothing -> True+        Just n -> seqNo >= n++{-# INLINE requeueOnHeapTop #-}+requeueOnHeapTop+    :: IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Entry Int (AheadHeapEntry m a)+    -> Int+    -> IO ()+requeueOnHeapTop hpVar ent seqNo =+    atomicModifyIORef_ hpVar $ \(hp, snum) ->+        assert (heapIsSane snum seqNo) (H.insert ent hp, Just seqNo)++{-# INLINE updateHeapSeq #-}+updateHeapSeq+    :: IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Int+    -> IO ()+updateHeapSeq hpVar seqNo =+    atomicModifyIORef_ hpVar $ \(hp, snum) ->+        assert (heapIsSane snum seqNo) (hp, Just seqNo)++------------------------------------------------------------------------------+-- Ahead: Concurrent streams with ordered results+------------------------------------------------------------------------------++-- Lookahead streams can execute multiple tasks concurrently, ahead of time,+-- but always serve them in the same order as they appear in the stream. To+-- implement lookahead streams efficiently we assign a sequence number to each+-- task when the task is picked up for execution. When the task finishes, the+-- output is tagged with the same sequence number and we rearrange the outputs+-- in sequence based on that number.+--+-- To explain the mechanism imagine that the current task at the head of the+-- stream has a "token" to yield to the outputQueue. The ownership of the token+-- is determined by the current sequence number is maintained in outputHeap.+-- Sequence number is assigned when a task is queued. When a thread dequeues a+-- task it picks up the sequence number as well and when the output is ready it+-- uses the sequence number to queue the output to the outputQueue.+--+-- The thread with current sequence number sends the output directly to the+-- outputQueue. Other threads push the output to the outputHeap. When the task+-- being queued on the heap is a stream of many elements we evaluate only the+-- first element and keep the rest of the unevaluated computation in the heap.+-- When such a task gets the "token" for outputQueue it evaluates and directly+-- yields all the elements to the outputQueue without checking for the+-- "token".+--+-- Note that no two outputs in the heap can have the same sequence numbers and+-- therefore we do not need a stable heap. We have also separated the buffer+-- for the current task (outputQueue) and the pending tasks (outputHeap) so+-- that the pending tasks cannot interfere with the current task. Note that for+-- a single task just the outputQueue is enough and for the case of many+-- threads just a heap is good enough. However we balance between these two+-- cases, so that both are efficient.+--+-- For bigger streams it may make sense to have separate buffers for each+-- stream. However, for singleton streams this may become inefficient. However,+-- if we do not have separate buffers, then the streams that come later in+-- sequence may hog the buffer, hindering the streams that are ahead. For this+-- reason we have a single element buffer limitation for the streams being+-- executed in advance.+--+-- This scheme works pretty efficiently with less than 40% extra overhead+-- compared to the Async streams where we do not have any kind of sequencing of+-- the outputs. It is especially devised so that we are most efficient when we+-- have short tasks and need just a single thread. Also when a thread yields+-- many items it can hold lockfree access to the outputQueue and do it+-- efficiently.+--+-- XXX Maybe we can start the ahead threads at a lower cpu and IO priority so+-- that they do not hog the resources and hinder the progress of the threads in+-- front of them.++-- Left associated ahead expressions are expensive. We start a new SVar for+-- each left associative expression. The queue is used only for right+-- associated expression, we queue the right expression and execute the left.+-- Thererefore the queue never has more than on item in it.+--+-- XXX Also note that limiting concurrency for cases like "take 10" would not+-- work well with left associative expressions, because we have no visibility+-- about how much the left side of the expression would yield.+--+-- XXX It may be a good idea to increment sequence numbers for each yield,+-- currently a stream on the left side of the expression may yield many+-- elements with the same sequene number. We can then use the seq number to+-- enforce yieldMax and yieldLImit as well.++-- Invariants:+--+-- * A worker should always ensure that it pushes all the consecutive items in+-- the heap to the outputQueue especially the items on behalf of the workers+-- that have already left when we were holding the token. This avoids deadlock+-- conditions when the later workers completion depends on the consumption of+-- earlier results. For more details see comments in the consumer pull side+-- code.++{-# INLINE underMaxHeap #-}+underMaxHeap ::+       Channel m a+    -> Heap (Entry Int (AheadHeapEntry m a))+    -> IO Bool+underMaxHeap sv hp = do+    (_, len) <- readIORef (outputQueue sv)++    -- XXX simplify this+    let maxHeap = case maxBufferLimit sv of+            Limited lim -> Limited $+                max 0 (lim - fromIntegral len)+            Unlimited -> Unlimited++    case maxHeap of+        Limited lim -> do+            active <- readIORef (workerCount sv)+            return $ H.size hp + active <= fromIntegral lim+        Unlimited -> return True++-- Return value:+-- True => stop+-- False => continue+preStopCheck ::+       Channel m a+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)) , Maybe Int)+    -> IO Bool+preStopCheck sv heap =+    -- check the stop condition under a lock before actually+    -- stopping so that the whole herd does not stop at once.+    withIORef heap $ \(hp, _) -> do+        heapOk <- underMaxHeap sv hp+        takeMVar (workerStopMVar sv)+        let stopping = do+                putMVar (workerStopMVar sv) ()+                return True+            continue = do+                putMVar (workerStopMVar sv) ()+                return False+        if heapOk+        then+            case yieldRateInfo sv of+                Nothing -> continue+                Just yinfo -> do+                    beyondRate <-+                        isBeyondMaxRate+                            (maxWorkerLimit sv) (workerCount sv) yinfo+                    if beyondRate then stopping else continue+        else stopping++-- XXX In absence of a "noyield" primitive (i.e. do not pre-empt inside a+-- critical section) from GHC RTS, we have a difficult problem. Assume we have+-- a 100,000 threads producing output and queuing it to the heap for+-- sequencing. The heap can be drained only by one thread at a time, any thread+-- that finds that heap can be drained now, takes a lock and starts draining+-- it, however the thread may get prempted in the middle of it holding the+-- lock. Since that thread is holding the lock, the other threads cannot pick+-- up the draining task, therefore they proceed to picking up the next task to+-- execute. If the draining thread could yield voluntarily at a point where it+-- has released the lock, then the next threads could pick up the draining+-- instead of executing more tasks. When there are 100,000 threads the drainer+-- gets a cpu share to run only 1:100000 of the time. This makes the heap+-- accumulate a lot of output when we the buffer size is large.+--+-- The solutions to this problem are:+-- 1) make the other threads wait in a queue until the draining finishes+-- 2) make the other threads queue and go away if draining is in progress+--+-- In both cases we give the drainer a chance to run more often.++-- | Move entries from the heap to the channel's output queue. Only those+-- entries which are in correct order are transferred. Stop whenever a missing+-- sequence number is encountered.+--+-- We enter this function only when we have verified that the sequence number+-- passed to it is the next expected sequence number.+processHeap+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int) -- ^ work queue+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int) -- ^ heap+    -> Channel m a+    -> Maybe WorkerInfo+    -> AheadHeapEntry m a -- heap entry dequeued from top of heap+    -> Int -- seq no. of the heap entry, this is the next correct seq no.+    -> Bool -- True if we are draining the heap when we are finally stopping+    -> m ()+processHeap q heap sv winfo entry sno stopping = loopHeap sno entry++    where++    -- We do not stop the worker on buffer full here as we want to proceed to+    -- nextHeap anyway so that we can clear any subsequent entries. We stop+    -- only in yield continuation where we may have a remaining stream to be+    -- pushed on the heap.+    singleStreamFromHeap seqNo a = do+        void $ liftIO $ yieldWith winfo sv a+        nextHeap seqNo++    yieldStreamFromHeap seqNo a r = do+        continue <- liftIO $ yieldWith winfo sv a+        runStreamWithYieldLimit continue seqNo r++    -- XXX when we have an unfinished stream on the heap we cannot account all+    -- the yields of that stream until it finishes, so if we have picked up+    -- and executed more actions beyond that in the parent stream and put them+    -- on the heap then they would eat up some yield limit which is not+    -- correct, we will think that our yield limit is over even though we have+    -- to yield items from unfinished stream before them. For this reason, if+    -- there are pending items in the heap we drain them unconditionally+    -- without considering the yield limit.+    runStreamWithYieldLimit continue seqNo r = do+        _ <- liftIO $ decrementYieldLimit (remainingWork sv)+        if continue -- see comment above -- && yieldLimitOk+        then do+            let stopk = do+                  liftIO (incrementYieldLimit (remainingWork sv))+                  nextHeap seqNo+            K.foldStreamShared undefined+                          (yieldStreamFromHeap seqNo)+                          (singleStreamFromHeap seqNo)+                          stopk+                          r+        else do+            runIn <- askRunInIO+            let ent = Entry seqNo (AheadEntryStream (runIn, Nothing, r))+            liftIO $ do+                requeueOnHeapTop heap ent seqNo+                incrementYieldLimit (remainingWork sv)++    processWorkQueue prevSeqNo = do+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        if yieldLimitOk+        then do+            work <- dequeueAhead q+            case work of+                Nothing -> return ()+                Just (m, seqNo) -> do+                    if seqNo == prevSeqNo + 1+                    then processWithToken q heap sv winfo m seqNo+                    else processWithoutToken q heap sv winfo m seqNo+        else liftIO $ incrementYieldLimit (remainingWork sv)++    nextHeap prevSeqNo = do+        res <- liftIO $ dequeueFromHeapSeq heap (prevSeqNo + 1)+        case res of+            Ready (Entry seqNo hent) -> loopHeap seqNo hent+            Clearing -> return ()+            Waiting _ ->+                if stopping+                then do+                    r <- liftIO $ preStopCheck sv heap+                    if r+                    then return ()+                    else processWorkQueue prevSeqNo+                else inline processWorkQueue prevSeqNo++    -- The main loop processing the heap. The seqNo is correct in sequence,+    -- this is the one we should be sending to output next.+    loopHeap seqNo ent =+        case ent of+            AheadEntryNull -> nextHeap seqNo+            AheadEntryPure a -> do+                -- Use 'send' directly so that we do not account this in worker+                -- latency as this will not be the real latency.+                -- Don't stop the worker in this case as we are just+                -- transferring available results from heap to outputQueue.+                void+                    $ liftIO+                    $ sendEvent+                        (outputQueue sv) (outputDoorBell sv) (ChildYield a)+                nextHeap seqNo+            AheadEntryStream (RunInIO runin, Just a, r) -> do+                let+                    action = do+                        -- XXX deduplicate this code with the same code above+                        void+                            $ liftIO+                            $ sendEvent+                                (outputQueue sv) (outputDoorBell sv) (ChildYield a)+                        runStreamWithYieldLimit True seqNo r+                    go = do+                        res <- liftIO $ runin action+                        restoreM res+                if stopping+                then do+                    stopIt <- liftIO $ preStopCheck sv heap+                    if stopIt+                    then liftIO $ do+                        -- put the entry back in the heap and stop+                        requeueOnHeapTop heap (Entry seqNo ent) seqNo+                    else go+                else go+            AheadEntryStream (RunInIO runin, Nothing, r) -> do+                -- XXX deuplicate this code with the code above+                let+                    action = runStreamWithYieldLimit True seqNo r+                    go = do+                        res <- liftIO $ runin action+                        restoreM res+                if stopping+                then do+                    stopIt <- liftIO $ preStopCheck sv heap+                    if stopIt+                    then liftIO $ do+                        -- put the entry back in the heap and stop+                        requeueOnHeapTop heap (Entry seqNo ent) seqNo+                    else go+                else go++{-# NOINLINE drainHeap #-}+drainHeap+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+drainHeap q heap sv winfo = do+    r <- liftIO $ dequeueFromHeap heap+    case r of+        Ready (Entry seqNo hent) ->+            processHeap q heap sv winfo hent seqNo True+        _ -> return ()++data HeapStatus = HContinue | HStop++-- XXX Rename to processOutOfOrder++-- | Without token means the worker is working on an item which not the next in+-- sequence, therefore, the output has to be placed on the heap rather than+-- sending it directly to the output queue.+--+processWithoutToken+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Channel m a+    -> Maybe WorkerInfo+    -> K.StreamK m a+    -> Int+    -> m ()+processWithoutToken q heap sv winfo m seqNo = do+    -- we have already decremented the yield limit for m+    let stopk = do+            liftIO (incrementYieldLimit (remainingWork sv))+            -- If the stream stops without yielding anything, and we do not put+            -- anything on heap, but if heap was waiting for this seq number+            -- then it will keep waiting forever, because we are never going to+            -- put it on heap. So we have to put a null entry on heap even when+            -- we stop.+            toHeap AheadEntryNull+        mrun = runInIO $ svarMrun sv++    -- XXX When StreamD streams are converted to StreamK, even for singleton+    -- streams we have a yield and a stop. That can cause perf overhead in case+    -- of concurrent workers. We should always create streams with a "single"+    -- continuation.+    r <- liftIO $ mrun $+            K.foldStreamShared undefined+                (\a r -> do+                    runIn <- askRunInIO+                    toHeap $ AheadEntryStream (runIn, Just a, r))+                (toHeap . AheadEntryPure)+                stopk+                m+    res <- restoreM r+    case res of+        Continue -> workLoopAhead q heap sv winfo+        Suspend -> drainHeap q heap sv winfo++    where++    -- XXX to reduce contention each CPU can have its own heap+    toHeap ent = do+        -- Heap insertion is an expensive affair so we use a non CAS based+        -- modification, otherwise contention and retries can make a thread+        -- context switch and throw it behind other threads which come later in+        -- sequence.+        newHp <- liftIO $ atomicModifyIORef heap $ \(hp, snum) ->+            let hp' = H.insert (Entry seqNo ent) hp+            in assert (heapIsSane snum seqNo) ((hp', snum), hp')++        when (svarInspectMode sv) $+            liftIO $ do+                maxHp <- readIORef (maxHeapSize $ svarStats sv)+                when (H.size newHp > maxHp) $+                    writeIORef (maxHeapSize $ svarStats sv) (H.size newHp)++        heapOk <- liftIO $ underMaxHeap sv newHp++        -- XXX Refactor to use join points+        status <-+            case yieldRateInfo sv of+                Nothing -> return HContinue+                Just yinfo ->+                    case winfo of+                        Just info -> do+                            rateOk <-+                                liftIO+                                    $ incrWorkerYieldCount+                                        (maxWorkerLimit sv)+                                        (workerCount sv)+                                        yinfo+                                        info+                            if rateOk+                            then return HContinue+                            else return HStop+                        Nothing -> return HContinue++        if heapOk+        then+            case status of+                HContinue -> return Continue+                HStop -> return Suspend+        else return Suspend++data TokenWorkerStatus = TokenContinue Int | TokenSuspend++-- XXX Rename to processInOrder++-- | With token means this worker is working on an item which is the next in+-- sequence, therefore, it can be yielded directly to the output queue,+-- avoiding the heap.+--+-- Before suspending the worker has the responsibility to transfer all the+-- in-sequence entries from the heap to the output queue.+processWithToken+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Channel m a+    -> Maybe WorkerInfo+    -> K.StreamK m a+    -> Int+    -> m ()+processWithToken q heap sv winfo action sno = do+    -- Note, we enter this function with yield limit already decremented+    -- XXX deduplicate stop in all invocations+    let stopk = do+            liftIO (incrementYieldLimit (remainingWork sv))+            return $ TokenContinue (sno + 1)+        mrun = runInIO $ svarMrun sv++    r <-+        liftIO+            $ mrun+            $ K.foldStreamShared+                undefined (yieldOutput sno) (singleOutput sno) stopk action++    res <- restoreM r+    case res of+        TokenContinue seqNo -> loopWithToken seqNo+        TokenSuspend -> drainHeap q heap sv winfo++    where++    singleOutput seqNo a = do+        continue <- liftIO $ yieldWith winfo sv a+        if continue+        then return $ TokenContinue (seqNo + 1)+        else do+            liftIO $ updateHeapSeq heap (seqNo + 1)+            return TokenSuspend++    -- XXX use a wrapper function around stop so that we never miss+    -- incrementing the yield in a stop continuation. Essentiatlly all+    -- "unstream" calls in this function must increment yield limit on stop.+    yieldOutput seqNo a r = do+        continue <- liftIO $ yieldWith winfo sv a+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        if continue && yieldLimitOk+        then do+            let stopk = do+                    liftIO (incrementYieldLimit (remainingWork sv))+                    return $ TokenContinue (seqNo + 1)+            K.foldStreamShared undefined+                          (yieldOutput seqNo)+                          (singleOutput seqNo)+                          stopk+                          r+        else do+            runIn <- askRunInIO+            let ent = Entry seqNo (AheadEntryStream (runIn, Nothing, r))+            liftIO $ requeueOnHeapTop heap ent seqNo+            liftIO $ incrementYieldLimit (remainingWork sv)+            return TokenSuspend++    loopWithToken nextSeqNo = do+        let preExit = liftIO $ do+                updateHeapSeq heap nextSeqNo+                incrementYieldLimit (remainingWork sv)+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        -- To avoid a race when another thread puts something+        -- on the heap and goes away, the consumer will not get+        -- a doorBell and we will not clear the heap before+        -- executing the next action. If the consumer depends+        -- on the output that is stuck in the heap then this+        -- will result in a deadlock. So we always clear the+        -- heap before executing the next action.+        if yieldLimitOk+        then do+            -- XXX Instead of checking seqno inside dequeue we can dequeue+            -- unconditionally and if the seqNo is not the same as nextSeqNo+            -- then release the token and call processWithoutToken. Need+            -- to check the performance though.+            work <- dequeueAheadSeqCheck q nextSeqNo+            case work of+                Nothing -> preExit >> workLoopAhead q heap sv winfo+                Just m -> do+                    let stopk = do+                            liftIO (incrementYieldLimit (remainingWork sv))+                            return $ TokenContinue (nextSeqNo + 1)+                        mrun = runInIO $ svarMrun sv+                    r <- liftIO $ mrun $+                        K.foldStreamShared undefined+                                      (yieldOutput nextSeqNo)+                                      (singleOutput nextSeqNo)+                                      stopk+                                      m+                    res <- restoreM r+                    case res of+                        TokenContinue seqNo -> loopWithToken seqNo+                        TokenSuspend -> drainHeap q heap sv winfo+        else preExit >> drainHeap q heap sv winfo++-- XXX the yield limit changes increased the performance overhead by 30-40%.+-- Just like AsyncT we can use an implementation without yeidlimit and even+-- without pacing code to keep the performance higher in the unlimited and+-- unpaced case.+--+-- XXX The yieldLimit stuff is pretty invasive. We can instead do it by using+-- three hooks, a pre-execute hook, a yield hook and a stop hook. In fact these+-- hooks can be used for a more general implementation to even check predicates+-- and not just yield limit.++workLoopAhead+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopAhead q heap sv winfo = do+        r <- liftIO $ dequeueFromHeap heap+        case r of+            Ready (Entry seqNo hent) ->+                processHeap q heap sv winfo hent seqNo False+            Clearing -> return ()+            Waiting _ -> do+                -- Before we execute the next item from the work queue we check+                -- if we are beyond the yield limit. It is better to check the+                -- yield limit before we pick up the next item. Otherwise we+                -- may have already started more tasks even though we may have+                -- reached the yield limit.  We can avoid this by taking active+                -- workers into account, but that is not as reliable, because+                -- workers may go away without picking up work and yielding a+                -- value.+                --+                -- Rate control can be done either based on actual yields in+                -- the output queue or based on any yield either to the heap or+                -- to the output queue. In both cases we may have one issue or+                -- the other. We chose to do this based on actual yields to the+                -- output queue because it makes the code common to both async+                -- and ahead streams.+                --+                yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+                if yieldLimitOk+                then do+                    work <- dequeueAhead q+                    case work of+                        Nothing -> return ()+                        Just (m, seqNo) -> do+                            if seqNo == 0+                            then processWithToken q heap sv winfo m seqNo+                            else processWithoutToken q heap sv winfo m seqNo+                else liftIO $ incrementYieldLimit (remainingWork sv)++-------------------------------------------------------------------------------+-- SVar creation+-- This code belongs in SVar.hs but is kept here for perf reasons+-------------------------------------------------------------------------------++-- XXX we have this function in this file because passing runStreamLIFO as a+-- function argument to this function results in a perf degradation of more+-- than 10%.  Need to investigate what the root cause is.+-- Interestingly, the same thing does not make any difference for Ahead.+-- {-# INLINABLE getLifoSVar #-}+getLifoSVar :: forall m a. MonadRunInIO m =>+    RunInIO m -> Config -> IO (Channel m a)+getLifoSVar mrun cfg = do+    outQ    <- newIORef ([], 0)+    -- The second component of the heap IORef tuple is:+    --+    --  * "Nothing" when we are in the process of clearing the heap i.e. when+    --  we are procssing the heap and transferring entries from the heap to the+    --  output queue+    --  * "Just n" when we are expecting sequence number n to arrive before we+    --  can start clearing the heap.+    outH    <- newIORef (H.empty, Just 0)+    outQMv  <- newEmptyMVar+    active  <- newIORef 0+    wfw     <- newIORef False+    running <- newIORef Set.empty+    q       <- newIORef ([] :: [(RunInIO m, K.StreamK m a)])+    -- Sequence number is incremented whenever something is de-queued,+    -- therefore, first sequence number would be 0+    aheadQ <- newIORef ([], -1)+    stopMVar <- newMVar ()+    yl <-+        case getYieldLimit cfg of+            Nothing -> return Nothing+            Just x -> Just <$> newIORef x+    stoppingRef <- newIORef False+    stoppedMVar <- newMVar False+    rateInfo <- newRateInfo cfg++    stats <- newSVarStats+    tid <- myThreadId++    -- We are reading it without lock, the result would be reliable only if no+    -- worker is pending.+    let isWorkFinished _ = do+            xs <- readIORef q+            return (null xs)++    let isWorkFinishedLimited sv = do+            yieldsDone <-+                    case remainingWork sv of+                        Just ref -> do+                            n <- readIORef ref+                            return (n <= 0)+                        Nothing -> return False+            qEmpty <- isWorkFinished sv+            return $ qEmpty || yieldsDone++    let eagerEval = getEagerDispatch cfg+        inOrder = getOrdered cfg++    let getSVar :: Channel m a+            -> (Channel m a -> m [ChildEvent a])+            -> (Channel m a -> m Bool)+            -> (Channel m a -> IO Bool)+            -> (IORef [(RunInIO m, K.StreamK m a)]+                -> Channel m a+                -> Maybe WorkerInfo+                -> m())+            -> Channel m a+        getSVar sv readOutput postProc workDone wloop = Channel+            { outputQueue      = outQ+            , remainingWork    = yl+            , maxBufferLimit   = getMaxBuffer cfg+            , maxWorkerLimit   = min (getMaxThreads cfg) (getMaxBuffer cfg)+            , yieldRateInfo    = rateInfo+            , outputDoorBell   = outQMv+            , readOutputQ      = readOutput sv+            , postProcess      = postProc sv+            , workerThreads    = running++            , workLoop =+                if inOrder+                then workLoopAhead aheadQ outH sv+                else wloop q sv+            , channelStopping = stoppingRef+            , channelStopped = stoppedMVar+            , enqueue =+                    if inOrder+                    then enqueueAhead sv aheadQ+                    else enqueueLIFO sv q+            , eagerDispatch = when eagerEval $ void $ dispatchWorker 0 sv+            , isWorkDone =+                if inOrder+                then isWorkDoneAhead sv aheadQ outH+                else workDone sv+            , isQueueDone =+                if inOrder+                then isQueueDoneAhead sv aheadQ+                else workDone sv++            , doorBellOnWorkQ  = wfw+            , svarMrun         = mrun+            , workerCount      = active+            -- XXX We can use delThread or modThread based on eager flag.+            , accountThread    = modifyThread running outQMv+            , workerStopMVar   = stopMVar+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode cfg+            , svarCreator      = tid+            , svarStats        = stats+            }++    let sv =+            case getStreamRate cfg of+                Nothing ->+                    case getYieldLimit cfg of+                        Nothing -> getSVar sv (readOutputQBounded eagerEval)+                                              postProcessBounded+                                              isWorkFinished+                                              workLoopLIFO+                        Just _  -> getSVar sv (readOutputQBounded eagerEval)+                                              postProcessBounded+                                              isWorkFinishedLimited+                                              workLoopLIFOLimited+                Just _  ->+                    case getYieldLimit cfg of+                        Nothing -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinished+                                              workLoopLIFO+                        Just _  -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinishedLimited+                                              workLoopLIFOLimited+     in return sv++    where++    {-# INLINE isQueueDoneAhead #-}+    isQueueDoneAhead sv q = do+        queueDone <- checkEmpty q+        yieldsDone <-+                case remainingWork sv of+                    Just yref -> do+                        n <- readIORef yref+                        return (n <= 0)+                    Nothing -> return False+        -- XXX note that yieldsDone can only be authoritative only when there+        -- are no workers running. If there are active workers they can+        -- later increment the yield count and therefore change the result.+        return $ yieldsDone || queueDone++    {-# INLINE isWorkDoneAhead #-}+    isWorkDoneAhead sv q ref = do+        heapDone <- do+                (hp, _) <- readIORef ref+                return (H.size hp <= 0)+        queueDone <- isQueueDoneAhead sv q+        return $ heapDone && queueDone++    checkEmpty q = do+        (xs, _) <- readIORef q+        return $ null xs++-- | Create a new async style concurrent stream evaluation channel. The monad+-- state used to run the stream actions is taken from the call site of+-- newAppendChannel.+--+-- This is a low level API, use newChannel instead.+{-# INLINABLE newAppendChannel #-}+{-# SPECIALIZE newAppendChannel :: (Config -> Config) -> IO (Channel IO a) #-}+newAppendChannel :: MonadRunInIO m => (Config -> Config) -> m (Channel m a)+newAppendChannel modifier = do+    mrun <- askRunInIO+    liftIO $ getLifoSVar mrun (modifier defaultConfig)
+ src/Streamly/Internal/Data/Stream/Channel/Consumer.hs view
@@ -0,0 +1,143 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Consumer+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Stream.Channel.Consumer+    (+    -- *** Reading Events+    -- | Low level functions used to build 'fromChannelK'.+      readOutputQBounded+    , readOutputQPaced+    , postProcessBounded+    , postProcessPaced+    )+where++import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (readIORef)++import Streamly.Internal.Data.Channel.Dispatcher+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Channel.Type++-------------------------------------------------------------------------------+-- Reading from the workers' output queue/buffer+-------------------------------------------------------------------------------++{-# INLINE readOutputQChan #-}+readOutputQChan :: Channel m a -> IO ([ChildEvent a], Int)+readOutputQChan sv = do+    let ss = if svarInspectMode sv then Just (svarStats sv) else Nothing+     in readOutputQRaw (outputQueue sv) ss++-- | Read the channel's output queue. When there is no output dispatches+-- workers and waits for output (using 'sendWorkerWait'). Always ensures that+-- there is at least one outstanding worker.+--+-- To be used as 'readOutputQ' function for the channel.+readOutputQBounded :: MonadIO m => Bool -> Channel m a -> m [ChildEvent a]+readOutputQBounded eagerEval sv = do+    (list, len) <- liftIO $ readOutputQChan sv+    -- When there is no output seen we dispatch more workers to help+    -- out if there is work pending in the work queue.+    if len <= 0+    then blockingRead+    else do+        -- send a worker proactively, if needed, even before we start+        -- processing the output.  This may degrade single processor+        -- perf but improves multi-processor, because of more+        -- parallelism+        sendOneWorker+        return list++    where++    sendOneWorker = do+        cnt <- liftIO $ readIORef $ workerCount sv+        when (cnt <= 0) $ do+            done <- liftIO $ isWorkDone sv+            when (not done) (forkWorker 0 sv)++    {-# INLINE blockingRead #-}+    blockingRead = do+        dispatchAllWait eagerEval sendWorkerDelay (dispatchWorker 0) sv+        liftIO (fst `fmap` readOutputQChan sv)++-- | Same as 'readOutputQBounded' but uses 'dispatchWorkerPaced' to+-- dispatch workers with rate control.+--+-- To be used as 'readOutputQ' function for the channel when rate control is+-- on.+readOutputQPaced :: MonadIO m => Channel m a -> m [ChildEvent a]+readOutputQPaced sv = do+    (list, len) <- liftIO $ readOutputQChan sv+    if len <= 0+    then blockingRead+    else do+        -- XXX send a worker proactively, if needed, even before we start+        -- processing the output.+        void $ dispatchWorkerPaced sv+        return list++    where++    {-# INLINE blockingRead #-}+    blockingRead = do+        dispatchAllWait False sendWorkerDelayPaced dispatchWorkerPaced sv+        liftIO (fst `fmap` readOutputQChan sv)++-- | If there is work to do dispatch as many workers as the target rate+-- requires.+--+-- To be used as 'postProcess' function for the channel when rate control is+-- enabled.+postProcessPaced :: MonadIO m => Channel m a -> m Bool+postProcessPaced sv = do+    workersDone <- allThreadsDone (workerThreads sv)+    -- XXX If during consumption we figure out we are getting delayed then we+    -- should trigger dispatch there as well.  We should try to check on the+    -- workers after consuming every n item from the buffer?+    if workersDone+    then do+        r <- liftIO $ isWorkDone sv+        when (not r) $ do+            void $ dispatchWorkerPaced sv+            -- Note that we need to guarantee a worker since the work is not+            -- finished, therefore we cannot just rely on dispatchWorkerPaced+            -- which may or may not send a worker.+            noWorker <- allThreadsDone (workerThreads  sv)+            when noWorker $ forkWorker 0 sv+        return r+    else return False++-- | If there is work to do ensure that we have at least one worker disptached.+--+-- To be used as 'postProcess' function for the channel.+postProcessBounded :: MonadIO m => Channel m a -> m Bool+postProcessBounded sv = do+    workersDone <- allThreadsDone (workerThreads sv)+    -- There may still be work pending even if there are no workers pending+    -- because all the workers may return if the outputQueue becomes full. In+    -- that case send off a worker to kickstart the work again.+    --+    -- Note that isWorkDone can only be safely checked if all workers are done.+    -- When some workers are in progress they may have decremented the yield+    -- Limit and later ending up incrementing it again. If we look at the yield+    -- limit in that window we may falsely say that it is 0 and therefore we+    -- are done.+    if workersDone+    then do+        r <- liftIO $ isWorkDone sv+        -- Note that we need to guarantee a worker, therefore we cannot just+        -- use dispatchWorker which may or may not send a worker.+        when (not r) (forkWorker 0 sv)+        -- XXX do we need to dispatch many here?+        -- void $ dispatchWorker sv+        return r+    else return False
+ src/Streamly/Internal/Data/Stream/Channel/Dispatcher.hs view
@@ -0,0 +1,509 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Dispatcher+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.Stream.Channel.Dispatcher+    (+    -- *** Worker Dispatching+    -- | Low level functions used to build readOutputQ and postProcess+    -- functions.+      forkWorker+    , dispatchWorker+    , dispatchWorkerPaced+    , dispatchAllWait+    , sendWorkerDelay+    , sendWorkerDelayPaced+    , startChannel -- XXX bootstrap?+    )+where++import Control.Concurrent (takeMVar, threadDelay, forkOS)+import Control.Exception (assert, catch, mask)+import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Maybe (fromJust, fromMaybe)+import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef)+import Streamly.Internal.Control.Concurrent (RunInIO(..))+import Streamly.Internal.Control.ForkIO (rawForkIO)+import Streamly.Internal.Data.Atomics+    (atomicModifyIORefCAS_, storeLoadBarrier)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units+       (MicroSecond64(..), diffAbsTime64, fromRelTime64, toRelTime64)++import Streamly.Internal.Data.Channel.Dispatcher+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Channel.Worker+import Streamly.Internal.Data.Stream.Channel.Type++-------------------------------------------------------------------------------+-- Dispatching workers+-------------------------------------------------------------------------------++-- XXX The old code passed the action and exception handler inside this and+-- only did a fork here. When we passed the channel and added the workerCount+-- update under the mask, many concurrent benchmarks regressed, some+-- drastically improved as well. We did an experiment to directly put this fork+-- code in forkWorker and just push the worker count update inside the mask and+-- that itself caused the entire regression. Also the memory consumption in+-- ConcurrentEager.toNullAp benchmark doubled from 300MB to 600 MB So something+-- fishy going on here which needs to be investigated.+--+{-# INLINE doFork #-}+doFork :: Bool -> Channel m a -> Maybe WorkerInfo -> IO ()+doFork bound chan winfo =+    mask $ \restore -> do+            liftIO $ atomicModifyIORefCAS_ (workerCount chan) $ \n -> n + 1+            when (svarInspectMode chan)+                $ recordMaxWorkers (workerCount chan) (svarStats chan)+            let frk =+                    if bound+                    then forkOS+                    else rawForkIO+                (RunInIO mrun) = svarMrun chan+                act = do+                        restore $ void $ mrun (workLoop chan winfo)+                        stopWith winfo chan+            tid <- frk $ catch act (exceptionWith winfo chan)+            -- In case of lazy dispatch we dispatch workers only from the+            -- consumer thread. In that case it is ok to use addThread here as+            -- it is guaranteed that the thread will be added to the workerSet+            -- before the thread STOP event is processed, because we do both of+            -- these actions in the same consumer thread. However, in case of+            -- eager dispatch we may dispatch workers from workers, in which+            -- case the thread Stop even may get processed before the addThread+            -- occurs, so in that case we have to use modifyThread which+            -- performs a toggle rather than adding or deleting.+            --+            -- XXX We can use addThread or modThread based on eager flag.+            -- XXX Update the dispatcher-to-worker threadId map for debugging+            -- tid <- liftIO myThreadId+            -- liftIO $ putStrLn $ "Dispatcher thread: " ++ show tid+            modThread tid++    where++    modThread = modifyThread (workerThreads chan) (outputDoorBell chan)++-- | Low level API to create a worker. Forks a thread which executes the+-- 'workLoop' of the channel. It does not fork only if the channel is stopped.+{-# NOINLINE forkWorker #-}+forkWorker :: MonadIO m =>+       Count -- ^ max yield limit for the worker+    -> Channel m a+    -> m ()+forkWorker yieldMax sv = do+    -- This allocation matters when significant number of workers are being+    -- sent. We allocate it only when needed.+    --+    -- XXX WorkerInfo is required for maxYields to work even if rate control is+    -- not enabled.+    winfo <-+        case yieldRateInfo sv of+            Nothing -> return Nothing+            Just _ -> liftIO $ do+                cntRef <- newIORef 0+                t <- getTime Monotonic+                lat <- newIORef (0, t)+                return $ Just WorkerInfo+                    { workerYieldMax = yieldMax+                    , workerYieldCount = cntRef+                    , workerLatencyStart = lat+                    }++    stopping <- liftIO $ readIORef (channelStopping sv)+    when (not stopping) $ liftIO $ doFork False sv winfo++-- | Determine the maximum number of workers required based on 'maxWorkerLimit'+-- and 'remainingWork'.+{-# INLINE getEffectiveWorkerLimit #-}+getEffectiveWorkerLimit :: MonadIO m => Channel m a -> m Limit+getEffectiveWorkerLimit sv = do+    let workerLimit = maxWorkerLimit sv+    case remainingWork sv of+        Nothing -> return workerLimit+        Just ref -> do+            n <- liftIO $ readIORef ref+            case yieldRateInfo sv of+                Just _ -> return workerLimit+                Nothing ->+                    return $+                        case workerLimit of+                            Unlimited -> Limited (fromIntegral n)+                            Limited lim -> Limited $ min lim (fromIntegral n)++-- | Determine whether the active threads are more than the max threads we are+-- allowed to dispatch.+{-# INLINE checkMaxThreads #-}+checkMaxThreads :: MonadIO m => Int -> Channel m a -> m Bool+checkMaxThreads active sv = do+    -- Note that we may deadlock if the previous workers (tasks in the+    -- stream) wait/depend on the future workers (tasks in the stream)+    -- executing. In that case we should either configure the maxWorker+    -- count to higher or use parallel style instead of ahead or async+    -- style.+    limit <- getEffectiveWorkerLimit sv+    return+        $ case limit of+            Unlimited -> True+            -- Note that the use of remainingWork and workerCount is not+            -- atomic and the counts may even have changed between reading+            -- and using them here, so this is just approximate logic and+            -- we cannot rely on it for correctness. We may actually+            -- dispatch more workers than required.+            Limited lim -> fromIntegral lim > active++-- | Determine whether we would exceed max buffer if we dispatch more workers+-- based on the current outputQueue size and active workers.+{-# INLINE checkMaxBuffer #-}+checkMaxBuffer :: MonadIO m => Int -> Channel m a -> m Bool+checkMaxBuffer active sv = do+    let limit = maxBufferLimit sv+    case limit of+        Unlimited -> return True+        Limited lim -> do+            (_, n) <- liftIO $ readIORef (outputQueue sv)+            return $ fromIntegral lim > n + active++-- | Higher level API to dispatch a worker, it uses 'forkWorker' to create a+-- worker.+--+-- Dispatches a worker only if all of the following are true:+--+-- * the channel has work to do+-- * max thread count is not reached+-- * max buffer limit is not reached+--+-- It is possible that no worker is dispatched even when there is no+-- outstanding worker - only if any of the following is true:+--+-- * maxBuffer limit is 0+-- * maxThreads limit is set to 0+-- * there is output pending in the output buffer+--+-- In all other cases a worker is guaranteed to be dispatched.+--+dispatchWorker :: MonadIO m =>+       Count -- ^ max yield limit for the worker+    -> Channel m a+    -> m Bool -- ^ can dispatch more workers+dispatchWorker yieldCount sv = do+    -- XXX in case of Ahead streams we should not send more than one worker+    -- when the work queue is done but heap is not done.+    -- XXX Should we have a single abstraction for checking q and+    -- work instead checking the two separately?+    --+    -- Yield count check may not be reliable unless there are no workers+    -- outsanding. If there are no outstanding workers, we are fine. But if+    -- there are outstanding workers, it may return done even if we are not+    -- done yet. But that is fine too as there are outstanding workers and we+    -- cannot block forever in dispatchAllWait.+    done <- liftIO $ isWorkDone sv+    -- Note, "done" may not mean that the work is actually finished if there+    -- are workers active, because there may be a worker which has not yet+    -- queued the leftover work.+    if not done+    then do+        qDone <- liftIO $ isQueueDone sv+        -- This count may be more until the sendStop events are processed.+        active <- liftIO $ readIORef $ workerCount sv+        when (active < 0) $ error "Bug: dispatchWorker active negative"+        if not qDone+        then do+            -- XXX for ahead streams shall we take the heap yields into account+            -- for controlling the dispatch? We should not dispatch if the heap+            -- has already got the limit covered.+            r <- checkMaxThreads active sv+            if r+            then do+                r1 <- checkMaxBuffer active sv+                if r1+                then forkWorker yieldCount sv >> return True+                else return False+            else return False+        else do+            when (active <= 0) $ do+                r <- liftIO $ isWorkDone sv+                when (not r) $ forkWorker 0 sv+            return False+    else return False++-- XXX in case of ahead style stream we need to take the heap size into account+-- because we return the workers on the basis of that which causes a condition+-- where we keep dispatching and they keep returning. So we must have exactly+-- the same logic for not dispatching and for returning.++-- | Like 'dispatchWorker' but with rate control. The number of workers to be+-- dispatched are decided based on the target rate. Uses 'dispatchWorker' to+-- actually dispatch when required. It may block wait until there is time to+-- dispatch.+--+-- It guarantees that if there is no outstanding worker and there is work+-- pending then it dispatches a worker though it may block for some time before+-- it does that depending on the rate goal.+dispatchWorkerPaced :: MonadIO m =>+       Channel m a+    -> m Bool -- ^ True means can dispatch more+dispatchWorkerPaced sv = do+    let yinfo = fromJust $ yieldRateInfo sv+    (svarYields, svarElapsed, wLatency) <- do+        now <- liftIO $ getTime Monotonic+        (yieldCount, baseTime, lat) <-+            liftIO+                $ collectLatency+                    (svarInspectMode sv) (svarStats sv) yinfo False+        let elapsed = fromRelTime64 $ diffAbsTime64 now baseTime+        let latency =+                if lat == 0+                then fromMaybe lat (workerBootstrapLatency yinfo)+                else lat++        return (yieldCount, elapsed, latency)++    if wLatency == 0+    -- Need to measure the latency with a single worker before we can perform+    -- any computation.+    then return False+    else do+        let workerLimit = maxWorkerLimit sv+        let targetLat = svarLatencyTarget yinfo+        let range = svarLatencyRange yinfo+        gainLoss <- liftIO $ readIORef (svarGainedLostYields yinfo)+        let work = estimateWorkers workerLimit svarYields gainLoss svarElapsed+                                   wLatency targetLat range++        -- XXX we need to take yieldLimit into account here. If we are at the+        -- end of the limit as well as the time, we should not be sleeping.+        -- If we are not actually planning to dispatch any more workers we need+        -- to take that in account.+        case work of+            BlockWait s -> do+                assert (s >= 0) (return ())+                -- XXX note that when we return from here we will block waiting+                -- for the result from the existing worker. If that takes too+                -- long we won't be able to send another worker until the+                -- result arrives.+                --+                -- Sleep only if there are no active workers and the+                -- outputQueue is empty, otherwise we will delay reading the+                -- pending output. Note we cannot use workerCount here as it is+                -- not a reliable way to ensure the outputQueue is empty. When+                -- workerCount is 0 we may still have a Stop event waiting in+                -- the outputQueue.+                done <- allThreadsDone (workerThreads sv)+                when done $ void $ do+                    let us = fromRelTime64 (toRelTime64 s) :: MicroSecond64+                    liftIO $ threadDelay (fromIntegral us)+                    dispatchWorker 1 sv+                return False+            PartialWorker yields -> do+                assert (yields > 0) (return ())+                updateGainedLostYields yinfo yields++                done <- allThreadsDone (workerThreads sv)+                when done $ void $ dispatchWorker yields sv+                return False+            ManyWorkers netWorkers yields -> do+                assert (netWorkers >= 1) (return ())+                assert (yields >= 0) (return ())+                updateGainedLostYields yinfo yields++                -- XXX workerPollingInterval is also modified by the+                -- collectLatency call above. Need to reconcile the two.+                let periodRef = workerPollingInterval yinfo+                    ycnt = max 1 $ yields `div` fromIntegral netWorkers+                    period = min ycnt (fromIntegral magicMaxBuffer)++                old <- liftIO $ readIORef periodRef+                when (period < old) $+                    liftIO $ writeIORef periodRef period++                cnt <- liftIO $ readIORef $ workerCount sv+                if cnt < netWorkers+                then do+                    let total = netWorkers - cnt+                        batch = max 1 $ fromIntegral $+                                    minThreadDelay `div` targetLat+                    -- XXX stagger the workers over a period?+                    -- XXX cannot sleep, as that would mean we cannot process+                    -- the outputs. need to try a different mechanism to+                    -- stagger.+                    -- when (total > batch) $+                       -- liftIO $ threadDelay $ nanoToMicroSecs minThreadDelay+                    dispatchN (min total batch)+                else return False++    where++    -- If the absolute value of yields required is more than the svarRateBuffer+    -- then the amount beyond the rate buffer is added to the permanently lost+    -- or gained yields.+    updateGainedLostYields yinfo yields = do+        let buf = fromIntegral $ svarRateBuffer yinfo+        when (yields /= 0 && abs yields > buf) $ do+            let delta =+                   if yields > 0+                   then yields - buf+                   else yields + buf+            liftIO $ modifyIORef (svarGainedLostYields yinfo) (+ delta)++    dispatchN n =+        if n == 0+        then return True+        else do+            r <- dispatchWorker 0 sv+            if r+            then dispatchN (n - 1)+            else return False++-- | Dispatches as many workers as it can until output is seen in the event+-- queue of the channel. If the dispatcher function returns 'False' then no+-- more dispatches can be done. If no more dispatches are possible blocks until+-- output arrives in the event queue.+--+-- When this function returns we are sure that there is some output available.+--+-- Before we call this function we must ensure that there is either a pending+-- worker or pending work, otherwise it might block forever. If there is+-- pending work and no pending worker the dispatcher function must ensure that+-- it dispatches a worker.+--+{-# NOINLINE dispatchAllWait #-}+dispatchAllWait+    :: MonadIO m+    => Bool -- ^ 'eager' option is on+    -> (Channel m a -> IO ()) -- ^ delay function+    -> (Channel m a -> m Bool) -- ^ dispatcher function+    -> Channel m a+    -> m ()+dispatchAllWait eagerEval delay dispatch sv = go++    where++    go = do++        -- Note that we are guaranteed to have at least one outstanding worker+        -- when we enter this function. So if we sleep we are guaranteed to be+        -- woken up by an outputDoorBell, when the worker exits.++        liftIO $ delay sv+        (_, n) <- liftIO $ readIORef (outputQueue sv)+        when (n <= 0 || eagerEval) $ do+            -- The queue may be empty temporarily if the worker has dequeued+            -- the work item but has not enqueued the remaining part yet. For+            -- the same reason, a worker may come back if it tries to dequeue+            -- and finds the queue empty, even though the whole work has not+            -- finished yet.++            -- If we find that the queue is empty, but it may be empty+            -- temporarily, when we checked it. If that's the case we might+            -- sleep indefinitely unless the active workers produce some+            -- output. We may deadlock specially if the otuput from the active+            -- workers depends on the future workers that we may never send.+            -- So in case the queue was temporarily empty set a flag to inform+            -- the enqueue to send us a doorbell.++            -- Note that this is just a best effort mechanism to avoid a+            -- deadlock. Deadlocks may still happen if for some weird reason+            -- the consuming computation shares an MVar or some other resource+            -- with the producing computation and gets blocked on that resource+            -- and therefore cannot do any pushworker to add more threads to+            -- the producer. In such cases the programmer should use a parallel+            -- style so that all the producers are scheduled immediately and+            -- unconditionally. We can also use a separate monitor thread to+            -- push workers instead of pushing them from the consumer, but then+            -- we are no longer using pull based concurrency rate adaptation.+            --+            -- XXX update this in the tutorial.+            --+            -- Having pending active workers does not mean that we are+            -- guaranteed to be woken up if we sleep. In case of Ahead streams,+            -- there may be queued items in the heap even though the+            -- outputQueue is empty, and we may have active workers which are+            -- deadlocked on those items to be processed by the consumer. We+            -- should either guarantee that any worker, before returning,+            -- clears the heap or we send a worker to clear it. Normally we+            -- always send a worker if no output is seen, but if the thread+            -- limit is reached or we are using pacing then we may not send a+            -- worker. See the concurrentApplication test in the tests, that+            -- test case requires at least one yield from the producer to not+            -- deadlock, if the last workers output is stuck in the heap then+            -- this test fails.  This problem can be extended to n threads when+            -- the consumer may depend on the evaluation of next n items in the+            -- producer stream.++            -- register for the outputDoorBell before we check the queue so+            -- that if we sleep because the queue was empty we are guaranteed+            -- to get a doorbell on the next enqueue.++            liftIO $ atomicModifyIORefCAS_ (doorBellOnWorkQ sv) $ const True+            liftIO storeLoadBarrier+            canDoMore <- dispatch sv++            -- XXX test for the case when we miss sending a worker when the+            -- worker count is more than 1500.+            --+            -- XXX Assert here that if the heap is not empty then there is at+            -- least one outstanding worker. Otherwise we could be sleeping+            -- forever.++            if canDoMore+            then go+            else do+                liftIO+                    $ withDiagMVar+                        (svarInspectMode sv)+                        (dumpChannel sv)+                        "dispatchAllWait: nothing to do"+                    $ takeMVar (outputDoorBell sv)+                (_, len) <- liftIO $ readIORef (outputQueue sv)+                if len <= 0+                then go+                else+                    liftIO+                        $ atomicModifyIORefCAS_ (doorBellOnWorkQ sv)+                        $ const False++-- | Start the evaluation of the channel's work queue by kicking off a worker.+-- Note: Work queue must not be empty otherwise the worker will exit without+-- doing anything.+startChannel :: MonadIO m =>+    Channel m a -> m ()+startChannel chan = do+    case yieldRateInfo chan of+        Nothing -> forkWorker 0 chan+        Just yinfo  ->+            if svarLatencyTarget yinfo == maxBound+            then liftIO $ threadDelay maxBound+            else forkWorker 1 chan++-- | Noop as of now.+sendWorkerDelayPaced :: Channel m a -> IO ()+sendWorkerDelayPaced _ = return ()++-- | Noop as of now.+sendWorkerDelay :: Channel m a -> IO ()+sendWorkerDelay _sv =+    -- XXX we need a better way to handle this than hardcoded delays. The+    -- delays may be different for different systems.+    -- If there is a usecase where this is required we can create a combinator+    -- to set it as a config in the state.+    {-+  do+    ncpu <- getNumCapabilities+    if ncpu <= 1+    then+        if (svarStyle sv == AheadVar)+        then threadDelay 100+        else threadDelay 25+    else+        if (svarStyle sv == AheadVar)+        then threadDelay 100+        else threadDelay 10+    -}+    return ()
+ src/Streamly/Internal/Data/Stream/Channel/Interleave.hs view
@@ -0,0 +1,257 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Interleave+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Channel.Interleave+    (+      newInterleaveChannel+    )+where++#include "inline.hs"++import Control.Concurrent (myThreadId)+import Control.Concurrent.MVar (newEmptyMVar, newMVar)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Concurrent.Queue.MichaelScott (LinkedQueue, newQ, nullQ, tryPopR, pushL)+import Data.IORef (newIORef, readIORef)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, MonadAsync, RunInIO(..), askRunInIO, restoreM)+import Streamly.Internal.Data.Channel.Dispatcher (delThread)++import qualified Data.Set as Set+import qualified Streamly.Internal.Data.StreamK as K++import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel.Consumer+import Streamly.Internal.Data.Stream.Channel.Type++------------------------------------------------------------------------------+-- Creating a channel+------------------------------------------------------------------------------++data WorkerStatus = Continue | Suspend++-- XXX This is not strictly round-robin as the streams that are faster may+-- yield more elements than the ones that are slower. Also, when streams+-- suspend due to buffer getting full they get added to the queue in a random+-- order. Document this under interleaved config option or fix it.++{-# INLINE enqueueFIFO #-}+enqueueFIFO ::+       Channel m a+    -> LinkedQueue (RunInIO m, K.StreamK m a)+    -> (RunInIO m, K.StreamK m a)+    -> IO ()+enqueueFIFO sv q m = do+    pushL q m+    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)++{-# INLINE workLoopFIFO #-}+workLoopFIFO+    :: MonadRunInIO m+    => LinkedQueue (RunInIO m, K.StreamK m a)+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopFIFO q sv winfo = run++    where++    run = do+        work <- liftIO $ tryPopR q+        case work of+            Nothing -> return ()+            Just (RunInIO runin, m) -> do+                r <- liftIO+                        $ runin+                        $ K.foldStreamShared+                            undefined yieldk single (return Continue) m+                res <- restoreM r+                case res of+                    Continue -> run+                    Suspend -> return ()++    single a = do+        res <- liftIO $ yieldWith winfo sv a+        return $ if res then Continue else Suspend++    -- XXX in general we would like to yield "n" elements from a single stream+    -- before moving on to the next. Single element granularity could be too+    -- expensive in certain cases. Similarly, we can use time limit for+    -- yielding.+    yieldk a r = do+        res <- liftIO $ yieldWith winfo sv a+        runInIO <- askRunInIO+        -- XXX If the queue is empty we do not need to enqueue. We can just+        -- continue evaluating the stream.+        liftIO $ enqueueFIFO sv q (runInIO, r)+        return $ if res then Continue else Suspend++{-# INLINE workLoopFIFOLimited #-}+workLoopFIFOLimited+    :: forall m a. MonadRunInIO m+    => LinkedQueue (RunInIO m, K.StreamK m a)+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopFIFOLimited q sv winfo = run++    where++    incrContinue =+        liftIO (incrementYieldLimit (remainingWork sv)) >> return Continue++    run = do+        work <- liftIO $ tryPopR q+        case work of+            Nothing -> return ()+            Just (RunInIO runin, m) -> do+                yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+                if yieldLimitOk+                then do+                    r <- liftIO+                            $ runin+                            $ K.foldStreamShared+                                undefined yieldk single incrContinue m+                    res <- restoreM r+                    case res of+                        Continue -> run+                        Suspend -> return ()+                else liftIO $ do+                    enqueueFIFO sv q (RunInIO runin, m)+                    incrementYieldLimit (remainingWork sv)++    single a = do+        res <- liftIO $ yieldWith winfo sv a+        return $ if res then Continue else Suspend++    yieldk a r = do+        res <- liftIO $ yieldWith winfo sv a+        runInIO <- askRunInIO+        liftIO $ enqueueFIFO sv q (runInIO, r)+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        if res && yieldLimitOk+        then return Continue+        else liftIO $ do+            incrementYieldLimit (remainingWork sv)+            return Suspend++-------------------------------------------------------------------------------+-- SVar creation+-------------------------------------------------------------------------------++-- XXX we have this function in this file because passing runStreamLIFO as a+-- function argument to this function results in a perf degradation of more+-- than 10%.  Need to investigate what the root cause is.+-- Interestingly, the same thing does not make any difference for Ahead.+getFifoSVar :: forall m a. MonadRunInIO m =>+    RunInIO m -> Config -> IO (Channel m a)+getFifoSVar mrun cfg = do+    outQ    <- newIORef ([], 0)+    outQMv  <- newEmptyMVar+    active  <- newIORef 0+    wfw     <- newIORef False+    running <- newIORef Set.empty+    q       <- newQ+    yl      <- case getYieldLimit cfg of+                Nothing -> return Nothing+                Just x -> Just <$> newIORef x+    stoppingRef <- newIORef False+    stoppedMVar <- newMVar False+    rateInfo <- newRateInfo cfg++    stats <- newSVarStats+    tid <- myThreadId++    let isWorkFinished _ = nullQ q+    let isWorkFinishedLimited sv = do+            yieldsDone <-+                    case remainingWork sv of+                        Just ref -> do+                            n <- readIORef ref+                            return (n <= 0)+                        Nothing -> return False+            qEmpty <- nullQ q+            return $ qEmpty || yieldsDone++    let getSVar :: Channel m a+            -> (Channel m a -> m [ChildEvent a])+            -> (Channel m a -> m Bool)+            -> (Channel m a -> IO Bool)+            -> (LinkedQueue (RunInIO m, K.StreamK m a)+                -> Channel m a+                -> Maybe WorkerInfo+                -> m())+            -> Channel m a+        getSVar sv readOutput postProc workDone wloop = Channel+            { outputQueue      = outQ+            , remainingWork    = yl+            , maxBufferLimit   = getMaxBuffer cfg+            , maxWorkerLimit   = min (getMaxThreads cfg) (getMaxBuffer cfg)+            , yieldRateInfo    = rateInfo+            , outputDoorBell   = outQMv+            , readOutputQ      = readOutput sv+            , postProcess      = postProc sv+            , workerThreads    = running+            , workLoop         = wloop q sv+            , channelStopping   = stoppingRef+            , channelStopped   = stoppedMVar+            , enqueue          = enqueueFIFO sv q+            , eagerDispatch    = return ()+            , isWorkDone       = workDone sv+            , isQueueDone      = workDone sv+            , doorBellOnWorkQ  = wfw+            , svarMrun         = mrun+            , workerCount      = active+            , accountThread    = delThread running+            , workerStopMVar   = undefined+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode cfg+            , svarCreator      = tid+            , svarStats        = stats+            }++    let sv =+            case getStreamRate cfg of+                Nothing ->+                    case getYieldLimit cfg of+                        Nothing -> getSVar sv (readOutputQBounded False)+                                              postProcessBounded+                                              isWorkFinished+                                              workLoopFIFO+                        Just _  -> getSVar sv (readOutputQBounded False)+                                              postProcessBounded+                                              isWorkFinishedLimited+                                              workLoopFIFOLimited+                Just _  ->+                    case getYieldLimit cfg of+                        Nothing -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinished+                                              workLoopFIFO+                        Just _  -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinishedLimited+                                              workLoopFIFOLimited+     in return sv++-- XXX GHC: If instead of MonadAsync we use (MonadIO m, MonadBaseControl IO m)+-- constraint we get a 2x perf regression. Need to look into that.++-- | Create a new 'interleaved' style concurrent stream evaluation channel. The+-- monad state used to run the stream actions is taken from the call site of+-- newInterleaveChannel.+--+-- This is a low level API, use newChannel instead.+{-# INLINABLE newInterleaveChannel #-}+{-# SPECIALIZE newInterleaveChannel :: (Config -> Config) -> IO (Channel IO a) #-}+newInterleaveChannel :: MonadAsync m =>+    (Config -> Config) -> m (Channel m a)+newInterleaveChannel modifier = do+    mrun <- askRunInIO+    liftIO $ getFifoSVar mrun (modifier defaultConfig)
+ src/Streamly/Internal/Data/Stream/Channel/Operations.hs view
@@ -0,0 +1,335 @@+#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Operations+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Channel.Operations+    (+    -- *** Reading Stream+      fromChannelK+    , fromChannel++    -- ** Enqueuing Work+    , toChannelK+    , toChannel+    )+where++#include "inline.hs"++import Control.Exception (fromException, displayException)+import Control.Monad (when)+import Control.Monad.Catch (throwM, MonadThrow)+import Control.Monad.IO.Class (MonadIO(liftIO))+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif+import Data.IORef (newIORef, mkWeakIORef, writeIORef)+import Streamly.Internal.Control.Concurrent+    (MonadAsync, MonadRunInIO, askRunInIO)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)++import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K++import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Channel.Type hiding (inspect)++import Prelude hiding (map, concat, concatMap)++#ifdef INSPECTION+import Control.Exception (Exception)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Typeable (Typeable)+import Test.Inspection (inspect, hasNoTypeClassesExcept)+#endif++------------------------------------------------------------------------------+-- Generating streams from a channel+------------------------------------------------------------------------------++-- $concurrentEval+--+-- Usually a channel is used to concurrently evaluate multiple actions in a+-- stream using many worker threads that push the results to the channel and a+-- single puller that pulls them from channel generating the evaluated stream.+--+-- @+--                  input stream+--                       |+--     <-----------------|<--------worker+--     |  exceptions     |+-- output stream <---Channel<------worker+--                       |+--                       |<--------worker+--+-- @+--+-- The puller itself schedules the worker threads based on demand.+-- Exceptions are propagated from the worker threads to the puller.++-------------------------------------------------------------------------------+-- Write a stream to a channel+-------------------------------------------------------------------------------++-- XXX Should be a Fold, singleton API could be called joinChannel, or the fold+-- can be called joinChannel.+-- XXX If we use toChannelK multiple times on a channel make sure the channel+-- does not go away before we use the subsequent ones.++-- | High level function to enqueue a work item on the channel. The fundamental+-- unit of work is a stream. Each stream enqueued on the channel is picked up+-- and evaluated by a worker thread. The worker evaluates the stream it picked+-- up serially. When multiple streams are queued on the channel each stream can+-- be evaluated concurrently by different workers.+--+-- Note that the items in each stream are not concurrently evaluated, streams+-- are fundamentally serial, therefore, elements in one particular stream will+-- be generated serially one after the other. Only two or more streams can be+-- run concurrently with each other.+--+-- See 'chanConcatMapK' for concurrent evaluation of each element of a stream.+-- Alternatively, you can wrap each element of the original stream into a+-- stream generating action and queue all those streams on the channel. Then+-- all of them would be evaluated concurrently. However, that would not be+-- streaming in nature, it would require buffering space for the entire+-- original stream. Prefer 'chanConcatMapK' for larger streams.+--+-- Items from each evaluated streams are queued to the same output queue of the+-- channel which can be read using 'fromChannelK'. 'toChannelK' can be called+-- multiple times to enqueue multiple streams on the channel.+--+{-# INLINE toChannelK #-}+toChannelK :: MonadRunInIO m => Channel m a -> K.StreamK m a -> m ()+toChannelK chan m = do+    runIn <- askRunInIO+    liftIO $ enqueue chan (runIn, m)++-- INLINE for fromStreamK/toStreamK fusion++-- | A wrapper over 'toChannelK' for 'Stream' type.+{-# INLINE toChannel #-}+toChannel :: MonadRunInIO m => Channel m a -> Stream m a -> m ()+toChannel chan = toChannelK chan . Stream.toStreamK++{-+-- | Send a stream of streams to a concurrent channel for evaluation.+{-# INLINE joinChannel #-}+joinChannel :: Channel m a -> Fold m (Stream m a) ()+joinChannel = undefined+-}++-------------------------------------------------------------------------------+-- Read a stream from a channel+-------------------------------------------------------------------------------++-- | Pull a stream from an SVar.+{-# NOINLINE fromChannelRaw #-}+fromChannelRaw :: (MonadIO m, MonadThrow m) => Channel m a -> K.StreamK m a+fromChannelRaw sv = K.MkStream $ \st yld sng stp -> do+    list <- readOutputQ sv+    -- Reversing the output is important to guarantee that we process the+    -- outputs in the same order as they were generated by the constituent+    -- streams.+    K.foldStream st yld sng stp $ processEvents $ reverse list++    where++    {-# INLINE processEvents #-}+    processEvents [] = K.MkStream $ \st yld sng stp -> do+        done <- postProcess sv+        if done+        then liftIO (channelDone sv "Channel done") >> stp+        else K.foldStream st yld sng stp $ fromChannelRaw sv++    processEvents (ev : es) = K.MkStream $ \st yld sng stp -> do+        let rest = processEvents es+        case ev of+            ChildYield a -> yld a rest+            ChildStopChannel -> do+                liftIO $ cleanupChan sv "ChildStopChannel"+                stp+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> K.foldStream st yld sng stp rest+                    Just ex ->+                        case fromException ex of+                            Just ThreadAbort ->+                                -- We terminate the loop after sending+                                -- ThreadAbort to workers so we should never+                                -- get it unless it is thrown from inside a+                                -- worker thread or by someone else to our+                                -- thread.+                                error $ "processEvents: got ThreadAbort for tid " ++ show tid+                                -- K.foldStream st yld sng stp rest+                            Nothing -> do+                                liftIO $ cleanupChan sv (displayException ex)+                                throwM ex++#ifdef INSPECTION+-- Use of GHC constraint tuple (GHC.Classes.(%,,%)) in fromStreamVar leads to+-- space leak because the tuple gets allocated in every recursive call and each+-- allocation holds on to the previous allocation. This test is to make sure+-- that we do not use the constraint tuple type class.+--+inspect $ hasNoTypeClassesExcept 'fromChannelRaw+    [ ''Monad+    , ''Applicative+    , ''MonadThrow+    , ''Exception+    , ''MonadIO+    , ''MonadBaseControl+    , ''Typeable+    , ''Functor+    ]+#endif++-- XXX Add a lock in the channel so that fromChannel cannot be called multiple+-- times.+--+-- XXX Add an option to block the consumer rather than stopping the stream if+-- the work queue gets over.++-- | Draw a stream from a concurrent channel. The stream consists of the+-- evaluated values from the input streams that were enqueued on the channel+-- using 'toChannelK'.+--+-- This is the event processing loop for the channel which does two+-- things, (1) dispatch workers, (2) process the events sent by the workers.+-- Workers are dispatched based on the channel's configuration settings.+--+-- The stream stops and the channel is shutdown if any of the following occurs:+--+-- * the work queue becomes empty+-- * channel's max yield limit is reached+-- * an exception is thrown by a worker+-- * 'shutdown' is called on the channel+--+-- Before the channel stops, all the workers are drained and no more workers+-- are dispatched. When the channel is garbage collected a 'ThreadAbort'+-- exception is thrown to all pending workers. If 'inspect' option is enabled+-- then channel's stats are printed on stdout when the channel stops.+--+-- CAUTION! This API must not be called more than once on a channel.+{-# INLINE fromChannelK #-}+fromChannelK :: MonadAsync m =>+    Maybe (IO () -> IO ()) -> Channel m a -> K.StreamK m a+fromChannelK register chan =+    -- Note: when an explicit cleanup handler registration is used, we still+    -- install a GC based cleanup handler, in case the explicit cleanup handler+    -- is not called by the user we will still clean it up when it is garbage+    -- collected.+    K.mkStream $ \st yld sng stp -> do+        ref <- liftIO $ newIORef ()+        _ <- liftIO $ mkWeakIORef ref (cleanupChan chan "Channel cleanup via GC")+        let msg = "Channel cleanup via explicit handler"++        -- Register the cleanup handler to be called at the end of a user+        -- defined bracket.+        --+        -- IMPORTANT: this hook should run before the resource cleanup hooks+        -- registered by the worker threads themselves. If the auto release+        -- hooks registered by the workers run first then we might release the+        -- resources which are potentially in use by the workers, thus the+        -- workers may misbehave. The correct sequence is to first abort and+        -- drain all the workers then run any hooks registered by them.++        case register of+            Nothing -> return ()+            Just f -> liftIO $ f (cleanupChan chan msg)++        startChannel chan+        -- We pass a copy of chan to fromChannelRaw, with svarRef set to ref,+        -- so that we know that it has no other references, when that copy gets+        -- garbage collected "ref" will get garbage collected and our hook will+        -- be called.+        --+        -- XXX We should install cleanupChan as the exception handler for+        -- ThreadAbort or any async exception while running fromChannelRaw.+        K.foldStreamShared st yld sng stp $+            fromChannelRaw chan{svarRef = Just ref}++-- | A wrapper over 'fromChannelK' for 'Stream' type.+{-# INLINE fromChannel #-}+fromChannel :: MonadAsync m => Channel m a -> Stream m a+-- XXX Pass the cleanup registration function to fromChannelK+fromChannel = Stream.fromStreamK . fromChannelK Nothing++#if __GLASGOW_HASKELL__ >= 810+type FromSVarState :: Type -> (Type -> Type) -> Type -> Type+#endif+data FromSVarState t m a =+      FromSVarInit+    | FromSVarRead (Channel m a)+    | FromSVarLoop (Channel m a) [ChildEvent a]+    | FromSVarDone (Channel m a)++-- | Like 'fromSVar' but generates a StreamD style stream instead of CPS.+--+{-# INLINE_NORMAL _fromChannelD #-}+_fromChannelD :: (MonadIO m, MonadThrow m) => Channel m a -> D.Stream m a+_fromChannelD svar = D.Stream step FromSVarInit+    where++    {-# INLINE_LATE step #-}+    step _ FromSVarInit = do+        ref <- liftIO $ newIORef ()+        _ <- liftIO $ mkWeakIORef ref (cleanupChan svar "Channel cleanup via GC")+        -- when this copy of svar gets garbage collected "ref" will get+        -- garbage collected and our GC hook will be called.+        let sv = svar{svarRef = Just ref}+        return $ D.Skip (FromSVarRead sv)++    step _ (FromSVarRead sv) = do+        list <- readOutputQ sv+        -- Reversing the output is important to guarantee that we process the+        -- outputs in the same order as they were generated by the constituent+        -- streams.+        return $ D.Skip $ FromSVarLoop sv (Prelude.reverse list)++    step _ (FromSVarLoop sv []) = do+        done <- postProcess sv+        return $ D.Skip $ if done+                      then FromSVarDone sv+                      else FromSVarRead sv++    step _ (FromSVarLoop sv (ev : es)) = do+        case ev of+            ChildYield a -> return $ D.Yield a (FromSVarLoop sv es)+            ChildStopChannel -> do+                liftIO $ cleanupChan sv "ChildStopChannel"+                return $ D.Skip (FromSVarDone sv)+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> return $ D.Skip (FromSVarLoop sv es)+                    Just ex ->+                        case fromException ex of+                            Just ThreadAbort ->+                                return $ D.Skip (FromSVarLoop sv es)+                            Nothing -> do+                                liftIO $ cleanupChan sv (displayException ex)+                                throwM ex++    step _ (FromSVarDone sv) = do+        when (svarInspectMode sv) $ do+            t <- liftIO $ getTime Monotonic+            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)+            liftIO $ printSVar (dumpChannel sv) "SVar Done"+        return D.Stop
+ src/Streamly/Internal/Data/Stream/Channel/Type.hs view
@@ -0,0 +1,887 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Type+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Channel.Type+    (+    -- ** Type+      Channel(..)++    -- ** Configuration+    , Config++    -- *** Default config+    , defaultConfig++    -- *** Limits+    , maxThreads+    , maxBuffer+    , maxYields++    -- *** Rate Control+    , Rate(..)+    , newRateInfo+    , rate+    , avgRate+    , minRate+    , maxRate+    , constRate++    -- *** Stop behavior+    , StopWhen (..)+    , stopWhen++    -- *** Scheduling behavior+    , eager+    , ordered+    , interleaved+    , boundThreads++    -- *** Diagnostics+    , inspect++    -- *** Resource management+    , useAcquire+    , clearAcquire++    -- *** Get config+    , getMaxBuffer+    , getMaxThreads+    , getYieldLimit+    , getInspectMode+    , getStreamRate+    , getEagerDispatch+    , getOrdered+    , getStopWhen+    , getInterleaved+    , getCleanup++    -- ** Sending Worker Events+    , yieldWith+    , stopWith+    , exceptionWith+    , shutdown++    -- ** Cleanup+    , channelDone+    , cleanupChan++    -- ** Diagnostics+    , dumpChannel+    )+where++import Control.Concurrent (ThreadId, throwTo, takeMVar, putMVar)+import Control.Concurrent.MVar (MVar)+import Control.Exception (SomeException(..))+import Control.Monad (void, when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Int (Int64)+import Data.IORef (IORef, newIORef, readIORef, atomicWriteIORef, writeIORef)+import Data.List (intersperse)+import Data.Set (Set)+import Streamly.Internal.Control.Concurrent (RunInIO)+import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS)+import Streamly.Internal.Data.Channel.Dispatcher (dumpSVarStats)+import Streamly.Internal.Data.Channel.Worker+    (sendYield, sendStop, sendEvent, sendException)+import Streamly.Internal.Data.StreamK (StreamK)+import Streamly.Internal.Control.Exception+    (AcquireIO(..), Priority(..), registerWith)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units (NanoSecond64(..))+import System.Mem (performMajorGC)++import qualified Data.Set as Set++import Streamly.Internal.Data.Channel.Types++-- 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).++-- XXX Since we have stream specific channels now, we can remove functions like+-- enqueue, readOuputQ, postProcess, workLoop etc from this.++-- XXX Add an option in channel for minthreads.+-- dispatch tail worker from the worker itself up to min threads or based on+-- pace data. min threads can be increased dynamically by the event loop.+-- for eager minthreads = maxthreads++-- | A mutable channel to evaluate multiple streams concurrently and provide+-- the combined results as output stream.+--+-- There are only two actors working on the channel data structure, the event+-- processing loop (single thread), and the workers (multiple threads). Locking+-- notes are provided below for concurrent access.+data Channel m a = Channel+    {+     -- XXX Do we need this? We store the runner in the work q, is that enough?+     -- This seems to be used only by the 'ordered' stream as of now.++     -- | Runner for the monadic actions in the stream. Captures the monad+     -- state at the point where the channel was created and uses the same+     -- state to run all actions.+      svarMrun :: RunInIO m++    ---------------------------------------------------------------------------+    -- Output queue related+    ---------------------------------------------------------------------------++    -- | Maximum size of the 'outputQueue'. The actual worst case buffer could+    -- be double of this as the event loop may read the queue and the workers+    -- may fill it up even before the event loop has started consuming.+    , maxBufferLimit :: Limit++    -- 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.+    --+    -- 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.+    --+    -- XXX We can send a bundle of events of one type coaleseced together in an+    -- unboxed structure.++    -- | (events, count): worker event queue of the channel. This is where the+    -- workers queue the results and other events.+    --+    -- [LOCKING] Frequently locked. This is locked and updated by workers on+    -- each yield, and locked, updated by the event loop thread once in a while+    -- for reading. Workers' locking contention may be high if there are a+    -- large number of workers.+    , outputQueue :: IORef ([ChildEvent a], Int)++    -- | Door bell for workers to wakeup the event loop.+    --+    -- [LOCKING] Infrequently locked. Used only when the 'outputQueue'+    -- transitions from empty to non-empty, or a work item is queued by a+    -- worker to the work queue and 'doorBellOnWorkQ' is set by the event loop.+    --+    -- We also use this for workerCount decrement, we wait on this during+    -- cleanup. So any workerCount decrement must send a doorBell.+    , outputDoorBell :: MVar ()++    -- XXX Can we use IO instead of m here?++    -- | Function to read the output queue of the channel, depends on the rate+    -- control option.+    , readOutputQ :: m [ChildEvent a]++    -- | Function to invoke after all the events read in a batch are processed+    -- i.e. before we go on to read the next batch, depends on the rate control+    -- option.+    , postProcess :: m Bool++    ---------------------------------------------------------------------------+    -- Work and rate control+    ---------------------------------------------------------------------------++    -- | Tracks how many yields are remaining before the channel stops, used+    -- when 'maxYields' option is enabled.+    --+    -- [LOCKING] Read only access by event loop 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)++    -- XXX We make this isChannelDone which should not include isQueueDone.+    --+    -- | Determine if there is no more work to do. When 'maxYields' is set for+    -- the channel we may be done even if the work queue still has work.+    , isWorkDone :: IO Bool++    -- | Rate control information for the channel used when 'rate' control is+    -- enabled,+    , yieldRateInfo :: Maybe YieldRateInfo++    ---------------------------------------------------------------------------+    -- Work queue related+    ---------------------------------------------------------------------------++    -- | When set to True, ring 'outputDoorBell' when a work item is queued on+    -- the work queue. This is set by the dispatcher before going to sleep. It+    -- wants to be woken up whenever the work queue got more work to do so that+    -- it can dispatch a worker.+    , doorBellOnWorkQ :: IORef Bool++    -- XXX instead of this we should use a dispatcher setting.++    -- | This is a hook which is invoked whenever the tail of the stream is+    -- re-enqueued on the work queue. Normally, this is set to a noop. When+    -- 'eager' option is enabled this is set to an unconditional worker+    -- dispatch function. This ensures that we eagerly send a worker as long+    -- as there is work to do.+    --+    -- NOTE that this is called from a worker context, therefore we should+    -- consider appropriate locking semantics.+    , eagerDispatch :: m ()++    -- | Enqueue a stream for evaluation on the channel. The first element of+    -- the tuple is the runner function which is used to run the stream actions+    -- in a specific monadic context.+    , enqueue :: (RunInIO m, StreamK m a) -> IO ()++    -- | Determine if the work queue is empty, therefore, there is no more work+    -- to do.+    , isQueueDone :: IO Bool++    -- | Worker function. It is implicitly aware of the work queue. It dequeues+    -- a work item from the queue and runs it. It keeps on doing this in a loop+    -- until it determines that it needs to stop.+    --+    -- Normally, the worker stops when the work queue becomes empty or the work+    -- rate is higher than the target rate when rate control is enabled. It+    -- stops by sending a 'ChildStop' event to the channel+    --+    -- When rate control is enabled, the worker is dispatched with a+    -- 'WorkerInfo' record which is used by the worker to maintain rate control+    -- information and communicate it to the channel.+    , workLoop :: Maybe WorkerInfo -> m ()++    , channelStopping :: IORef Bool+    , channelStopped :: MVar Bool++    ---------------------------------------------------------------------------+    -- Worker thread accounting+    ---------------------------------------------------------------------------+    --+    -- | This is capped 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++    -- | Tracks all active worker threads. An entry is added by the dispatcher+    -- when a worker is dispatched, and removed whenever the event processing+    -- loop receives a 'ChildStop' event.+    --+    -- [LOCKING] Normally, this is updated only by the event loop thread, but+    -- in case of eager dispatch (done in worker context) it is updated by a+    -- worker. So reads from the event loop should be mindful of that.+    -- Updates to this must be async signal safe because we rely on it for+    -- cleanup and cleanup may leave unfinished threads if a thread is forked+    -- but this is not updated.+    , workerThreads :: IORef (Set ThreadId)++    -- | Total number of active worker threads.+    --+    -- [LOCKING] Updated locked, by the event loop thread when dispatching a+    -- worker and by a worker thread when the thread stops. This is read+    -- without lock at several places where we want to rely on an approximate+    -- value. Updates to this must be async signal safe because we rely on it+    -- for cleanup and cleanup may hang and leave unfinished threads if this is+    -- not correct.+    , workerCount :: IORef Int++    -- XXX Can we use IO instead of m here?+    , accountThread  :: ThreadId -> m ()++    -- | Used when 'ordered' is enabled. This is a lock to stop the workers one+    -- at a time. Stopping one might affect whether the other should stop.+    , workerStopMVar :: MVar ()++    ---------------------------------------------------------------------------+    -- Channel cleanup --+    ---------------------------------------------------------------------------+    -- | A weak IORef to call a cleanup function when the channel is garbage+    -- collected.+    , svarRef :: Maybe (IORef ())++    ---------------------------------------------------------------------------+    -- Channel Stats --+    ---------------------------------------------------------------------------+    -- | Stats collection.+    , svarStats :: SVarStats++    ---------------------------------------------------------------------------+    -- Diagnostics --+    ---------------------------------------------------------------------------+    -- | When 'inspect' mode is enabled we report diagnostic data about the+    -- channel at certain points.+    , svarInspectMode :: Bool+    -- | threadId of the thread that created the channel+    , svarCreator :: ThreadId++    -- XXX Add a map of dispatcher thread to worker thread.+    }++-------------------------------------------------------------------------------+-- Channel Config+-------------------------------------------------------------------------------++-- 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++-- | An abstract type for specifying the configuration parameters of a+-- 'Channel'. Use @Config -> Config@ modifier functions to modify the default+-- configuration. See the individual modifier documentation for default values.+--+data Config = Config+    { -- 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+    , _inspect    :: Bool+    , _eagerDispatch  :: Bool+    , _stopWhen :: StopWhen+    , _ordered :: Bool+    , _interleaved :: Bool+    , _bound :: Bool++    -- XXX We can also use resource-t to release the channel. But that will+    -- require a MonadResource constraint. It is a bigger change, we can plan+    -- in future. With MonadResource, runResourceT will have to be called to+    -- create a scope. Here we have an option to use prompt release or GC+    -- release, but there are chances of missing a prompt release when the+    -- option is provided to the programmer instead of always enforcing it.+    --+    -- We could store Channel m a, here instead of a deallocation function, if+    -- we make the Config type as "Config m a". That way we can also share+    -- channels across multiple computations.+    , _release :: Maybe (IO () -> IO ())+    }++-------------------------------------------------------------------------------+-- State defaults and reset+-------------------------------------------------------------------------------++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. Use get/set routines instead of directly accessing+-- the Config fields+defaultConfig :: Config+defaultConfig = Config+    { -- streamVar = Nothing+      _yieldLimit = Nothing+    , _threadsHigh = defaultMaxThreads+    , _bufferHigh = defaultMaxBuffer+    , _maxStreamRate = Nothing+    , _streamLatency = Nothing+    , _inspect = False+    -- XXX Set it to True when Rate is not set?+    , _eagerDispatch = False+    , _stopWhen = AllStop+    , _ordered = False+    , _interleaved = False+    , _bound = False+    , _release = Nothing+    }++-------------------------------------------------------------------------------+-- Smart get/set routines for State+-------------------------------------------------------------------------------++-- | The maximum number of yields that this channel would produce. The Channel+-- automatically stops after that. This could be used to limit the speculative+-- execution beyond the limit.+--+-- 'Nothing' means there is no limit.+--+-- Keep in mind that checking this limit all the time has a performance+-- overhead.+--+-- Known Bugs: currently this works only when rate is specified.+-- Known Bugs: for ordered streams sometimes the actual count is less than+-- expected.+maxYields :: Maybe Int64 -> Config -> Config+maxYields lim st =+    st { _yieldLimit =+            case lim of+                Nothing -> Nothing+                Just n  ->+                    if n <= 0+                    then Just 0+                    else Just (fromIntegral n)+       }++getYieldLimit :: Config -> Maybe Count+getYieldLimit = _yieldLimit++-- | Specify the maximum number of threads that can be spawned by the channel.+-- A value of 0 resets the thread limit to default, a negative value means+-- there is no limit. The default value is 1500.+--+-- When the actions in a stream are IO bound, having blocking IO calls, this+-- option can be used to control the maximum number of in-flight IO requests.+-- When the actions are CPU bound this option can be used to control the amount+-- of CPU used by the stream.+--+maxThreads :: Int -> Config -> Config+maxThreads n st =+    st { _threadsHigh =+            if n < 0+            then Unlimited+            else if n == 0+                 then defaultMaxThreads+                 else Limited (fromIntegral n)+       }++getMaxThreads :: Config -> Limit+getMaxThreads = _threadsHigh++-- | Specify the maximum size of the buffer for storing the results from+-- concurrent computations. If the buffer becomes full we stop spawning more+-- concurrent tasks until there is space in the buffer.+-- A value of 0 resets the buffer size to default, a negative value means+-- there is no limit. The default value is 1500.+--+-- CAUTION! using an unbounded 'maxBuffer' value (i.e. a negative value)+-- coupled with an unbounded 'maxThreads' value is a recipe for disaster in+-- presence of infinite streams, or very large streams.  Especially, it must+-- not be used when 'pure' is used in 'ZipAsyncM' streams as 'pure' in+-- applicative zip streams generates an infinite stream causing unbounded+-- concurrent generation with no limit on the buffer or threads.+--+maxBuffer :: Int -> Config -> Config+maxBuffer n st =+    st { _bufferHigh =+            if n < 0+            then Unlimited+            else if n == 0+                 then defaultMaxBuffer+                 else Limited (fromIntegral n)+       }++getMaxBuffer :: Config -> Limit+getMaxBuffer = _bufferHigh++-- | Specify the stream evaluation rate of a channel.+--+-- A 'Nothing' value means there is no smart rate control, concurrent execution+-- blocks only if 'maxThreads' or 'maxBuffer' is reached, or there are no more+-- concurrent tasks to execute. This is the default.+--+-- When rate (throughput) is specified, concurrent production may be ramped+-- up or down automatically to achieve the specified stream throughput. The+-- specific behavior for different styles of 'Rate' specifications is+-- documented under 'Rate'.  The effective maximum production rate achieved by+-- a channel is governed by:+--+-- * The 'maxThreads' limit+-- * The 'maxBuffer' limit+-- * The maximum rate that the stream producer can achieve+-- * The maximum rate that the stream consumer can achieve+--+-- Maximum production rate is given by:+--+-- \(rate = \frac{maxThreads}{latency}\)+--+-- If we know the average latency of the tasks we can set 'maxThreads'+-- accordingly.+--+rate :: Maybe Rate -> Config -> Config+rate r st = st { _maxStreamRate = r }++getStreamRate :: Config -> Maybe Rate+getStreamRate = _maxStreamRate++_setStreamLatency :: Int -> Config -> Config+_setStreamLatency n st =+    st { _streamLatency =+            if n <= 0+            then Nothing+            else Just (fromIntegral n)+       }++getStreamLatency :: Config -> Maybe NanoSecond64+getStreamLatency = _streamLatency++-- XXX Rename to "inspect"++-- | Print debug information about the 'Channel' when the stream ends. When the+-- stream does not end normally, the channel debug information is printed when+-- the channel is garbage collected. If you are expecting but not seeing the+-- debug info try adding a 'performMajorGC' before the program ends.+--+inspect :: Bool -> Config -> Config+inspect flag st = st { _inspect = flag }++getInspectMode :: Config -> Bool+getInspectMode = _inspect++-- | By default, processing of output from the worker threads is given priority+-- over dispatching new workers. More workers are dispatched only when there is+-- no output to process. When 'eager' is set to 'True', workers are dispatched+-- aggresively as long as there is more work to do irrespective of whether+-- there is output pending to be processed by the stream consumer. However,+-- dispatching may stop if 'maxThreads' or 'maxBuffer' is reached.+--+-- /Note:/ This option has no effect when rate has been specified.+--+-- /Note:/ Not supported with 'interleaved'.+--+eager :: Bool -> Config -> Config+eager flag st = st { _eagerDispatch = flag }++getEagerDispatch :: Config -> Bool+getEagerDispatch = _eagerDispatch++-- | Specify when the 'Channel' should stop.+stopWhen :: StopWhen -> Config -> Config+stopWhen cond st = st { _stopWhen = cond }++getStopWhen :: Config -> StopWhen+getStopWhen = _stopWhen++-- | When enabled the streams may be evaluated cocnurrently but the results are+-- produced in the same sequence as a serial evaluation would produce.+--+-- /Note:/ Not supported with 'interleaved'.+--+ordered :: Bool -> Config -> Config+ordered flag st = st { _ordered = flag }++getOrdered :: Config -> Bool+getOrdered = _ordered++-- | Interleave the streams fairly instead of prioritizing the left stream.+-- This schedules all streams in a round robin fashion over limited number of+-- threads.+--+-- /Note:/ Can only be used on finite number of streams.+--+-- /Note:/ Not supported with 'ordered'.+--+interleaved :: Bool -> Config -> Config+interleaved flag st = st { _interleaved = flag }++getInterleaved :: Config -> Bool+getInterleaved = _interleaved++-- | Spawn bound threads (i.e., spawn threads using 'forkOS' instead of+-- 'forkIO'). The default value is 'False'.+--+-- /Unimplemented/+boundThreads :: Bool -> Config -> Config+boundThreads flag st = st { _bound = flag }++_getBound :: Config -> Bool+_getBound = _bound++-- | A concurrent stream allocates worker threads to evaluates actions in the+-- stream concurrently. When an exception (sync or async) occurs in the code+-- outside the scope of the stream generation code, these workers need to be+-- stopped promptly. To enable that we can use an 'AcquireIO' bracket from the+-- surrounding scope. When 'AcquireIO' scope ends the channel is automatically+-- cleaned up.+--+-- Here is an example:+--+-- >>> import Control.Monad (when)+-- >>> import Control.Concurrent (threadDelay)+-- >>> import Data.Function ((&))+-- >>> import System.IO (hClose, IOMode(..), openFile)+--+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream+-- >>> import qualified Streamly.Control.Exception as Exception+--+-- >>> :{+-- close x h = do+--  putStrLn $ "closing: " ++ x+--  hClose h+-- :}+--+-- >>> :{+-- action ref =+--      Stream.fromList ["file1", "file2"]+--    & Stream.parMapM (Stream.useAcquire ref)+--        (\x -> do+--            (h, release) <- Exception.acquire ref (openFile x ReadMode) (close x)+--            -- use h here+--            threadDelay 1000000+--            when (x == "file1") $ do+--                putStrLn $ "Manually releasing: " ++ x+--                release+--            return x+--        )+--    & Stream.trace print+--    & Stream.fold Fold.drain+-- :}+--+-- >>> run = Exception.withAcquireIO action+--+useAcquire :: AcquireIO -> Config -> Config+useAcquire f cfg = cfg { _release = Just (registerWith Priority1 f) }++-- | Clear the resource release registration function.+clearAcquire :: Config -> Config+clearAcquire cfg = cfg { _release = Nothing }++getCleanup :: Config -> Maybe (IO () -> IO ())+getCleanup = _release++-------------------------------------------------------------------------------+-- Initialization+-------------------------------------------------------------------------------++newRateInfo :: Config -> IO (Maybe YieldRateInfo)+newRateInfo st = do+    -- convert rate in Hertz to latency in Nanoseconds+    let rateToLatency r = if r <= 0 then maxBound else round $ 1.0e9 / r+    case getStreamRate st of+        Just (Rate low goal high buf) ->+            let l    = rateToLatency goal+                minl = rateToLatency high+                maxl = rateToLatency low+            in mkYieldRateInfo l (LatencyRange minl maxl) buf+        Nothing -> return Nothing++    where++    mkYieldRateInfo latency latRange buf = do+        measured <- newIORef 0+        wcur     <- newIORef (0,0,0)+        wcol     <- newIORef (0,0,0)+        now      <- getTime Monotonic+        wlong    <- newIORef (0,now)+        period   <- newIORef 1+        gainLoss <- newIORef (Count 0)++        return $ Just YieldRateInfo+            { svarLatencyTarget      = latency+            , svarLatencyRange       = latRange+            , svarRateBuffer         = buf+            , svarGainedLostYields   = gainLoss+            , workerBootstrapLatency = getStreamLatency st+            , workerPollingInterval  = period+            , workerMeasuredLatency  = measured+            , workerPendingLatency   = wcur+            , workerCollectedLatency = wcol+            , svarAllTimeLatency     = wlong+            }++-------------------------------------------------------------------------------+-- Rate+-------------------------------------------------------------------------------++-- | Same as @rate (Just $ Rate (r/2) r (2*r) maxBound)@+--+-- Specifies the average production rate of a stream in number of yields+-- per second (i.e.  @Hertz@).  Concurrent production is ramped up or down+-- automatically to achieve the specified average yield rate. The rate can+-- go down to half of the specified rate on the lower side and double of+-- the specified rate on the higher side.+--+avgRate :: Double -> Config -> Config+avgRate r = rate (Just $ Rate (r/2) r (2*r) maxBound)++-- | Same as @rate (Just $ Rate r r (2*r) maxBound)@+--+-- Specifies the minimum rate at which the stream should yield values. As+-- far as possible the yield rate would never be allowed to go below the+-- specified rate, even though it may possibly go above it at times, the+-- upper limit is double of the specified rate.+--+minRate :: Double -> Config -> Config+minRate r = rate (Just $ Rate r r (2*r) maxBound)++-- | Same as @rate (Just $ Rate (r/2) r r maxBound)@+--+-- Specifies the maximum rate at which the stream should yield values. As+-- far as possible the yield rate would never be allowed to go above the+-- specified rate, even though it may possibly go below it at times, the+-- lower limit is half of the specified rate. This can be useful in+-- applications where certain resource usage must not be allowed to go+-- beyond certain limits.+--+maxRate :: Double -> Config -> Config+maxRate r = rate (Just $ Rate (r/2) r r maxBound)++-- | Same as @rate (Just $ Rate r r r 0)@+--+-- Specifies a constant yield rate. If for some reason the actual rate+-- goes above or below the specified rate we do not try to recover it by+-- increasing or decreasing the rate in future.  This can be useful in+-- applications like graphics frame refresh where we need to maintain a+-- constant refresh rate.+--+constRate :: Double -> Config -> Config+constRate r = rate (Just $ Rate r r r 0)++-------------------------------------------------------------------------------+-- Operations+-------------------------------------------------------------------------------++-- | Used by workers to send a value to the channel's output stream.+--+-- When a worker is dispatched, a 'WorkerInfo' record is supplied to it by the+-- dispatcher. This record contains the timestamp at the time of dispatch.+-- Whenever the worker yields a value, the yield count in the 'WorkerInfo' is+-- incremented. If the channel has rate control enabled, the yield count and+-- time duration is periodically (based on 'workerPollingInterval') pushed to+-- the channel's 'workerPendingLatency' stat. It is done only if the+-- 'workerPollingInterval' is non-zero.+--+-- Queues the event but returns 'False' if:+--+-- * the buffer limit is exceeding+-- * channel yield rate is exceeding (when rate control is enabled and+-- 'WorkerInfo' is available)+--+-- This is a thread-safe API and can be called by anyone from anywhere. Even a+-- thread that is not registered as a worker with the channel can use it but+-- when rate control is enabled, it might confuse the rate control mechanism if+-- we use workers beyond the knowledge of dispatcher.+--+{-# INLINE yieldWith #-}+yieldWith ::+       Maybe WorkerInfo -- ^ Rate control info for the worker+    -> Channel m a+    -> a+    -> IO Bool -- ^ True means the worker can continue otherwise stop.+yieldWith winfo chan =+    sendYield+        (maxBufferLimit chan)+        (maxWorkerLimit chan)+        (workerCount chan)+        (yieldRateInfo chan)+        (outputQueue chan)+        (outputDoorBell chan)+        winfo++-- | Send a 'ChildStop' event to the channel, used when the worker stops+-- yielding and exits. The final update of the collected latency stats in+-- 'WorkerInfo' is pushed to the channel. Upon receiving the 'ChildStop' event+-- the channel would remove the worker from its set of registered workers.+--+-- A worker that uses this API must have been registered on the Channel prior+-- to invoking this API. This is usually done by the dispatcher  when the+-- worker is dispatched.+{-# INLINE stopWith #-}+stopWith :: Maybe WorkerInfo -> Channel m a -> IO ()+stopWith winfo chan =+    sendStop+        (workerCount chan)+        (yieldRateInfo chan)+        (outputQueue chan)+        (outputDoorBell chan)+        winfo++-- | Like 'stopWith' but marks the stop event with the specified exception.+{-# INLINE exceptionWith #-}+exceptionWith :: Maybe WorkerInfo -> Channel m a -> SomeException -> IO ()+exceptionWith _winfo chan =+    sendException+        (workerCount chan)+        (outputQueue chan)+        (outputDoorBell chan)++-- | Send a 'ChildStopChannel' event to shutdown the channel. Upon receiving+-- the event the event processing loop kills all the registered worker threads+-- and stops the channel.+{-# INLINABLE shutdown #-}+shutdown :: MonadIO m => Channel m a -> m ()+shutdown chan = liftIO $ do+    void+        $ sendEvent+            (outputQueue chan)+            (outputDoorBell chan)+            ChildStopChannel++-- | Dump the channel stats for diagnostics. Used when 'inspect' option is+-- enabled.+{-# NOINLINE dumpChannel #-}+dumpChannel :: Channel m a -> IO String+dumpChannel sv = do+    xs <- sequence $ intersperse (return "\n")+        [ return (dumpCreator (svarCreator sv))+        , return "---------CURRENT STATE-----------"+        , dumpOutputQ (outputQueue sv)+        -- XXX print the types of events in the outputQueue, first 5+        , dumpDoorBell (outputDoorBell sv)+        , dumpNeedDoorBell (doorBellOnWorkQ sv)+        , dumpRunningThreads (workerThreads sv)+        -- XXX print the status of first 5 threads+        , dumpWorkerCount (workerCount sv)+        , return "---------STATS-----------\n"+        , dumpSVarStats (svarInspectMode sv) (yieldRateInfo sv) (svarStats sv)+        ]+    return $ concat xs++-------------------------------------------------------------------------------+-- Cleanup+-------------------------------------------------------------------------------++channelDone :: Channel m a -> String -> IO ()+channelDone chan reason = do+    when (svarInspectMode chan) $ do+        t <- getTime Monotonic+        writeIORef (svarStopTime (svarStats chan)) (Just t)+        printSVar (dumpChannel chan) reason+        -- If there are any other channels referenced by this channel a GC will+        -- prompt them to be cleaned up quickly.+        performMajorGC++-- XXX Handle ThreadAbort while this is running?++-- | Never called from a worker thread. This can be called multiple times and+-- only one will succeed others will block until it finishes.+--+cleanupChan :: Channel m a -> String -> IO ()+cleanupChan chan reason = do+    stopped <- takeMVar (channelStopped chan)+    when (not stopped) $ do+        -- putStrLn "cleanupChan: START"+        atomicWriteIORef (channelStopping chan) True+        go+        channelDone chan reason+        putMVar (channelStopped chan) True+        -- putStrLn "cleanupChan: DONE"++    where++    go = do+        -- Empty the queue so that any new results put the doorbell MVar+        _ <- readOutputQBasic (outputQueue chan)+        cnt <- readIORef (workerCount chan)+        -- Note that the workerSet may not have the threadIds of those workers+        -- which are in the process of dispatch but not yet dispatched. To+        -- ensure that we have aborted all the workers we need to wait until+        -- the worker count drops down to zero, until then we need to watch the+        -- workerset and send ThreadAbort if we find any ThreadId in it. As of+        -- now, this can only happen in the eagerDispatch case as we can+        -- dispatch workers from workers in that case.+        workers <-+            atomicModifyIORefCAS (workerThreads chan) (\x -> (Set.empty,x))+        -- self <- myThreadId+        Prelude.mapM_ (`throwTo` ThreadAbort)+              -- (Prelude.filter (/= self) $ Set.toList workers)+              (Set.toList workers)+        {-+        let setSize = Set.size workers+        putStrLn $ "cleanupChan: thread count: " ++ show cnt+                ++ " workerSet size: " ++ show setSize+        -}+        when (cnt /= 0) $ do+            {-+                withDiagMVar+                    (svarInspectMode chan)+                    (dumpChannel chan)+                    "cleanupChan"+                $ -}+            takeMVar (outputDoorBell chan)+            -- threadDelay 10000+            go
+ 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.Data.Fold (Fold)++import qualified Streamly.Data.StreamK as K+import qualified Streamly.Internal.Data.Stream as D++import Prelude hiding (Foldable(..), 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/Concurrent.hs view
@@ -0,0 +1,857 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Concurrent+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++-- Single effects related functionality can be moved to+-- Data.Async/Control.Async.++module Streamly.Internal.Data.Stream.Concurrent+    (+    -- * Imports+    -- $setup++    -- * Types+      MonadAsync -- XXX Move in channel?++    -- * Combinators+    -- | Stream combinators using a concurrent channel++    -- ** Evaluate+    -- | Evaluates a stream concurrently using a channel.+    , parBuffered+    -- Add unfoldrM/iterateM?++    -- ** Generate+    -- | Uses a single channel to evaluate all actions.+    , parRepeatM+    , parReplicateM++    -- ** Map+    -- | Uses a single channel to evaluate all actions.+    , parMapM+    , parSequence++    -- ** Combine two+    -- | Use a channel for each pair.+    , parTwo+    , parZipWithM+    , parZipWith+    , parMergeByM+    , parMergeBy++    -- ** List of streams+    -- | Shares a single channel across many streams.+    , parListLazy+    , parListOrdered+    , parListInterleaved+    , parListEager+    , parListEagerFst+    , parListEagerMin+    , parList++    -- ** Stream of streams+    -- *** Apply+    , parCrossApply++    -- *** Concat+    -- | Shares a single channel across many streams.+    , parConcat+    , parConcatMap+    , parMergeMap++    -- *** ConcatIterate+    , parConcatIterate+    , parMergeIterate++    -- ** Reactive+    , newStreamAndCallback+    , parYieldWith+    , fromCallback+    , parTapCount+    , tapCount++    -- ** Deprecated+    , parEval+    , parApply+    )+where++#include "inline.hs"+#include "deprecation.h"++import Control.Concurrent (myThreadId, killThread)+import Control.Monad (void, when)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Control.ForkLifted (forkManaged)+import Streamly.Internal.Data.Channel.Dispatcher (modifyThread)+import Streamly.Internal.Data.Channel.Worker (sendEvent)+import Streamly.Internal.Data.Stream (Stream, Step(..))++import qualified Streamly.Internal.Data.IORef as Unboxed+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K++import Prelude hiding (mapM, sequence, concat, concatMap, zipWith)+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel++-- $setup+--+-- Imports for example snippets in this module.+--+-- >>> :m+-- >>> {-# LANGUAGE FlexibleContexts #-}+-- >>> import Control.Concurrent (threadDelay)+-- >>> import qualified Streamly.Data.Array as Array+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Data.Parser as Parser+-- >>> import qualified Streamly.Data.StreamK as StreamK+-- >>> import qualified Streamly.Internal.Data.Stream as Stream+-- >>> import qualified Streamly.Internal.Data.Stream.Prelude as Stream+-- >>> import Prelude hiding (concatMap, concat, zipWith)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}++-------------------------------------------------------------------------------+-- Evaluating a stream+-------------------------------------------------------------------------------++{-+{-# INLINE_NORMAL parBufferedD #-}+parBufferedD :: MonadAsync m => (Config -> Config) -> D.Stream m a -> D.Stream m a+parBufferedD modifier m = D.Stream step Nothing+    where++    step _ Nothing = do+        chan <- newChannel modifier+        sendFirstWorker chan (D.toStreamK m)+        -- XXX should use an unfold to make this efficient+        return $ D.Skip $ Just $ fromChannelD chan++    step gst (Just (D.UnStream step1 st)) = do+        r <- step1 gst st+        return $ case r of+            D.Yield a s -> D.Yield a (Just $ D.Stream step1 s)+            D.Skip s    -> D.Skip (Just $ D.Stream step1 s)+            D.Stop      -> D.Stop+-}++-- | 'parBuffered' evaluates a stream as a whole asynchronously with respect to+-- the consumer of the stream. A worker thread evaluates multiple elements of+-- the stream ahead of time and buffers the results; the consumer of the stream+-- runs in another thread consuming the elements from the buffer, thus+-- decoupling the production and consumption of the stream. 'parBuffered' can be+-- used to run different stages of a pipeline concurrently.+--+-- It is important to note that 'parBuffered' does not evaluate individual actions+-- in the stream concurrently with respect to each other, it merely evaluates+-- the stream serially but in a different thread than the consumer thread,+-- thus the consumer and producer can run concurrently. See 'parMapM' and+-- 'parSequence' to evaluate actions in the stream concurrently.+--+-- The evaluation requires only one thread as only one stream needs to be+-- evaluated. Therefore, the concurrency options that are relevant to multiple+-- streams do not apply here e.g. maxThreads, eager, interleaved, ordered,+-- stopWhen options do not have any effect on 'parBuffered'.+--+-- Useful idioms:+--+-- >>> parUnfoldrM step = Stream.parBuffered id . Stream.unfoldrM step+-- >>> parIterateM step = Stream.parBuffered id . Stream.iterateM step+{-# INLINE parBuffered #-}+parBuffered, parEval+    :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+parBuffered modifier input = withChannel modifier input (const id)+    -- Stream.fromStreamD $ parBufferedD cfg $ Stream.toStreamD stream+RENAME(parEval,parBuffered)++-------------------------------------------------------------------------------+-- combining two streams+-------------------------------------------------------------------------------++{-# INLINE _appendGeneric #-}+_appendGeneric :: MonadAsync m =>+       ((Config -> Config) -> m (Channel m a))+    -> (Config -> Config)+    -> K.StreamK m a+    -> K.StreamK m a+    -> K.StreamK m a+_appendGeneric newChan modifier stream1 stream2 = K.concatEffect action++    where++    action = do+        chan <- newChan modifier+        let cfg = modifier defaultConfig+            done = K.nilM (shutdown chan)+        case getStopWhen cfg of+            AllStop -> do+                toChannelK chan stream2+                toChannelK chan stream1+            FirstStops -> do+                toChannelK chan stream2+                toChannelK chan (K.append stream1 done)+            AnyStops -> do+                toChannelK chan (K.append stream2 done)+                toChannelK chan (K.append stream1 done)+        return $ Stream.toStreamK $ fromChannel chan++-- | Create a new channel and add both the streams to it for async evaluation.+-- The output stream is the result of the evaluation.+{-# INLINE appendWithK #-}+appendWithK :: MonadAsync m =>+    (Config -> Config) -> K.StreamK m a -> K.StreamK m a -> K.StreamK m a+appendWithK modifier stream1 stream2 =+{-+    if getOrdered (modifier defaultConfig)+    then parConcatMapK modifier id (stream1 `K.cons` K.fromPure stream2)+    else _appendGeneric Append.newChannel modifier stream1 stream2+-}+    parConcatMapK modifier id (stream1 `K.cons` K.fromPure stream2)++-- | Evaluate the first stream in the current thread and add the second stream+-- to the supplied channel. This is to be used by a worker thread.+--+-- This can be used with parConcatMap:+--+-- @+-- concatMap = K.parConcatMap (_appendWithChanK chan) f stream+-- @+--+{-# INLINE _appendWithChanK #-}+_appendWithChanK :: MonadAsync m =>+    Channel m a -> K.StreamK m a -> K.StreamK m a -> K.StreamK m a+_appendWithChanK chan stream1 stream2 =+    K.before (toChannelK chan stream2) stream1++-- | Binary operation to evaluate two streams concurrently using a channel.+--+-- If you want to combine more than two streams you almost always want the+-- 'parList' or `parConcat` operation instead. The performance of this+-- operation degrades rapidly when more streams are combined as each operation+-- adds one more concurrent channel. On the other hand, 'parConcat' uses a+-- single channel for all streams. However, with this operation you can+-- precisely control the scheduling by creating arbitrary shape expression+-- trees.+--+-- Definition:+--+-- >>> parTwo cfg x y = Stream.parList cfg [x, y]+--+-- Example, the following code finishes in 4 seconds:+--+-- >>> async = Stream.parTwo id+-- >>> stream1 = Stream.fromEffect (delay 4)+-- >>> stream2 = Stream.fromEffect (delay 2)+-- >>> Stream.fold Fold.toList $ stream1 `async` stream2+-- 2 sec+-- 4 sec+-- [2,4]+--+{-# INLINE parTwo #-}+parTwo :: MonadAsync m =>+    (Config -> Config) -> Stream m a -> Stream m a -> Stream m a+parTwo modifier stream1 stream2 =+    Stream.fromStreamK+        $ appendWithK+            modifier (Stream.toStreamK stream1) (Stream.toStreamK stream2)++-- XXX Add a deep evaluation variant that evaluates individual elements in the+-- generated streams in parallel.++-- | Allocate a channel and use it to concurrently evaluate the streams+-- generated by the mapped function.+--+{-# INLINE parConcatMapK #-}+parConcatMapK :: MonadAsync m =>+    (Config -> Config) -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b+parConcatMapK modifier f input =+    let g = chanConcatMapK modifier+     in withChannelK modifier input (`g` f)++-- | Map each element of the input to a stream and then concurrently evaluate+-- and concatenate the resulting streams. Multiple streams may be evaluated+-- concurrently but earlier streams are perferred. Output from the streams are+-- used as they arrive.+--+-- Definition:+--+-- >>> parConcatMap modifier f stream = Stream.parConcat modifier $ fmap f stream+--+-- Examples:+--+-- >>> f cfg xs = Stream.fold Fold.toList $ Stream.parConcatMap cfg id $ Stream.fromList xs+--+-- The following streams finish in 4 seconds:+--+-- >>> stream1 = Stream.fromEffect (delay 4)+-- >>> stream2 = Stream.fromEffect (delay 2)+-- >>> stream3 = Stream.fromEffect (delay 1)+-- >>> f id [stream1, stream2, stream3]+-- 1 sec+-- 2 sec+-- 4 sec+-- [1,2,4]+--+-- Limiting threads to 2 schedules the third stream only after one of the first+-- two has finished, releasing a thread:+--+-- >>> f (Stream.maxThreads 2) [stream1, stream2, stream3]+-- ...+-- [2,1,4]+--+-- When used with a Single thread it behaves like serial concatMap:+--+-- >>> f (Stream.maxThreads 1) [stream1, stream2, stream3]+-- ...+-- [4,2,1]+--+-- >>> stream1 = Stream.fromList [1,2,3]+-- >>> stream2 = Stream.fromList [4,5,6]+-- >>> f (Stream.maxThreads 1) [stream1, stream2]+-- [1,2,3,4,5,6]+--+-- Schedule all streams in a round robin fashion over the available threads:+--+-- >>> f cfg xs = Stream.fold Fold.toList $ Stream.parConcatMap (Stream.interleaved True . cfg) id $ Stream.fromList xs+--+-- >>> stream1 = Stream.fromList [1,2,3]+-- >>> stream2 = Stream.fromList [4,5,6]+-- >>> f (Stream.maxThreads 1) [stream1, stream2]+-- [1,4,2,5,3,6]+--+{-# INLINE parConcatMap #-}+parConcatMap :: MonadAsync m =>+    (Config -> Config) -> (a -> Stream m b) -> Stream m a -> Stream m b+parConcatMap modifier f stream =+    Stream.fromStreamK+        $ parConcatMapK+            modifier (Stream.toStreamK . f) (Stream.toStreamK stream)++-- | Same as 'mergeMapWith interleave' but concurrent.+--+-- /Unimplemented/+--+{-# INLINE parMergeMap #-}+parMergeMap :: -- MonadAsync m =>+    (Config -> Config) -> (a -> Stream m b) -> Stream m a -> Stream m b+parMergeMap _modifier _f _stream = undefined++-- | Evaluate the streams in the input stream concurrently and combine them.+--+-- >>> parConcat modifier = Stream.parConcatMap modifier id+--+{-# INLINE parConcat #-}+parConcat :: MonadAsync m =>+    (Config -> Config) -> Stream m (Stream m a) -> Stream m a+parConcat modifier = parConcatMap modifier id++-------------------------------------------------------------------------------+-- concat Lists+-------------------------------------------------------------------------------++-- XXX Rename to parListCat?++-- | Like 'parConcat' but works on a list of streams.+--+-- >>> parList modifier = Stream.parConcat modifier . Stream.fromList+--+{-# INLINE parList #-}+parList :: MonadAsync m => (Config -> Config) -> [Stream m a] -> Stream m a+parList modifier = parConcat modifier . Stream.fromList++-- | Like 'concat' but works on a list of streams.+--+-- >>> parListLazy = Stream.parList id+--+{-# INLINE parListLazy #-}+parListLazy :: MonadAsync m => [Stream m a] -> Stream m a+parListLazy = parList id++-- | Like 'parListLazy' but interleaves the streams fairly instead of prioritizing+-- the left stream. This schedules all streams in a round robin fashion over+-- limited number of threads.+--+-- >>> parListInterleaved = Stream.parList (Stream.interleaved True)+--+{-# INLINE parListInterleaved #-}+parListInterleaved :: MonadAsync m => [Stream m a] -> Stream m a+parListInterleaved = parList (interleaved True)++-- | Like 'parListLazy' but with 'ordered' on.+--+-- >>> parListOrdered = Stream.parList (Stream.ordered True)+--+{-# INLINE parListOrdered #-}+parListOrdered :: MonadAsync m => [Stream m a] -> Stream m a+parListOrdered = parList (ordered True)++-- | Like 'parListLazy' but with 'eager' on.+--+-- >>> parListEager = Stream.parList (Stream.eager True)+--+{-# INLINE parListEager #-}+parListEager :: MonadAsync m => [Stream m a] -> Stream m a+parListEager = parList (eager True)++-- | Like 'parListEager' but stops the output as soon as the first stream stops.+--+-- >>> parListEagerFst = Stream.parList (Stream.eager True . Stream.stopWhen Stream.FirstStops)+--+{-# INLINE parListEagerFst #-}+parListEagerFst :: MonadAsync m => [Stream m a] -> Stream m a+parListEagerFst = parList (eager True . stopWhen FirstStops)++-- | Like 'parListEager' but stops the output as soon as any of the two streams+-- stops.+--+-- Definition:+--+-- >>> parListEagerMin = Stream.parList (Stream.eager True . Stream.stopWhen Stream.AnyStops)+--+{-# INLINE parListEagerMin #-}+parListEagerMin :: MonadAsync m => [Stream m a] -> Stream m a+parListEagerMin = parList (eager True . stopWhen AnyStops)++-------------------------------------------------------------------------------+-- Applicative+-------------------------------------------------------------------------------++-- XXX Rename to parStreamApply?++-- | Apply an argument stream to a function stream concurrently. Uses a+-- shared channel for all individual applications within a stream application.+{-# INLINE parCrossApply #-}+{-# SPECIALIZE parCrossApply ::+   (Config -> Config) -> Stream IO (a -> b) -> Stream IO a -> Stream IO b #-}+parCrossApply, parApply :: MonadAsync m =>+    (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+parCrossApply modifier stream1 stream2 =+    parConcatMap+        modifier+        (\g -> parConcatMap modifier (Stream.fromPure . g) stream2)+        stream1+RENAME(parApply,parCrossApply)++-------------------------------------------------------------------------------+-- Map+-------------------------------------------------------------------------------++-- |+-- Definition:+--+-- >>> parMapM modifier f = Stream.parConcatMap modifier (Stream.fromEffect . f)+--+-- For example, the following finishes in 3 seconds (as opposed to 6 seconds)+-- because all actions run in parallel. Even though results are available out+-- of order they are ordered due to the config option:+--+-- >>> f x = delay x >> return x+-- >>> Stream.fold Fold.toList $ Stream.parMapM (Stream.ordered True) f $ Stream.fromList [3,2,1]+-- 1 sec+-- 2 sec+-- 3 sec+-- [3,2,1]+--+{-# INLINE parMapM #-}+parMapM :: MonadAsync m =>+    (Config -> Config) -> (a -> m b) -> Stream m a -> Stream m b+parMapM modifier f = parConcatMap modifier (Stream.fromEffect . f)++-- | Definition:+--+-- >>> parSequence modifier = Stream.parMapM modifier id+--+-- Useful idioms:+--+-- >>> parFromListM = Stream.parSequence id . Stream.fromList+-- >>> parFromFoldableM = Stream.parSequence id . StreamK.toStream . StreamK.fromFoldable+--+{-# INLINE parSequence #-}+parSequence :: MonadAsync m =>+    (Config -> Config) -> Stream m (m a) -> Stream m a+parSequence modifier = parMapM modifier id++-- | Evaluates the streams being zipped in separate threads than the consumer.+-- The zip function is evaluated in the consumer thread.+--+-- >>> parZipWithM cfg f m1 m2 = Stream.zipWithM f (Stream.parBuffered cfg m1) (Stream.parBuffered cfg m2)+--+-- Multi-stream concurrency options won't apply here, see the notes in+-- 'parBuffered'.+--+-- If you want to evaluate the zip function as well in a separate thread, you+-- can use a 'parBuffered' on 'parZipWithM'.+--+{-# INLINE parZipWithM #-}+parZipWithM :: MonadAsync m+    => (Config -> Config)+    -> (a -> b -> m c)+    -> Stream m a+    -> Stream m b+    -> Stream m c+parZipWithM cfg f m1 m2 =+    Stream.zipWithM f (parBuffered cfg m1) (parBuffered cfg m2)++-- |+-- >>> parZipWith cfg f = Stream.parZipWithM cfg (\a b -> return $ f a b)+--+-- >>> m1 = Stream.fromList [1,2,3]+-- >>> m2 = Stream.fromList [4,5,6]+-- >>> Stream.fold Fold.toList $ Stream.parZipWith id (,) m1 m2+-- [(1,4),(2,5),(3,6)]+--+{-# INLINE parZipWith #-}+parZipWith :: MonadAsync m+    => (Config -> Config)+    -> (a -> b -> c)+    -> Stream m a+    -> Stream m b+    -> Stream m c+parZipWith cfg f = parZipWithM cfg (\a b -> return $ f a b)++-- | Like 'mergeByM' but evaluates both the streams concurrently.+--+-- Definition:+--+-- >>> parMergeByM cfg f m1 m2 = Stream.mergeByM f (Stream.parBuffered cfg m1) (Stream.parBuffered cfg m2)+--+{-# INLINE parMergeByM #-}+parMergeByM :: MonadAsync m+    => (Config -> Config)+    -> (a -> a -> m Ordering)+    -> Stream m a+    -> Stream m a+    -> Stream m a+parMergeByM cfg f m1 m2 =+    Stream.mergeByM f (parBuffered cfg m1) (parBuffered cfg m2)++-- | Like 'mergeBy' but evaluates both the streams concurrently.+--+-- Definition:+--+-- >>> parMergeBy cfg f = Stream.parMergeByM cfg (\a b -> return $ f a b)+--+{-# INLINE parMergeBy #-}+parMergeBy :: MonadAsync m+    => (Config -> Config)+    -> (a -> a -> Ordering)+    -> Stream m a+    -> Stream m a+    -> Stream m a+parMergeBy cfg f = parMergeByM cfg (\a b -> return $ f a b)++-------------------------------------------------------------------------------+-- concatIterate+-------------------------------------------------------------------------------++-- | Same as 'concatIterate' but concurrent.+--+-- /Pre-release/+{-# INLINE parConcatIterate #-}+parConcatIterate :: MonadAsync m =>+       (Config -> Config)+    -> (a -> Stream m a)+    -> Stream m a+    -> Stream m a+parConcatIterate modifier f input =+     Stream.fromStreamK+        $ withChannelK modifier (Stream.toStreamK input) iterateStream++    where++    iterateStream chan = chanConcatMapK modifier chan (generate chan)++    -- XXX The channel q should be FIFO for DFS, otherwise it is BFS+    generate chan x = x `K.cons` iterateStream chan (Stream.toStreamK $ f x)++-- | Same as 'mergeIterateWith interleave' but concurrent.+--+-- /Unimplemented/+{-# INLINE parMergeIterate #-}+parMergeIterate :: -- MonadAsync m =>+       (Config -> Config)+    -> (a -> Stream m a)+    -> Stream m a+    -> Stream m a+parMergeIterate _modifier _f _input = undefined++-------------------------------------------------------------------------------+-- Generate+-------------------------------------------------------------------------------++-- |+-- Definition:+--+-- >>> parRepeatM cfg = Stream.parSequence cfg . Stream.repeat+--+-- Generate a stream by repeatedly executing a monadic action forever.+{-# INLINE parRepeatM #-}+parRepeatM :: MonadAsync m => (Config -> Config) -> m a -> Stream m a+parRepeatM cfg = parSequence cfg . Stream.repeat++-- | Generate a stream by concurrently performing a monadic action @n@ times.+--+--  Definition:+--+-- >>> parReplicateM cfg n = Stream.parSequence cfg . Stream.replicate n+--+-- Example, 'parReplicateM' in the following example executes all the+-- replicated actions concurrently, thus taking only 1 second:+--+-- >>> Stream.fold Fold.drain $ Stream.parReplicateM id 10 $ delay 1+-- ...+--+{-# INLINE parReplicateM #-}+parReplicateM :: MonadAsync m => (Config -> Config) -> Int -> m a -> Stream m a+parReplicateM cfg n = parSequence cfg . Stream.replicate n++-------------------------------------------------------------------------------+-- Reactive+-------------------------------------------------------------------------------++-- Note: we can use another API with two callbacks stop and yield if we want+-- the callback to be able to indicate end of stream. Or we can use a Maybe+-- stream where Nothing indicates end of stream.++-- XXX Rename to parNewCallback++-- | Returns an entangled pair of a callback and a stream i.e. whenever the+-- callback is called a value appears in the stream. The stream is infinite,+-- there is no way for the callback to indicate that it is done now.+--+-- The callback queues a value to a concurrent channel associated with the+-- stream. The stream can be evaluated safely in any thread.+--+-- /Pre-release/+--+{-# INLINE_NORMAL newStreamAndCallback #-}+newStreamAndCallback :: MonadAsync m => m (a -> m (), Stream m a)+newStreamAndCallback = do+    chan <- newChannel (eager True)++    -- XXX Add our own thread-id to the SVar as we can not know the callback's+    -- thread-id and the callback is not run in a managed worker. We need to+    -- handle this better. The caller thread might be killed by the Channel if+    -- the stream evaluator dies.+    --+    liftIO myThreadId+        >>= modifyThread (workerThreads chan) (outputDoorBell chan)++    -- XXX We can use a "Maybe a" here. Use Nothing to send a Stop event.+    let callback a =+            liftIO+                $ void+                $ sendEvent+                    (outputQueue chan) (outputDoorBell chan) (ChildYield a)+    -- XXX Use fromChannelD?+    return (callback, fromChannel chan)++-- XXX Take the Channel config as argument.  What config can be set by user+-- here?++-- | @fromCallback action@ runs @action@ with a callback which is used by+-- the action to send values that appear in the resulting stream. The action+-- must be run in a separate thread independent of the one in which the stream+-- is being evaluated. The action is supposed to be run forever in an infinite+-- loop.+--+-- Example:+--+-- >> import Control.Concurrent (threadDelay, forkIO)+-- >> import Control.Monad (void, forever)+-- >> import qualified Streamly.Data.Fold as Fold+-- >> import qualified Streamly.Data.Stream.Prelude as Stream+-- >>+-- >> main = do+-- >>     Stream.fold (Fold.drainMapM print)+-- >>         $ Stream.fromCallback+-- >>         $ \yield ->+-- >>             void $ forkIO $ forever $ do+-- >>                 yield "x" >> threadDelay 1000000+--+-- /Pre-release/+--+{-# INLINE fromCallback #-}+fromCallback :: MonadAsync m => ((a -> m ()) -> m ()) -> Stream m a+fromCallback setCallback = Stream.concatEffect $ do+    (callback, stream) <- newStreamAndCallback+    setCallback callback+    return stream++-- XXX What happens if an exception occurs when evaluating the stream? The+-- result of callback can be used to communicate that. But we can only know+-- about the exception on the next callback call. For better handling the user+-- can supply an exception sender function as argument to fromCallback. Or+-- maybe we should just forward all exceptions the parent stream.+--+-- XXX Add a serial version of this i.e. yieldWith?+-- XXX For folds a parAwaitWith is possible.+-- XXX For pipes parYieldAwaitWith++-- | An improved version of 'fromCallback'.+--+-- * Takes a channel config modifier+-- * Evaluates the action in a parallel thread+-- * The action is supplied with a yield function to yield values to the stream+-- * Any exception generated is forwarded to the stream+-- * Sends a Stop event when the action is done.+--+-- /Unimplemented/+parYieldWith :: -- MonadAsync m =>+    (Config -> Config) -> ((a -> m b) -> m c) -> Stream m a+parYieldWith = undefined++-- | @parTapCount predicate fold stream@ taps the count of those elements in+-- the stream that pass the @predicate@. The resulting count stream is sent to+-- a @fold@ running concurrently in another thread.+--+-- For example, to print the count of elements processed every second:+--+-- >>> rate = Stream.rollingMap2 (flip (-)) . Stream.delayPost 1+-- >>> report = Stream.fold (Fold.drainMapM print) . rate+-- >>> tap = Stream.parTapCount (const True) report+-- >>> go = Stream.fold Fold.drain $ tap $ Stream.enumerateFrom 0+--+-- Note: This may not work correctly on 32-bit machines because of Int+-- overflow.+--+-- /Pre-release/+--+{-# INLINE_NORMAL parTapCount #-}+parTapCount+    :: MonadAsync m+    => (a -> Bool)+    -> (D.Stream m Int -> m b)+    -> D.Stream m a+    -> D.Stream m a+parTapCount predicate fld (D.Stream step state) = D.Stream step' Nothing+  where++    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        -- As long as we are using an "Int" for counts lockfree reads from+        -- Var should work correctly on both 32-bit and 64-bit machines.+        -- However, an Int on a 32-bit machine may overflow quickly.+        countVar <- liftIO $ Unboxed.newIORef (0 :: Int)+        tid <- forkManaged+            $ void $ fld+            $ Unboxed.pollIORefInt countVar+        return $ Skip (Just (countVar, tid, state))++    step' gst (Just (countVar, tid, st)) = do+        r <- step gst st+        case r of+            Yield x s -> do+                when (predicate x)+                    $ liftIO $ Unboxed.modifyIORef' countVar (+ 1)+                return $ Yield x (Just (countVar, tid, s))+            Skip s -> return $ Skip (Just (countVar, tid, s))+            Stop -> do+                liftIO $ killThread tid+                return Stop++{-# DEPRECATED tapCount "Please use parTapCount instead." #-}+-- | Same as 'parTapCount'. Deprecated.+{-# INLINE tapCount #-}+tapCount ::+       (MonadAsync m)+    => (a -> Bool)+    -> (Stream m Int -> m b)+    -> Stream m a+    -> Stream m a+tapCount = parTapCount++-------------------------------------------------------------------------------+-- Stream cloning+-------------------------------------------------------------------------------++-- Clone a stream into n streams, perform some processing on them and then zip+-- or merge the results in different ways?+--+-- For serial processing combining n scans into a single scan on the source+-- stream would be the most efficient way of doing this. But this has a+-- limitation that we process one element at a time through the combined scan.+-- This is a way to combine the states of different scans in a modular way.+-- This works well for cases where each scan consumes and produces one element+-- at a time. If different scans produce elements by consuming different number+-- of elements then this may become complicated, inconvenient to use.+--+-- It does not make much sense to clone a stream to multiple free streams+-- unless we enforce processing those streams in independent threads. If+-- we are anyway running them in the same thread then there is not much point+-- of cloning, we can just map a function on the stream to do multiple tasks in+-- tandem.+--+-- Cloning a stream to multiple free streams can provide independent buffering+-- and speed of evaluation to each cloned stream pipeline. For example, we can+-- parseBreak each stream independently using a different parser. The+-- evaluation would be push driven. The source stream would be evaluated in a+-- separate thread and we would push the generated elements to all the cloned+-- streams.+--+-- 1. If the cloned streams have infinite buffers then this can lead to the+-- source stream getting evaluated faster than consumers and buffering the+-- entire source stream in cloned streams.+--+-- 2. If the cloned streams have limited buffers, then they will all go at the+-- speed of the slowest stream if they are run concurrently.+--+-- 3. If the cloned streams have limited buffers and are evaluated serially+-- then we may run into deadlock if we are deep evaluating one stream and the+-- source gets blocked because other stream's buffer are full.+--+-- This is somewhat like list sharing. And it will have the same space leak+-- issues if used incorrectly. In fact, we can evaluate the source stream to+-- generate a lazy list using unsafePerformIO and share that lazy list among+-- multiple consumers. The evaluation of the list would drive the stream. And+-- the list would be naturally shared across consumers which can use different+-- buffering. This would be more like the lazy IO model. However, it may be+-- better to use streams instead of lists because streams use a monad and lists+-- are pure - pure lists can lead to the same issues as lazy IO when used in+-- pure functions.+--+-- Therefore, for safety, it makes better sense to use consumers (Stream m a ->+-- m b) rather than generating free streams as results. Each such consumer can+-- be enforced to run in its own thread. We can also pass a result collector+-- callback in a ReaderT env to collect the results from all these consumers+-- into a single stream.+--+-- parTap -- tap the stream to a single consumer+-- parDistribute -- a finite list of consumers is specified. all consumers+-- are guaranteed to get the entire stream from beginning. Run each consumer in+-- a separate thread.+-- parDistributeStream -- consumers can join the distribution channel+-- dynamically, they will get the source stream from now onwards.++-- XXX We could use Stream or StreamK, what are the pros and cons? The StreamK+-- version can be used to implement parDistribute using foldr?+{-+{-# INLINE parTap #-}+parTap :: MonadAsync m => (Stream m a -> m b) -> Stream m a -> Stream m a+parTap f m = undefined++-- Can we just use a parBuffered fold in tap?+-- We can easily convert the Fold to "Stream m a -> m b" form. Check if this+-- provides the same perf as above.+{-# INLINE parTap #-}+parTap :: MonadAsync m => Fold m a b -> Stream m a -> Stream m a+parTap f xs = undefined++-- Can we just use a parallel distribute fold in tap?+-- Maybe better to use a custom impl of distribute?+{-# INLINE parDistribute #-}+parDistribute :: (Foldable f, , MonadAsync m)+    => f (Stream m a -> m b) -> Stream m a -> Stream m a+parDistribute = flip (Prelude.foldr parTap)+-}
src/Streamly/Internal/Data/Stream/Instances.hs view
@@ -15,14 +15,11 @@     {-# INLINE (<$) #-};                                                      \     (<$) =  fmap . const };                                                   \                                                                               \-instance (MonadBase b m, Monad m CONSTRAINT) => MonadBase b (STREAM m) where {\-    liftBase = liftBaseDefault };                                             \-                                                                              \ instance (MonadIO m CONSTRAINT) => MonadIO (STREAM m) where {                 \-    liftIO = lift . liftIO };                                                 \+    liftIO x = STREAM $ K.fromEffect $ liftIO x };                            \                                                                               \ instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where {           \-    throwM = lift . throwM };                                                 \+    throwM x = STREAM $ K.fromEffect $ throwM x };                            \                                                                               \ {- \ instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where {       \@@ -32,16 +29,16 @@ -} \                                                                               \ instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where {     \-    ask = lift ask;                                                           \-    local f (STREAM m) = STREAM $ K.withLocal f m };                          \+    ask = STREAM $ K.fromEffect ask;                                          \+    local f (STREAM m) = STREAM $ withLocal f m };                          \                                                                               \ instance (MonadState s m CONSTRAINT) => MonadState s (STREAM m) where {       \     {-# INLINE get #-}; \-    get     = lift get;                                                       \+    get = STREAM $ K.fromEffect get;                                          \     {-# INLINE put #-}; \-    put x   = lift (put x);                                                   \+    put x = STREAM $ K.fromEffect $ put x;                                    \     {-# INLINE state #-}; \-    state k = lift (state k) }+    state k = STREAM $ K.fromEffect $ state k }  ------------------------------------------------------------------------------ -- Lists@@ -56,14 +53,10 @@ -- well, because they do not get inlined. Need to add INLINE in Ord class in -- base? -#if MIN_VERSION_deepseq(1,4,3) #define NFDATA1_INSTANCE(STREAM)                                              \ instance NFData1 (STREAM Identity) where {                                    \     {-# INLINE liftRnf #-};                                                   \     liftRnf f (STREAM xs) = runIdentity $ P.foldl' (\_ x -> f x) () xs}-#else-#define NFDATA1_INSTANCE(STREAM)-#endif  #define LIST_INSTANCES(STREAM)                                                \ instance IsList (STREAM Identity a) where {                                   \@@ -143,7 +136,7 @@                                                                               \     {-# INLINE maximum #-};                                                   \     maximum =                                                                 \-          fromMaybe (errorWithoutStackTrace $ "maximum: empty stream")        \+          fromMaybe (errorWithoutStackTrace "maximum: empty stream")        \         . toMaybe                                                             \         . foldl' getMax Nothing' where {                                      \             getMax Nothing' x = Just' x;                                      \@@ -151,7 +144,7 @@                                                                               \     {-# INLINE minimum #-};                                                   \     minimum =                                                                 \-          fromMaybe (errorWithoutStackTrace $ "minimum: empty stream")        \+          fromMaybe (errorWithoutStackTrace "minimum: empty stream")        \         . toMaybe                                                             \         . foldl' getMin Nothing' where {                                      \             getMin Nothing' x = Just' x;                                      \
src/Streamly/Internal/Data/Stream/IsStream.hs view
@@ -1,16 +1,18 @@+{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.IsStream -- Copyright   : (c) 2017 Composewell Technologies -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com--- Stability   : pre-release+-- Stability   : experimental -- Portability : GHC -- -- This is an internal module which is a superset of the corresponding released -- module "Streamly.Prelude". It contains some additional unreleased or -- experimental APIs. -module Streamly.Internal.Data.Stream.IsStream+module Streamly.Internal.Data.Stream.IsStream  {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream from streamly-core package\", \"Streamly.Internal.Data.Stream.Concurrent\", \"Streamly.Internal.Data.Stream.Exception.Lifted\", & \"Streamly.Internal.Data.Stream.Time\" from streamly package instead." #-}     ( module Streamly.Internal.Data.Stream.IsStream.Type     , module Streamly.Internal.Data.Stream.IsStream.Generate     , module Streamly.Internal.Data.Stream.IsStream.Eliminate@@ -20,11 +22,16 @@     , module Streamly.Internal.Data.Stream.IsStream.Exception     , module Streamly.Internal.Data.Stream.IsStream.Lift     , module Streamly.Internal.Data.Stream.IsStream.Top+    , module Streamly.Internal.Data.Stream.IsStream.Combinators+    , module Streamly.Internal.Data.Stream.IsStream.Common+    , module Streamly.Internal.Data.Stream.IsStream.Enumeration+    , fromStream+    , toStream     ) where  import Streamly.Internal.Data.Stream.IsStream.Top-import Streamly.Internal.Data.Stream.IsStream.Eliminate+import Streamly.Internal.Data.Stream.IsStream.Eliminate hiding (toStream) import Streamly.Internal.Data.Stream.IsStream.Exception import Streamly.Internal.Data.Stream.IsStream.Generate import Streamly.Internal.Data.Stream.IsStream.Lift@@ -32,5 +39,18 @@ import Streamly.Internal.Data.Stream.IsStream.Reduce import Streamly.Internal.Data.Stream.IsStream.Transform import Streamly.Internal.Data.Stream.IsStream.Type-    hiding (cmpBy, drain, eqBy, foldl', foldrM, foldr, fold, toList, toStream-        , fromEffect, fromPure, repeat)+    hiding (cmpBy, drain, eqBy, foldl', fold, toList, toStream+        , fromEffect, fromPure, repeat, fromStream)+import Streamly.Internal.Data.Stream.IsStream.Combinators+import Streamly.Internal.Data.Stream.IsStream.Common+import Streamly.Internal.Data.Stream.IsStream.Enumeration++import qualified Streamly.Internal.Data.Stream as D++{-# INLINE fromStream #-}+fromStream :: (IsStream t, Monad m) => D.Stream m a -> t m a+fromStream = fromStreamD++{-# INLINE toStream #-}+toStream :: (IsStream t, Monad m) => t m a -> D.Stream m a+toStream = toStreamD
src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.Combinators -- Copyright   : (c) 2017 Composewell Technologies@@ -7,7 +9,7 @@ -- Portability : GHC -- ---module Streamly.Internal.Data.Stream.IsStream.Combinators+module Streamly.Internal.Data.Stream.IsStream.Combinators {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     ( maxThreads     , maxBuffer     , maxYields@@ -29,7 +31,7 @@ import Streamly.Internal.Data.Stream.IsStream.Type     (IsStream, mkStream, foldStreamShared) import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream)  import Streamly.Internal.Data.SVar
src/Streamly/Internal/Data/Stream/IsStream/Common.hs view
@@ -1,4 +1,6 @@+{-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-orphans  #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Common@@ -11,7 +13,7 @@ -- Bottom level IsStream module that can be used by all other upper level -- IsStream modules. -module Streamly.Internal.Data.Stream.IsStream.Common+module Streamly.Internal.Data.Stream.IsStream.Common {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * Generation       fromPure@@ -22,15 +24,16 @@     , relTimesWith      -- * Elimination-    , foldOn+    , foldContinue     , fold-    , fold_      -- * Transformation     , map     , scanlMAfter'+    , postscanlMAfter'     , postscanlM'     , smapM+    , foldManyPost     -- $smapM_Notes     , take     , takeWhile@@ -69,32 +72,34 @@ import Control.Monad.IO.Class (MonadIO(..)) import Foreign.Storable (Storable) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Array.Foreign.Type (Array)-import Streamly.Internal.Data.Fold.Type (Fold (..))+import Streamly.Internal.Data.Array (Array)+import Streamly.Internal.Data.Fold (Fold (..)) import Streamly.Internal.Data.Stream.IsStream.Combinators (maxYields) import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream(..), fromStreamD, toStreamD, fromStreamS, toStreamS)+    (IsStream(..), fromStreamD, toStreamD) import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64)+import Streamly.Internal.System.IO (defaultChunkSize)+import Streamly.Data.MutByteArray (Unbox) -import qualified Streamly.Internal.Data.Array.Foreign.Type as A+import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.Stream.Async as Async import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream import qualified Streamly.Internal.Data.Stream.Parallel as Par-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamD as D-#ifdef USE_STREAMK_ONLY-import qualified Streamly.Internal.Data.Stream.StreamK as S-#else-import qualified Streamly.Internal.Data.Stream.StreamD as S-#endif-import Streamly.Internal.System.IO (defaultChunkSize)+import qualified Streamly.Internal.Data.StreamK as K+    (fromPure, fromEffect, repeatMWith, reverse)+import qualified Streamly.Internal.Data.Stream as D+    (repeatM, timesWith, foldAddLazy, map, scanlMAfter', postscanlMAfter'+    , postscanlM', take,  takeWhile, takeEndBy, drop, findIndices+    , fromStreamK, toStreamK, concatMapM, concatMap, foldManyPost, splitOnSeq+    , zipWithM, zipWith, intersperseM, reverse, fold)  import Prelude hiding (take, takeWhile, drop, reverse, concatMap, map, zipWith)  -- -- $setup -- >>> :m+-- >>> :set -fno-warn-deprecations -- >>> import Control.Concurrent (threadDelay) -- >>> import Control.Monad (join) -- >>> import Control.Monad.Trans.Class (lift)@@ -104,7 +109,7 @@ -- >>> import System.IO.Unsafe (unsafePerformIO) -- >>> import qualified Streamly.Prelude as Stream -- >>> import Streamly.Internal.Data.Stream.IsStream as Stream--- >>> import qualified Streamly.Data.Array.Foreign as Array+-- >>> import qualified Streamly.Data.Array as Array -- >>> import qualified Streamly.Data.Fold as Fold -- >>> import qualified Streamly.Internal.Data.Fold as Fold -- >>> import qualified Streamly.Data.Unfold as Unfold@@ -198,7 +203,7 @@ {-# RULES "repeatM serial" repeatM = repeatMSerial #-} {-# INLINE repeatMSerial #-} repeatMSerial :: MonadAsync m => m a -> SerialT m a-repeatMSerial = fromStreamS . S.repeatM+repeatMSerial = fromStreamD . D.repeatM  ------------------------------------------------------------------------------ -- Generation - Time related@@ -225,7 +230,7 @@ -- {-# INLINE timesWith #-} timesWith :: (IsStream t, MonadAsync m) => Double -> t m (AbsTime, RelTime64)-timesWith g = fromStreamD $ D.times g+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@@ -269,18 +274,18 @@ -- Elimination - Running a Fold ------------------------------------------------------------------------------ --- | We can create higher order folds using 'foldOn'. We can fold a number of--- streams to a given fold efficiently with full stream fusion. For example, to--- fold a list of streams on the same sum fold:+-- | We can create higher order folds using 'foldContinue'. We can fold a+-- number of streams to a given fold efficiently with full stream fusion. For+-- example, to fold a list of streams on the same sum fold: ----- >>> concatFold = Prelude.foldl Stream.foldOn Fold.sum+-- > concatFold = Prelude.foldl Stream.foldContinue Fold.sum ----- >>> fold f = Fold.finish . Stream.foldOn f+-- > fold f = Fold.extractM . Stream.foldContinue f -- -- /Internal/-{-# INLINE foldOn #-}-foldOn :: Monad m => Fold m a b -> SerialT m a -> Fold m a b-foldOn f s = D.foldOn f $ IsStream.toStreamD s+{-# INLINE foldContinue #-}+foldContinue :: Monad m => Fold m a b -> SerialT m a -> Fold m a b+foldContinue f s = D.foldAddLazy f $ IsStream.toStreamD s  -- | Fold a stream using the supplied left 'Fold' and reducing the resulting -- expression strictly at each step. The behavior is similar to 'foldl''. A@@ -306,15 +311,7 @@ -- @since 0.7.0 {-# INLINE fold #-} fold :: Monad m => Fold m a b -> SerialT m a -> m b-fold fl strm = do-    (b, _) <- fold_ fl strm-    return $! b--{-# INLINE fold_ #-}-fold_ :: Monad m => Fold m a b -> SerialT m a -> m (b, SerialT m a)-fold_ fl strm = do-    (b, str) <- D.fold_ fl $ IsStream.toStreamD strm-    return $! (b, IsStream.fromStreamD str)+fold fl strm = D.fold fl $ IsStream.toStreamD strm  ------------------------------------------------------------------------------ -- Transformation@@ -328,7 +325,7 @@ -- Same as 'fmap'. -- -- @--- > S.toList $ S.map (+1) $ S.fromList [1,2,3]+-- > D.toList $ D.map (+1) $ D.fromList [1,2,3] -- [2,3,4] -- @ --@@ -354,6 +351,12 @@ scanlMAfter' step initial done stream =     fromStreamD $ D.scanlMAfter' step initial done $ toStreamD stream +{-# INLINE postscanlMAfter' #-}+postscanlMAfter' :: (IsStream t, Monad m)+    => (b -> a -> m b) -> m b -> (b -> m b) -> t m a -> t m b+postscanlMAfter' step initial done stream =+    fromStreamD $ D.postscanlMAfter' step initial done $ toStreamD stream+ -- XXX this needs to be concurrent -- | Like 'postscanl'' but with a monadic step function and a monadic seed. --@@ -421,7 +424,7 @@ -- @since 0.1.0 {-# INLINE take #-} take :: (IsStream t, Monad m) => Int -> t m a -> t m a-take n m = fromStreamS $ S.take n $ toStreamS+take n m = fromStreamD $ D.take n $ toStreamD     (maxYields (Just (fromIntegral n)) m)  -- | End the stream as soon as the predicate fails on an element.@@ -429,7 +432,7 @@ -- @since 0.1.0 {-# INLINE takeWhile #-} takeWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a-takeWhile p m = fromStreamS $ S.takeWhile p $ toStreamS m+takeWhile p m = fromStreamD $ D.takeWhile p $ toStreamD m  {-# INLINE takeEndBy #-} takeEndBy :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a@@ -440,7 +443,7 @@ -- @since 0.1.0 {-# INLINE drop #-} drop :: (IsStream t, Monad m) => Int -> t m a -> t m a-drop n m = fromStreamS $ S.drop n $ toStreamS m+drop n m = fromStreamD $ D.drop n $ toStreamD m  ------------------------------------------------------------------------------ -- Searching@@ -454,13 +457,13 @@ -- @since 0.5.0 {-# INLINE findIndices #-} findIndices :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m Int-findIndices p m = fromStreamS $ S.findIndices p (toStreamS m)+findIndices p m = fromStreamD $ D.findIndices p (toStreamD m)  ------------------------------------------------------------------------------ -- Transformation by Inserting ------------------------------------------------------------------------------ --- intersperseM = intersperseBySpan 1+-- intersperseM = intersperseMWith 1  -- | Insert an effect and its output before consuming an element of a stream -- except the first one.@@ -478,7 +481,7 @@ -- @since 0.5.0 {-# INLINE intersperseM #-} intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a-intersperseM m = fromStreamS . S.intersperseM m . toStreamS+intersperseM m = fromStreamD . D.intersperseM m . toStreamD  -- | Intersperse a monadic action into the input stream after every @n@ -- seconds.@@ -517,21 +520,21 @@ -- /Since: 0.1.1/ {-# INLINE reverse #-} reverse :: (IsStream t, Monad m) => t m a -> t m a-reverse s = fromStreamS $ S.reverse $ toStreamS s+reverse s = fromStreamD $ D.reverse $ toStreamD s  -- | Like 'reverse' but several times faster, requires a 'Storable' instance. -- -- /Pre-release/ {-# INLINE reverse' #-}-reverse' :: (IsStream t, MonadIO m, Storable a) => t m a -> t m a+reverse' :: (IsStream t, MonadIO m, Unbox a) => t m a -> t m a -- reverse' s = fromStreamD $ D.reverse' $ toStreamD s reverse' =         fromStreamD-        . A.flattenArraysRev -- unfoldMany A.readRev+        . A.concatRev -- unfoldMany A.readerRev         . D.fromStreamK         . K.reverse         . D.toStreamK-        . A.arraysOf defaultChunkSize+        . A.chunksOf defaultChunkSize         . toStreamD  ------------------------------------------------------------------------------@@ -598,7 +601,6 @@ -- >>> concatMap f = Stream.concatMapM (return . f) -- >>> concatMap f = Stream.concatMapWith Stream.serial f -- >>> concatMap f = Stream.concat . Stream.map f--- >>> concatMap f = Stream.unfoldMany (Unfold.lmap f Unfold.fromStream) -- -- @since 0.6.0 {-# INLINE concatMap #-}@@ -620,6 +622,27 @@ concatM :: (IsStream t, Monad m) => m (t m a) -> t m a concatM generator = concatMapM (\() -> generator) (fromPure ()) +-- | Like 'foldMany' but appends empty fold output if the fold and stream+-- termination aligns:+--+-- >>> f = Fold.take 2 Fold.sum+-- >>> Stream.toList $ Stream.foldManyPost f $ Stream.fromList []+-- [0]+-- >>> Stream.toList $ Stream.foldManyPost f $ Stream.fromList [1..9]+-- [3,7,11,15,9]+-- >>> Stream.toList $ Stream.foldManyPost f $ Stream.fromList [1..10]+-- [3,7,11,15,19,0]+--+-- /Pre-release/+--+{-# INLINE foldManyPost #-}+foldManyPost+    :: (IsStream t, Monad m)+    => Fold m a b+    -> t m a+    -> t m b+foldManyPost f m = fromStreamD $ D.foldManyPost f (toStreamD m)+ ------------------------------------------------------------------------------ -- Split stream and fold ------------------------------------------------------------------------------@@ -639,7 +662,7 @@ -- ["h","e","l","l","o"] -- -- >>> splitOnSeq' "hello" ""--- [""]+-- [] -- -- >>> splitOnSeq' "hello" "hello" -- ["",""]@@ -671,6 +694,8 @@ -- -- > splitOnSeq . intercalate == id --+-- >>> splitOnSeq pat f = Stream.foldManyPost (Fold.takeEndBySeq_ pat f)+-- -- /Pre-release/  -- XXX We can use a polymorphic vector implemented by Array# to represent the@@ -680,10 +705,15 @@ -- that we can search files in files for example. {-# INLINE splitOnSeq #-} splitOnSeq-    :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)+    :: (IsStream t, MonadIO m, Storable a, Unbox a, Enum a, Eq a)     => Array a -> Fold m a b -> t m a -> t m b splitOnSeq patt f m =     IsStream.fromStreamD $ D.splitOnSeq patt f (IsStream.toStreamD m)+-- XXX This may have a problem if the stream terminates and we start extracting+-- the fold and then the fold terminates before consuming all the buffered+-- input.  We have no way to supply the buffered input back to the driver.+-- splitOnSeq patt f =+    -- foldManyPost (Fold.takeEndBySeq_ patt f)  ------------------------------------------------------------------------------ -- Zipping@@ -695,8 +725,8 @@ {-# INLINE zipWithM #-} zipWithM :: (IsStream t, Monad m) => (a -> b -> m c) -> t m a -> t m b -> t m c zipWithM f m1 m2 =-    IsStream.fromStreamS-        $ S.zipWithM f (IsStream.toStreamS m1) (IsStream.toStreamS m2)+    IsStream.fromStreamD+        $ D.zipWithM f (IsStream.toStreamD m1) (IsStream.toStreamD 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@@ -706,7 +736,7 @@ -- first, the element @a@ from previous evaluation of stream @a@ is discarded. -- -- @--- > S.toList $ S.zipWith (+) (S.fromList [1,2,3]) (S.fromList [4,5,6])+-- > D.toList $ D.zipWith (+) (D.fromList [1,2,3]) (D.fromList [4,5,6]) -- [5,7,9] -- @ --@@ -714,5 +744,5 @@ {-# INLINE zipWith #-} zipWith :: (IsStream t, Monad m) => (a -> b -> c) -> t m a -> t m b -> t m c zipWith f m1 m2 =-    IsStream.fromStreamS-        $ S.zipWith f (IsStream.toStreamS m1) (IsStream.toStreamS m2)+    IsStream.fromStreamD+        $ D.zipWith f (IsStream.toStreamD m1) (IsStream.toStreamD m2)
src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Eliminate -- Copyright   : (c) 2017 Composewell Technologies@@ -15,7 +17,7 @@ -- We call them stream folding functions, they reduce a stream @t m a@ to a -- monadic value @m b@. -module Streamly.Internal.Data.Stream.IsStream.Eliminate+module Streamly.Internal.Data.Stream.IsStream.Eliminate {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * Running Examples     -- $setup@@ -23,16 +25,12 @@     -- * Running a 'Fold'     --  See "Streamly.Internal.Data.Fold".       fold-    , fold_-    , foldOn      -- * Running a 'Parser'     -- "Streamly.Internal.Data.Parser".     , parse-    , parseK+    -- , parseK     , parseD-    , parse_-    , parseD_      -- * Stream Deconstruction     -- | foldr and foldl do not provide the remaining stream.  'uncons' is more@@ -154,7 +152,6 @@  #include "inline.hs" -import Control.Monad.Catch (MonadThrow) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..)) import Foreign.Storable (Storable)@@ -162,39 +159,42 @@ import Streamly.Internal.Data.Parser (Parser (..)) import Streamly.Internal.Data.SVar (defState) import Streamly.Internal.Data.Stream.IsStream.Common-    ( fold, fold_, foldOn, drop, findIndices, reverse, splitOnSeq, take-    , takeWhile, mkParallel)+    ( fold, drop, findIndices, reverse, splitOnSeq+    , take , takeWhile, mkParallel) import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream, toStreamS, fromStreamD, toStreamD)-import Streamly.Internal.Data.Stream.Serial (SerialT(..))+    (IsStream, fromStreamD, toStreamD)+import Streamly.Internal.Data.Stream.Serial (SerialT)+import Streamly.Data.MutByteArray (Unbox) -import qualified Streamly.Internal.Data.Array.Foreign.Type as A+import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Stream.Serial as Stream import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Parser as PRD+-- import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-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 as D+    (foldr1, foldlT, foldlM', mapM_, null, head, headElse, last, elem+    , notElem, all, any, minimum, minimumBy, maximum, maximumBy, the, lookup+    , find, findM, toListRev, isPrefixOf, isSubsequenceOf, stripPrefix,  (!!)+    , fromStreamK, foldrM, parseD)+import qualified Streamly.Internal.Data.StreamK as K+    (uncons, foldlS, tail, init) import qualified System.IO as IO-#ifdef USE_STREAMK_ONLY-import qualified Streamly.Internal.Data.Stream.StreamK as S-#else-import qualified Streamly.Internal.Data.Stream.StreamD as S-#endif  import Prelude hiding-       ( drop, take, takeWhile, foldr , foldl, mapM_, sequence, all, any, sum-       , product, elem, notElem, maximum, minimum, head, last, tail, length-       , null , reverse, init, and, or, lookup, foldr1, (!!) , splitAt, break+       ( Foldable(..), drop, take, takeWhile, mapM_, sequence, all, any+       , notElem, head, last, tail+       , reverse, init, and, or, lookup, (!!), splitAt, break        , mconcat)  -- $setup -- >>> :m+-- >>> :set -fno-warn-deprecations -- >>> import Streamly.Prelude (SerialT) -- >>> import qualified Streamly.Prelude as Stream -- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream -- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Fold as Fold  ------------------------------------------------------------------------------ -- Deconstruction@@ -204,19 +204,20 @@ -- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is -- the head of the stream and @ma@ its tail. ----- This is a brute force primitive. Avoid using it as long as possible, use it--- when no other combinator can do the job. This can be used to do pretty much--- anything in an imperative manner, 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.+-- This can be used to do pretty much anything in an imperative manner, 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--- the specific implementations are generally more efficient.+-- 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. -- -- @since 0.1.0 {-# INLINE uncons #-} uncons :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (a, t m a))-uncons (SerialT m) = fmap (fmap (fmap IsStream.fromStream)) $ K.uncons m+uncons = fmap (fmap (fmap IsStream.fromStream)) . K.uncons . Stream.toStreamK  ------------------------------------------------------------------------------ -- Right Folds@@ -244,7 +245,7 @@ -- /Since: 0.1.0/ {-# INLINE foldrM #-} foldrM :: Monad m => (a -> m b -> m b) -> m b -> SerialT m a -> m b-foldrM = IsStream.foldrM+foldrM step acc (Stream.SerialT m) = D.foldrM step acc $ D.fromStreamK m  -- | Right fold, lazy for lazy monads and pure streams, and strict for strict -- monads.@@ -259,7 +260,7 @@ -- @since 0.1.0 {-# INLINE foldr #-} foldr :: Monad m => (a -> b -> b) -> b -> SerialT m a -> m b-foldr = IsStream.foldr+foldr f z = foldrM (\a b -> f a <$> b) (return z)  -- XXX This seems to be of limited use as it cannot be used to construct -- recursive structures and for reduction foldl1' is better.@@ -271,7 +272,7 @@ {-# INLINE foldr1 #-} {-# DEPRECATED foldr1 "Use foldrM instead." #-} foldr1 :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)-foldr1 f m = S.foldr1 f (toStreamS m)+foldr1 f m = D.foldr1 f (toStreamD m)  ------------------------------------------------------------------------------ -- Left Folds@@ -291,12 +292,12 @@ -- -- For example, to reverse a stream: ----- > S.toList $ S.foldlT (flip S.cons) S.nil $ (S.fromList [1..5] :: SerialT IO Int)+-- > D.toList $ D.foldlT (flip D.cons) D.nil $ (D.fromList [1..5] :: SerialT IO Int) -- {-# INLINE foldlT #-} foldlT :: (Monad m, IsStream t, Monad (s m), MonadTrans s)     => (s m b -> a -> s m b) -> s m b -> t m a -> s m b-foldlT f z s = S.foldlT f z (toStreamS s)+foldlT f z s = D.foldlT f z (toStreamD s)  -- | Strict left fold with an extraction function. Like the standard strict -- left fold, but applies a user supplied extraction function (the third@@ -351,7 +352,7 @@ -- /Since: 0.8.0 (signature change)/ {-# INLINE foldlM' #-} foldlM' :: Monad m => (b -> a -> m b) -> m b -> SerialT m a -> m b-foldlM' step begin m = S.foldlM' step begin $ toStreamS m+foldlM' step begin = D.foldlM' step begin . IsStream.toStreamD  ------------------------------------------------------------------------------ -- Running a sink@@ -373,15 +374,17 @@ -- /Internal/ -- {-# INLINE_NORMAL parseD #-}-parseD :: MonadThrow m => PRD.Parser m a b -> SerialT m a -> m b-parseD p = D.parse p . toStreamD+parseD :: Monad m => PRD.Parser a m b -> SerialT m a -> m (Either PRD.ParseError b)+parseD p = D.parseD p . toStreamD +{- -- | Parse a stream using the supplied ParserK 'PRK.Parser'. -- -- /Internal/ {-# INLINE parseK #-}-parseK :: MonadThrow m => PRK.Parser m a b -> SerialT m a -> m b-parseK = parse+parseK :: Monad m => PRK.Parser a m b -> SerialT m a -> m (Either PRD.ParseError b)+parseK p = parse (PRK.toParser p)+-}  -- | Parse a stream using the supplied 'Parser'. --@@ -389,7 +392,7 @@ -- result in an error.  For example: -- -- >>> Stream.parse (Parser.takeEQ 1 Fold.drain) Stream.nil--- *** Exception: ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0"+-- Left (ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0") -- -- Note: --@@ -402,22 +405,8 @@ -- /Pre-release/ -- {-# INLINE [3] parse #-}-parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b-parse = parseD . PRK.fromParserK--{-# INLINE_NORMAL parseD_ #-}-parseD_ :: MonadThrow m => PRD.Parser m a b -> SerialT m a -> m (b, SerialT m a)-parseD_ parser strm = do-    (b, strmD) <- D.parse_ parser (toStreamD strm)-    return $! (b, fromStreamD strmD)---- | Parse a stream using the supplied 'Parser'.------ /Internal/----{-# INLINE [3] parse_ #-}-parse_ :: MonadThrow m => Parser m a b -> SerialT m a -> m (b, SerialT m a)-parse_ = parseD_ . PRK.fromParserK+parse :: Monad m => Parser a m b -> SerialT m a -> m (Either PRD.ParseError b)+parse = parseD  ------------------------------------------------------------------------------ -- Specific Fold Functions@@ -434,7 +423,7 @@ -- @since 0.1.0 {-# INLINE mapM_ #-} mapM_ :: Monad m => (a -> m b) -> SerialT m a -> m ()-mapM_ f m = S.mapM_ f $ toStreamS m+mapM_ f = D.mapM_ f . IsStream.toStreamD  -- | -- > drain = mapM_ (\_ -> return ())@@ -509,17 +498,17 @@ -- @since 0.1.1 {-# INLINE null #-} null :: Monad m => SerialT m a -> m Bool-null = S.null . toStreamS+null = D.null . toStreamD  -- | Extract the first element of the stream, if any. -- -- > head = (!! 0)--- > head = Stream.fold Fold.head+-- > head = Stream.fold Fold.one -- -- @since 0.1.0 {-# INLINE head #-} head :: Monad m => SerialT m a -> m (Maybe a)-head = S.head . toStreamS+head = D.head . toStreamD  -- | Extract the first element of the stream, if any, otherwise use the -- supplied default value. It can help avoid one branch in high performance@@ -538,14 +527,14 @@ -- @since 0.1.1 {-# INLINE tail #-} tail :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))-tail (SerialT m) = fmap (fmap IsStream.fromStream) $ K.tail m+tail m = fmap (fmap IsStream.fromStream) $ K.tail $ Stream.toStreamK m  -- | Extract all but the last element of the stream, if any. -- -- @since 0.5.0 {-# INLINE init #-} init :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))-init (SerialT m) = fmap (fmap IsStream.fromStream) $ K.init m+init m = fmap (fmap IsStream.fromStream) $ K.init $ Stream.toStreamK m  -- | Extract the last element of the stream, if any. --@@ -555,7 +544,7 @@ -- @since 0.1.1 {-# INLINE last #-} last :: Monad m => SerialT m a -> m (Maybe a)-last m = S.last $ toStreamS m+last m = D.last $ toStreamD m  -- | Determine whether an element is present in the stream. --@@ -564,7 +553,7 @@ -- @since 0.1.0 {-# INLINE elem #-} elem :: (Monad m, Eq a) => a -> SerialT m a -> m Bool-elem e m = S.elem e (toStreamS m)+elem e m = D.elem e (toStreamD m)  -- | Determine whether an element is not present in the stream. --@@ -573,7 +562,7 @@ -- @since 0.1.0 {-# INLINE notElem #-} notElem :: (Monad m, Eq a) => a -> SerialT m a -> m Bool-notElem e m = S.notElem e (toStreamS m)+notElem e m = D.notElem e (toStreamD m)  -- | Determine the length of the stream. --@@ -589,7 +578,7 @@ -- @since 0.1.0 {-# INLINE all #-} all :: Monad m => (a -> Bool) -> SerialT m a -> m Bool-all p m = S.all p (toStreamS m)+all p m = D.all p (toStreamD m)  -- | Determine whether any of the elements of a stream satisfy a predicate. --@@ -598,7 +587,7 @@ -- @since 0.1.0 {-# INLINE any #-} any :: Monad m => (a -> Bool) -> SerialT m a -> m Bool-any p m = S.any p (toStreamS m)+any p m = D.any p (toStreamD m)  -- | Determines if all elements of a boolean stream are True. --@@ -659,7 +648,7 @@ -- @since 0.1.0 {-# INLINE minimum #-} minimum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)-minimum m = S.minimum (toStreamS m)+minimum m = D.minimum (toStreamD m)  -- | Determine the minimum element in a stream using the supplied comparison -- function.@@ -669,7 +658,7 @@ -- @since 0.6.0 {-# INLINE minimumBy #-} minimumBy :: Monad m => (a -> a -> Ordering) -> SerialT m a -> m (Maybe a)-minimumBy cmp m = S.minimumBy cmp (toStreamS m)+minimumBy cmp m = D.minimumBy cmp (toStreamD m)  -- | -- @@@ -682,7 +671,7 @@ -- @since 0.1.0 {-# INLINE maximum #-} maximum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)-maximum m = S.maximum (toStreamS m)+maximum m = D.maximum (toStreamD m)  -- | Determine the maximum element in a stream using the supplied comparison -- function.@@ -692,7 +681,7 @@ -- @since 0.6.0 {-# INLINE maximumBy #-} maximumBy :: Monad m => (a -> a -> Ordering) -> SerialT m a -> m (Maybe a)-maximumBy cmp m = S.maximumBy cmp (toStreamS m)+maximumBy cmp m = D.maximumBy cmp (toStreamD m)  -- | Ensures that all the elements of the stream are identical and then returns -- that unique element.@@ -700,7 +689,7 @@ -- @since 0.6.0 {-# INLINE the #-} the :: (Eq a, Monad m) => SerialT m a -> m (Maybe a)-the m = S.the (toStreamS m)+the m = D.the (toStreamD m)  ------------------------------------------------------------------------------ -- Searching@@ -711,7 +700,7 @@ -- @since 0.6.0 {-# INLINE (!!) #-} (!!) :: Monad m => SerialT m a -> Int -> m (Maybe a)-m !! i = toStreamS m S.!! i+m !! i = toStreamD m D.!! i  -- | 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@.@@ -722,7 +711,7 @@ -- @since 0.5.0 {-# INLINE lookup #-} lookup :: (Monad m, Eq a) => a -> SerialT m (a, b) -> m (Maybe b)-lookup a m = S.lookup a (toStreamS m)+lookup a m = D.lookup a (toStreamD m)  -- | Like 'findM' but with a non-monadic predicate. --@@ -732,7 +721,7 @@ -- @since 0.5.0 {-# INLINE find #-} find :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe a)-find p m = S.find p (toStreamS m)+find p m = D.find p (toStreamD m)  -- | Returns the first element that satisfies the given predicate. --@@ -741,7 +730,7 @@ -- @since 0.6.0 {-# INLINE findM #-} findM :: Monad m => (a -> m Bool) -> SerialT m a -> m (Maybe a)-findM p m = S.findM p (toStreamS m)+findM p m = D.findM p (toStreamD m)  -- | Returns the first index that satisfies the given predicate. --@@ -799,7 +788,7 @@  -- | -- @--- toHandle h = S.mapM_ $ hPutStrLn h+-- toHandle h = D.mapM_ $ hPutStrLn h -- @ -- -- Write a stream of Strings to an IO Handle.@@ -933,7 +922,7 @@ -- /Requires 'Storable' constraint/ -- {-# INLINE isInfixOf #-}-isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a)+isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a)     => SerialT m a -> SerialT m a -> m Bool isInfixOf infx stream = do     arr <- fold A.write infx
src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.Enumeration -- Copyright   : (c) 2018 Composewell Technologies@@ -20,7 +22,7 @@ -- in this module can be used to define them. Alternatively, these functions -- can be used directly. -module Streamly.Internal.Data.Stream.IsStream.Enumeration+module Streamly.Internal.Data.Stream.IsStream.Enumeration {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (       Enumerable (..) @@ -63,10 +65,21 @@ import Streamly.Internal.Data.Stream.IsStream.Type (IsStream(..), fromStreamD)  import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D+import qualified Streamly.Internal.Data.Stream as D+    ( enumerateFromNum+    , enumerateFromThenNum+    , enumerateFromThenToIntegral+    , enumerateFromThenIntegral+    , enumerateFromStepIntegral+    , enumerateFromToIntegral+    , enumerateFromIntegral+    , enumerateFromToFractional+    , enumerateFromThenToFractional+    ) import qualified Streamly.Internal.Data.Stream.Serial as Serial (map)  -- $setup+-- >>> :set -fno-warn-deprecations -- >>> import Streamly.Prelude as Stream -- >>> import Streamly.Internal.Data.Stream.IsStream.Enumeration as Stream
src/Streamly/Internal/Data/Stream/IsStream/Exception.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Exception -- Copyright   : (c) 2019 Composewell Technologies@@ -6,7 +8,7 @@ -- Stability   : experimental -- Portability : GHC -module Streamly.Internal.Data.Stream.IsStream.Exception+module Streamly.Internal.Data.Stream.IsStream.Exception {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (       before     , after_@@ -30,10 +32,26 @@ import Streamly.Internal.Data.Stream.IsStream.Type     (IsStream(..), fromStreamD, toStreamD) -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D+    ( before+    , afterUnsafe+    , onException+    , bracketUnsafe+    , finallyUnsafe+    , ghandle+    , handle+    ) +import qualified Streamly.Internal.Data.Stream.Lifted as D+    ( afterD+    , bracket3D+    , retryD+    )++ -- $setup -- >>> :m+-- >>> :set -fno-warn-deprecations -- >>> import qualified Streamly.Prelude as Stream -- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (nilM) @@ -68,7 +86,7 @@ -- {-# INLINE after_ #-} after_ :: (IsStream t, Monad m) => m b -> t m a -> t m a-after_ action xs = fromStreamD $ D.after_ action $ toStreamD xs+after_ action xs = fromStreamD $ D.afterUnsafe action $ toStreamD xs  -- | Run the action @m b@ whenever the stream @t m a@ stops normally, or if it -- is garbage collected after a partial lazy evaluation.@@ -83,7 +101,7 @@ {-# INLINE after #-} after :: (IsStream t, MonadRunInIO m)     => m b -> t m a -> t m a-after action xs = fromStreamD $ D.after action $ toStreamD xs+after action xs = fromStreamD $ D.afterD action $ toStreamD xs  -- | Run the action @m b@ if the stream aborts due to an exception. The -- exception is not caught, simply rethrown.@@ -108,7 +126,7 @@ -- {-# INLINE finally_ #-} finally_ :: (IsStream t, MonadCatch m) => m b -> t m a -> t m a-finally_ action xs = fromStreamD $ D.finally_ action $ toStreamD xs+finally_ action xs = fromStreamD $ D.finallyUnsafe action $ toStreamD xs  -- | Run the action @m b@ whenever the stream @t m a@ stops normally, aborts -- due to an exception or if it is garbage collected after a partial lazy@@ -117,10 +135,6 @@ -- The semantics of running the action @m b@ are similar to the cleanup action -- semantics described in 'bracket'. ----- @--- finally release = bracket (return ()) (const release)--- @--- -- /See also 'finally_'/ -- -- /Inhibits stream fusion/@@ -129,7 +143,7 @@ -- {-# INLINE finally #-} finally :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> t m a -> t m a-finally action xs = fromStreamD $ D.finally action $ toStreamD xs+finally action xs = bracket (return ()) (const action) (const xs)  -- | Like 'bracket' but with following differences: --@@ -147,7 +161,7 @@ bracket_ :: (IsStream t, MonadCatch m)     => m b -> (b -> m c) -> (b -> t m a) -> t m a bracket_ bef aft bet = fromStreamD $-    D.bracket_ bef aft (toStreamD . bet)+    D.bracketUnsafe bef aft (toStreamD . bet)  -- | Run the alloc action @m b@ with async exceptions disabled but keeping -- blocking operations interruptible (see 'Control.Exception.mask').  Use the@@ -192,7 +206,7 @@ bracket' :: (IsStream t, MonadAsync m, MonadCatch m)     => m b -> (b -> m c) -> (b -> m d) -> (b -> m e) -> (b -> t m a) -> t m a bracket' bef aft gc exc bet = fromStreamD $-    D.bracket' bef aft exc gc (toStreamD . bet)+    D.bracket3D 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@@ -211,7 +225,7 @@     => (e -> t m a -> t m a) -> t m a -> t m a ghandle handler =       fromStreamD-    . D.ghandle (\e xs -> toStreamD $ handler e (fromStreamD xs))+    . D.ghandle (\e xs -> return $ toStreamD $ handler e (fromStreamD xs))     . toStreamD  -- | When evaluating a stream if an exception occurs, stream evaluation aborts@@ -224,7 +238,7 @@ handle :: (IsStream t, MonadCatch m, Exception e)     => (e -> t m a) -> t m a -> t m a handle handler xs =-    fromStreamD $ D.handle (toStreamD . handler) $ toStreamD xs+    fromStreamD $ D.handle (return . toStreamD . handler) $ toStreamD xs   -- | @retry@ takes 3 arguments@@ -267,4 +281,4 @@     -> t m a     -> t m a retry emap handler inp =-    fromStreamD $ D.retry emap (toStreamD . handler) $ toStreamD inp+    fromStreamD $ D.retryD emap (toStreamD . handler) $ toStreamD inp
src/Streamly/Internal/Data/Stream/IsStream/Expand.hs view
@@ -1,5 +1,10 @@-{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-} +{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Expand -- Copyright   : (c) 2017 Composewell Technologies@@ -11,7 +16,7 @@ -- Expand a stream by combining two or more streams or by combining streams -- with unfolds. -module Streamly.Internal.Data.Stream.IsStream.Expand+module Streamly.Internal.Data.Stream.IsStream.Expand {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * Binary Combinators (Linear)     -- | Functions ending in the shape:@@ -77,12 +82,14 @@     , zipAsyncWithM      -- ** Merge-    -- , merge+    , merge     , mergeBy     , mergeByM     , mergeByMFused     , mergeAsyncBy     , mergeAsyncByM+    , mergeMinBy+    , mergeFstBy      -- * Combine Streams and Unfolds     -- |@@ -154,11 +161,10 @@     , iterateMapWith     , iterateSmapMWith     , iterateMapLeftsWith+    , iterateUnfold      -- * Deprecated     , concatUnfold-    , (<=>)-    , (<|)     ) where @@ -172,20 +178,27 @@     , zipWith, zipWithM) import Streamly.Internal.Data.Stream.IsStream.Type     (IsStream(..), fromStreamD, toStreamD)-import Streamly.Internal.Data.Unfold.Type (Unfold)+import Streamly.Data.Unfold (Unfold)  import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial-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 qualified Streamly.Internal.Data.Stream as D+    (append, interleave, interleaveFstSuffix, interleaveFst, interleaveMin+    , roundRobin, mergeByM, unfoldMany, unfoldInterleave, intersperse+    , unfoldRoundRobin, interpose, interposeSuffix, gintercalate+    , gintercalateSuffix, intersperseMSuffix)+import qualified Streamly.Internal.Data.StreamK as K+    (interleave, append, mergeMapWith, mergeBy, mergeByM) import qualified Streamly.Internal.Data.Stream.ZipAsync as ZipAsync  import Prelude hiding (concat, concatMap, zipWith)  -- $setup -- >>> :m+-- >>> :set -fno-warn-deprecations+-- >>> :set -fno-warn-unrecognised-warning-flags+-- >>> :set -fno-warn-x-partial -- >>> import Control.Concurrent (threadDelay) -- >>> import Data.IORef -- >>> import Prelude hiding (zipWith, concatMap, concat)@@ -195,7 +208,7 @@ -- >>> 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.Foreign as Array+-- >>> import qualified Streamly.Data.Array as Array -- >>> :{ --  delay n = do --      threadDelay (n * 1000000)   -- sleep for n seconds@@ -243,7 +256,7 @@ -- @since 0.8.0 {-# INLINE serial #-} serial :: IsStream t => t m a -> t m a -> t m a-serial m1 m2 = fromStream $ K.serial (toStream m1) (toStream m2)+serial m1 m2 = fromStream $ K.append (toStream m1) (toStream m2)  ------------------------------------------------------------------------------- -- Interleaving@@ -286,17 +299,7 @@ -- {-# INLINE wSerial #-} wSerial :: IsStream t => t m a -> t m a -> t m a-wSerial m1 m2 = fromStream $ Serial.wSerialK (toStream m1) (toStream m2)--infixr 5 <=>---- | Same as 'wSerial'.------ @since 0.1.0-{-# DEPRECATED (<=>) "Please use 'wSerial' instead." #-}-{-# INLINE (<=>) #-}-(<=>) :: IsStream t => t m a -> t m a -> t m a-(<=>) = wSerial+wSerial m1 m2 = fromStream $ K.interleave (toStream m1) (toStream m2)  -- XXX Same as 'wSerial'. We should perhaps rename wSerial to interleave. -- XXX Document the interleaving behavior of side effects in all the@@ -349,7 +352,7 @@ {-# INLINE interleaveSuffix #-} interleaveSuffix ::(IsStream t, Monad m) => t m b -> t m b -> t m b interleaveSuffix m1 m2 =-    fromStreamD $ D.interleaveSuffix (toStreamD m1) (toStreamD 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.@@ -373,7 +376,7 @@ {-# INLINE interleaveInfix #-} interleaveInfix ::(IsStream t, Monad m) => t m b -> t m b -> t m b interleaveInfix m1 m2 =-    fromStreamD $ D.interleaveInfix (toStreamD m1) (toStreamD m2)+    fromStreamD $ D.interleaveFst (toStreamD m1) (toStreamD m2)  -- | Interleaves the outputs of two streams, yielding elements from each stream -- alternately, starting from the first stream. The output stops as soon as any@@ -484,14 +487,6 @@ async :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a async m1 m2 = fromStream $ asyncK (toStream m1) (toStream m2) --- | Same as 'async'.------ @since 0.1.0-{-# DEPRECATED (<|) "Please use 'async' instead." #-}-{-# INLINE (<|) #-}-(<|) :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-(<|) = async- infixr 6 `wAsync`  -- | For singleton streams, 'wAsync' is the same as 'async'.  See 'async' for@@ -709,8 +704,7 @@ -- -- @since 0.6.0 {-# INLINE mergeBy #-}-mergeBy ::-       (IsStream t, Monad m) => (a -> a -> Ordering) -> t m a -> t m a -> t m a+mergeBy :: IsStream t => (a -> a -> Ordering) -> t m a -> t m a -> t m a mergeBy f m1 m2 = fromStream $ K.mergeBy f (toStream m1) (toStream m2)  -- | Like 'mergeBy' but with a monadic comparison function.@@ -767,37 +761,36 @@ mergeByMFused 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.-{-# INLINABLE mergeEndByAny #-}-mergeEndByAny-    :: (IsStream t, Monad m)-    => (a -> a -> m Ordering) -> t m a -> t m a -> t m a-mergeEndByAny f m1 m2 = fromStreamD $-    D.mergeEndByAny f (toStreamD m1) (toStreamD m2)+--+-- /Unimplemented/+{-# INLINABLE mergeMinBy #-}+mergeMinBy :: -- (IsStream t, Monad m) =>+    (a -> a -> m Ordering) -> t m a -> t m a -> t 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.-{-# INLINABLE mergeEndByFirst #-}-mergeEndByFirst-    :: (IsStream t, Monad m)-    => (a -> a -> m Ordering) -> t m a -> t m a -> t m a-mergeEndByFirst f m1 m2 = fromStreamS $-    D.mergeEndByFirst f (toStreamD m1) (toStreamD m2)+-- | Like 'mergeByM' but stops merging as soon as the first stream stops.+--+-- /Unimplemented/+{-# INLINABLE mergeFstBy #-}+mergeFstBy :: -- (IsStream t, Monad m) =>+    (a -> a -> m Ordering) -> t m a -> t m a -> t m a+mergeFstBy _f _m1 _m2 = undefined+    -- fromStreamD $ D.mergeFstBy f (toStreamD m1) (toStreamD m2) --- Holding this back for now, we may want to use the name "merge" differently+-- XXX we may want to use the name "merge" differently -- | Same as @'mergeBy' 'compare'@. ----- @ -- >>> Stream.toList $ Stream.merge (Stream.fromList [1,3,5]) (Stream.fromList [2,4,6,8]) -- [1,2,3,4,5,6,8]--- @ ----- @since 0.6.0+-- /Internal/+-- {-# INLINABLE merge #-} merge ::-       (IsStream t, Monad m, Ord a) => t m a -> t m a -> t m a+       (IsStream t, Ord a) => t m a -> t m a -> t m a merge = mergeBy compare--}  -- | Like 'mergeBy' but merges concurrently (i.e. both the elements being -- merged are generated concurrently).@@ -848,7 +841,7 @@ unfoldManyInterleave ::(IsStream t, Monad m)     => Unfold m a b -> t m a -> t m b unfoldManyInterleave u m =-    fromStreamD $ D.unfoldManyInterleave u (toStreamD m)+    fromStreamD $ D.unfoldInterleave u (toStreamD m)  -- | Like 'unfoldMany' but executes the streams in the same way as -- 'roundrobin'.@@ -858,7 +851,7 @@ unfoldManyRoundRobin ::(IsStream t, Monad m)     => Unfold m a b -> t m a -> t m b unfoldManyRoundRobin u m =-    fromStreamD $ D.unfoldManyRoundRobin u (toStreamD m)+    fromStreamD $ D.unfoldRoundRobin u (toStreamD m)  ------------------------------------------------------------------------------ -- Combine N Streams - interpose@@ -876,7 +869,7 @@ interpose :: (IsStream t, Monad m)     => c -> Unfold m b c -> t m b -> t m c interpose x unf str =-    fromStreamD $ D.interpose (return x) unf (toStreamD str)+    fromStreamD $ D.interpose x unf (toStreamD str)  -- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x) --@@ -890,7 +883,7 @@ interposeSuffix :: (IsStream t, Monad m)     => c -> Unfold m b c -> t m b -> t m c interposeSuffix x unf str =-    fromStreamD $ D.interposeSuffix (return x) unf (toStreamD str)+    fromStreamD $ D.interposeSuffix x unf (toStreamD str)  ------------------------------------------------------------------------------ -- Combine N Streams - intercalate@@ -948,10 +941,10 @@  -- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed) ----- | 'intersperseSuffix' followed by unfold and concat.+-- | 'intersperseMSuffix' followed by unfold and concat. ----- > intercalateSuffix unf a str = unfoldMany unf $ intersperseSuffix a str--- > intersperseSuffix = intercalateSuffix (Unfold.function id)+-- > intercalateSuffix unf a str = unfoldMany unf $ intersperseMSuffix a str+-- > intersperseMSuffix = intercalateSuffix (Unfold.function id) -- > unlines = intercalateSuffix Unfold.fromList "\n" -- -- >>> Stream.toList $ Stream.intercalateSuffix Unfold.fromList "\n" $ Stream.fromList ["abc", "def", "ghi"]@@ -962,14 +955,7 @@ intercalateSuffix :: (IsStream t, Monad m)     => Unfold m b c -> b -> t m b -> t m c intercalateSuffix unf seed str = fromStreamD $ D.unfoldMany unf-    $ D.intersperseSuffix (return seed) (toStreamD str)--{--{-# INLINE iterateUnfold #-}-iterateUnfold :: (IsStream t, MonadAsync m)-    => Unfold m a a -> t m a -> t m a-iterateUnfold unf xs = undefined--}+    $ D.intersperseMSuffix (return seed) (toStreamD str)  ------------------------------------------------------------------------------ -- Combine N Streams - concatMap@@ -1010,23 +996,6 @@ concatSmapMWith combine f initial =     IsStream.concatMapWith combine id . smapM f initial --- 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-    :: -- (IsStream t, MonadAsync m) =>-       (forall x. t m x -> t m x -> t m x)-    -> (a -> t m (Either (t m b) b))-    -> t m a-    -> t m b-concatMapEitherWith = undefined--}- -- XXX Implement a StreamD version for fusion. -- -- | Combine streams in pairs using a binary stream combinator, then combine@@ -1050,7 +1019,7 @@     -> t m b concatPairsWith par f m =     fromStream-        $ K.concatPairsWith+        $ K.mergeMapWith             (\s1 s2 -> toStream $ fromStream s1 `par` fromStream s2)             (toStream . f)             (toStream m)@@ -1094,12 +1063,14 @@     where     go x = fromPure x `combine` IsStream.concatMapWith combine go (f x) -{-+-- | Same as @iterateMapWith Stream.serial@ but more efficient due to stream+-- fusion.+--+-- /Unimplemented/ {-# INLINE iterateUnfold #-}-iterateUnfold :: (IsStream t, MonadAsync m)-    => Unfold m a a -> t m a -> t m a-iterateUnfold unf xs = undefined--}+iterateUnfold :: -- (IsStream t, MonadAsync m) =>+    Unfold m a a -> t m a -> t m a+iterateUnfold = undefined  ------------------------------------------------------------------------------ -- Flattening Graphs@@ -1143,9 +1114,26 @@             (fromEffect $ f b a)  --------------------------------------------------------------------------------- iterateMap - Either streams+-- 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+    :: -- (IsStream t, MonadAsync m) =>+       (forall x. t m x -> t m x -> t m x)+    -> (a -> t m (Either (t m b) b))+    -> t m a+    -> t m b+concatMapEitherWith = undefined+-}+ -- | In an 'Either' stream iterate on 'Left's.  This is a special case of -- 'iterateMapWith': --@@ -1163,10 +1151,10 @@ -- {-# INLINE iterateMapLeftsWith #-} iterateMapLeftsWith-    :: IsStream t-    => (t m (Either a b) -> t m (Either a b) -> t m (Either a b))-    -> (a -> t m (Either a b))-    -> t m (Either a b)-    -> t m (Either a b)+    :: (IsStream t, b ~ Either a c)+    => (t m b -> t m b -> t m b)+    -> (a -> t m b)+    -> t m b+    -> t m b iterateMapLeftsWith combine f =     iterateMapWith combine (either f (const IsStream.nil))
src/Streamly/Internal/Data/Stream/IsStream/Generate.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-orphans #-}  -- |@@ -15,7 +16,7 @@ -- as StreamK when StreamK is used, avoiding conversion to StreamD. Will that -- help? Are there any other reasons to keep these and not use unfolds? -module Streamly.Internal.Data.Stream.IsStream.Generate+module Streamly.Internal.Data.Stream.IsStream.Generate {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * Primitives       IsStream.nil@@ -79,10 +80,8 @@     , fromPrimIORef      -- * Deprecated-    , once     , yield     , yieldM-    , each     , fromHandle     , currentTime     )@@ -91,10 +90,9 @@ #include "inline.hs"  import Control.Monad.IO.Class (MonadIO(..))-import Data.Primitive.Types (Prim) import Data.Void (Void) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Unfold.Type (Unfold)+import Streamly.Internal.Data.Unfold (Unfold) import Streamly.Internal.Data.SVar (Rate (..)) import Streamly.Internal.Data.Stream.IsStream.Enumeration     (Enumerable(..), enumerate, enumerateTo)@@ -102,29 +100,33 @@     ( absTimesWith, concatM, relTimesWith, timesWith, fromPure, fromEffect     , yield, yieldM, repeatM) import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream (..), fromSerial, consM, fromStreamD, fromStreamS)-import Streamly.Internal.Data.Stream.Serial (SerialT(..), WSerialT)-import Streamly.Internal.Data.Stream.Zip (ZipSerialM)+    (IsStream (..), fromSerial, consM, fromStreamD)+import Streamly.Internal.Data.Stream.Serial (SerialT, WSerialT) import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64)+import Streamly.Data.MutByteArray (Unbox) -import qualified Streamly.Internal.Data.IORef.Prim as Prim+import qualified Streamly.Internal.Data.MutArray as Unboxed+    (pollIntIORef, IORef) import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-#ifdef USE_STREAMK_ONLY-import qualified Streamly.Internal.Data.Stream.StreamK as S-import qualified Streamly.Internal.Data.Stream.StreamK.Type as S-#else-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as S-#endif+import qualified Streamly.Internal.Data.Stream as D+    (unfold, unfoldr, toStreamK, unfoldr, repeat, replicate, replicateM+    , fromIndices, fromIndicesM, iterate, iterateM, toStreamK, fromListM+    , fromListM)+import qualified Streamly.Internal.Data.StreamK as K+    (unfoldr, unfoldrMWith, replicateMWith, fromIndicesMWith, iterateMWith+    , mfix, fromFoldable, fromFoldableM)+import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK) import qualified System.IO as IO  import Prelude hiding (iterate, replicate, repeat)  -- $setup -- >>> :m+-- >>> :set -fno-warn-deprecations+-- >>> :set -fno-warn-unrecognised-warning-flags+-- >>> :set -fno-warn-x-partial -- >>> import Data.Function ((&)) -- >>> import Prelude hiding (iterate, replicate, repeat) -- >>> import qualified Streamly.Prelude as Stream@@ -141,7 +143,7 @@  -- | Convert an 'Unfold' into a stream by supplying it an input seed. ----- >>> Stream.drain $ Stream.unfold (Unfold.replicateM 3) (putStrLn "hello")+-- >>> Stream.drain $ Stream.unfold Unfold.replicateM (3, putStrLn "hello") -- hello -- hello -- hello@@ -187,9 +189,9 @@ -- @since 0.1.0 {-# INLINE_EARLY unfoldr #-} unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a-unfoldr step seed = fromStreamS (S.unfoldr step seed)+unfoldr step seed = fromStreamD (D.unfoldr step seed) {-# RULES "unfoldr fallback to StreamK" [1]-    forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}+    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@@ -240,7 +242,7 @@ {-# RULES "unfoldrM zipSerial" unfoldrM = unfoldrMZipSerial #-} {-# INLINE_EARLY unfoldrMZipSerial #-} unfoldrMZipSerial :: MonadAsync m =>-    (b -> m (Maybe (a, b))) -> b -> ZipSerialM m a+    (b -> m (Maybe (a, b))) -> b -> IsStream.ZipSerialM m a unfoldrMZipSerial f = fromSerial . Serial.unfoldrM f  ------------------------------------------------------------------------------@@ -253,7 +255,7 @@ -- @since 0.4.0 {-# INLINE_NORMAL repeat #-} repeat :: (IsStream t, Monad m) => a -> t m a-repeat = fromStreamS . S.repeat+repeat = fromStreamD . D.repeat  -- | -- >>> replicate n = Stream.take n . Stream.repeat@@ -263,7 +265,7 @@ -- @since 0.6.0 {-# INLINE_NORMAL replicate #-} replicate :: (IsStream t, Monad m) => Int -> a -> t m a-replicate n = fromStreamS . S.replicate n+replicate n = fromStreamD . D.replicate n  -- | -- >>> replicateM n = Stream.take n . Stream.repeatM@@ -297,7 +299,7 @@ {-# RULES "replicateM serial" replicateM = replicateMSerial #-} {-# INLINE replicateMSerial #-} replicateMSerial :: MonadAsync m => Int -> m a -> SerialT m a-replicateMSerial n = fromStreamS . S.replicateM n+replicateMSerial n = fromStreamD . D.replicateM n  ------------------------------------------------------------------------------ -- Time Enumeration@@ -420,7 +422,7 @@ -- @since 0.6.0 {-# INLINE fromIndices #-} fromIndices :: (IsStream t, Monad m) => (Int -> a) -> t m a-fromIndices = fromStreamS . S.fromIndices+fromIndices = fromStreamD . D.fromIndices  -- -- |@@ -441,7 +443,7 @@ {-# RULES "fromIndicesM serial" fromIndicesM = fromIndicesMSerial #-} {-# INLINE fromIndicesMSerial #-} fromIndicesMSerial :: MonadAsync m => (Int -> m a) -> SerialT m a-fromIndicesMSerial = fromStreamS . S.fromIndicesM+fromIndicesMSerial = fromStreamD . D.fromIndicesM  ------------------------------------------------------------------------------ -- Iterating functions@@ -460,7 +462,7 @@ -- @since 0.1.2 {-# INLINE_NORMAL iterate #-} iterate :: (IsStream t, Monad m) => (a -> a) -> a -> t m a-iterate step = fromStreamS . S.iterate step+iterate step = fromStreamD . D.iterate step  -- | -- >>> iterateM f m = m >>= \a -> return a `Stream.consM` iterateM f (f a)@@ -509,7 +511,7 @@ {-# RULES "iterateM serial" iterateM = iterateMSerial #-} {-# INLINE iterateMSerial #-} iterateMSerial :: MonadAsync m => (a -> m a) -> m a -> SerialT m a-iterateMSerial step = fromStreamS . S.iterateM step+iterateMSerial step = fromStreamD . D.iterateM step  -- | We can define cyclic structures using @let@: --@@ -537,30 +539,6 @@ -- 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.IsStream as Stream--- >>> import System.IO.Unsafe (unsafeInterleaveIO)------ >>> :{--- main = Stream.mapM_ print $ Stream.mfix f---     where---     f action = do---         let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act---         x <- Stream.fromListM [incr 1 action, incr 2 action]---         y <- 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 :: (IsStream t, Monad m) => (m a -> t m a) -> t m a@@ -624,14 +602,6 @@ fromListMSerial :: MonadAsync m => [m a] -> SerialT m a fromListMSerial = fromStreamD . D.fromListM --- | Same as 'fromFoldable'.------ @since 0.1.0-{-# DEPRECATED each "Please use fromFoldable instead." #-}-{-# INLINE each #-}-each :: (IsStream t, Foldable f) => f a -> t m a-each = fromFoldable- -- | Read lines from an IO Handle into a stream of Strings. -- -- @since 0.1.0@@ -661,20 +631,12 @@ fromCallback setCallback = concatM $ do     (callback, stream) <- Par.newCallbackStream     setCallback callback-    return $ SerialT stream+    return $ Stream.fromStreamK stream --- | Construct a stream by reading a 'Prim' 'IORef' repeatedly.+-- | Construct a stream by reading an 'Unboxed' 'IORef' repeatedly. -- -- /Pre-release/ -- {-# INLINE fromPrimIORef #-}-fromPrimIORef :: (IsStream t, MonadIO m, Prim a) => Prim.IORef a -> t m a-fromPrimIORef = fromStreamD . Prim.toStreamD---- | Same as fromEffect------ @since 0.2.0-{-# DEPRECATED once "Please use fromEffect instead." #-}-{-# INLINE once #-}-once :: (Monad m, IsStream t) => m a -> t m a-once = IsStream.fromEffect+fromPrimIORef :: (IsStream t, MonadIO m, Unbox a) => Unboxed.IORef a -> t m a+fromPrimIORef = fromStreamD . Unboxed.pollIntIORef
src/Streamly/Internal/Data/Stream/IsStream/Lift.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Lift -- Copyright   : (c) 2019 Composewell Technologies@@ -6,7 +8,7 @@ -- Stability   : experimental -- Portability : GHC -module Streamly.Internal.Data.Stream.IsStream.Lift+module Streamly.Internal.Data.Stream.IsStream.Lift {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * Generalize Inner Monad       hoist@@ -29,15 +31,11 @@ import Control.Monad.Trans.Class (MonadTrans(..)) import Data.Functor.Identity (Identity (..)) import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream(..), fromStreamS, toStreamS, fromStreamD, toStreamD)+    (IsStream(..), fromStreamD, toStreamD) import Streamly.Internal.Data.Stream.Serial (SerialT) -import qualified Streamly.Internal.Data.Stream.StreamD as D-#ifdef USE_STREAMK_ONLY-import qualified Streamly.Internal.Data.Stream.StreamK as S-#else-import qualified Streamly.Internal.Data.Stream.StreamD as S-#endif+import qualified Streamly.Internal.Data.Stream as D+    (morphInner, liftInner, runReaderT, evalStateT, runStateT)  ------------------------------------------------------------------------------ -- Generalize the underlying monad@@ -50,7 +48,7 @@ {-# INLINE hoist #-} hoist :: (Monad m, Monad n)     => (forall x. m x -> n x) -> SerialT m a -> SerialT n a-hoist f xs = fromStreamS $ S.hoist f (toStreamS xs)+hoist f xs = fromStreamD $ D.morphInner f (toStreamD xs)  -- | Generalize the inner monad of the stream from 'Identity' to any monad. --@@ -58,7 +56,7 @@ -- {-# INLINE generally #-} generally :: (IsStream t, Monad m) => t Identity a -> t m a-generally xs = fromStreamS $ S.hoist (return . runIdentity) (toStreamS xs)+generally xs = fromStreamD $ D.morphInner (return . runIdentity) (toStreamD xs)  ------------------------------------------------------------------------------ -- Add and remove a monad transformer
src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs view
@@ -1,3 +1,6 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Reduce -- Copyright   : (c) 2017 Composewell Technologies@@ -8,7 +11,7 @@ -- -- Reduce streams by streams, folds or parsers. -module Streamly.Internal.Data.Stream.IsStream.Reduce+module Streamly.Internal.Data.Stream.IsStream.Reduce {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * Reduce By Streams       dropPrefix@@ -22,7 +25,7 @@     --     -- @     -- f (Fold m a b) -> t m a -> t m b-    -- f (Parser m a b) -> t m a -> t m b+    -- f (Parser a m b) -> t m a -> t m b     -- @      -- ** Generic Folding@@ -50,6 +53,7 @@     , splitOn     , splitOnSuffix     , splitOnPrefix+    , splitOnAny      -- , splitBy     , splitWithSuffix@@ -68,7 +72,7 @@      -- Splitting using multiple sequence separators     -- , splitOnAnySeq-    -- , splitOnAnySuffixSeq+    , splitOnSuffixSeqAny     -- , splitOnAnyPrefixSeq      -- -- *** Splitting By Streams@@ -88,6 +92,7 @@     -- | A new window starts after the previous window is finished.      -- , classifyChunksOf+    , classifySessionsByGeneric     , classifySessionsBy     , classifySessionsOf @@ -125,6 +130,7 @@     -- output stream.      , wordsBy -- stripAndCompactBy+    , wordsOn     , groups     , groupsBy     , groupsByRolling@@ -146,50 +152,69 @@  #include "inline.hs" -import Control.Concurrent (threadDelay) import Control.Exception (assert)-import Control.Monad.Catch (MonadThrow) import Control.Monad.IO.Class (MonadIO(..)) import Data.Heap (Entry(..)) import Data.Kind (Type)+import Data.Map (Map) import Data.Maybe (isNothing)+import Data.Proxy (Proxy(..)) import Foreign.Storable (Storable) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Fold.Type (Fold (..))+import Streamly.Internal.Data.Fold (Fold (..))+import Streamly.Internal.Data.IsMap (IsMap(..)) import Streamly.Internal.Data.Refold.Type (Refold (..))-import Streamly.Internal.Data.Parser (Parser (..))-import Streamly.Internal.Data.Array.Foreign.Type (Array)+import Streamly.Internal.Data.Parser (Parser (..), ParseError)+import Streamly.Internal.Data.Array (Array) import Streamly.Internal.Data.Stream.IsStream.Common-    ( concatMap-    , fold+    ( fold     , interjectSuffix     , intersperseM     , map-    , parallelFst-    , repeatM     , scanlMAfter'+    , foldManyPost     , splitOnSeq     , fromPure) import Streamly.Internal.Data.Stream.IsStream.Type     (IsStream(..), fromStreamD, toStreamD, cons)+import Streamly.Internal.Data.Stream.Serial(toStreamK) import Streamly.Internal.Data.Time.Units        ( AbsTime, MilliSecond64(..), addToAbsTime, toRelTime        , toAbsTime)+import Streamly.Data.MutByteArray (Unbox)  import qualified Data.Heap as H-import qualified Data.Map.Strict as Map-import qualified Streamly.Internal.Data.Array.Foreign.Type as A+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Array as A+    (chunksOf, read) import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK-import qualified Streamly.Internal.Data.Parser.ParserD as PRD+    (Fold, Step(..), takeEndBy_, takeEndBy, catMaybes, take)+import qualified Streamly.Internal.Data.IsMap as IsMap+import qualified Streamly.Internal.Data.Parser as PRD (Parser(..)) import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D+    ( foldMany+    , groupsOf+    , refoldMany+    , foldIterateM+    , refoldIterateM+    , parseManyD+    , parseIterateD+    , groupsBy+    , groupsRollingBy+    , wordsBy+    , splitOnSuffixSeq+    , splitInnerBy+    , splitInnerBySuffix+    )+import qualified Streamly.Internal.Data.Stream.IsStream.Expand as Expand import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform  import Prelude hiding (concatMap, map)  -- $setup -- >>> :m+-- >>> :set -fno-warn-deprecations -- >>> import Prelude hiding (zipWith, concatMap, concat) -- >>> import qualified Streamly.Prelude as Stream -- >>> import Streamly.Internal.Data.Stream.IsStream as Stream@@ -197,7 +222,7 @@ -- >>> 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.Foreign as Array+-- >>> import qualified Streamly.Data.Array as Array  ------------------------------------------------------------------------------ -- Trimming@@ -207,7 +232,7 @@ -- -- Space: @O(1)@ ----- /Unimplemented/ - Help wanted.+-- /Unimplemented/ {-# INLINE dropPrefix #-} dropPrefix ::     -- (Eq a, IsStream t, Monad m) =>@@ -219,7 +244,7 @@ -- -- Space: @O(n)@ where n is the length of the infix. ----- /Unimplemented/ - Help wanted.+-- /Unimplemented/ {-# INLINE dropInfix #-} dropInfix ::     -- (Eq a, IsStream t, Monad m) =>@@ -231,7 +256,7 @@ -- -- Space: @O(n)@ where n is the length of the suffix. ----- /Unimplemented/ - Help wanted.+-- /Unimplemented/ {-# INLINE dropSuffix #-} dropSuffix ::     -- (Eq a, IsStream t, Monad m) =>@@ -248,27 +273,6 @@ -- -- XXX We need takeGE/takeBetween to implement "some" using "many". --- | Like 'foldMany' but appends empty fold output if the fold and stream--- termination aligns:------ >>> f = Fold.take 2 Fold.sum--- >>> Stream.toList $ Stream.foldManyPost f $ Stream.fromList []--- [0]--- >>> Stream.toList $ Stream.foldManyPost f $ Stream.fromList [1..9]--- [3,7,11,15,9]--- >>> Stream.toList $ Stream.foldManyPost f $ Stream.fromList [1..10]--- [3,7,11,15,19,0]------ /Pre-release/----{-# INLINE foldManyPost #-}-foldManyPost-    :: (IsStream t, Monad m)-    => Fold m a b-    -> t m a-    -> t m b-foldManyPost f m = fromStreamD $ D.foldManyPost f (toStreamD m)- -- | Apply a 'Fold' repeatedly on a stream and emit the fold outputs in the -- output stream. --@@ -360,7 +364,7 @@ -- parse combinator. -- -- >>> Stream.toList $ Stream.parseMany (Parser.takeBetween 0 2 Fold.sum) $ Stream.fromList [1..10]--- [3,7,11,15,19]+-- [Right 3,Right 7,Right 11,Right 15,Right 19] -- -- @ -- > Stream.toList $ Stream.parseMany (Parser.line Fold.toList) $ Stream.fromList "hello\\nworld"@@ -379,31 +383,35 @@ -- {-# INLINE parseMany #-} parseMany-    :: (IsStream t, MonadThrow m)-    => Parser m a b+    :: (IsStream t, Monad m)+    => Parser a m b     -> t m a-    -> t m b+    -> t m (Either ParseError b) parseMany p m =-    fromStreamD $ D.parseMany (PRK.fromParserK p) (toStreamD m)+    fromStreamD $ D.parseManyD p (toStreamD m) +-- | Same as parseMany but for StreamD streams.+--+-- /Internal/+-- {-# INLINE parseManyD #-} parseManyD-    :: (IsStream t, MonadThrow m)-    => PRD.Parser m a b+    :: (IsStream t, Monad m)+    => PRD.Parser a m b     -> t m a-    -> t m b+    -> t m (Either ParseError b) parseManyD p m =-    fromStreamD $ D.parseMany p (toStreamD m)+    fromStreamD $ D.parseManyD p (toStreamD m)  -- | Apply a stream of parsers to an input stream and emit the results in the -- output stream. ----- /Pre-release/+-- /Unimplemented/ -- {-# INLINE parseSequence #-} parseSequence        :: -- (IsStream t, Monad m) =>-       t m (Parser m a b)+       t m (Parser a m b)     -> t m a     -> t m b parseSequence _f _m = undefined@@ -421,8 +429,8 @@ {-# INLINE parseManyTill #-} parseManyTill ::     -- (IsStream t, MonadThrow m) =>-       Parser m a b-    -> Parser m a x+       Parser a m b+    -> Parser a m x     -> t m a     -> t m b parseManyTill = undefined@@ -432,7 +440,7 @@ -- the result is used to generate the next parser and so on. -- -- >>> import Data.Monoid (Sum(..))--- >>> Stream.toList $ Stream.map getSum $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) 0 $ Stream.map Sum $ Stream.fromList [1..10]+-- >>> Stream.toList $ fmap getSum $ Stream.rights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum $ Stream.fromList [1..10] -- [3,10,21,36,55,55] -- -- This is the streaming equivalent of monad like sequenced application of@@ -442,52 +450,13 @@ -- {-# INLINE parseIterate #-} parseIterate-    :: (IsStream t, MonadThrow m)-    => (b -> Parser m a b)+    :: (IsStream t, Monad m)+    => (b -> Parser a m b)     -> b     -> t m a-    -> t m b+    -> t m (Either ParseError b) parseIterate f i m = fromStreamD $-    D.parseIterate (PRK.fromParserK . f) i (toStreamD m)----------------------------------------------------------------------------------- Generalized grouping----------------------------------------------------------------------------------- This combinator is the most general grouping combinator and can be used to--- implement all other grouping combinators.------ XXX check if this can implement the splitOn combinator i.e. we can slide in--- new elements, slide out old elements and incrementally compute the hash.--- Also, can we implement the windowed classification combinators using this?------ In fact this is a parse. Instead of using a special return value in the fold--- we are using a mapping function.------ Note that 'scanl'' (usually followed by a map to extract the desired value--- from the accumulator) can be used to realize many implementations e.g. a--- sliding window implementation. A scan followed by a mapMaybe is also a good--- pattern to express many problems where we want to emit a filtered output and--- not emit an output on every input.------ Passing on of the initial accumulator value to the next fold is equivalent--- to returning the leftover concept.--{---- | @groupScan splitter fold stream@ folds the input stream using @fold@.--- @splitter@ is applied on the accumulator of the fold every time an item is--- consumed by the fold. The fold continues until @splitter@ returns a 'Just'--- value.  A 'Just' result from the @splitter@ specifies a result to be emitted--- in the output stream and the initial value of the accumulator for the next--- group's fold. This allows us to control whether to start fresh for the next--- fold or to continue from the previous fold's output.----{-# INLINE groupScan #-}-groupScan-    :: (IsStream t, Monad m)-    => (x -> m (Maybe (b, x))) -> Fold m a x -> t m a -> t m b-groupScan split fold m = undefined--}+    D.parseIterateD f i (toStreamD m)  ------------------------------------------------------------------------------ -- Grouping@@ -824,16 +793,16 @@ -- >>> 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-    :: (IsStream t, Monad m, Storable a, Integral a)-    => [Array a] -> Fold m a b -> t m a -> t m b-splitOnAny subseq f m = undefined-    -- fromStreamD $ D.splitOnAny f subseq (toStreamD m)--}+splitOnAny :: -- (IsStream t, Monad m, Unbox a, Integral a) =>+    [Array a] -> Fold m a b -> t m a -> t m b+splitOnAny _subseq _f _m =+    undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)  -- XXX use a non-monadic intersperse to remove the MonadAsync constraint. -- XXX Use two folds, one ring buffer fold for separator sequence and the other@@ -875,10 +844,10 @@ -- /Pre-release/ {-# INLINE splitBySeq #-} splitBySeq-    :: (IsStream t, MonadAsync m, Storable a, Enum a, Eq a)+    :: (IsStream t, MonadAsync m, Storable a, Unbox a, Enum a, Eq a)     => Array a -> Fold m a b -> t m a -> t m b splitBySeq patt f m =-    intersperseM (fold f (A.toStream patt)) $ splitOnSeq patt f m+    intersperseM (fold f (fromStreamD $ A.read patt)) $ splitOnSeq patt f m  -- | Like 'splitSuffixBy' but the separator is a sequence of elements, instead -- of a predicate for a single element.@@ -921,24 +890,29 @@ -- -- > splitSuffixOn . intercalateSuffix == id --+-- >>> splitOnSuffixSeq pat f = Stream.foldMany (Fold.takeEndBySeq_ pat f)+-- -- /Pre-release/ {-# INLINE splitOnSuffixSeq #-} splitOnSuffixSeq-    :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)+    :: (IsStream t, MonadIO m, Storable a, Unbox a, Enum a, Eq a)     => Array a -> Fold m a b -> t m a -> t m b splitOnSuffixSeq patt f m =     fromStreamD $ D.splitOnSuffixSeq False patt f (toStreamD m)+-- XXX This may have a problem if the stream terminates and we start extracting+-- the fold and then the fold terminates before consuming all the buffered+-- input.  We have no way to supply the buffered input back to the driver.+-- splitOnSuffixSeq patt f =+--     foldMany (FL.takeEndBySeq_ patt f) -{- -- | Like 'splitOn' but drops any empty splits. --+-- /Unimplemented/ {-# INLINE wordsOn #-}-wordsOn-    :: (IsStream t, Monad m, Storable a, Eq a)-    => Array a -> Fold m a b -> t m a -> t m b-wordsOn subseq f m = undefined-    -- fromStreamD $ D.wordsOn f subseq (toStreamD m)--}+wordsOn :: -- (IsStream t, Monad m, Unbox a, Eq a) =>+    Array a -> Fold m a b -> t m a -> t m b+wordsOn _subseq _f _m =+    undefined -- D.fromStreamD $ D.wordsOn f subseq (D.toStreamD m)  -- | Like 'splitOnSuffixSeq' but keeps the suffix intact in the splits. --@@ -968,24 +942,27 @@ -- >>> splitWithSuffixSeq' "." "a..b.." -- ["a.",".","b.","."] --+-- >>> splitWithSuffixSeq pat f = Stream.foldMany (Fold.takeEndBySeq pat f)+-- -- /Pre-release/ {-# INLINE splitWithSuffixSeq #-} splitWithSuffixSeq-    :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)+    :: (IsStream t, MonadIO m, Storable a, Unbox a, Enum a, Eq a)     => Array a -> Fold m a b -> t m a -> t m b splitWithSuffixSeq patt f m =     fromStreamD $ D.splitOnSuffixSeq True patt f (toStreamD m)+-- splitWithSuffixSeq patt f =+--     foldMany (FL.takeEndBySeq patt f) -{- -- This can be implemented easily using Rabin Karp -- | Split post any one of the given patterns.+--+-- /Unimplemented/ {-# INLINE splitOnSuffixSeqAny #-}-splitOnSuffixSeqAny-    :: (IsStream t, Monad m, Storable a, Integral a)-    => [Array a] -> Fold m a b -> t m a -> t m b-splitOnSuffixSeqAny subseq f m = undefined-    -- fromStreamD $ D.splitPostAny f subseq (toStreamD m)--}+splitOnSuffixSeqAny :: -- (IsStream t, Monad m, Unbox a, Integral a) =>+    [Array a] -> Fold m a b -> t m a -> t m b+splitOnSuffixSeqAny _subseq _f _m = undefined+    -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)  ------------------------------------------------------------------------------ -- Chunking@@ -1007,7 +984,7 @@ chunksOf     :: (IsStream t, Monad m)     => Int -> Fold m a b -> t m a -> t m b-chunksOf n f = fromStreamD . D.chunksOf n f . toStreamD+chunksOf n f = fromStreamD . D.groupsOf n f . toStreamD  -- | @arraysOf n stream@ groups the elements in the input stream into arrays of -- @n@ elements each.@@ -1018,9 +995,9 @@ -- -- /Pre-release/ {-# INLINE arraysOf #-}-arraysOf :: (IsStream t, MonadIO m, Storable a)+arraysOf :: (IsStream t, MonadIO m, Unbox a)     => Int -> t m a -> t m (Array a)-arraysOf n = fromStreamD . A.arraysOf n . toStreamD+arraysOf n = fromStreamD . A.chunksOf n . toStreamD  -- XXX we can implement this by repeatedly applying the 'lrunFor' fold. -- XXX add this example after fixing the serial stream rate control@@ -1045,7 +1022,8 @@ -- -- | Like 'chunksOf' but if the chunk is not completed within the specified -- time interval then emit whatever we have collected till now. The chunk--- timeout is reset whenever a chunk is emitted.+-- timeout is reset whenever a chunk is emitted. The granularity of the clock+-- is 100 ms. -- -- >>> s = Stream.delayPost 0.3 $ Stream.fromList [1..1000] -- >>> f = Stream.mapM_ print $ Stream.chunksOfTimeout 5 1 Fold.toList s@@ -1057,7 +1035,7 @@ chunksOfTimeout n timeout f =       map snd     . classifySessionsBy-        timeout False (const (return False)) timeout (FL.take n f)+        0.1 False (const (return False)) timeout (FL.take n f)     . Transform.timestamped     . map ((),) @@ -1065,16 +1043,6 @@ -- Windowed classification ------------------------------------------------------------------------------ --- We divide the stream into windows or chunks in space or time and 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 can be split into--- windows by size or by using a split predicate on the elements in the stream.--- For example, when we receive a closing flag, we can close the window.------ A "chunk" is a space window and a "session" is a time window. Are there any--- other better short words to describe them. An alternative is to use--- "swindow" and "twindow". Another word for "session" could be "spell".--- -- TODO: To mark the position in space or time we can have Indexed or -- TimeStamped types. That can make it easy to deal with the position indices -- or timestamps.@@ -1133,10 +1101,10 @@ -- insert the new elements, and apply an incremental fold on the sliding -- window, supplying the outgoing elements, the new ring buffer as arguments. slidingChunkBuffer-    :: (IsStream t, Monad m, Ord a, Storable a)+    :: (IsStream t, Monad m, Ord a, Unbox a)     => Int -- window size     -> Int -- window slide-    -> Fold m (Ring a, Array a) b+    -> Fold m (RingArray a, Array a) b     -> t m a     -> t m b slidingChunkBuffer = undefined@@ -1146,7 +1114,7 @@ -- an incremental fold on the sliding window, supplying the outgoing elements, -- and the new radix tree buffer as arguments. slidingSessionBuffer-    :: (IsStream t, Monad m, Ord a, Storable a)+    :: (IsStream t, Monad m, Ord a, Unbox a)     => Int    -- window size     -> Int    -- tick size     -> Fold m (RTree a, Array a) b@@ -1186,67 +1154,180 @@ classifyKeepAliveChunks spanout = classifyChunksBy spanout True -} -data SessionState t m k a b = SessionState+data SessionState t m f s b = SessionState     { sessionCurTime :: !AbsTime  -- ^ time since last event     , sessionEventTime :: !AbsTime -- ^ time as per last event-    , sessionCount :: !Int -- ^ total number sessions in progress-    , sessionTimerHeap :: H.Heap (H.Entry AbsTime k) -- ^ heap for timeouts-    , sessionKeyValueMap :: Map.Map k a -- ^ Stored sessions for keys-    , sessionOutputStream :: t (m :: Type -> Type) (k, b) -- ^ Completed sessions+    -- We can use the Map size instead of maintaining a count, but if we have+    -- to switch to HashMap then it can be useful.+    , sessionCount :: !Int -- ^ total number of sessions in progress+    , sessionTimerHeap :: H.Heap (H.Entry AbsTime (Key f)) -- ^ heap for timeouts+    , sessionKeyValueMap :: f s -- ^ Stored sessions for keys+    , sessionOutputStream :: t (m :: Type -> Type) (Key f, b) -- ^ Completed sessions     } -data SessionEntry a b = LiveSession !a !b | ZombieSession+data SessionEntry s = LiveSession !AbsTime !s | ZombieSession --- | @classifySessionsBy tick keepalive predicate timeout fold stream@--- classifies an input event @stream@ consisting of  @(timestamp, (key,--- value))@ into sessions based on the @key@, folding all the values--- corresponding to the same key into a session using the supplied @fold@.------ When the fold terminates or a @timeout@ occurs, a tuple consisting of the--- session key and the folded value is emitted in the output stream. The--- timeout is measured from the first event in the session.  If the @keepalive@--- option is set to 'True' the timeout is reset to 0 whenever an event is--- received.------ The @timestamp@ in the input stream is an absolute time from some epoch,--- characterizing the time when the input event was generated.  The notion of--- current time is maintained by a monotonic event time clock using the--- timestamps seen in the input stream. The latest timestamp seen till now is--- used as the base for the current time.  When no new events are seen, a timer--- is started with a clock resolution of @tick@ seconds. This timer is used to--- detect session timeouts in the absence of new events.------ To ensure an upper bound on the memory used the number of sessions can be--- limited to an upper bound. If the ejection @predicate@ returns 'True', the--- oldest session is ejected before inserting a new session.------ >>> :{--- Stream.mapM_ print---     $ Stream.classifySessionsBy 1 False (const (return False)) 3 (Fold.take 3 Fold.toList)---     $ Stream.timestamped---     $ Stream.delay 0.1---     $ (,) <$> Stream.fromList [1,2,3] <*> Stream.fromList ['a','b','c']--- :}--- (1,"abc")--- (2,"abc")--- (3,"abc")------ /Pre-release/----{-# INLINABLE classifySessionsBy #-}-classifySessionsBy-    :: (IsStream t, MonadAsync m, Ord k)-    => Double         -- ^ timer tick in seconds+-- delete from map and output the fold accumulator+ejectEntry :: (Monad m, IsStream t, IsMap f) =>+    (acc -> m b)+    -> heap+    -> f entry+    -> t m (Key f, b)+    -> Int+    -> acc+    -> Key f+    -> m (heap, f entry, t m (Key f, b), Int)+ejectEntry extract hp mp out cnt acc key = do+    sess <- extract acc+    let out1 = (key, sess) `cons` out+    let mp1 = IsMap.mapDelete key mp+    return (hp, mp1, out1, cnt - 1)++{-# NOINLINE flush #-}+flush :: (Monad m, IsMap f, IsStream t) =>+       (s -> m b)+    -> SessionState t m f (SessionEntry s) b+    -> m (SessionState t m f (SessionEntry s) b)+flush extract session@SessionState{..} = do+    (hp', mp', out, count) <-+        ejectAll+            ( sessionTimerHeap+            , sessionKeyValueMap+            , IsStream.nil+            , sessionCount+            )+    return $ session+        { sessionCount = count+        , sessionTimerHeap = hp'+        , sessionKeyValueMap = mp'+        , sessionOutputStream = out+        }++    where++    ejectAll (hp, mp, out, !cnt) = do+        let hres = H.uncons hp+        case hres of+            Just (Entry _ key, hp1) -> do+                r <- case IsMap.mapLookup key mp of+                    Nothing -> return (hp1, mp, out, cnt)+                    Just ZombieSession ->+                        return (hp1, IsMap.mapDelete key mp, out, cnt)+                    Just (LiveSession _ acc) ->+                        ejectEntry extract hp1 mp out cnt acc key+                ejectAll r+            Nothing -> do+                assert (IsMap.mapNull mp) (return ())+                return (hp, mp, out, cnt)++{-# NOINLINE ejectOne #-}+ejectOne :: (IsMap f, IsStream t, Monad m) =>+       Bool+    -> (acc -> m b)+    -> ( H.Heap (Entry AbsTime (Key f))+       , f (SessionEntry acc)+       , t m (Key f, b)+       , Int+       )+    -> m ( H.Heap (Entry AbsTime (Key f))+         , f (SessionEntry acc)+         , t m (Key f, b), Int+         )+ejectOne reset extract = go++    where++    go (hp, mp, out, !cnt) = do+        let hres = H.uncons hp+        case hres of+            Just (Entry expiry key, hp1) ->+                case IsMap.mapLookup key mp of+                    Nothing -> go (hp1, mp, out, cnt)+                    Just ZombieSession ->+                        go (hp1, IsMap.mapDelete key mp, out, cnt)+                    Just (LiveSession expiry1 acc) -> do+                        if not reset || expiry1 <= expiry+                        then ejectEntry extract hp1 mp out cnt acc key+                        else+                            -- reset the session timeout and continue+                            let hp2 = H.insert (Entry expiry1 key) hp1+                            in go (hp2, mp, out, cnt)+            Nothing -> do+                assert (IsMap.mapNull mp) (return ())+                return (hp, mp, out, cnt)++{-# NOINLINE ejectExpired #-}+ejectExpired :: (IsMap f, IsStream t, Monad m) =>+       Bool+    -> (Int -> m Bool)+    -> (acc -> m b)+    -> SessionState t m f (SessionEntry acc) b+    -> AbsTime+    -> m (SessionState t m f (SessionEntry acc) b)+ejectExpired reset ejectPred extract session@SessionState{..} curTime = do+    (hp', mp', out, count) <-+        ejectLoop+            sessionTimerHeap sessionKeyValueMap IsStream.nil sessionCount+    return $ session+        { sessionCurTime = curTime+        , sessionCount = count+        , sessionTimerHeap = hp'+        , sessionKeyValueMap = mp'+        , sessionOutputStream = out+        }++    where++    ejectLoop hp mp out !cnt = do+        let hres = H.uncons hp+        case hres of+            Just (Entry expiry key, hp1) -> do+                (eject, force) <-+                    if curTime >= expiry+                    then return (True, False)+                    else do+                        r <- ejectPred cnt+                        return (r, r)+                if eject+                then+                    case IsMap.mapLookup key mp of+                        Nothing -> ejectLoop hp1 mp out cnt+                        Just ZombieSession ->+                            ejectLoop hp1 (IsMap.mapDelete key mp) out cnt+                        Just (LiveSession expiry1 acc) -> do+                            if expiry1 <= curTime || not reset || force+                            then do+                                (hp2,mp1,out1,cnt1) <-+                                    ejectEntry extract hp1 mp out cnt acc key+                                ejectLoop hp2 mp1 out1 cnt1+                            else+                                -- reset the session timeout and continue+                                let hp2 = H.insert (Entry expiry1 key) hp1+                                in ejectLoop hp2 mp out cnt+                else return (hp, mp, out, cnt)+            Nothing -> do+                assert (IsMap.mapNull mp) (return ())+                return (hp, mp, out, cnt)++-- XXX Use mutable IORef in accumulator+{-# INLINE classifySessionsByGeneric #-}+classifySessionsByGeneric+    :: forall t m f a b. (IsStream t, MonadAsync m, IsMap f)+    => Proxy (f :: (Type -> Type))+    -> Double         -- ^ timer tick in seconds     -> Bool           -- ^ reset the timer when an event is received     -> (Int -> m Bool) -- ^ predicate to eject sessions based on session count     -> Double         -- ^ session timeout in seconds     -> Fold m a b  -- ^ Fold to be applied to session data-    -> t m (AbsTime, (k, a)) -- ^ timestamp, (session key, session data)-    -> t m (k, b) -- ^ session key, fold result-classifySessionsBy tick reset ejectPred tmout-    (Fold step initial extract) str =-    concatMap sessionOutputStream $-        scanlMAfter' sstep (return szero) flush stream+    -> t m (AbsTime, (Key f, a)) -- ^ timestamp, (session key, session data)+    -> t m (Key f, b) -- ^ session key, fold result+classifySessionsByGeneric _ tick reset ejectPred tmout+    (Fold step initial extract final) input =+    Expand.unfoldMany+        (Unfold.lmap (toStreamK . sessionOutputStream) Unfold.fromStreamK)+        $ scanlMAfter' sstep (return szero) (flush final)+        $ interjectSuffix tick (return Nothing)+        $ map Just input      where @@ -1257,7 +1338,7 @@         , sessionEventTime = toAbsTime (0 :: MilliSecond64)         , sessionCount = 0         , sessionTimerHeap = H.empty-        , sessionKeyValueMap = Map.empty+        , sessionKeyValueMap = IsMap.mapEmpty :: f s         , sessionOutputStream = IsStream.nil         } @@ -1273,12 +1354,14 @@      -- Got a new stream input element     sstep session@SessionState{..} (Just (timestamp, (key, value))) = do-        -- XXX we should use a heap in pinned memory to scale it to a large-        -- size+        -- XXX instead of a heap we could use a timer wheel.         --         -- XXX if the key is an Int, we can also use an IntMap for slightly         -- better performance.         --+        -- How it works:+        --+        -- Values for each key are collected in a map using the supplied fold.         -- When we insert a key in the Map we insert an entry into the heap as         -- well with the session expiry as the sort key.  The Map entry         -- consists of the fold result, and the expiry time of the session. If@@ -1303,9 +1386,17 @@         -- finished we still keep a dummy Map entry (ZombieSession) until the         -- heap entry is removed. That way if we have a Map entry we do not         -- insert a heap entry because we know it is already there.+        -- XXX The ZombieSession mechanism does not work as expected as we+        -- ignore ZombieSession when inserting a new entry. Anyway, we can+        -- remove this mechanism as at most only two heap entries may be+        -- created and they will be ultimately cleaned up.         --+        -- Heap processing needs the map and map processing needs the heap,+        -- therefore we cannot separate the two for modularity unless we have a+        -- way to achieve mutual recursion.+        --         let curTime = max sessionEventTime timestamp-            mOld = Map.lookup key sessionKeyValueMap+            mOld = IsMap.mapLookup key sessionKeyValueMap         let done fb = do                 -- deleting a key from the heap is expensive, so we never                 -- delete a key from heap, we just purge it from the Map and it@@ -1315,7 +1406,8 @@                 --                 let (mp, cnt) = case mOld of                         Just (LiveSession _ _) ->-                            ( Map.insert key ZombieSession sessionKeyValueMap+                            ( IsMap.mapInsert+                                key ZombieSession sessionKeyValueMap                             , sessionCount - 1                             )                         _ -> (sessionKeyValueMap, sessionCount)@@ -1338,7 +1430,7 @@                                 eject <- ejectPred sessionCount                                 (hp, mp, out, cnt) <-                                     if eject-                                    then ejectOne vars+                                    then ejectOne reset extract vars                                     else return vars                                  -- Insert the new session in heap@@ -1348,7 +1440,7 @@                             Just _ -> return vars                  let acc = LiveSession expiry fs1-                    mp2 = Map.insert key acc mp1+                    mp2 = IsMap.mapInsert key acc mp1                 return $ SessionState                     { sessionCurTime = curTime                     , sessionEventTime = curTime@@ -1374,114 +1466,59 @@     -- Got a timer tick event     sstep sessionState@SessionState{..} Nothing =         let curTime = addToAbsTime sessionCurTime tickMs-        in ejectExpired sessionState curTime--    flush session@SessionState{..} = do-        (hp', mp', out, count) <--            ejectAll-                ( sessionTimerHeap-                , sessionKeyValueMap-                , IsStream.nil-                , sessionCount-                )-        return $ session-            { sessionCount = count-            , sessionTimerHeap = hp'-            , sessionKeyValueMap = mp'-            , sessionOutputStream = out-            }--    -- delete from map and output the fold accumulator-    ejectEntry hp mp out cnt acc key = do-        sess <- extract acc-        let out1 = (key, sess) `cons` out-        let mp1 = Map.delete key mp-        return (hp, mp1, out1, cnt - 1)--    ejectAll (hp, mp, out, !cnt) = do-        let hres = H.uncons hp-        case hres of-            Just (Entry _ key, hp1) -> do-                r <- case Map.lookup key mp of-                    Nothing -> return (hp1, mp, out, cnt)-                    Just ZombieSession ->-                        return (hp1, Map.delete key mp, out, cnt)-                    Just (LiveSession _ acc) ->-                        ejectEntry hp1 mp out cnt acc key-                ejectAll r-            Nothing -> do-                assert (Map.null mp) (return ())-                return (hp, mp, out, cnt)--    ejectOne (hp, mp, out, !cnt) = do-        let hres = H.uncons hp-        case hres of-            Just (Entry expiry key, hp1) ->-                case Map.lookup key mp of-                    Nothing -> ejectOne (hp1, mp, out, cnt)-                    Just ZombieSession ->-                        ejectOne (hp1, Map.delete key mp, out, cnt)-                    Just (LiveSession expiry1 acc) -> do-                        if not reset || expiry1 <= expiry-                        then ejectEntry hp1 mp out cnt acc key-                        else-                            -- reset the session timeout and continue-                            let hp2 = H.insert (Entry expiry1 key) hp1-                            in ejectOne (hp2, mp, out, cnt)-            Nothing -> do-                assert (Map.null mp) (return ())-                return (hp, mp, out, cnt)--    ejectExpired session@SessionState{..} curTime = do-        (hp', mp', out, count) <--            ejectLoop-                sessionTimerHeap sessionKeyValueMap IsStream.nil sessionCount-        return $ session-            { sessionCurTime = curTime-            , sessionCount = count-            , sessionTimerHeap = hp'-            , sessionKeyValueMap = mp'-            , sessionOutputStream = out-            }--        where--        ejectLoop hp mp out !cnt = do-            let hres = H.uncons hp-            case hres of-                Just (Entry expiry key, hp1) -> do-                    (eject, force) <--                        if curTime >= expiry-                        then return (True, False)-                        else do-                            r <- ejectPred cnt-                            return (r, r)-                    if eject-                    then-                        case Map.lookup key mp of-                            Nothing -> ejectLoop hp1 mp out cnt-                            Just ZombieSession ->-                                ejectLoop hp1 (Map.delete key mp) out cnt-                            Just (LiveSession expiry1 acc) -> do-                                if expiry1 <= curTime || not reset || force-                                then do-                                    (hp2,mp1,out1,cnt1) <--                                        ejectEntry hp1 mp out cnt acc key-                                    ejectLoop hp2 mp1 out1 cnt1-                                else-                                    -- reset the session timeout and continue-                                    let hp2 = H.insert (Entry expiry1 key) hp1-                                    in ejectLoop hp2 mp out cnt-                    else return (hp, mp, out, cnt)-                Nothing -> do-                    assert (Map.null mp) (return ())-                    return (hp, mp, out, cnt)+        in ejectExpired reset ejectPred extract sessionState curTime -    -- merge timer events in the stream-    stream = map Just str `parallelFst` repeatM timer-    timer = do-        liftIO $ threadDelay (round $ tick * 1000000)-        return Nothing+-- | @classifySessionsBy tick keepalive predicate timeout fold stream@+-- classifies an input event @stream@ consisting of  @(timestamp, (key,+-- value))@ into sessions based on the @key@, folding all the values+-- corresponding to the same key into a session using the supplied @fold@.+--+-- When the fold terminates or a @timeout@ occurs, a tuple consisting of the+-- session key and the folded value is emitted in the output stream. The+-- timeout is measured from the first event in the session.  If the @keepalive@+-- option is set to 'True' the timeout is reset to 0 whenever an event is+-- received.+--+-- The @timestamp@ in the input stream is an absolute time from some epoch,+-- characterizing the time when the input event was generated.  The notion of+-- current time is maintained by a monotonic event time clock using the+-- timestamps seen in the input stream. The latest timestamp seen till now is+-- used as the base for the current time.  When no new events are seen, a timer+-- is started with a clock resolution of @tick@ seconds. This timer is used to+-- detect session timeouts in the absence of new events.+--+-- To ensure an upper bound on the memory used the number of sessions can be+-- limited to an upper bound. If the ejection @predicate@ returns 'True', the+-- oldest session is ejected before inserting a new session.+--+-- When the stream ends any buffered sessions are ejected immediately.+--+-- If a session key is received even after a session has finished, another+-- session is created for that key.+--+-- >>> :{+-- Stream.mapM_ print+--     $ Stream.classifySessionsBy 1 False (const (return False)) 3 (Fold.take 3 Fold.toList)+--     $ Stream.timestamped+--     $ Stream.delay 0.1+--     $ Stream.fromList ((,) <$> [1,2,3] <*> ['a','b','c'])+-- :}+-- (1,"abc")+-- (2,"abc")+-- (3,"abc")+--+-- /Pre-release/+{-# INLINE classifySessionsBy #-}+classifySessionsBy+    :: (IsStream t, MonadAsync m, Ord k)+    => Double         -- ^ timer tick in seconds+    -> Bool           -- ^ reset the timer when an event is received+    -> (Int -> m Bool) -- ^ predicate to eject sessions based on session count+    -> Double         -- ^ session timeout in seconds+    -> Fold m a b  -- ^ Fold to be applied to session data+    -> t m (AbsTime, (k, a)) -- ^ timestamp, (session key, session data)+    -> t m (k, b) -- ^ session key, fold result+classifySessionsBy = classifySessionsByGeneric (Proxy :: Proxy (Map k))  -- | Same as 'classifySessionsBy' with a timer tick of 1 second and keepalive -- option set to 'True'.@@ -1567,8 +1604,7 @@ -- -- /Pre-release/ {-# INLINE splitInnerBy #-}-splitInnerBy-    :: (IsStream t, Monad m)+splitInnerBy :: forall t m (f :: Type -> Type) a. (IsStream t, Monad m)     => (f a -> m (f a, Maybe (f a)))  -- splitter     -> (f a -> f a -> m (f a))        -- joiner     -> t m (f a)@@ -1581,11 +1617,11 @@ -- -- /Pre-release/ {-# INLINE splitInnerBySuffix #-}-splitInnerBySuffix-    :: (IsStream t, Monad m, Eq (f a), Monoid (f a))+splitInnerBySuffix :: forall t m (f :: Type -> Type) a.+    (IsStream t, 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     -> t m (f a)     -> t m (f a) splitInnerBySuffix splitter joiner xs =-    fromStreamD $ D.splitInnerBySuffix splitter joiner $ toStreamD xs+    fromStreamD $ D.splitInnerBySuffix (== mempty) splitter joiner $ toStreamD xs
src/Streamly/Internal/Data/Stream/IsStream/Top.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Top -- Copyright   : (c) 2020 Composewell Technologies@@ -9,7 +11,7 @@ -- Top level IsStream module that can use all other lower level IsStream -- modules. -module Streamly.Internal.Data.Stream.IsStream.Top+module Streamly.Internal.Data.Stream.IsStream.Top {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * Transformation     -- ** Sampling@@ -39,10 +41,10 @@     , joinInner     , joinInnerMap     , joinInnerMerge-    , joinLeft+    -- , joinLeft     , mergeLeftJoin     , joinLeftMap-    , joinOuter+    -- , joinOuter     , mergeOuterJoin     , joinOuterMap     )@@ -52,14 +54,12 @@  import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.State.Strict (get, put)--- import Data.Hashable (Hashable)+-- import Control.Monad.Trans.Class (lift)+-- import Control.Monad.Trans.State.Strict (get, put)+-- import Data.Function ((&)) import Data.IORef (newIORef, readIORef, modifyIORef') import Data.Kind (Type)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup(..))-#endif+-- import Data.Maybe (isJust) import Streamly.Internal.Control.Concurrent (MonadAsync) import Streamly.Internal.Data.Stream.IsStream.Common (concatM) import Streamly.Internal.Data.Stream.IsStream.Type@@ -69,22 +69,26 @@  import qualified Data.List as List import qualified Data.Map.Strict as Map-import qualified Streamly.Internal.Data.Array as Array+-- import qualified Streamly.Internal.Data.Array.Generic as Array+--     (fromStream, length, read)+-- import qualified Streamly.Data.Array.Mut as MA import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as Parser-import qualified Streamly.Internal.Data.Stream.IsStream.Lift as Stream+    (groupByRollingEither)+-- import qualified Streamly.Internal.Data.Stream.IsStream.Lift as Stream import qualified Streamly.Internal.Data.Stream.IsStream.Eliminate as Stream import qualified Streamly.Internal.Data.Stream.IsStream.Generate as Stream import qualified Streamly.Internal.Data.Stream.IsStream.Expand as Stream import qualified Streamly.Internal.Data.Stream.IsStream.Reduce as Stream import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Stream import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Stream.StreamD as StreamD+import qualified Streamly.Internal.Data.Stream as StreamD -import Prelude hiding (filter, zipWith, concatMap, concat)+import Prelude hiding (Foldable(..), filter, zipWith, concatMap, concat)  -- $setup -- >>> :m+-- >>> :set -fno-warn-deprecations -- >>> import Prelude hiding (filter, zipWith, concatMap, concat) -- >>> import qualified Streamly.Prelude as Stream -- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream@@ -130,7 +134,7 @@ -- | Like 'sampleInterval' but samples at the beginning of the time window. -- -- @--- sampleIntervalStart n = Stream.catMaybes . Stream.intervalsOf n Fold.head+-- sampleIntervalStart n = Stream.catMaybes . Stream.intervalsOf n Fold.one -- @ -- -- /Pre-release/@@ -138,11 +142,65 @@ {-# INLINE sampleIntervalStart #-} sampleIntervalStart :: (IsStream t, MonadAsync m, Functor (t m)) =>     Double -> t m a -> t m a-sampleIntervalStart n = Stream.catMaybes . Stream.intervalsOf n Fold.head+sampleIntervalStart n = Stream.catMaybes . Stream.intervalsOf n Fold.one +data BurstState t x =+      BurstNone+    | BurstWait !t !x+    | BurstDone !x+    | BurstDoneNext !x !t !x++{-# INLINE sampleBurst #-}+sampleBurst :: (IsStream t, MonadAsync m, Functor (t m)) =>+    Bool -> Double -> t m a -> t m a+sampleBurst sampleAtEnd gap xs =+    -- XXX Ideally we should schedule a timer event exactly after gap time,+    -- but the tick stream should work well as long as the timer+    -- granularity is small enough compared to the gap.+    Stream.mapMaybe extract+        $ Stream.scanl' step BurstNone+        $ Stream.timeIndexed+        $ Stream.interjectSuffix 0.01 (return Nothing) (Stream.map Just xs)++    where++    gap1 = toRelTime64 (NanoSecond64 (round (gap * 10^(9::Int))))++    {-# INLINE step #-}+    step BurstNone (t1, Just x1) = BurstWait t1 x1+    step BurstNone _ = BurstNone++    step (BurstDone _) (t1, Just x1) = BurstWait t1 x1+    step (BurstDone _) _ = BurstNone++    step old@(BurstWait t0 x0) (t1, Nothing)+        | t1 - t0 >= gap1 = BurstDone x0+        | otherwise = old+    -- This can happen due to scheduling delays, if we received back to+    -- back events spaced by more than the timeout without an+    -- intervening timeout event then we emit the old event instead of+    -- replacing it by the new.+    step (BurstWait t0 x0) (t1, Just x1)+        | t1 - t0 >= gap1 = BurstDoneNext x0 t1 x1+        | sampleAtEnd = BurstWait t1 x1+        | otherwise = BurstWait t1 x0++    step (BurstDoneNext _ t0 x0) (t1, Nothing)+        | t1 - t0 >= gap1 = BurstDone x0+        | otherwise =  BurstWait t0 x0+    step (BurstDoneNext _ t0 x0) (t1, Just x1)+        | t1 - t0 >= gap1 = BurstDoneNext x0 t1 x1+        | sampleAtEnd = BurstWait t1 x1+        | otherwise = BurstWait t1 x0++    {-# INLINE extract #-}+    extract (BurstDoneNext x _ _) = Just x+    extract (BurstDone x) = Just x+    extract _ = Nothing+ -- | Sample one event at the end of each burst of events.  A burst is a group -- of events close together in time, it ends when an event is spaced by more--- than the specified time interval from the previous event.+-- than the specified time interval (in seconds) from the previous event. -- -- This is known as @debounce@ in some libraries. --@@ -153,13 +211,7 @@ {-# INLINE sampleBurstEnd #-} sampleBurstEnd :: (IsStream t, MonadAsync m, Functor (t m)) =>     Double -> t m a -> t m a-sampleBurstEnd gap =-    let f (t1, _) (t2, _) =-            t2 - t1 >= toRelTime64 (NanoSecond64 (round (gap * 10^(9::Int))))-    in Stream.map snd-        . Stream.catMaybes-        . Stream.groupsByRolling f Fold.last-        . Stream.timeIndexed+sampleBurstEnd = sampleBurst True  -- | Like 'sampleBurstEnd' but samples the event at the beginning of the burst -- instead of at the end of it.@@ -169,13 +221,7 @@ {-# INLINE sampleBurstStart #-} sampleBurstStart :: (IsStream t, MonadAsync m, Functor (t m)) =>     Double -> t m a -> t m a-sampleBurstStart gap =-    let f (t1, _) (t2, _) =-            t2 - t1 >= toRelTime64 (NanoSecond64 (round (gap * 10^(9::Int))))-    in Stream.map snd-        . Stream.catMaybes-        . Stream.groupsByRolling f Fold.head-        . Stream.timeIndexed+sampleBurstStart = sampleBurst False  ------------------------------------------------------------------------------ -- Reordering@@ -200,10 +246,10 @@     let p =             Parser.groupByRollingEither                 (\x -> (< GT) . cmp x)-                Fold.toStreamRev-                Fold.toStream+                (fmap fromStream Fold.toStreamKRev)+                (fmap fromStream Fold.toStreamK)      in   Stream.concatPairsWith (Stream.mergeBy cmp) id-        . Stream.parseMany (fmap (either id id) p)+        . Stream.rights . Stream.parseMany (fmap (either id id) p)  ------------------------------------------------------------------------------ -- SQL Joins@@ -339,6 +385,7 @@ joinInnerMerge :: (a -> b -> Ordering) -> t m a -> t m b -> t m (a, b) joinInnerMerge = undefined +{- -- 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@@ -386,6 +433,7 @@                 return (a, Just b1)             else Stream.nil         Nothing -> return (a, Nothing)+-}  -- | Like 'joinLeft' but uses a hashmap for efficiency. --@@ -421,6 +469,7 @@     (a -> b -> Ordering) -> t m a -> t m b -> t m (a, Maybe b) mergeLeftJoin _eq _s1 _s2 = undefined +{- -- XXX We can do this concurrently. -- -- | For all elements in @t m a@, for all elements in @t m b@ if @a@ and @b@@@ -443,17 +492,29 @@     -> SerialT m (Maybe a, Maybe b) joinOuter eq s1 s =     Stream.concatM $ do-        arr <- Array.fromStream $ fmap (,False) s-        return $ go arr <> leftOver arr+        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 <> leftOver inputArr foundArr      where -    leftOver =-            fmap (\(x, _) -> (Nothing, Just x))-                . Stream.filter (not . snd)-                . Array.toStream+    leftOver inputArr foundArr =+            let stream1 = IsStream.fromSerial $ 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 -    go arr = Stream.evalStateT (return False) $ do+    go inputArr foundArr = Stream.evalStateT (return False) $ do         a <- 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@@ -464,19 +525,20 @@                 if r                 then Stream.nil                 else Stream.fromPure Nothing-        (_i, b) <--            let stream = IsStream.fromSerial $ Array.toStream arr+        (i, b) <-+            let stream = IsStream.fromSerial $ Array.read inputArr              in Stream.indexed $ fmap Just (Stream.liftInner stream) <> final+         case b of-            Just (b1, _used) ->+            Just b1 ->                 if a `eq` b1                 then do                     lift $ put True-                    -- XXX Need to use a mutable array-                    -- when (not used) $ Array.writeIndex i True+                    MA.putIndex i True foundArr                     return (Just a, Just b1)                 else 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 @t m b@ and find those that are not in that@@ -587,7 +649,7 @@     (a -> a -> Ordering) -> t m a -> t m a -> t m a intersectBySorted eq s1 =       IsStream.fromStreamD-    . StreamD.intersectBySorted eq (IsStream.toStreamD s1)+    . StreamD.sortedIntersectBy eq (IsStream.toStreamD s1)     . IsStream.toStreamD  -- Roughly joinLeft s1 s2 = s1 `difference` s2 + s1 `intersection` s2
src/Streamly/Internal/Data/Stream/IsStream/Transform.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Transform -- Copyright   : (c) 2017 Composewell Technologies@@ -6,7 +8,7 @@ -- Stability   : experimental -- Portability : GHC -module Streamly.Internal.Data.Stream.IsStream.Transform+module Streamly.Internal.Data.Stream.IsStream.Transform {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * Piping     -- | Pass through a 'Pipe'.@@ -33,11 +35,11 @@     , tapAsync     , tapAsyncK     , distributeAsync_-    , tapRate     , pollCounts      -- * Scanning By 'Fold'     , scan+    , scanMany     , postscan      -- * Scanning@@ -45,6 +47,7 @@     , scanl'     , scanlM'     , scanlMAfter'+    , postscanlMAfter'     , postscanl'     , postscanlM'     , prescanl'@@ -77,7 +80,6 @@     , uniq     , uniqBy     , nubBy-    , nubWindowBy     , prune     , repeated @@ -85,7 +87,6 @@     -- | Produce a subset of the stream trimmed at ends.      , take-    , takeInterval     , takeLast     , takeLastInterval     , takeWhile@@ -93,7 +94,6 @@     , takeWhileLast     , takeWhileAround     , drop-    , dropInterval     , dropLast     , dropLastInterval     , dropWhile@@ -109,10 +109,10 @@     -- Element agnostic (Opposite of sampling)     , intersperse     , intersperseM -- XXX naming-    , intersperseBySpan+    , intersperseMWith -    , intersperseSuffix-    , intersperseSuffixBySpan+    , intersperseMSuffix+    , intersperseMSuffixWith     , interjectSuffix      -- , interspersePrefix@@ -121,9 +121,9 @@     -- * Inserting Side Effects/Time     , intersperseM_ -- XXX naming     , delay-    , intersperseSuffix_+    , intersperseMSuffix_     , delayPost-    , interspersePrefix_+    , intersperseMPrefix_     , delayPre      -- * Element Aware Insertion@@ -156,6 +156,7 @@     -- | Map using the previous element.     , rollingMapM     , rollingMap+    , rollingMap2      -- * Maybe Streams     -- Move these to Streamly.Data.Maybe.Stream?@@ -214,15 +215,13 @@  import Control.Concurrent (threadDelay) import Control.Monad (void)-import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (MonadTrans(..))-import Data.Either (isLeft, isRight)+import Data.Either (isLeft, isRight, fromLeft, fromRight) import Data.Kind (Type) import Data.Maybe (isJust, fromJust)-import Streamly.Internal.BaseCompat (fromLeft, fromRight)-import Streamly.Internal.Data.Fold.Type (Fold (..))-import Streamly.Internal.Data.Pipe.Type (Pipe (..))+import Streamly.Internal.Data.Fold (Fold (..))+import Streamly.Internal.Data.Pipe (Pipe (..)) import Streamly.Internal.Data.Stream.IsStream.Combinators       ( inspectMode, maxBuffer, maxThreads, rate, avgRate, minRate       , maxRate, constRate)@@ -236,6 +235,7 @@     , reverse     , reverse'     , scanlMAfter'+    , postscanlMAfter'     , smapM     , take     , takeWhile@@ -247,24 +247,25 @@     ) import Streamly.Internal.Control.Concurrent (MonadAsync) import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream(..), fromStreamS, toStreamS, fromStreamD, toStreamD, toConsK)+    (IsStream(..), fromStreamD, toStreamD, toConsK) import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.SVar (Rate(..))-import Streamly.Internal.Data.Time.Units (TimeUnit64, AbsTime, RelTime64)+import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64) -import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Data.Fold as FL+import qualified Streamly.Internal.Data.Stream.Concurrent as Concur import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Stream.StreamD as D-#if __GLASGOW_HASKELL__ == 802-import qualified Streamly.Internal.Data.Stream.StreamK as K-#endif-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-#ifdef USE_STREAMK_ONLY-import qualified Streamly.Internal.Data.Stream.StreamK as S-#else-import qualified Streamly.Internal.Data.Stream.StreamD as S-#endif+import qualified Streamly.Internal.Data.Stream as D+    (pipe, foldrT, tap, tapOffsetEvery, mapM, scan+    , scanMany, postscan, scanlx', scanlM', scanl', postscanl', prescanl'+    , prescanlM', scanl1M', scanl1', filter, filterM, uniq, deleteBy, takeWhileM+    , dropWhile, dropWhileM, insertBy, intersperse+    , intersperseM_, intersperseMSuffix, intersperseMSuffix_+    , intersperseMSuffixWith, indexed, indexedR, rollingMap, rollingMapM+    , rollingMap2, mapMaybe, mapMaybeM)+import qualified Streamly.Internal.Data.StreamK as K+    (foldrS, foldrSShared, mapMWith) import qualified Prelude  import Prelude hiding@@ -274,6 +275,7 @@ -- -- $setup -- >>> :m+-- >>> :set -fno-warn-deprecations -- >>> import Control.Concurrent (threadDelay) -- >>> import Data.Function ((&)) -- >>> import Streamly.Prelude ((|$))@@ -296,7 +298,7 @@ -- {-# INLINE transform #-} transform :: (IsStream t, Monad m) => Pipe m a b -> t m a -> t m b-transform pipe xs = fromStreamD $ D.transform pipe (toStreamD xs)+transform p xs = fromStreamD $ D.pipe p (toStreamD xs)  ------------------------------------------------------------------------------ -- Transformation Folds@@ -316,7 +318,7 @@ -- -- Find if any element in the stream is 'True': ----- >>> Stream.toList $ Stream.foldrS (\x xs -> if odd x then return True else xs) (return False) $ (Stream.fromList (2:4:5:undefined) :: Stream.SerialT IO Int)+-- >>> Stream.toList $ Stream.foldrS (\x xs -> if odd x then (Stream.fromPure True) else xs) (Stream.fromPure False) $ (Stream.fromList (2:4:5:undefined) :: Stream.SerialT IO Int) -- [True] -- -- Map (+2) on odd elements and filter out the even elements:@@ -362,7 +364,7 @@ {-# INLINE foldrT #-} foldrT :: (IsStream t, Monad m, Monad (s m), MonadTrans s)     => (a -> s m b -> s m b) -> s m b -> t m a -> s m b-foldrT f z s = S.foldrT f z (toStreamS s)+foldrT f z s = D.foldrT f z (toStreamD s)  ------------------------------------------------------------------------------ -- Transformation by Mapping@@ -511,6 +513,7 @@ -- parent stream, but we guarantee that before the parent stream stops the tap -- finishes and all exceptions from it are drained. --+-- >>> tapAsync f = Stream.tapAsyncK (Stream.fold f . Stream.adapt) -- -- Compare with 'tap'. --@@ -519,37 +522,18 @@ tapAsync :: (IsStream t, MonadAsync m) => FL.Fold m a b -> t m a -> t m a tapAsync f xs = fromStreamD $ Par.tapAsyncF f (toStreamD xs) --- | Redirect a copy of the stream to a supplied fold and run it concurrently--- in an independent thread. The fold may buffer some elements. The buffer size--- is determined by the prevailing 'Streamly.Prelude.maxBuffer' setting.------ @---               Stream m a -> m b---                       |--- -----stream m a ---------------stream m a----------- @------ @--- > S.drain $ S.tapAsync (S.mapM_ print) (S.enumerateFromTo 1 2)--- 1--- 2--- @------ Exceptions from the concurrently running fold are propagated to the current--- computation.  Note that, because of buffering in the fold, exceptions may be--- delayed and may not correspond to the current element being processed in the--- parent stream, but we guarantee that before the parent stream stops the tap--- finishes and all exceptions from it are drained.--------- Compare with 'tap'.+-- XXX We should keep only tapAsyncK as tapAsync can be implemented in terms+-- of tapAsyncK and it has better performance. Rename this to tapAsync.++-- | Like 'tapAsyncF' but uses a stream fold function instead of a 'Fold' type. -- -- /Pre-release/ {-# INLINE tapAsyncK #-} tapAsyncK :: (IsStream t, MonadAsync m) => (t m a -> m b) -> t m a -> t m a tapAsyncK f m = fromStream $ Par.tapAsyncK (f . fromStream) (toStream m) +-- XXX rename this to tapManyAsync_?+-- -- | Concurrently distribute a stream to a collection of fold functions, -- discarding the outputs of the folds. --@@ -594,52 +578,21 @@ pollCounts ::        (IsStream t, MonadAsync m)     => (a -> Bool)-    -> (t m Int -> t m Int)-    -> Fold m Int b+    -> (t m Int -> m b)     -> t m a     -> t m a-pollCounts predicate transf f xs =+pollCounts predicate f xs =       fromStreamD-    $ D.pollCounts predicate (toStreamD . transf . fromStreamD) f+    $ Concur.parTapCount predicate (f . fromStreamD)     $ toStreamD xs --- | Calls the supplied function with the number of elements consumed--- every @n@ seconds. The given function is run in a separate thread--- until the end of the stream. In case there is an exception in the--- stream the thread is killed during the next major GC.------ Note: The action is not guaranteed to run if the main thread exits.------ @--- > delay n = threadDelay (round $ n * 1000000) >> return n--- > Stream.toList $ Stream.tapRate 2 (\n -> print $ show n ++ " elements processed") (delay 1 Stream.|: delay 0.5 Stream.|: delay 0.5 Stream.|: Stream.nil)--- "2 elements processed"--- [1.0,0.5,0.5]--- "1 elements processed"--- @------ Note: This may not work correctly on 32-bit machines.------ /Pre-release/-{-# INLINE tapRate #-}-tapRate ::-       (IsStream t, MonadAsync m, MonadCatch m)-    => Double-    -> (Int -> m b)-    -> t m a-    -> t m a-tapRate n f xs = fromStreamD $ D.tapRate n f $ toStreamD xs- -- | Apply a monadic function to each element flowing through the stream and -- discard the results. ----- @ -- >>> Stream.drain $ Stream.trace print (Stream.enumerateFromTo 1 2) -- 1 -- 2 ----- @--- -- Compare with 'tap'. -- -- @since 0.7.0@@ -657,7 +610,7 @@ -- -- @ ----- Same as 'interspersePrefix_' but always serial.+-- Same as 'intersperseMPrefix_' but always serial. -- -- See also: 'trace' --@@ -678,9 +631,16 @@ -- @since 0.7.0 {-# INLINE scan #-} scan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b--- scan = P.scanOnce-scan fld m = fromStreamD $ D.scanOnce fld $ toStreamD m+scan fld m = fromStreamD $ D.scan fld $ toStreamD m +-- | Like 'scan' but restarts scanning afresh when the scanning fold+-- terminates.+--+-- /Pre-release/+{-# INLINE scanMany #-}+scanMany :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b+scanMany fld m = fromStreamD $ D.scanMany fld $ toStreamD m+ -- | Postscan a stream using the given monadic fold. -- -- The following example extracts the input stream up to a point where the@@ -699,7 +659,7 @@ -- @since 0.7.0 {-# INLINE postscan #-} postscan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b-postscan fld = fromStreamD . D.postscanOnce fld . toStreamD+postscan fld = fromStreamD . D.postscan fld . toStreamD  ------------------------------------------------------------------------------ -- Scanning - Transformation by Folding@@ -726,7 +686,7 @@ {-# DEPRECATED scanx "Please use scanl followed by map instead." #-} {-# INLINE scanx #-} scanx :: (IsStream t, Monad m) => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b-scanx step begin done = fromStreamS . S.scanlx' step begin done . toStreamS+scanx step begin done = fromStreamD . D.scanlx' step begin done . toStreamD  -- XXX this needs to be concurrent -- XXX because of the use of D.cons for appending, scanlM' has quadratic@@ -796,6 +756,7 @@ -- lazy expressions inside the accumulator, it is recommended that a strict -- data structure is used for accumulator. --+-- >>> scanl' step z = scan (Fold.foldl' step z) -- >>> scanl' f z xs = scanlM' (\a b -> return (f a b)) (return z) xs -- >>> scanl' f z xs = z `Stream.cons` postscanl' f z xs --@@ -804,10 +765,11 @@ -- @since 0.2.0 {-# INLINE scanl' #-} scanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b-scanl' step z m = fromStreamS $ S.scanl' step z $ toStreamS m+scanl' step z m = fromStreamD $ D.scanl' step z $ toStreamD m  -- | Like 'scanl'' but does not stream the initial value of the accumulator. --+-- >>> postscanl' step z = postscan (Fold.foldl' step z) -- >>> postscanl' f z = postscanlM' (\a b -> return (f a b)) (return z) -- >>> postscanl' f z xs = Stream.drop 1 $ Stream.scanl' f z xs --@@ -883,14 +845,8 @@ -- -- @since 0.1.0 {-# INLINE filter #-}-#if __GLASGOW_HASKELL__ != 802--- GHC 8.2.2 crashes with this code, when used with "stack" filter :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a-filter p m = fromStreamS $ S.filter p $ toStreamS m-#else-filter :: IsStream t => (a -> Bool) -> t m a -> t m a-filter p m = fromStream $ K.filter p $ toStream m-#endif+filter p m = fromStreamD $ D.filter p $ toStreamD m  -- | Same as 'filter' but with a monadic predicate. --@@ -921,9 +877,15 @@ {-# INLINE uniqBy #-} uniqBy :: (IsStream t, Monad m, Functor (t m)) =>     (a -> a -> Bool) -> t m a -> t m a-uniqBy eq =-    catMaybes . rollingMap (\x y -> if x `eq` y then Nothing else Just y)+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. -- -- @since 0.6.0@@ -984,17 +946,6 @@     (a -> a -> Bool) -> t m a -> t m a nubBy = undefined -- fromStreamD . D.nubBy . toStreamD --- | Drop repeated elements within the specified tumbling window in the stream.------ @nubBy = nubWindowBy maxBound@------ /Unimplemented/----{-# INLINE nubWindowBy #-}-nubWindowBy :: -- (IsStream t, Monad m) =>-    Int -> (a -> a -> Bool) -> t m a -> t m a-nubWindowBy = undefined -- fromStreamD . D.nubWithinBy . toStreamD- -- | Deletes the first occurrence of the element in the stream that satisfies -- the given equality predicate. --@@ -1007,7 +958,7 @@ -- @since 0.6.0 {-# INLINE deleteBy #-} deleteBy :: (IsStream t, Monad m) => (a -> a -> Bool) -> a -> t m a -> t m a-deleteBy cmp x m = fromStreamS $ S.deleteBy cmp x (toStreamS m)+deleteBy cmp x m = fromStreamD $ D.deleteBy cmp x (toStreamD m)  ------------------------------------------------------------------------------ -- Lossy Buffering@@ -1110,33 +1061,13 @@     (a -> Bool) -> t m a -> t m a takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m --- | @takeInterval duration@ yields stream elements upto specified time--- @duration@. The duration starts when the stream is evaluated for the first--- time, before the first element is yielded. The time duration is checked--- before generating each element, if the duration has expired the stream--- stops.------ The total time taken in executing the stream is guaranteed to be /at least/--- @duration@, however, because the duration is checked before generating an--- element, the upper bound is indeterminate and depends on the time taken in--- generating and processing the last element.------ No element is yielded if the duration is zero. At least one element is--- yielded if the duration is non-zero.------ /Pre-release/----{-# INLINE takeInterval #-}-takeInterval ::(MonadIO m, IsStream t, TimeUnit64 d) => d -> t m a -> t m a-takeInterval d = fromStreamD . D.takeByTime d . toStreamD- -- | Drop elements in the stream as long as the predicate succeeds and then -- take the rest of the stream. -- -- @since 0.1.0 {-# INLINE dropWhile #-} dropWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a-dropWhile p m = fromStreamS $ S.dropWhile p $ toStreamS m+dropWhile p m = fromStreamD $ D.dropWhile p $ toStreamD m  -- | Same as 'dropWhile' but with a monadic predicate. --@@ -1145,24 +1076,6 @@ dropWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m --- | @dropInterval duration@ drops stream elements until specified @duration@ has--- passed.  The duration begins when the stream is evaluated for the first--- time. The time duration is checked /after/ generating a stream element, the--- element is yielded if the duration has expired otherwise it is dropped.------ The time elapsed before starting to generate the first element is /at most/--- @duration@, however, because the duration expiry is checked after the--- element is generated, the lower bound is indeterminate and depends on the--- time taken in generating an element.------ All elements are yielded if the duration is zero.------ /Pre-release/----{-# INLINE dropInterval #-}-dropInterval ::(MonadIO m, IsStream t, TimeUnit64 d) => d -> t m a -> t m a-dropInterval d = fromStreamD . D.dropByTime d . toStreamD- -- | Drop @n@ elements at the end of the stream. -- -- O(n) space, where n is the number elements dropped.@@ -1225,7 +1138,7 @@ {-# INLINE insertBy #-} insertBy ::        (IsStream t, Monad m) => (a -> a -> Ordering) -> a -> t m a -> t m a-insertBy cmp x m = fromStreamS $ S.insertBy cmp x (toStreamS m)+insertBy cmp x m = fromStreamD $ D.insertBy cmp x (toStreamD m)  -- | Insert a pure value between successive elements of a stream. --@@ -1235,7 +1148,7 @@ -- @since 0.7.0 {-# INLINE intersperse #-} intersperse :: (IsStream t, MonadAsync m) => a -> t m a -> t m a-intersperse a = fromStreamS . S.intersperse a . toStreamS+intersperse a = fromStreamD . D.intersperse a . toStreamD  -- | Insert a side effect before consuming an element of a stream except the -- first one.@@ -1252,60 +1165,60 @@ -- elements. -- -- @--- > Stream.toList $ Stream.intersperseBySpan 2 (return ',') $ Stream.fromList "hello"+-- > Stream.toList $ Stream.intersperseMWith 2 (return ',') $ Stream.fromList "hello" -- "he,ll,o" -- -- @ -- -- /Unimplemented/-{-# INLINE intersperseBySpan #-}-intersperseBySpan :: -- IsStream t =>+{-# INLINE intersperseMWith #-}+intersperseMWith :: -- IsStream t =>     Int -> m a -> t m a -> t m a-intersperseBySpan _n _f _xs = undefined+intersperseMWith _n _f _xs = undefined  -- | Insert an effect and its output after consuming an element of a stream. ----- >>> Stream.toList $ Stream.trace putChar $ intersperseSuffix (putChar '.' >> return ',') $ Stream.fromList "hello"+-- >>> Stream.toList $ Stream.trace putChar $ intersperseMSuffix (putChar '.' >> return ',') $ Stream.fromList "hello" -- h.,e.,l.,l.,o.,"h,e,l,l,o," -- -- /Pre-release/-{-# INLINE intersperseSuffix #-}-intersperseSuffix :: (IsStream t, Monad m) => m a -> t m a -> t m a-intersperseSuffix m = fromStreamD . D.intersperseSuffix m . toStreamD+{-# INLINE intersperseMSuffix #-}+intersperseMSuffix :: (IsStream t, Monad m) => m a -> t m a -> t m a+intersperseMSuffix m = fromStreamD . D.intersperseMSuffix m . toStreamD  -- | Insert a side effect after consuming an element of a stream. -- -- @--- >>> Stream.mapM_ putChar $ Stream.intersperseSuffix_ (threadDelay 1000000) $ Stream.fromList "hello"+-- >>> Stream.mapM_ putChar $ Stream.intersperseMSuffix_ (threadDelay 1000000) $ Stream.fromList "hello" -- hello -- -- @ -- -- /Pre-release/ ---{-# INLINE intersperseSuffix_ #-}-intersperseSuffix_ :: (IsStream t, Monad m) => m b -> t m a -> t m a-intersperseSuffix_ m = fromStreamD . D.intersperseSuffix_ m . toStreamD+{-# INLINE intersperseMSuffix_ #-}+intersperseMSuffix_ :: (IsStream t, Monad m) => m b -> t m a -> t m a+intersperseMSuffix_ m = fromStreamD . D.intersperseMSuffix_ m . toStreamD  -- XXX Use an offset argument, like tapOffsetEvery ----- | Like 'intersperseSuffix' but intersperses an effectful action into the+-- | Like 'intersperseMSuffix' but intersperses an effectful action into the -- input stream after every @n@ elements and after the last element. ----- >>> Stream.toList $ Stream.intersperseSuffixBySpan 2 (return ',') $ Stream.fromList "hello"+-- >>> Stream.toList $ Stream.intersperseMSuffixWith 2 (return ',') $ Stream.fromList "hello" -- "he,ll,o," -- -- /Pre-release/ ---{-# INLINE intersperseSuffixBySpan #-}-intersperseSuffixBySpan :: (IsStream t, Monad m)+{-# INLINE intersperseMSuffixWith #-}+intersperseMSuffixWith :: (IsStream t, Monad m)     => Int -> m a -> t m a -> t m a-intersperseSuffixBySpan n eff =-    fromStreamD . D.intersperseSuffixBySpan n eff . toStreamD+intersperseMSuffixWith n eff =+    fromStreamD . D.intersperseMSuffixWith n eff . toStreamD  -- | Insert a side effect before consuming an element of a stream. ----- >>> Stream.toList $ Stream.trace putChar $ Stream.interspersePrefix_ (putChar '.' >> return ',') $ Stream.fromList "hello"+-- >>> Stream.toList $ Stream.trace putChar $ Stream.intersperseMPrefix_ (putChar '.' >> return ',') $ Stream.fromList "hello" -- .h.e.l.l.o"hello" -- -- Same as 'trace_' but may be concurrent.@@ -1314,9 +1227,9 @@ -- -- /Pre-release/ ---{-# INLINE interspersePrefix_ #-}-interspersePrefix_ :: (IsStream t, MonadAsync m) => m b -> t m a -> t m a-interspersePrefix_ m = mapM (\x -> void m >> return x)+{-# INLINE intersperseMPrefix_ #-}+intersperseMPrefix_ :: (IsStream t, MonadAsync m) => m b -> t m a -> t m a+intersperseMPrefix_ m = mapM (\x -> void m >> return x)  ------------------------------------------------------------------------------ -- Inserting Time@@ -1352,7 +1265,7 @@ -- {-# INLINE delayPost #-} delayPost :: (IsStream t, MonadIO m) => Double -> t m a -> t m a-delayPost n = intersperseSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000+delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000  -- Note: delay must be serial, that's why 'trace_' is used. --@@ -1511,15 +1424,15 @@ -- 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. If the--- stream consists of a single element the output is an empty stream.------ This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.+-- | 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 :: (IsStream t, Monad m) => (a -> a -> b) -> t m a -> t m b+rollingMap :: (IsStream t, Monad m) => (Maybe a -> a -> b) -> t m a -> t m b rollingMap f m = fromStreamD $ D.rollingMap f $ toStreamD m  -- | Like 'rollingMap' but with an effectful map function.@@ -1527,9 +1440,20 @@ -- /Pre-release/ -- {-# INLINE rollingMapM #-}-rollingMapM :: (IsStream t, Monad m) => (a -> a -> m b) -> t m a -> t m b+rollingMapM :: (IsStream t, Monad m) => (Maybe a -> a -> m b) -> t m a -> t m b 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 :: (IsStream t, Monad m) => (a -> a -> b) -> t m a -> t m b+rollingMap2 f m = fromStreamD $ D.rollingMap2 f $ toStreamD m+ ------------------------------------------------------------------------------ -- Maybe Streams ------------------------------------------------------------------------------@@ -1546,7 +1470,7 @@ -- @since 0.3.0 {-# INLINE mapMaybe #-} mapMaybe :: (IsStream t, Monad m) => (a -> Maybe b) -> t m a -> t m b-mapMaybe f m = fromStreamS $ S.mapMaybe f $ toStreamS m+mapMaybe f m = fromStreamD $ D.mapMaybe f $ toStreamD m  -- | Like 'mapMaybe' but maps a monadic function. --
src/Streamly/Internal/Data/Stream/IsStream/Type.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -10,18 +11,17 @@ -- Portability : GHC -- ---module Streamly.Internal.Data.Stream.IsStream.Type+module Streamly.Internal.Data.Stream.IsStream.Type {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}     (     -- * IsStream Type Class       IsStream (..)-    , K.Stream (..)-    , Streaming+    , K.StreamK (..)      -- * Type Conversion-    , fromStreamS-    , toStreamS     , fromStreamD     , toStreamD+    , toStreamK+    , fromStreamK     , adapt     , toConsK @@ -89,9 +89,7 @@     , toList      -- * Fold operations-    , foldrM     , foldrMx-    , foldr      , foldlx'     , foldlMx'@@ -101,23 +99,18 @@     -- * Zip style operations     , eqBy     , cmpBy--    -- * Deprecated-    , interleaving-    , zipping-    , zippingAsync     ) where  import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Fold.Type (Fold (..))+import Streamly.Internal.Data.Fold (Fold (..)) import Streamly.Internal.Data.Stream.Serial-    (SerialT(..), Serial, WSerialT(..), WSerial)+    (SerialT, Serial, WSerialT(..), WSerial) import Streamly.Internal.Data.Stream.Async     (AsyncT(..), Async, WAsyncT(..), WAsync) import Streamly.Internal.Data.Stream.Ahead (AheadT(..), Ahead) import Streamly.Internal.Data.Stream.Parallel (ParallelT(..), Parallel)-import Streamly.Internal.Data.Stream.Zip (ZipSerialM(..), ZipSerial)+import Streamly.Internal.Data.Stream.Zip (ZipSerialM, ZipSerial) import Streamly.Internal.Data.Stream.ZipAsync (ZipAsyncM(..), ZipAsync) import Streamly.Internal.Data.SVar.Type (State, adaptState) @@ -126,22 +119,24 @@ import qualified Streamly.Internal.Data.Stream.Async as Async import qualified Streamly.Internal.Data.Stream.Parallel as Parallel import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-#ifdef USE_STREAMK_ONLY-import qualified Streamly.Internal.Data.Stream.StreamK as S-import qualified Streamly.Internal.Data.Stream.StreamK.Type as S-#else-import qualified Streamly.Internal.Data.Stream.StreamD.Type as S-#endif+import qualified Streamly.Internal.Data.Stream as D+    (Stream(..), toStreamK, fromStreamK+    , drain, eqBy, cmpBy, fromList, toList, foldrMx, foldlMx'+    , foldlx', foldl', fold)+import qualified Streamly.Internal.Data.StreamK as K+    (StreamK(..), cons, fromEffect+    , nil, fromPure, bindWith, drain+    , fromFoldable, nilM, repeat)+import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Streamly.Internal.Data.Stream.Serial as Stream+    (fromStreamK, toStreamK) import qualified Streamly.Internal.Data.Stream.Zip as Zip import qualified Streamly.Internal.Data.Stream.ZipAsync as ZipAsync -import Prelude hiding (foldr, repeat)+import Prelude hiding (Foldable(..), repeat)+import Data.Foldable (Foldable)  #include "inline.hs"-#define USE_IS_STREAM-#include "PreludeCommon.hs"  ------------------------------------------------------------------------------ -- Types that can behave as a Stream@@ -160,16 +155,14 @@ -- -- @since 0.8.0 class-#if __GLASGOW_HASKELL__ >= 806     ( forall m a. MonadAsync m => Semigroup (t m a)     , forall m a. MonadAsync m => Monoid (t m a)     , forall m. Monad m => Functor (t m)     , forall m. MonadAsync m => Applicative (t m)     ) =>-#endif       IsStream t where-    toStream :: t m a -> K.Stream m a-    fromStream :: K.Stream m a -> t m a+    toStream :: t m a -> K.StreamK m a+    fromStream :: K.StreamK m a -> t m a     -- | Constructs a stream by adding a monadic action at the head of an     -- existing stream. For example:     --@@ -207,16 +200,18 @@     -- We can define (|:) just as 'consM' but it is defined explicitly for each     -- type because we want to use SPECIALIZE pragma on the definition. --- | Same as 'IsStream'.------ @since 0.1.0-{-# DEPRECATED Streaming "Please use IsStream instead." #-}-type Streaming = IsStream- ------------------------------------------------------------------------------- -- Type adapting combinators ------------------------------------------------------------------------------- +{-# INLINE toStreamK #-}+toStreamK :: IsStream t => t m a -> StreamK.StreamK m a+toStreamK = toStream++{-# INLINE fromStreamK #-}+fromStreamK :: IsStream t => StreamK.StreamK m a -> t m a+fromStreamK = fromStream+ -- XXX Move/reset the State here by reconstructing the stream with cleared -- state. Can we make sure we do not do that when t1 = t2? If we do this then -- we do not need to do that explicitly using svarStyle.  It would act as@@ -231,16 +226,81 @@ adapt = fromStream . toStream  {-# INLINE fromStreamD #-}-fromStreamD :: (IS_STREAM Monad m) => D.Stream m a -> STREAM m a-fromStreamD = FROM_STREAM . D.toStreamK+fromStreamD :: (IsStream t, Monad m) => D.Stream m a -> t m a+fromStreamD = fromStream . D.toStreamK  -- | Adapt a polymorphic consM operation to a StreamK cons operation {-# INLINE toConsK #-} toConsK :: IsStream t =>-    (m a -> t m a -> t m a) -> m a -> K.Stream m a -> K.Stream m a+    (m a -> t m a -> t m a) -> m a -> K.StreamK m a -> K.StreamK m a toConsK cns x xs = toStream $ x `cns` fromStream xs  ------------------------------------------------------------------------------+-- Conversion to and from direct style stream+------------------------------------------------------------------------------++{-# INLINE toStreamD #-}+toStreamD :: (IsStream t, Monad m) => t m a -> D.Stream m a+toStreamD = D.fromStreamK . toStream++------------------------------------------------------------------------------+-- Elimination+------------------------------------------------------------------------------++{-# INLINE_EARLY drain #-}+drain :: (IsStream t, Monad m) => t m a -> m ()+drain m = D.drain $ D.fromStreamK (toStream m)+{-# RULES "drain fallback to CPS" [1]+    forall a. D.drain (D.fromStreamK a) = K.drain a #-}++------------------------------------------------------------------------------+-- Comparison+------------------------------------------------------------------------------++-- | Compare two streams for equality+--+-- @since 0.5.3+{-# INLINE eqBy #-}+eqBy :: (IsStream t, Monad m) =>+    (a -> b -> Bool) -> t m a -> t m b -> m Bool+eqBy f m1 m2 = D.eqBy f (toStreamD m1) (toStreamD m2)++-- | Compare two streams+--+-- @since 0.5.3+{-# INLINE cmpBy #-}+cmpBy+    :: (IsStream t, Monad m)+    => (a -> b -> Ordering) -> t m a -> t m b -> m Ordering+cmpBy f m1 m2 = D.cmpBy f (toStreamD m1) (toStreamD m2)++------------------------------------------------------------------------------+-- List 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.+--+-- @since 0.4.0+{-# INLINE_EARLY fromList #-}+fromList :: (Monad m, IsStream t) => [a] -> t m a+fromList = fromStreamD . 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.+--+-- @since 0.1.0+{-# INLINE toList #-}+toList :: (IsStream t, Monad m) => t m a -> m [a]+toList m = D.toList $ toStreamD m++------------------------------------------------------------------------------ -- Building a stream ------------------------------------------------------------------------------ @@ -258,7 +318,7 @@ -- continuation and a yield continuation. {-# INLINE_EARLY mkStream #-} mkStream :: IsStream t-    => (forall r. State K.Stream m a+    => (forall r. State K.StreamK m a         -> (a -> t m a -> m r)         -> (a -> m r)         -> m r@@ -270,8 +330,8 @@  {-# RULES "mkStream from stream" mkStream = mkStreamFromStream #-} mkStreamFromStream :: IsStream t-    => (forall r. State K.Stream m a-        -> (a -> K.Stream m a -> m r)+    => (forall r. State K.StreamK m a+        -> (a -> K.StreamK m a -> m r)         -> (a -> m r)         -> m r         -> m r)@@ -280,15 +340,57 @@  {-# RULES "mkStream stream" mkStream = mkStreamStream #-} mkStreamStream-    :: (forall r. State K.Stream m a-        -> (a -> K.Stream m a -> m r)+    :: (forall r. State K.StreamK m a+        -> (a -> K.StreamK m a -> m r)         -> (a -> m r)         -> m r         -> m r)-    -> K.Stream m a+    -> K.StreamK m a mkStreamStream = K.MkStream  ------------------------------------------------------------------------------+-- Folds+------------------------------------------------------------------------------++{-# INLINE foldrMx #-}+foldrMx :: (IsStream t, Monad m)+    => (a -> m x -> m x) -> m x -> (m x -> m b) -> t m a -> m b+foldrMx step final project m = D.foldrMx step final project $ toStreamD m++-- | Like 'foldlx'', but with a monadic step function.+--+-- @since 0.7.0+{-# INLINE foldlMx' #-}+foldlMx' ::+    (IsStream t, Monad m)+    => (x -> a -> m x) -> m x -> (x -> m b) -> t m a -> m b+foldlMx' step begin done m = D.foldlMx' step begin done $ toStreamD m++-- | 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.+--+-- @since 0.7.0+{-# INLINE foldlx' #-}+foldlx' ::+    (IsStream t, Monad m) => (x -> a -> x) -> x -> (x -> b) -> t m a -> m b+foldlx' step begin done m = D.foldlx' step begin done $ toStreamD m++-- | Strict left associative fold.+--+-- @since 0.2.0+{-# INLINE foldl' #-}+foldl' ::+    (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> m b+foldl' step begin m = D.foldl' step begin $ toStreamD m+++{-# INLINE fold #-}+fold :: (IsStream t, Monad m) => Fold m a b -> t m a -> m b+fold fld m = D.fold fld $ toStreamD m++------------------------------------------------------------------------------ -- Folding a stream ------------------------------------------------------------------------------ @@ -298,7 +400,7 @@ {-# INLINE_EARLY foldStreamShared #-} foldStreamShared     :: IsStream t-    => State K.Stream m a+    => State K.StreamK m a     -> (a -> t m a -> m r)     -> (a -> m r)     -> m r@@ -313,11 +415,11 @@ {-# RULES "foldStreamShared from stream"    foldStreamShared = foldStreamSharedStream #-} foldStreamSharedStream-    :: State K.Stream m a-    -> (a -> K.Stream m a -> m r)+    :: State K.StreamK m a+    -> (a -> K.StreamK m a -> m r)     -> (a -> m r)     -> m r-    -> K.Stream m a+    -> K.StreamK m a     -> m r foldStreamSharedStream st yld sng stp m =     let K.MkStream k = m@@ -329,7 +431,7 @@ {-# INLINE foldStream #-} foldStream     :: IsStream t-    => State K.Stream m a+    => State K.StreamK m a     -> (a -> t m a -> m r)     -> (a -> m r)     -> m r@@ -353,8 +455,8 @@ fromSerial = adapt  instance IsStream SerialT where-    toStream = getSerialT-    fromStream = SerialT+    toStream = Stream.toStreamK+    fromStream = Stream.fromStreamK      {-# INLINE consM #-}     {-# SPECIALIZE consM :: IO a -> SerialT IO a -> SerialT IO a #-}@@ -372,13 +474,6 @@ fromWSerial :: IsStream t => WSerialT m a -> t m a fromWSerial = adapt --- | Same as 'fromWSerial'.------ @since 0.1.0-{-# DEPRECATED interleaving "Please use fromWSerial instead." #-}-interleaving :: IsStream t => WSerialT m a -> t m a-interleaving = fromWSerial- instance IsStream WSerialT where     toStream = getWSerialT     fromStream = WSerialT@@ -489,6 +584,10 @@ -- Zip ------------------------------------------------------------------------------- +consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a+consMZip m (Zip.ZipSerialM r) =+    Zip.ZipSerialM $ StreamK.consM m r+ -- | Fix the type of a polymorphic stream as 'ZipSerialM'. -- -- /Since: 0.2.0 ("Streamly")/@@ -496,27 +595,19 @@ -- @since 0.8.0 fromZipSerial :: IsStream t => ZipSerialM m a -> t m a fromZipSerial = adapt---- | Same as 'fromZipSerial'.------ @since 0.1.0-{-# DEPRECATED zipping "Please use fromZipSerial instead." #-}-zipping :: IsStream t => ZipSerialM m a -> t m a-zipping = fromZipSerial- instance IsStream ZipSerialM where-    toStream = getZipSerialM-    fromStream = ZipSerialM+    toStream = Zip.getZipSerialM+    fromStream = Zip.ZipSerialM      {-# INLINE consM #-}     {-# SPECIALIZE consM :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}     consM :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a-    consM = Zip.consMZip+    consM = consMZip      {-# INLINE (|:) #-}     {-# SPECIALIZE (|:) :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}     (|:) :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a-    (|:) = Zip.consMZip+    (|:) = consMZip  -- | Fix the type of a polymorphic stream as 'ZipAsyncM'. --@@ -526,13 +617,6 @@ fromZipAsync :: IsStream t => ZipAsyncM m a -> t m a fromZipAsync = adapt --- | Same as 'fromZipAsync'.------ @since 0.1.0-{-# DEPRECATED zippingAsync "Please use fromZipAsync instead." #-}-zippingAsync :: IsStream t => ZipAsyncM m a -> t m a-zippingAsync = fromZipAsync- instance IsStream ZipAsyncM where     toStream = getZipAsyncM     fromStream = ZipAsyncM@@ -666,8 +750,8 @@ -- Equivalent to: -- -- @--- concatForFoldableWith f xs g = Prelude.foldr (f . g) S.nil xs--- concatForFoldableWith f = flip (S.concatMapFoldableWith f)+-- concatForFoldableWith f xs g = Prelude.foldr (f . g) D.nil xs+-- concatForFoldableWith f = flip (D.concatMapFoldableWith f) -- @ -- -- /Since: 0.8.0 (Renamed forEachWith to concatForFoldableWith)/@@ -686,8 +770,8 @@ -- Equivalent to: -- -- @--- concatFoldableWith f = Prelude.foldr f S.nil--- concatFoldableWith f = S.concatMapFoldableWith f id+-- concatFoldableWith f = Prelude.foldr f D.nil+-- concatFoldableWith f = D.concatMapFoldableWith f id -- @ -- -- /Since: 0.8.0 (Renamed foldWith to concatFoldableWith)/
+ src/Streamly/Internal/Data/Stream/Lifted.hs view
@@ -0,0 +1,335 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Lifted+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Lifted+    (+      after+    , bracket+    , bracket3+    , finally+    , retry++    -- For IsStream module+    , afterD+    , bracket3D+    , retryD+    )+where++#include "inline.hs"++import Control.Exception (Exception, SomeException, mask_)+import Control.Monad.Catch (MonadCatch)+#ifdef USE_UNLIFTIO+import Control.Monad.IO.Unlift (MonadUnliftIO)+#else+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Control (MonadBaseControl)+#endif+import Data.Map.Strict (Map)+import GHC.Exts (inline)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, MonadAsync, withRunInIO)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.IOFinalizer.Lifted+    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)+import Streamly.Internal.Data.Stream (Step(..))++import qualified Control.Monad.Catch as MC+import qualified Data.Map.Strict as Map+import qualified Streamly.Internal.Data.Stream as D++-- $setup+-- >>> :m+-- >>> import qualified Streamly.Internal.Data.Stream.Lifted as Stream++-- XXX Implement in terms of the corresponding IO operation (gbracketIO).++data GbracketIOState s1 s2 v wref+    = GBracketIOInit+    | GBracketIONormal s1 v wref+    | GBracketIOException s2++{-# INLINE_NORMAL gbracket #-}+gbracket+    :: MonadRunInIO m+    => m c -- ^ before+    -> (c -> m d1) -- ^ on normal stop+    -> (c -> e -> D.Stream m b -> m (D.Stream m b)) -- ^ on exception+    -> (c -> m d2) -- ^ on GC without normal stop or exception+    -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)+    -> (c -> D.Stream m b) -- ^ stream generator+    -> D.Stream m b+gbracket bef aft onExc onGC ftry action =+    D.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) <- withRunInIO $ \run -> mask_ $ run $ do+            r <- bef+            ref <- newIOFinalizer (onGC r)+            return (r, ref)+        return $ Skip $ GBracketIONormal (action r) r ref++    step gst (GBracketIONormal (D.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 (D.Stream step1 s) v ref)+                Skip s ->+                    return $ Skip (GBracketIONormal (D.Stream step1 s) v ref)+                Stop ->+                    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 <-+                    clearingIOFinalizer ref (onExc v e (D.UnStream step1 st))+                return $ Skip (GBracketIOException stream)+    step gst (GBracketIOException (D.UnStream step1 st)) = do+        res <- step1 gst st+        case res of+            Yield x s ->+                return $ Yield x (GBracketIOException (D.Stream step1 s))+            Skip s    -> return $ Skip (GBracketIOException (D.Stream step1 s))+            Stop      -> return Stop++{-# INLINE_NORMAL bracket3D #-}+bracket3D :: (MonadAsync m, MonadCatch m) =>+       m b+    -> (b -> m c)+    -> (b -> m d)+    -> (b -> m e)+    -> (b -> D.Stream m a)+    -> D.Stream m a+bracket3D bef aft onExc onGC =+    gbracket+        bef+        aft+        (\a (e :: SomeException) _ -> onExc a >> MC.throwM e)+        onGC+        (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 'bracket' 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+--+-- @bracket3 before onStop onGC onException action@ runs @action@ using the+-- result of @before@. If the stream stops, @onStop@ action is executed, if the+-- stream is abandoned @onGC@ is executed, if the stream encounters an+-- exception @onException@ is executed.+--+-- The exception is not caught, it is rethrown.+--+-- /Pre-release/+{-# INLINE bracket3 #-}+bracket3 :: (MonadAsync m, MonadCatch m)+    => m b+    -> (b -> m c)+    -> (b -> m d)+    -> (b -> m e)+    -> (b -> Stream m a)+    -> Stream m a+bracket3 = bracket3D++-- | Run the alloc action @IO b@ with async exceptions disabled but keeping+-- blocking operations interruptible (see 'Control.Exception.mask').  Use the+-- output @b@ of the IO action as input to the function @b -> Stream m a@ to+-- generate an output stream.+--+-- @b@ is usually a resource under the IO monad, e.g. a file handle, that+-- requires a cleanup after use. The cleanup action @b -> m c@, runs whenever+-- (1) the stream ends normally, (2) due to a sync or async exception or, (3)+-- if it gets garbage collected after a partial lazy evaluation. The exception+-- is not caught, it is rethrown.+--+-- '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_'/+--+-- /Inhibits stream fusion/+--+{-# INLINE bracket #-}+bracket :: (MonadAsync m, MonadCatch m)+    => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a+bracket bef aft = bracket3 bef aft aft aft++-- | Run the action @m b@ whenever the stream @Stream m a@ stops normally,+-- aborts due to an exception or if it is garbage collected after a partial+-- lazy evaluation.+--+-- The semantics of running the action @m b@ are similar to the cleanup action+-- semantics described in 'bracket'.+--+-- >>> finally action xs = Stream.bracket (return ()) (const action) (const xs)+--+-- /See also 'finally_'/+--+-- /Inhibits stream fusion/+--+{-# INLINE finally #-}+finally :: (MonadAsync m, MonadCatch m) =>+    m b -> Stream m a -> Stream m a+finally action xs = bracket (return ()) (const action) (const xs)++{-# INLINE_NORMAL afterD #-}+afterD :: MonadRunInIO m+    => m b -> D.Stream m a -> D.Stream m a+afterD action (D.Stream step state) = D.Stream step' Nothing++    where++    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        ref <- 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++-- | Run the action @m b@ whenever the stream @Stream m a@ stops normally, or+-- if it is garbage collected after a partial lazy evaluation.+--+-- The semantics of the action @m b@ are similar to the semantics of cleanup+-- action in 'bracket'.+--+-- /See also 'after_'/+--+{-# INLINE after #-}+after ::+#ifdef USE_UNLIFTIO+    MonadUnliftIO m+#else+    (MonadIO m, MonadBaseControl IO m)+#endif+    => m b -> Stream m a -> Stream m a+after = afterD++data RetryState emap s1 s2+    = RetryWithMap emap s1+    | RetryDefault s2++-- | See 'Streamly.Internal.Data.Stream.retry'+--+{-# INLINE_NORMAL retryD #-}+retryD+    :: forall e m a. (Exception e, Ord e, MonadCatch m)+    => Map e Int+       -- ^ map from exception to retry count+    -> (e -> D.Stream m a)+       -- ^ default handler for those exceptions that are not in the map+    -> D.Stream m a+    -> D.Stream m a+retryD emap0 defaultHandler (D.Stream step0 state0) = D.Stream step state++    where++    state = RetryWithMap emap0 state0++    {-# INLINE_LATE step #-}+    step gst (RetryWithMap emap st) = do+        eres <- MC.try $ step0 gst st+        case eres of+            Left e -> handler e emap st+            Right res ->+                return+                    $ case res of+                          Yield x st1 -> Yield x $ RetryWithMap emap st1+                          Skip st1 -> Skip $ RetryWithMap emap st1+                          Stop -> Stop+    step gst (RetryDefault (D.UnStream step1 state1)) = do+        res <- step1 gst state1+        return+            $ case res of+                  Yield x st1 -> Yield x $ RetryDefault (D.Stream step1 st1)+                  Skip st1 -> Skip $ RetryDefault (D.Stream step1 st1)+                  Stop -> Stop++    {-# INLINE handler #-}+    handler e emap st =+        return+            $ Skip+            $ case Map.lookup e emap of+                  Just i+                      | i > 0 ->+                          let emap1 = Map.insert e (i - 1) emap+                           in RetryWithMap emap1 st+                      | otherwise -> RetryDefault $ defaultHandler e+                  Nothing -> RetryDefault $ defaultHandler e++-- | @retry@ takes 3 arguments+--+-- 1. A map @m@ whose keys are exceptions and values are the number of times to+-- retry the action given that the exception occurs.+--+-- 2. A handler @han@ that decides how to handle an exception when the exception+-- cannot be retried.+--+-- 3. The stream itself that we want to run this mechanism on.+--+-- When evaluating a stream if an exception occurs,+--+-- 1. The stream evaluation aborts+--+-- 2. The exception is looked up in @m@+--+--    a. If the exception exists and the mapped value is > 0 then,+--+--       i. The value is decreased by 1.+--+--       ii. The stream is resumed from where the exception was called, retrying+--       the action.+--+--    b. If the exception exists and the mapped value is == 0 then the stream+--    evaluation stops.+--+--    c. If the exception does not exist then we handle the exception using+--    @han@.+--+-- /Internal/+--+{-# INLINE retry #-}+retry :: (MonadCatch m, Exception e, Ord e)+    => Map e Int+       -- ^ map from exception to retry count+    -> (e -> Stream m a)+       -- ^ default handler for those exceptions that are not in the map+    -> Stream m a+    -> Stream m a+retry = retryD
+ src/Streamly/Internal/Data/Stream/MkType.hs view
@@ -0,0 +1,641 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.MkType+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Stream.MkType+    (+    -- * Imports for Examples+    -- $setup++    -- * Template Haskell Macros+      mkZipType+    , mkCrossType++    -- * Re-exports+    , MonadIO(..)+    , MonadThrow(..)+    , MonadReader(..)+    , MonadTrans(..)+    , ap+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Language.Haskell.TH.Lib+import Language.Haskell.TH.Syntax++import Control.Monad (ap)+import Control.Monad.Catch (MonadThrow(..))+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Reader.Class (MonadReader(..))+import Control.Monad.Trans.Class (MonadTrans(..))+import Prelude hiding (repeat)++-- $setup+-- >>> :m+-- >>> import Language.Haskell.TH+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream+-- >>> import Streamly.Internal.Data.Stream.MkType++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++{-# INLINE singleton #-}+singleton :: a -> [a]+singleton x = [x]++toTypeStr :: String -> String+toTypeStr typ = "mk" ++ typ++unTypeStr :: String -> String+unTypeStr typ = "un" ++ typ++--------------------------------------------------------------------------------+-- Names+--------------------------------------------------------------------------------++_m :: Name+_m = mkName "m"++_a :: Name+_a = mkName "a"++_r :: Name+_r = mkName "r"++_Stream :: Name+_Stream = mkName "Stream.Stream"++_fmap :: Name+_fmap = mkName "fmap"++_pure :: Name+_pure = mkName "pure"++_return :: Name+_return = mkName "return"++_strm :: Name+_strm = mkName "strm"++_strm1 :: Name+_strm1 = mkName "strm1"++_strm2 :: Name+_strm2 = mkName "strm2"++_Functor :: Name+_Functor = mkName "Functor"++_Applicative :: Name+_Applicative = mkName "Applicative"++_Monad :: Name+_Monad = mkName "Monad"++_MonadTrans :: Name+_MonadTrans = mkName "MonadTrans"++_MonadIO :: Name+_MonadIO = mkName "MonadIO"++_MonadThrow :: Name+_MonadThrow = mkName "MonadThrow"++_MonadReader :: Name+_MonadReader = mkName "MonadReader"++_lift :: Name+_lift = mkName "lift"++_ask :: Name+_ask = mkName "ask"++_local :: Name+_local = mkName "local"++_throwM :: Name+_throwM = mkName "throwM"++_liftIO :: Name+_liftIO = mkName "liftIO"++_f :: Name+_f = mkName "f"++_f1 :: Name+_f1 = mkName "f1"++_dotOp :: Name+_dotOp = mkName "."++_apOp :: Name+_apOp = mkName "<*>"++_bindOp :: Name+_bindOp = mkName ">>="++_IsList :: Name+_IsList = mkName "IsList"++_IsString :: Name+_IsString = mkName "IsString"++_Eq :: Name+_Eq = mkName "Eq"++_Ord :: Name+_Ord = mkName "Ord"++_Traversable :: Name+_Traversable = mkName "Traversable"++_Identity :: Name+_Identity = mkName "Identity"++_Read :: Name+_Read = mkName "Read"++_Show :: Name+_Show = mkName "Show"++_show :: Name+_show = mkName "show"++_readPrec :: Name+_readPrec = mkName "readPrec"++_Semigroup :: Name+_Semigroup = mkName "Semigroup"++_Monoid :: Name+_Monoid = mkName "Monoid"++_Foldable :: Name+_Foldable = mkName "Foldable"++--------------------------------------------------------------------------------+-- Simple derivations+--------------------------------------------------------------------------------++-- Requires TypeFamilies and UndecidableInstances+derivIsListIdent :: Name -> Q Dec+derivIsListIdent _Type =+    standaloneDerivD+        (pure [])+        (appT (conT _IsList) (foldl1 appT [conT _Type, conT _Identity, varT _a]))++derivIsStringIdent :: Name -> Q Dec+derivIsStringIdent _Type =+    standaloneDerivD+        (singleton <$> [t|$(varT _a) ~ Char|])+        (appT+             (conT _IsString)+             (foldl1 appT [conT _Type, conT _Identity, varT _a]))++derivEqIdent :: Name -> Q Dec+derivEqIdent _Type =+    standaloneDerivD+        (singleton <$> [t|Eq $(varT _a)|])+        (appT (conT _Eq) (foldl1 appT [conT _Type, conT _Identity, varT _a]))++derivOrdIdent :: Name -> Q Dec+derivOrdIdent _Type =+    standaloneDerivD+        (singleton <$> [t|Ord $(varT _a)|])+        (appT (conT _Ord) (foldl1 appT [conT _Type, conT _Identity, varT _a]))++{-+derivTraversableIdent :: Name -> Q Dec+derivTraversableIdent _Type =+    standaloneDerivD+        (pure [])+        (appT+             (conT _Traversable)+             (foldl1 appT [conT _Type, conT _Identity]))+-}++showInstance :: Name -> Q Dec+showInstance _Type =+    instanceD+        (singleton <$> appT (conT _Show) (varT _a))+        (appT (conT _Show) (foldl1 appT [conT _Type, conT _Identity, varT _a]))+        [ pragInlD _show Inline FunLike AllPhases+        , funD+              _show+              [ clause+                    [conP _Type [varP _strm]]+                    (normalB (appE (varE _show) (varE _strm)))+                    []+              ]+        ]++readInstance :: Name -> Q Dec+readInstance _Type =+    instanceD+        (singleton <$> appT (conT _Read) (varT _a))+        (appT (conT _Read) (foldl1 appT [conT _Type, conT _Identity, varT _a]))+        [ pragInlD _readPrec Inline FunLike AllPhases+        , funD+              _readPrec+              [ clause+                    []+                    (normalB+                        (foldl1 appE [varE _fmap, conE _Type, varE _readPrec])+                    )+                    []+              ]+        ]++functorInstance :: Name -> Q Dec+functorInstance _Type = do+    instanceD+        (pure <$> appT (conT _Monad) (varT _m))+        (appT (conT _Functor) (appT (conT _Type) (varT _m)))+        [ pragInlD _fmap Inline FunLike AllPhases+        , funD+              _fmap+              [ clause+                    [varP _f, conP _Type [varP _strm]]+                    (normalB+                         (appE+                              (conE _Type)+                              (appE (appE (varE _fmap) (varE _f)) (varE _strm))))+                    []+              ]+        ]++monadtransInstance :: Name -> Q Dec+monadtransInstance _Type =+    instanceD+        (pure [])+        (appT (conT _MonadTrans) (conT _Type))+        [ pragInlD _lift Inline FunLike AllPhases+        , funD+              _lift+              [ clause+                    []+                    (normalB+                         (infixE+                              (Just (conE _Type))+                              (varE _dotOp)+                              (Just (varE (mkName "Stream.fromEffect")))))+                    []+              ]+        ]++monadioInstance :: Name -> Q Dec+monadioInstance _Type =+    instanceD+        (sequence+             [ appT (conT _Monad) (appT (conT _Type) (varT _m))+             , appT (conT _MonadIO) (varT _m)+             ])+        (appT (conT _MonadIO) (appT (conT _Type) (varT _m)))+        [ pragInlD _liftIO Inline FunLike AllPhases+        , funD+              _liftIO+              [ clause+                    []+                    (normalB+                         (infixE+                              (Just (conE _Type))+                              (varE _dotOp)+                              (Just+                                   (infixE+                                        (Just (varE (mkName "Stream.fromEffect")))+                                        (varE _dotOp)+                                        (Just (varE _liftIO))))))+                    []+              ]+        ]++monadthrowInstance :: Name -> Q Dec+monadthrowInstance _Type =+    instanceD+        (sequence+             [ appT (conT _Monad) (appT (conT _Type) (varT _m))+             , appT (conT _MonadThrow) (varT _m)+             ])+        (appT (conT _MonadThrow) (appT (conT _Type) (varT _m)))+        [ pragInlD _throwM Inline FunLike AllPhases+        , funD+              _throwM+              [ clause+                    []+                    (normalB+                         (infixE+                              (Just (conE _Type))+                              (varE _dotOp)+                              (Just+                                   (infixE+                                        (Just (varE (mkName "Stream.fromEffect")))+                                        (varE _dotOp)+                                        (Just (varE _throwM))))))+                    []+              ]+        ]++{-+monadreaderInstance :: Name -> Q Dec+monadreaderInstance _Type =+    instanceD+        (sequence+             [ appT (conT _Monad) (appT (conT _Type) (varT _m))+             , appT (appT (conT _MonadReader) (varT _r)) (varT _m)+             ])+        (appT (appT (conT _MonadReader) (varT _r)) (appT (conT _Type) (varT _m)))+        [ pragInlD _ask Inline FunLike AllPhases+        , funD _ask [clause [] (normalB (appE (varE _lift) (varE _ask))) []]+        , pragInlD _local Inline FunLike AllPhases+        , funD+              _local+              [ clause+                    [varP _f, conP _Type [varP _strm]]+                    (normalB+                         (appE+                              (conE _Type)+                              (appE (appE (varE _local) (varE _f)) (varE _strm))))+                    []+              ]+        ]+-}++--------------------------------------------------------------------------------+-- Type declaration+--------------------------------------------------------------------------------++typeDec :: String -> [Name] -> Q [Dec]+typeDec dtNameStr toDerive = do+    typ <-+        newtypeD+            (return [])+            _Type+            [plainTV _m, plainTV _a]+            Nothing+            (normalC+                 (mkName dtNameStr)+                 [ bangType+                       (bang noSourceUnpackedness noSourceStrictness)+                       (appT (appT (conT _Stream) (varT _m)) (varT _a))+                 ])+            [derivClause Nothing (conT <$> toDerive) | not (null toDerive)]+    let streamType = appT (appT (conT _Stream) (varT _m)) (varT _a)+        nameType = appT (appT (conT _Type) (varT _m)) (varT _a)+    mkTypSig <- sigD _toType (appT (appT arrowT streamType) nameType)+    mkTyp <- funD _toType [clause [] (normalB (conE _Type)) []]+    unTypSig <- sigD _unType (appT (appT arrowT nameType) streamType)+    unTyp <-+        funD+            _unType+            [clause [conP _Type [varP _strm]] (normalB (varE _strm)) []]+    return [typ, mkTypSig, mkTyp, unTypSig, unTyp]++    where++    _Type = mkName dtNameStr+    _toType = mkName (toTypeStr dtNameStr)+    _unType = mkName (unTypeStr dtNameStr)++--------------------------------------------------------------------------------+-- Main deivations+--------------------------------------------------------------------------------++mkStreamApplicative :: Bool -> String -> [String] -> String -> String -> Q Dec+mkStreamApplicative isMonad dtNameStr ctxM pureDefStr apDefStr =+    instanceD+        (Prelude.mapM (\c -> appT (conT (mkName c)) (varT _m)) ctxM)+        (appT (conT _Applicative) (appT (conT _Type) (varT _m)))+        [ pragInlD _pure Inline FunLike AllPhases+        , funD+              _pure+              [ clause+                    []+                    (normalB+                         (infixE+                              (Just (conE _Type))+                              (varE _dotOp)+                              (Just (varE _pureDef))))+                    []+              ]+        , pragInlD _apOp Inline FunLike AllPhases+        , funD+              _apOp+              [ if isMonad+                then apClauseMonad+                else apClauseApplicative+              ]+        ]++    where++    _Type = mkName dtNameStr+    _pureDef = mkName pureDefStr+    _apDef = mkName apDefStr+    apClauseMonad = clause [] (normalB (varE _apDef)) []+    apClauseApplicative =+        clause+            [conP _Type [varP _strm1], conP _Type [varP _strm2]]+            (normalB+                 (appE+                      (conE _Type)+                      (appE+                           (appE (varE _apDef) (varE _strm1))+                           (varE _strm2))))+            []++mkStreamMonad :: String -> [String] -> String -> Q Dec+mkStreamMonad dtNameStr ctxM bindDefStr =+    instanceD+        (Prelude.mapM (\c -> appT (conT (mkName c)) (varT _m)) ctxM)+        (appT (conT _Monad) (appT (conT _Type) (varT _m)))+        [ pragInlD _bindOp Inline FunLike AllPhases+        , funD+              _bindOp+              [ clause+                    [conP _Type [varP _strm1], varP _f]+                    (normalB+                         (letE+                              [ funD+                                    _f1+                                    [ clause+                                          [varP _a]+                                          (normalB+                                               (appE+                                                    (varE _unType)+                                                    (appE (varE _f) (varE _a))))+                                          []+                                    ]+                              ]+                              (appE+                                   (conE _Type)+                                   (appE+                                        (appE (varE _bindDef) (varE _strm1))+                                        (varE _f1)))))+                    []+              ]+        ]++    where++    _Type = mkName dtNameStr+    _unType = mkName (unTypeStr dtNameStr)+    _bindDef = mkName bindDefStr++--------------------------------------------------------------------------------+-- Functions+--------------------------------------------------------------------------------++flattenDec :: [Q [Dec]] -> Q [Dec]+flattenDec [] = pure []+flattenDec (ma:mas) = do+    a <- ma+    as <- flattenDec mas+    pure (a ++ as)++-- | Create a type with a zip-like applicative.+--+-- >>> expr <- runQ (mkZipType "ZipStream" "zipApply" False)+-- >>> putStrLn $ pprint expr+-- newtype ZipStream m a+--     = ZipStream (Stream.Stream m a)+--     deriving Foldable+-- mkZipStream :: Stream.Stream m a -> ZipStream m a+-- mkZipStream = ZipStream+-- unZipStream :: ZipStream m a -> Stream.Stream m a+-- unZipStream (ZipStream strm) = strm+-- deriving instance IsList (ZipStream Identity a)+-- deriving instance a ~+--                   GHC.Types.Char => IsString (ZipStream Identity a)+-- deriving instance GHC.Classes.Eq a => Eq (ZipStream Identity a)+-- deriving instance GHC.Classes.Ord a => Ord (ZipStream Identity a)+-- instance Show a => Show (ZipStream Identity a)+--     where {{-# INLINE show #-}; show (ZipStream strm) = show strm}+-- instance Read a => Read (ZipStream Identity a)+--     where {{-# INLINE readPrec #-}; readPrec = fmap ZipStream readPrec}+-- instance Monad m => Functor (ZipStream m)+--     where {{-# INLINE fmap #-};+--            fmap f (ZipStream strm) = ZipStream (fmap f strm)}+-- instance Monad m => Applicative (ZipStream m)+--     where {{-# INLINE pure #-};+--            pure = ZipStream . Stream.repeat;+--            {-# INLINE (<*>) #-};+--            (<*>) (ZipStream strm1) (ZipStream strm2) = ZipStream (zipApply strm1 strm2)}+mkZipType+    :: String -- ^ Name of the type+    -> String -- ^ Function to use for (\<*\>)+    -> Bool   -- ^ 'True' if (\<*\>) requires MonadAsync constraint (concurrent)+    -> Q [Dec]+mkZipType dtNameStr apOpStr isConcurrent =+    flattenDec+        [ typeDec dtNameStr [_Foldable | not isConcurrent]+        , sequence+              $ if not isConcurrent+                then [ derivIsListIdent _Type+                     , derivIsStringIdent _Type+                     , derivEqIdent _Type+                     , derivOrdIdent _Type+                     -- , derivTraversableIdent _Type+                     , showInstance _Type+                     , readInstance _Type+                     ]+                else []+        , sequence+              [ functorInstance _Type+              , mkStreamApplicative+                    False+                    dtNameStr+                    classConstraints+                    "Stream.repeat"+                    apOpStr+              ]+        ]++    where++    _Type = mkName dtNameStr+    classConstraints =+        if isConcurrent+        then ["Stream.MonadAsync"]+        else ["Monad"]++-- | Create a type with specific stream combination properties.+--+-- >>> expr <- runQ (mkCrossType "Parallel" "parBind" True)+-- >>> putStrLn $ pprint expr+-- newtype Parallel m a = Parallel (Stream.Stream m a)+-- mkParallel :: Stream.Stream m a -> Parallel m a+-- mkParallel = Parallel+-- unParallel :: Parallel m a -> Stream.Stream m a+-- unParallel (Parallel strm) = strm+-- instance Monad m => Functor (Parallel m)+--     where {{-# INLINE fmap #-};+--            fmap f (Parallel strm) = Parallel (fmap f strm)}+-- instance Stream.MonadAsync m => Monad (Parallel m)+--     where {{-# INLINE (>>=) #-};+--            (>>=) (Parallel strm1) f = let f1 a = unParallel (f a)+--                                        in Parallel (parBind strm1 f1)}+-- instance Stream.MonadAsync m => Applicative (Parallel m)+--     where {{-# INLINE pure #-};+--            pure = Parallel . Stream.fromPure;+--            {-# INLINE (<*>) #-};+--            (<*>) = ap}+-- instance (Monad (Parallel m), MonadIO m) => MonadIO (Parallel m)+--     where {{-# INLINE liftIO #-};+--            liftIO = Parallel . (Stream.fromEffect . liftIO)}+-- instance (Monad (Parallel m),+--           MonadThrow m) => MonadThrow (Parallel m)+--     where {{-# INLINE throwM #-};+--            throwM = Parallel . (Stream.fromEffect . throwM)}++mkCrossType+    :: String -- ^ Name of the type+    -> String -- ^ Function to use for (>>=)+    -> Bool   -- ^ 'True' if (>>=) requires MonadAsync constraint (concurrent)+    -> Q [Dec]+mkCrossType dtNameStr bindOpStr isConcurrent =+    flattenDec+        [ typeDec dtNameStr [_Foldable | not isConcurrent]+        , sequence+              $ if not isConcurrent+                then [ derivIsListIdent _Type+                     , derivIsStringIdent _Type+                     , derivEqIdent _Type+                     , derivOrdIdent _Type+                     -- , derivTraversableIdent _Type+                     , showInstance _Type+                     , readInstance _Type+                     ]+                else []+        , sequence $+              [ functorInstance _Type+              , mkStreamMonad dtNameStr classConstraints bindOpStr+              , mkStreamApplicative+                    True+                    dtNameStr+                    classConstraints+                    "Stream.fromPure"+                    "ap"+              , monadioInstance _Type+              , monadthrowInstance _Type+              -- , monadreaderInstance _Type+              ] ++ [monadtransInstance _Type | not isConcurrent]+        ]++    where++    _Type = mkName dtNameStr+    classConstraints =+        if isConcurrent+        then ["Stream.MonadAsync"]+        else ["Monad"]
src/Streamly/Internal/Data/Stream/Parallel.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  -- | -- Module      : Streamly.Internal.Data.Stream.Parallel@@ -20,7 +22,7 @@ --      return n                    -- IO Int -- :} ---module Streamly.Internal.Data.Stream.Parallel+module Streamly.Internal.Data.Stream.Parallel {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream.Concurrent\" instead." #-}     (     -- * Parallel Stream Type       ParallelT(..)@@ -47,35 +49,40 @@  import Control.Concurrent (myThreadId, takeMVar) import Control.Monad (when)+#if !(MIN_VERSION_transformers(0,6,0)) import Control.Monad.Base (MonadBase(..), liftBaseDefault)+#endif import Control.Monad.Catch (MonadThrow, throwM) -- import Control.Monad.Error.Class   (MonadError(..)) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader.Class (MonadReader(..)) import Control.Monad.State.Class (MonadState(..))+#if !(MIN_VERSION_transformers(0,6,0)) import Control.Monad.Trans.Class (MonadTrans(lift))+#endif import Data.Functor (void)+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif import Data.IORef (readIORef, writeIORef) import Data.Maybe (fromJust)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif-import Prelude hiding (map) -import qualified Data.Set as Set-+import Streamly.Data.Fold (Fold) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Fold.Type (Fold)-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.Stream (Step(..)) -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Data.Set as Set+import qualified Streamly.Internal.Data.StreamK as K+    (StreamK, foldStreamShared, mkStream, foldStream, fromEffect+    , nil, concatMapWith, fromPure, bindWith)+import qualified Streamly.Internal.Data.Stream as D+    (Stream(..), mapM, toStreamK, fromStreamK) import qualified Streamly.Internal.Data.Stream.SVar.Generate as SVar import qualified Streamly.Internal.Data.Stream.SVar.Eliminate as SVar+import qualified Streamly.Internal.Data.Stream.Serial as Stream  import Streamly.Internal.Data.SVar+import Prelude hiding (map)  #include "inline.hs" #include "Instances.hs"@@ -91,6 +98,14 @@ --      return n                    -- IO Int -- :} +{-# INLINABLE withLocal #-}+withLocal :: MonadReader r m => (r -> r) -> K.StreamK m a -> K.StreamK m a+withLocal f m =+    K.mkStream $ \st yld sng stp ->+        let single = local f . sng+            yieldk a r = local f $ yld a (withLocal f r)+        in K.foldStream st yieldk single (local f stp) m+ ------------------------------------------------------------------------------- -- Parallel -------------------------------------------------------------------------------@@ -102,7 +117,7 @@ {-# NOINLINE runOne #-} runOne     :: MonadIO m-    => State Stream m a -> Stream m a -> Maybe WorkerInfo -> m ()+    => State K.StreamK m a -> K.StreamK m a -> Maybe WorkerInfo -> m () runOne st m0 winfo =     case getYieldLimit st of         Nothing -> go m0@@ -125,7 +140,7 @@  runOneLimited     :: MonadIO m-    => State Stream m a -> Stream m a -> Maybe WorkerInfo -> m ()+    => State K.StreamK m a -> K.StreamK m a -> Maybe WorkerInfo -> m () runOneLimited st m0 winfo = go m0      where@@ -162,7 +177,7 @@  {-# NOINLINE forkSVarPar #-} forkSVarPar :: MonadAsync m-    => SVarStopStyle -> Stream m a -> Stream m a -> Stream m a+    => SVarStopStyle -> K.StreamK m a -> K.StreamK m a -> K.StreamK m a forkSVarPar ss m r = K.mkStream $ \st yld sng stp -> do     sv <- newParallelVar ss st     pushWorkerPar sv (runOne st{streamVar = Just sv} m)@@ -172,11 +187,16 @@             writeIORef (svarStopBy sv) $ Set.elemAt 0 set         _ -> return ()     pushWorkerPar sv (runOne st{streamVar = Just sv} r)-    K.foldStream st yld sng stp $ getSerialT (SVar.fromSVar sv)+    K.foldStream st yld sng stp $ Stream.toStreamK (SVar.fromSVar sv)  {-# INLINE joinStreamVarPar #-}-joinStreamVarPar :: MonadAsync m-    => SVarStyle -> SVarStopStyle -> Stream m a -> Stream m a -> Stream m a+joinStreamVarPar ::+       MonadAsync m+    => SVarStyle+    -> SVarStopStyle+    -> K.StreamK m a+    -> K.StreamK m a+    -> K.StreamK m a joinStreamVarPar style ss m1 m2 = K.mkStream $ \st yld sng stp ->     case streamVar st of         Just sv | svarStyle sv == style && svarStopStyle sv == ss -> do@@ -226,7 +246,7 @@ -------------------------------------------------------------------------------  {-# INLINE parallelK #-}-parallelK :: MonadAsync m => Stream m a -> Stream m a -> Stream m a+parallelK :: MonadAsync m => K.StreamK m a -> K.StreamK m a -> K.StreamK m a parallelK = joinStreamVarPar ParallelVar StopNone  -- | XXX we can implement it more efficienty by directly implementing instead@@ -244,7 +264,7 @@ -- -- /Pre-release/ {-# INLINE parallelFstK #-}-parallelFstK :: MonadAsync m => Stream m a -> Stream m a -> Stream m a+parallelFstK :: MonadAsync m => K.StreamK m a -> K.StreamK m a -> K.StreamK m a parallelFstK = joinStreamVarPar ParallelVar StopBy  -- This is a race like combinator for streams.@@ -254,7 +274,7 @@ -- -- /Pre-release/ {-# INLINE parallelMinK #-}-parallelMinK :: MonadAsync m => Stream m a -> Stream m a -> Stream m a+parallelMinK :: MonadAsync m => K.StreamK m a -> K.StreamK m a -> K.StreamK m a parallelMinK = joinStreamVarPar ParallelVar StopAny  ------------------------------------------------------------------------------@@ -265,12 +285,12 @@ -- -- /Pre-release/ ---mkParallelK :: MonadAsync m => Stream m a -> Stream m a+mkParallelK :: MonadAsync m => K.StreamK m a -> K.StreamK m a mkParallelK m = K.mkStream $ \st yld sng stp -> do     sv <- newParallelVar StopNone (adaptState st)     -- pushWorkerPar sv (runOne st{streamVar = Just sv} $ toStream m)     SVar.toSVarParallel st sv $ D.fromStreamK m-    K.foldStream st yld sng stp $ getSerialT $ SVar.fromSVar sv+    K.foldStream st yld sng stp $ Stream.toStreamK $ SVar.fromSVar sv  -- | Same as 'mkParallel' but for StreamD stream. --@@ -315,7 +335,7 @@ -- is determined by the prevailing 'Streamly.Prelude.maxBuffer' setting. -- -- @---               Stream m a -> m b+--               StreamK m a -> m b --                       | -- -----stream m a ---------------stream m a----- --@@ -338,12 +358,16 @@ -- -- /Pre-release/ {-# INLINE tapAsyncK #-}-tapAsyncK :: MonadAsync m => (Stream m a -> m b) -> Stream m a -> Stream m a+tapAsyncK ::+       MonadAsync m => (K.StreamK m a -> m b) -> K.StreamK m a -> K.StreamK m a tapAsyncK f m = K.mkStream $ \st yld sng stp -> do-    sv <- SVar.newFoldSVar st (f . getSerialT)+    sv <- SVar.newFoldSVar st (f . Stream.toStreamK)     K.foldStreamShared st yld sng stp-        $ getSerialT (SVar.teeToSVar sv $ SerialT m)+        $ Stream.toStreamK (SVar.teeToSVar sv $ Stream.fromStreamK m) +#if __GLASGOW_HASKELL__ >= 810+type TapState :: Type -> Type -> Type -> Type+#endif data TapState fs st a = TapInit | Tapping !fs st | TapDone st  -- | Like 'tapAsync' but uses a 'Fold' instead of a fold function.@@ -416,9 +440,14 @@ -- /Since: 0.7.0 (maxBuffer applies to ParallelT streams)/ -- -- @since 0.8.0-newtype ParallelT m a = ParallelT {getParallelT :: Stream m a}-    deriving (MonadTrans)+newtype ParallelT m a = ParallelT {getParallelT :: K.StreamK m a} +#if !(MIN_VERSION_transformers(0,6,0))+instance MonadTrans ParallelT where+    {-# INLINE lift #-}+    lift = ParallelT . K.fromEffect+#endif+ -- | A parallely composing IO stream of elements of type @a@. -- See 'ParallelT' documentation for more details. --@@ -457,7 +486,7 @@ apParallel :: MonadAsync m =>     ParallelT m (a -> b) -> ParallelT m a -> ParallelT m b apParallel (ParallelT m1) (ParallelT m2) =-    let f x1 = K.concatMapWith parallelK (pure . x1) m2+    let f x1 = K.concatMapWith parallelK (K.fromPure . x1) m2     in ParallelT $ K.concatMapWith parallelK f m1  instance (Monad m, MonadAsync m) => Applicative (ParallelT m) where@@ -487,6 +516,11 @@ -- Other instances ------------------------------------------------------------------------------ +#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m, MonadAsync m) => MonadBase b (ParallelT m) where+    liftBase = liftBaseDefault+#endif+ MONAD_COMMON_INSTANCES(ParallelT, MONADPARALLEL)  -------------------------------------------------------------------------------@@ -503,7 +537,7 @@ -- /Pre-release/ -- {-# INLINE_NORMAL newCallbackStream #-}-newCallbackStream :: MonadAsync m => m (a -> m (), Stream m a)+newCallbackStream :: MonadAsync m => m (a -> m (), K.StreamK m a) newCallbackStream = do     sv <- newParallelVar StopNone defState
src/Streamly/Internal/Data/Stream/Prelude.hs view
@@ -1,57 +1,25 @@-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wno-orphans #-}- -- | -- Module      : Streamly.Internal.Data.Stream.Prelude--- Copyright   : (c) 2017 Composewell Technologies+-- Copyright   : (c) 2022 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 SerialT/AsyncT/AheadT/ParallelT stream modules to--- implement their instances..--- module Streamly.Internal.Data.Stream.Prelude     (-    -- * Running Effects-      drain--    -- * Conversion operations-    , fromList-    , toList--    -- * Fold operations-    , foldrM-    , foldrMx-    , foldr--    , foldlx'-    , foldlMx'-    , foldl'-    , fold--    -- * Zip style operations-    , eqBy-    , cmpBy+      -- * Concurrency Channels+      module Streamly.Internal.Data.Stream.Channel+      -- * Concurrent Streams+    , module Streamly.Internal.Data.Stream.Concurrent+      -- * Time+    , module Streamly.Internal.Data.Stream.Time+      -- * Lifted+    , module Streamly.Internal.Data.Stream.Lifted     ) where -#include "inline.hs"--import Streamly.Internal.Data.Fold.Type (Fold (..))--#ifdef USE_STREAMK_ONLY-import qualified Streamly.Internal.Data.Stream.StreamK as S-import qualified Streamly.Internal.Data.Stream.StreamK.Type as S-#else-import qualified Streamly.Internal.Data.Stream.StreamD.Type as S-#endif--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)--#include "PreludeCommon.hs"+import Streamly.Internal.Data.Stream.Channel+import Streamly.Internal.Data.Stream.Concurrent+import Streamly.Internal.Data.Stream.Time+import Streamly.Internal.Data.Stream.Lifted
− src/Streamly/Internal/Data/Stream/PreludeCommon.hs 
@@ -1,139 +0,0 @@---------------------------------------------------------------------------------- Conversion to and from direct style stream---------------------------------------------------------------------------------#ifdef USE_IS_STREAM-#define IS_STREAM IsStream t,-#define FROM_STREAM fromStream-#define TO_STREAM toStream-#define STREAM t-#else-#define IS_STREAM-#define FROM_STREAM id-#define TO_STREAM id-#define STREAM K.Stream-#endif---- These definitions are dependent on what is imported as S-{-# INLINE fromStreamS #-}-fromStreamS :: (IS_STREAM Monad m) => S.Stream m a -> STREAM m a-fromStreamS = FROM_STREAM . S.toStreamK--{-# INLINE toStreamS #-}-toStreamS :: (IS_STREAM Monad m) => STREAM m a -> S.Stream m a-toStreamS = S.fromStreamK . TO_STREAM--{-# INLINE toStreamD #-}-toStreamD :: (IS_STREAM Monad m) => STREAM m a -> D.Stream m a-toStreamD = D.fromStreamK . TO_STREAM----------------------------------------------------------------------------------- Conversions---------------------------------------------------------------------------------{-# INLINE_EARLY drain #-}-drain :: (IS_STREAM Monad m) => STREAM m a -> m ()-drain m = D.drain $ D.fromStreamK (TO_STREAM m)-{-# RULES "drain fallback to CPS" [1]-    forall a. D.drain (D.fromStreamK a) = K.drain a #-}----------------------------------------------------------------------------------- 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.------ @since 0.4.0-{-# INLINE_EARLY fromList #-}-#ifdef USE_IS_STREAM-fromList :: (Monad m, IsStream t) => [a] -> STREAM m a-#else-fromList :: Monad m => [a] -> STREAM m a-#endif-fromList = fromStreamS . S.fromList-{-# RULES "fromList fallback to StreamK" [1]-    forall a. S.toStreamK (S.fromList a) = K.fromFoldable a #-}---- | Convert a stream into a list in the underlying monad.------ @since 0.1.0-{-# INLINE toList #-}-toList :: (IS_STREAM Monad m) => STREAM m a -> m [a]-toList m = S.toList $ toStreamS m----------------------------------------------------------------------------------- Folds---------------------------------------------------------------------------------{-# INLINE foldrM #-}-foldrM :: (IS_STREAM Monad m) => (a -> m b -> m b) -> m b -> STREAM m a -> m b-foldrM step acc m = S.foldrM step acc $ toStreamS m--{-# INLINE foldrMx #-}-foldrMx :: (IS_STREAM Monad m)-    => (a -> m x -> m x) -> m x -> (m x -> m b) -> STREAM m a -> m b-foldrMx step final project m = D.foldrMx step final project $ toStreamD m--{-# INLINE foldr #-}-foldr :: (IS_STREAM Monad m) => (a -> b -> b) -> b -> STREAM m a -> m b-foldr f z = foldrM (\a b -> f a <$> b) (return z)---- | Like 'foldlx'', but with a monadic step function.------ @since 0.7.0-{-# INLINE foldlMx' #-}-foldlMx' ::-    (IS_STREAM Monad m)-    => (x -> a -> m x) -> m x -> (x -> m b) -> STREAM m a -> m b-foldlMx' step begin done m = S.foldlMx' step begin done $ toStreamS m---- | 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.------ @since 0.7.0-{-# INLINE foldlx' #-}-foldlx' ::-    (IS_STREAM Monad m) => (x -> a -> x) -> x -> (x -> b) -> STREAM m a -> m b-foldlx' step begin done m = S.foldlx' step begin done $ toStreamS m---- | Strict left associative fold.------ @since 0.2.0-{-# INLINE foldl' #-}-foldl' ::-    (IS_STREAM Monad m) => (b -> a -> b) -> b -> STREAM m a -> m b-foldl' step begin m = S.foldl' step begin $ toStreamS m---{-# INLINE fold #-}-fold :: (IS_STREAM Monad m) => Fold m a b -> STREAM m a -> m b-fold fld m = S.fold fld $ toStreamS m----------------------------------------------------------------------------------- Comparison----------------------------------------------------------------------------------- | Compare two streams for equality------ @since 0.5.3-{-# INLINE eqBy #-}-eqBy :: (IS_STREAM 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------ @since 0.5.3-{-# INLINE cmpBy #-}-cmpBy-    :: (IS_STREAM Monad m)-    => (a -> b -> Ordering) -> STREAM m a -> STREAM m b -> m Ordering-cmpBy f m1 m2 = D.cmpBy f (toStreamD m1) (toStreamD m2)
+ src/Streamly/Internal/Data/Stream/SVar.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.SVar+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Stream.SVar+    {-# DEPRECATED "This module will be removed in future." #-}+    (+      module Streamly.Internal.Data.Stream.SVar.Eliminate+    , module Streamly.Internal.Data.Stream.SVar.Generate+    )+where++import Streamly.Internal.Data.Stream.SVar.Eliminate+import Streamly.Internal.Data.Stream.SVar.Generate
src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-} -- | -- Module      : Streamly.Internal.Data.Stream.SVar.Eliminate -- Copyright   : (c) 2017 Composewell Technologies@@ -9,6 +10,7 @@ -- Eliminate a stream by distributing it to multiple SVars concurrently. -- module Streamly.Internal.Data.Stream.SVar.Eliminate+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (     -- * Concurrent Function Application       toSVarParallel@@ -35,12 +37,16 @@ import Streamly.Internal.Control.ForkLifted (doFork) import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS_) import Streamly.Internal.Data.Fold.SVar (write, writeLimited)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.Serial (SerialT(..))+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) -import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.Stream as D+    (Stream(..), Step(..), fold)+import qualified Streamly.Internal.Data.StreamK as K+    (Stream, mkStream, foldStream, foldStreamShared, nilM)+import qualified Streamly.Internal.Data.Stream.Serial as Stream+    (fromStreamK, toStreamK)  import Streamly.Internal.Data.SVar @@ -214,7 +220,7 @@     -- Add the producer thread-id to the SVar.     liftIO myThreadId >>= modifyThread sv -    void $ doFork (void $ f $ SerialT $ fromProducer sv)+    void $ doFork (void $ f $ Stream.fromStreamK $ fromProducer sv)                   (svarMrun sv)                   (handleFoldException sv)     return sv@@ -369,8 +375,8 @@ {-# INLINE teeToSVar #-} teeToSVar :: MonadAsync m =>     SVar K.Stream m a -> SerialT m a -> SerialT m a-teeToSVar svr (SerialT m) = SerialT $ K.mkStream $ \st yld sng stp -> do-    K.foldStreamShared st yld sng stp (go False m)+teeToSVar svr m = Stream.fromStreamK $ K.mkStream $ \st yld sng stp -> do+    K.foldStreamShared st yld sng stp (go False $ Stream.toStreamK m)      where
src/Streamly/Internal/Data/Stream/SVar/Generate.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-} #ifdef __HADDOCK_VERSION__ #undef INSPECTION #endif@@ -17,6 +18,7 @@ -- -- module Streamly.Internal.Data.Stream.SVar.Generate+    {-# DEPRECATED "SVar is replaced by Channel." #-}     (     -- * Write to SVar       toSVar@@ -38,16 +40,18 @@ import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef) import Data.Maybe (isNothing) import Streamly.Internal.Control.Concurrent (MonadAsync, askRunInIO)-import Streamly.Internal.Data.Stream.Serial (SerialT(..))+import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import System.Mem (performMajorGC) -import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.Stream as D+    (Stream(..), Step(..))+import qualified Streamly.Internal.Data.StreamK as K+    (Stream, foldStreamShared, mkStream, foldStream)+import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK)  import Streamly.Internal.Data.SVar -#if __GLASGOW_HASKELL__ < 810 #ifdef INSPECTION import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow)@@ -55,8 +59,8 @@ import Data.Typeable (Typeable) import Test.Inspection (inspect, hasNoTypeClassesExcept) #endif-#endif + ------------------------------------------------------------------------------ -- Generating streams from SVar ------------------------------------------------------------------------------@@ -109,8 +113,8 @@  -- | Pull a stream from an SVar. {-# NOINLINE fromStreamVar #-}-fromStreamVar :: MonadAsync m => SVar K.Stream m a -> K.Stream m a-fromStreamVar sv = K.MkStream $ \st yld sng stp -> do+fromStreamVar :: forall m a. MonadAsync m => SVar K.Stream m a -> K.Stream m a+fromStreamVar sv = K.mkStream $ \st yld sng stp -> do     list <- readOutputQ sv     -- Reversing the output is important to guarantee that we process the     -- outputs in the same order as they were generated by the constituent@@ -119,6 +123,7 @@      where +    allDone :: forall r. m r -> m r     allDone stp = do         when (svarInspectMode sv) $ do             t <- liftIO $ getTime Monotonic@@ -127,13 +132,13 @@         stp      {-# INLINE processEvents #-}-    processEvents [] = K.MkStream $ \st yld sng stp -> do+    processEvents [] = K.mkStream $ \st yld sng stp -> do         done <- postProcess sv         if done         then allDone stp         else K.foldStream st yld sng stp $ fromStreamVar sv -    processEvents (ev : es) = K.MkStream $ \st yld sng stp -> do+    processEvents (ev : es) = K.mkStream $ \st yld sng stp -> do         let rest = processEvents es         case ev of             ChildYield a -> yld a rest@@ -158,8 +163,8 @@                 sid <- liftIO $ readIORef (svarStopBy sv)                 return $ tid == sid -#if __GLASGOW_HASKELL__ < 810 #ifdef INSPECTION+#if __GLASGOW_HASKELL__ != 906 -- Use of GHC constraint tuple (GHC.Classes.(%,,%)) in fromStreamVar leads to -- space leak because the tuple gets allocated in every recursive call and each -- allocation holds on to the previous allocation. This test is to make sure@@ -187,7 +192,7 @@ {-# INLINE fromSVar #-} fromSVar :: MonadAsync m => SVar K.Stream m a -> SerialT m a fromSVar sv =-    SerialT $ K.mkStream $ \st yld sng stp -> do+    Stream.fromStreamK $ K.mkStream $ \st yld sng stp -> do         ref <- liftIO $ newIORef ()         _ <- liftIO $ mkWeakIORef ref hook         -- We pass a copy of sv to fromStreamVar, so that we know that it has
src/Streamly/Internal/Data/Stream/Serial.hs view
@@ -1,5 +1,13 @@+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.Serial -- Copyright   : (c) 2017 Composewell Technologies@@ -13,17 +21,18 @@ -- -- >>> import qualified Streamly.Prelude as Stream ---module Streamly.Internal.Data.Stream.Serial+module Streamly.Internal.Data.Stream.Serial {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream\" from streamly-core package instead." #-}     (     -- * Serial appending stream       SerialT(..)+    , toStreamK+    , fromStreamK     , Serial     , serial      -- * Serial interleaving stream     , WSerialT(..)     , WSerial-    , wSerialK     , wSerial     , wSerialFst     , wSerialMin@@ -42,19 +51,16 @@     -- * Transformation     , map     , mapM--    -- * Deprecated-    , StreamT-    , InterleavedT     ) where +#if !(MIN_VERSION_base(4,18,0)) import Control.Applicative (liftA2)-import Control.DeepSeq (NFData(..))-#if MIN_VERSION_deepseq(1,4,3)-import Control.DeepSeq (NFData1(..)) #endif+import Control.DeepSeq (NFData(..), NFData1(..))+#if !(MIN_VERSION_transformers(0,6,0)) import Control.Monad.Base (MonadBase(..), liftBaseDefault)+#endif import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Reader.Class (MonadReader(..))@@ -64,31 +70,35 @@ import Data.Functor.Identity (Identity(..), runIdentity) import Data.Maybe (fromMaybe) import Data.Semigroup (Endo(..))-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif-import GHC.Exts (IsList(..), IsString(..))+import GHC.Exts (IsList(..), IsString(..), oneShot) import Text.Read        ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec        , readListPrecDefault)-import Streamly.Internal.BaseCompat ((#.), errorWithoutStackTrace, oneShot)+import Streamly.Internal.BaseCompat ((#.)) import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.Stream.StreamK.Type-       (Stream, mkStream, foldStream)+import Streamly.Internal.Data.StreamK (Stream) -import qualified Streamly.Internal.Data.Stream.Prelude as P-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.Stream.Common as P+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K -import Prelude hiding (map, mapM, errorWithoutStackTrace, repeat)+import Prelude hiding (map, mapM, repeat, filter)  #include "Instances.hs" #include "inline.hs"  -- $setup--- >>> import qualified Streamly.Prelude as Stream+-- >>> :set -fno-warn-deprecations+-- >>> import qualified Streamly.Prelude as IsStream +{-# INLINABLE withLocal #-}+withLocal :: MonadReader r m => (r -> r) -> K.Stream m a -> K.Stream m a+withLocal f m =+    K.mkStream $ \st yld sng stp ->+        let single = local f . sng+            yieldk a r = local f $ yld a (withLocal f r)+        in K.foldStream st yieldk single (local f stp) m+ ------------------------------------------------------------------------------ -- SerialT ------------------------------------------------------------------------------@@ -103,8 +113,8 @@ -- A single 'Monad' bind behaves like a @for@ loop: -- -- >>> :{--- Stream.toList $ do---      x <- Stream.fromList [1,2] -- foreach x in stream+-- IsStream.toList $ do+--      x <- IsStream.fromList [1,2] -- foreach x in stream --      return x -- :} -- [1,2]@@ -112,9 +122,9 @@ -- Nested monad binds behave like nested @for@ loops: -- -- >>> :{--- Stream.toList $ do---     x <- Stream.fromList [1,2] -- foreach x in stream---     y <- Stream.fromList [3,4] -- foreach y in stream+-- IsStream.toList $ do+--     x <- IsStream.fromList [1,2] -- foreach x in stream+--     y <- IsStream.fromList [3,4] -- foreach y in stream --     return (x, y) -- :} -- [(1,3),(1,4),(2,3),(2,4)]@@ -124,7 +134,7 @@ -- @since 0.8.0 newtype SerialT m a = SerialT {getSerialT :: Stream m a}     -- XXX when deriving do we inherit an INLINE?-    deriving (Semigroup, Monoid, MonadTrans)+    deriving (Semigroup, Monoid)  -- | A serial IO stream of elements of type @a@. See 'SerialT' documentation -- for more details.@@ -134,19 +144,24 @@ -- @since 0.8.0 type Serial = SerialT IO --- |--- @since 0.1.0-{-# DEPRECATED StreamT "Please use 'SerialT' instead." #-}-type StreamT = SerialT+toStreamK :: SerialT m a -> Stream m a+toStreamK = getSerialT +fromStreamK :: Stream m a -> SerialT m a+fromStreamK = SerialT+ ------------------------------------------------------------------------------ -- Generation ------------------------------------------------------------------------------ +infixr 5 `cons`+ {-# INLINE cons #-} cons :: a -> SerialT m a -> SerialT m a cons x (SerialT ms) = SerialT $ K.cons x ms +infixr 5 `consM`+ {-# INLINE consM #-} {-# SPECIALIZE consM :: IO a -> SerialT IO a -> SerialT IO a #-} consM :: Monad m => m a -> SerialT m a -> SerialT m a@@ -185,11 +200,15 @@     -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)     --     {-# INLINE (>>=) #-}-    (>>=) (SerialT m) f = SerialT $ K.bindWith K.serial m (getSerialT . f)+    (>>=) (SerialT m) f = SerialT $ K.bindWith K.append m (getSerialT . f)      {-# INLINE (>>) #-}-    (>>)  = (*>)+    (>>) = (*>) +instance MonadTrans SerialT where+    {-# INLINE lift #-}+    lift = SerialT . K.fromEffect+ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------@@ -218,17 +237,17 @@ {-# INLINE apSerial #-} apSerial :: Monad m => SerialT m (a -> b) -> SerialT m a -> SerialT m b apSerial (SerialT m1) (SerialT m2) =-    SerialT $ D.toStreamK $ D.fromStreamK m1 <*> D.fromStreamK m2+    SerialT $ D.toStreamK $ D.fromStreamK m1 `D.crossApply` D.fromStreamK m2  {-# INLINE apSequence #-} apSequence :: Monad m => SerialT m a -> SerialT m b -> SerialT m b apSequence (SerialT m1) (SerialT m2) =-    SerialT $ D.toStreamK $ D.fromStreamK m1 *> D.fromStreamK m2+    SerialT $ D.toStreamK $ D.fromStreamK m1 `D.crossApplySnd` D.fromStreamK m2  {-# INLINE apDiscardSnd #-} apDiscardSnd :: Monad m => SerialT m a -> SerialT m b -> SerialT m a apDiscardSnd (SerialT m1) (SerialT m2) =-    SerialT $ D.toStreamK $ D.fromStreamK m1 <* D.fromStreamK m2+    SerialT $ D.toStreamK $ D.fromStreamK m1 `D.crossApplyFst` D.fromStreamK m2  -- Note: we need to define all the typeclass operations because we want to -- INLINE them.@@ -240,10 +259,8 @@     (<*>) = apSerial     -- (<*>) = K.apSerial -#if MIN_VERSION_base(4,10,0)     {-# INLINE liftA2 #-}     liftA2 f x = (<*>) (fmap f x)-#endif      {-# INLINE (*>) #-}     (*>)  = apSequence@@ -276,8 +293,8 @@ -- A single 'Monad' bind behaves like a @for@ loop: -- -- >>> :{--- Stream.toList $ Stream.fromWSerial $ do---      x <- Stream.fromList [1,2] -- foreach x in stream+-- IsStream.toList $ IsStream.fromWSerial $ do+--      x <- IsStream.fromList [1,2] -- foreach x in stream --      return x -- :} -- [1,2]@@ -285,9 +302,9 @@ -- Nested monad binds behave like interleaved nested @for@ loops: -- -- >>> :{--- Stream.toList $ Stream.fromWSerial $ do---     x <- Stream.fromList [1,2] -- foreach x in stream---     y <- Stream.fromList [3,4] -- foreach y in stream+-- IsStream.toList $ IsStream.fromWSerial $ do+--     x <- IsStream.fromList [1,2] -- foreach x in stream+--     y <- IsStream.fromList [3,4] -- foreach y in stream --     return (x, y) -- :} -- [(1,3),(2,3),(1,4),(2,4)]@@ -297,7 +314,7 @@ -- @2@: -- -- >>> import Streamly.Prelude (wSerial)--- >>> Stream.toList $ Stream.fromList [(1,3),(1,4)] `Stream.wSerial` Stream.fromList [(2,3),(2,4)]+-- >>> IsStream.toList $ IsStream.fromList [(1,3),(1,4)] `IsStream.wSerial` IsStream.fromList [(2,3),(2,4)] -- [(1,3),(2,3),(1,4),(2,4)] -- -- The @W@ in the name stands for @wide@ or breadth wise scheduling in@@ -307,8 +324,11 @@ -- -- @since 0.8.0 newtype WSerialT m a = WSerialT {getWSerialT :: Stream m a}-    deriving (MonadTrans) +instance MonadTrans WSerialT where+    {-# INLINE lift #-}+    lift = WSerialT . K.fromEffect+ -- | An interleaving serial IO stream of elements of type @a@. See 'WSerialT' -- documentation for more details. --@@ -317,11 +337,6 @@ -- @since 0.8.0 type WSerial = WSerialT IO --- |--- @since 0.1.0-{-# DEPRECATED InterleavedT "Please use 'WSerialT' instead." #-}-type InterleavedT = WSerialT- {-# INLINE consMWSerial #-} {-# SPECIALIZE consMWSerial :: IO a -> WSerialT IO a -> WSerialT IO a #-} consMWSerial :: Monad m => m a -> WSerialT m a -> WSerialT m a@@ -333,26 +348,16 @@  infixr 6 `wSerial` --- 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.------ Similar combinators can be implemented using WAhead style.--{-# INLINE wSerialK #-}-wSerialK :: Stream m a -> Stream m a -> Stream m a-wSerialK 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 (wSerialK m2 r)-    foldStream st yieldk single stop m1- -- | 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.+--+-- This gives exponential priority to earlier streams than the ones joining+-- later. Because of exponential weighting it can be used with 'concatMapWith'.+--+-- /Not fused/ --- Scheduling Notes:+-- NOTE: -- -- Note that evaluation of @a \`wSerial` b \`wSerial` c@ does not interleave -- @a@, @b@ and @c@ with equal priority.  This expression is equivalent to @a@@ -365,46 +370,15 @@ -- {-# INLINE wSerial #-} wSerial :: WSerialT m a -> WSerialT m a -> WSerialT m a-wSerial (WSerialT m1) (WSerialT m2) = WSerialT $ wSerialK m1 m2---- | Like `wSerial` but stops interleaving as soon as the first stream stops.------ @since 0.7.0-{-# INLINE wSerialFstK #-}-wSerialFstK :: Stream m a -> Stream m a -> Stream m a-wSerialFstK 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 (wSerialK s1 r)-             in foldStream st yieldk single stop s2+wSerial (WSerialT m1) (WSerialT m2) = WSerialT $ K.interleave m1 m2  {-# INLINE wSerialFst #-} wSerialFst :: WSerialT m a -> WSerialT m a -> WSerialT m a-wSerialFst (WSerialT m1) (WSerialT m2) = WSerialT $ wSerialFstK m1 m2---- | Like `wSerial` but stops interleaving as soon as any of the two streams--- stops.------ @since 0.7.0-{-# INLINE wSerialMinK #-}-wSerialMinK :: Stream m a -> Stream m a -> Stream m a-wSerialMinK m1 m2 = mkStream $ \st yld _ stp -> do-    let stop       = stp-        -- "single a" is defined as "yld a (wSerialMin m2 K.nil)" instead of-        -- "sng a" to keep the behaviour consistent with the yield continuation.-        single a   = yld a (wSerialMinK m2 K.nil)-        yieldk a r = yld a (wSerialMinK m2 r)-    foldStream st yieldk single stop m1+wSerialFst (WSerialT m1) (WSerialT m2) = WSerialT $ K.interleaveFst m1 m2  {-# INLINE wSerialMin #-} wSerialMin :: WSerialT m a -> WSerialT m a -> WSerialT m a-wSerialMin (WSerialT m1) (WSerialT m2) = WSerialT $ wSerialMinK m1 m2+wSerialMin (WSerialT m1) (WSerialT m2) = WSerialT $ K.interleaveMin m1 m2  instance Semigroup (WSerialT m a) where     (<>) = wSerial@@ -418,10 +392,10 @@     mappend = (<>)  {-# INLINE apWSerial #-}-apWSerial :: Monad m => WSerialT m (a -> b) -> WSerialT m a -> WSerialT m b+apWSerial :: WSerialT m (a -> b) -> WSerialT m a -> WSerialT m b apWSerial (WSerialT m1) (WSerialT m2) =-    let f x1 = K.concatMapWith wSerialK (pure . x1) m2-    in WSerialT $ K.concatMapWith wSerialK f m1+    let f x1 = K.concatMapWith K.interleave (K.fromPure . x1) m2+    in WSerialT $ K.concatMapWith K.interleave f m1  instance Monad m => Applicative (WSerialT m) where     {-# INLINE pure #-}@@ -436,11 +410,16 @@ instance Monad m => Monad (WSerialT m) where     return = pure     {-# INLINE (>>=) #-}-    (>>=) (WSerialT m) f = WSerialT $ K.bindWith wSerialK m (getWSerialT . f)+    (>>=) (WSerialT m) f = WSerialT $ K.bindWith K.interleave m (getWSerialT . f)  ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------++#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m) => MonadBase b (SerialT m) where+    liftBase = liftBaseDefault+#endif  MONAD_COMMON_INSTANCES(WSerialT,) LIST_INSTANCES(WSerialT)
− src/Streamly/Internal/Data/Stream/StreamD.hs 
@@ -1,36 +0,0 @@--- |--- 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.Nesting-    , module Streamly.Internal.Data.Stream.StreamD.Transform-    )-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.Nesting-import Streamly.Internal.Data.Stream.StreamD.Transform
− src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs 
@@ -1,510 +0,0 @@--- |--- 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-    , parse_--    -- * 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-    , isSubsequenceOf-    , stripPrefix-    )-where--#include "inline.hs"--import Control.Exception (assert)-import Control.Monad.Catch (MonadThrow, throwM)-import GHC.Exts (SpecConstrAnnotation(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.SVar.Type (defState)--import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Nesting--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----------------------------------------------------------------------------------- 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 parse #-}-parse-    :: MonadThrow m-    => PRD.Parser m a b-    -> Stream m a-    -> m b-parse parser strm = do-    (b, _) <- parse_ parser strm-    return b---- | Run a 'Parse' over a stream and return rest of the Stream.-{-# INLINE_NORMAL parse_ #-}-parse_-    :: MonadThrow m-    => PRD.Parser m a b-    -> Stream m a-    -> m (b, Stream m a)-parse_ (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 (b, stream)-        PRD.IError err -> throwM $ ParseError err--    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 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 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 (b, Stream step st)-                    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 (b, Nesting.append (fromList src) (Stream step s))-                    PR.Error err -> throwM $ ParseError err-            Skip s -> go SPEC s buf pst-            Stop   -> do-                b <- extract pst-                return (b, let List buffer = buf in fromList buffer)--    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 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 (b, Nesting.append (fromList src) (Stream step s))-            PR.Error err -> throwM $ ParseError err----------------------------------------------------------------------------------- Specialized Folds---------------------------------------------------------------------------------{-# INLINE_NORMAL null #-}-null :: Monad m => Stream m a -> m Bool-null = foldrM (\_ _ -> return False) (return True)--{-# INLINE_NORMAL head #-}-head :: Monad m => Stream m a -> m (Maybe a)-head = foldrM (\x _ -> return (Just x)) (return Nothing)--{-# 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 state-  where-    go st = do-        r <- step defState st-        case r of-            Yield _ s -> return (Just $ Stream step s)-            Skip  s   -> go s-            Stop      -> return Nothing---- XXX will it fuse? need custom impl?-{-# INLINE_NORMAL last #-}-last :: Monad m => Stream m a -> m (Maybe a)-last = foldl' (\_ y -> Just y) Nothing--{-# INLINE_NORMAL elem #-}-elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool--- elem e m = foldrM (\x xs -> if x == e then return True else xs) (return False) m-elem e (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s-              | x == e    -> return True-              | otherwise -> go s-            Skip s -> go s-            Stop   -> return False--{-# 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--- all p m = foldrM (\x xs -> if p x then xs else return False) (return True) m-all p (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s-              | p x       -> go s-              | otherwise -> return False-            Skip s -> go s-            Stop   -> return True--{-# INLINE_NORMAL any #-}-any :: Monad m => (a -> Bool) -> Stream m a -> m Bool--- any p m = foldrM (\x xs -> if p x then return True else xs) (return False) m-any p (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s-              | p x       -> return True-              | otherwise -> go s-            Skip s -> go s-            Stop   -> return False--{-# INLINE_NORMAL maximum #-}-maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)-maximum (Stream step state) = go Nothing state-  where-    go Nothing st = do-        r <- step defState st-        case r of-            Yield x s -> go (Just x) s-            Skip  s   -> go Nothing s-            Stop      -> return Nothing-    go (Just acc) st = do-        r <- step defState st-        case r of-            Yield x s-              | acc <= x  -> go (Just x) s-              | otherwise -> go (Just acc) s-            Skip s -> go (Just acc) s-            Stop   -> return (Just acc)--{-# INLINE_NORMAL maximumBy #-}-maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)-maximumBy cmp (Stream step state) = go Nothing state-  where-    go Nothing st = do-        r <- step defState st-        case r of-            Yield x s -> go (Just x) s-            Skip  s   -> go 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 (Just acc) s-                _  -> go (Just x) s-            Skip s -> go (Just acc) s-            Stop   -> return (Just acc)--{-# INLINE_NORMAL minimum #-}-minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)-minimum (Stream step state) = go Nothing state-  where-    go Nothing st = do-        r <- step defState st-        case r of-            Yield x s -> go (Just x) s-            Skip  s   -> go Nothing s-            Stop      -> return Nothing-    go (Just acc) st = do-        r <- step defState st-        case r of-            Yield x s-              | acc <= x  -> go (Just acc) s-              | otherwise -> go (Just x) s-            Skip s -> go (Just acc) s-            Stop   -> return (Just acc)--{-# INLINE_NORMAL minimumBy #-}-minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)-minimumBy cmp (Stream step state) = go Nothing state-  where-    go Nothing st = do-        r <- step defState st-        case r of-            Yield x s -> go (Just x) s-            Skip  s   -> go 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 (Just x) s-                _  -> go (Just acc) s-            Skip s -> go (Just acc) s-            Stop   -> return (Just acc)--{-# INLINE_NORMAL (!!) #-}-(!!) :: (Monad m) => Stream m a -> Int -> m (Maybe a)-(Stream step state) !! i = go 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 (n - 1) s-            Skip s -> go n s-            Stop   -> return Nothing--{-# INLINE_NORMAL lookup #-}-lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)-lookup e = foldrM (\(a, b) xs -> if e == a then return (Just b) else xs)-                   (return Nothing)--{-# INLINE_NORMAL findM #-}-findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)-findM p = foldrM (\x xs -> p x >>= \r -> if r then return (Just x) else xs)-                   (return Nothing)--{-# 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]-toListRev = foldl' (flip (:)) []----------------------------------------------------------------------------------- Transformation comprehensions---------------------------------------------------------------------------------{-# INLINE_NORMAL the #-}-the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)-the (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s -> go' x s-            Skip s    -> go s-            Stop      -> return Nothing-    go' n st = do-        r <- step defState st-        case r of-            Yield x s | x == n -> go' n s-                      | otherwise -> return Nothing-            Skip s -> go' n s-            Stop   -> return (Just n)----------------------------------------------------------------------------------- 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 ()-mapM_ m = drain . mapM m----------------------------------------------------------------------------------- Multi-stream folds---------------------------------------------------------------------------------{-# INLINE_NORMAL isPrefixOf #-}-isPrefixOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool-isPrefixOf (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)-  where-    go (sa, sb, Nothing) = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go (sa', sb, Just x)-            Skip sa'    -> go (sa', sb, Nothing)-            Stop        -> return True--    go (sa, sb, Just x) = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go (sa, sb', Nothing)-                    else return False-            Skip sb' -> go (sa, sb', Just x)-            Stop     -> return False--{-# INLINE_NORMAL isSubsequenceOf #-}-isSubsequenceOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool-isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)-  where-    go (sa, sb, Nothing) = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go (sa', sb, Just x)-            Skip sa'    -> go (sa', sb, Nothing)-            Stop        -> return True--    go (sa, sb, Just x) = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go (sa, sb', Nothing)-                    else go (sa, sb', Just x)-            Skip sb' -> go (sa, sb', Just x)-            Stop     -> return False--{-# INLINE_NORMAL stripPrefix #-}-stripPrefix-    :: (Eq a, Monad m)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripPrefix (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)-  where-    go (sa, sb, Nothing) = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go (sa', sb, Just x)-            Skip sa'    -> go (sa', sb, Nothing)-            Stop        -> return $ Just (Stream stepb sb)--    go (sa, sb, Just x) = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go (sa, sb', Nothing)-                    else return Nothing-            Skip sb' -> go (sa, sb', Just x)-            Stop     -> return Nothing
− src/Streamly/Internal/Data/Stream/StreamD/Exception.hs 
@@ -1,412 +0,0 @@--- |--- 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-    , after_-    , after-    , bracket_-    , bracket'-    , onException-    , finally_-    , finally-    , ghandle-    , handle-    , retry-    )-where--#include "inline.hs"--import Control.Exception (Exception, SomeException, mask_)-import Control.Monad.Catch (MonadCatch)-import Data.Map.Strict (Map)-import GHC.Exts (inline)-import Streamly.Internal.Control.Concurrent (MonadRunInIO, MonadAsync, withRunInIO)-import Streamly.Internal.Data.IOFinalizer-    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)--import qualified Control.Monad.Catch as MC-import qualified Data.Map.Strict as Map--import Streamly.Internal.Data.Stream.StreamD.Type--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.--- * does not require a 'MonadAsync' constraint.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE_NORMAL gbracket_ #-}-gbracket_-    :: Monad m-    => m c                                  -- ^ before-    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)-    -> (c -> m d)                           -- ^ after, on normal stop-    -> (c -> e -> Stream m b -> Stream m b) -- ^ on exception-    -> (c -> Stream m b)                    -- ^ stream generator-    -> Stream m b-gbracket_ bef exc aft fexc fnormal =-    Stream step GBracketInit--    where--    {-# INLINE_LATE step #-}-    step _ GBracketInit = do-        r <- bef-        return $ Skip $ GBracketNormal (fnormal r) r--    step gst (GBracketNormal (UnStream step1 st) v) = do-        res <- exc $ 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 (fexc 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-    :: MonadRunInIO m-    => m c -- ^ before-    -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)-    -> (c -> m d1) -- ^ on normal stop-    -> (c -> m d2) -- ^ on GC without normal stop or exception-    -> (c -> e -> Stream m b -> m (Stream m b)) -- ^ on exception-    -> (c -> Stream m b) -- ^ stream generator-    -> Stream m b-gbracket bef exc aft gc fexc fnormal =-    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) <- withRunInIO $ \run -> mask_ $ run $ do-            r <- bef-            ref <- newIOFinalizer (gc r)-            return (r, ref)-        return $ Skip $ GBracketIONormal (fnormal r) r ref--    step gst (GBracketIONormal (UnStream step1 st) v ref) = do-        res <- exc $ 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 ->-                    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 <- clearingIOFinalizer ref (fexc 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---- | See 'Streamly.Internal.Data.Stream.IsStream.before'.----{-# 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---- | See 'Streamly.Internal.Data.Stream.IsStream.after_'.----{-# INLINE_NORMAL after_ #-}-after_ :: Monad m => m b -> Stream m a -> Stream m a-after_ 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---- | See 'Streamly.Internal.Data.Stream.IsStream.after'.----{-# INLINE_NORMAL after #-}-after :: MonadRunInIO m-    => m b -> Stream m a -> Stream m a-after action (Stream step state) = Stream step' Nothing--    where--    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        ref <- 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.------ | See 'Streamly.Internal.Data.Stream.IsStream.onException'.----{-# INLINE_NORMAL onException #-}-onException :: MonadCatch m => m b -> Stream m a -> Stream m a-onException action str =-    gbracket_ (return ()) (inline MC.try) return-        (\_ (e :: MC.SomeException) _ -> nilM (action >> MC.throwM e))-        (const str)--{-# 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---- | See 'Streamly.Internal.Data.Stream.IsStream.bracket_'.----{-# INLINE_NORMAL bracket_ #-}-bracket_ :: MonadCatch m-    => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a-bracket_ bef aft =-    gbracket_ bef (inline MC.try) aft-        (\a (e :: SomeException) _ -> nilM (aft a >> MC.throwM e))---- | See 'Streamly.Internal.Data.Stream.IsStream.bracket'.----{-# INLINE_NORMAL bracket' #-}-bracket' :: (MonadAsync m, MonadCatch m) =>-       m b-    -> (b -> m c)-    -> (b -> m d)-    -> (b -> m e)-    -> (b -> Stream m a)-    -> Stream m a-bracket' bef aft exc gc =-    gbracket bef (inline MC.try) aft gc-        (\a (e :: SomeException) _ -> exc a >> return (nilM (MC.throwM e)))--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---- | See 'Streamly.Internal.Data.Stream.IsStream.finally_'.----{-# INLINE finally_ #-}-finally_ :: MonadCatch m => m b -> Stream m a -> Stream m a-finally_ action xs = bracket_ (return ()) (const action) (const xs)---- | See 'Streamly.Internal.Data.Stream.IsStream.finally'.------ finally action xs = after action $ onException action xs----{-# INLINE finally #-}-finally :: (MonadAsync m, MonadCatch m) => m b -> Stream m a -> Stream m a-finally action xs = bracket' (return ()) act act act (const xs)-    where act _ = action---- | See 'Streamly.Internal.Data.Stream.IsStream.ghandle'.----{-# INLINE_NORMAL ghandle #-}-ghandle :: (MonadCatch m, Exception e)-    => (e -> Stream m a -> Stream m a) -> Stream m a -> Stream m a-ghandle f str =-    gbracket_ (return ()) (inline MC.try) return (const f) (const str)---- | See 'Streamly.Internal.Data.Stream.IsStream.handle'.----{-# INLINE_NORMAL handle #-}-handle :: (MonadCatch m, Exception e)-    => (e -> Stream m a) -> Stream m a -> Stream m a-handle f str =-    gbracket_ (return ()) (inline MC.try) return (\_ e _ -> f e) (const str)---- | 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--data RetryState emap s1 s2-    = RetryWithMap emap s1-    | RetryDefault s2---- | See 'Streamly.Internal.Data.Stream.IsStream.retry'----{-# INLINE_NORMAL retry #-}-retry-    :: forall e m a. (Exception e, Ord e, MonadCatch m)-    => Map e Int-       -- ^ map from exception to retry count-    -> (e -> Stream m a)-       -- ^ default handler for those exceptions that are not in the map-    -> Stream m a-    -> Stream m a-retry emap0 defaultHandler (Stream step0 state0) = Stream step state--    where--    state = RetryWithMap emap0 state0--    {-# INLINE_LATE step #-}-    step gst (RetryWithMap emap st) = do-        eres <- MC.try $ step0 gst st-        case eres of-            Left e -> handler e emap st-            Right res ->-                return-                    $ case res of-                          Yield x st1 -> Yield x $ RetryWithMap emap st1-                          Skip st1 -> Skip $ RetryWithMap emap st1-                          Stop -> Stop-    step gst (RetryDefault (UnStream step1 state1)) = do-        res <- step1 gst state1-        return-            $ case res of-                  Yield x st1 -> Yield x $ RetryDefault (Stream step1 st1)-                  Skip st1 -> Skip $ RetryDefault (Stream step1 st1)-                  Stop -> Stop--    {-# INLINE handler #-}-    handler e emap st =-        return-            $ Skip-            $ case Map.lookup e emap of-                  Just i-                      | i > 0 ->-                          let emap1 = Map.insert e (i - 1) emap-                           in RetryWithMap emap1 st-                      | otherwise -> RetryDefault $ defaultHandler e-                  Nothing -> RetryDefault $ defaultHandler e
− src/Streamly/Internal/Data/Stream/StreamD/Generate.hs 
@@ -1,406 +0,0 @@--- |--- 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------ Prefer unfolds ("Streamly.Internal.Data.Unfold") over the combinators in--- this module. They are more powerful and efficient as they can be transformed--- and composed on the input side efficiently and they can fuse in nested--- operations (e.g.  unfoldMany). All the combinators in this module can be--- expressed using unfolds with the same efficiency.------ Operations in this module that are not in "Streamly.Internal.Data.Unfold":--- generate, times, fromPrimIORef.------ We should plan to replace this module with "Streamly.Internal.Data.Unfold"--- in future.---- 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-    , enumerateFromStepIntegral-    , enumerateFromIntegral-    , enumerateFromThenIntegral-    , enumerateFromToIntegral-    , enumerateFromThenToIntegral--    , enumerateFromStepNum-    , enumerateFromNum-    , enumerateFromThenNum-    , enumerateFromToFractional-    , enumerateFromThenToFractional--    -- * Time Enumeration-    , times--    -- * 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.--    -- Note: Direct style stream does not support @fromFoldable@.-    , fromList-    , fromListM--    -- * Conversions-    , fromStreamK-    , toStreamK-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Time.Clock-    (Clock(Monotonic), asyncClock, readClock)-import Streamly.Internal.Data.Time.Units-    (toAbsTime, AbsTime, toRelTime64, RelTime64)--import Prelude hiding (iterate, repeat, replicate, takeWhile)-import Streamly.Internal.Data.Stream.StreamD.Type----------------------------------------------------------------------------------- Primitives----------------------------------------------------------------------------------- | An empty 'Stream'.-{-# INLINE_NORMAL nil #-}-nil :: Monad m => Stream m a-nil = Stream (\_ _ -> return Stop) ()---- XXX implement in terms of consM?--- cons x = consM (return x)------ | Can fuse but has O(n^2) complexity.-{-# INLINE_NORMAL cons #-}-cons :: Monad m => a -> Stream m a -> Stream m a-cons x (Stream step state) = Stream step1 Nothing-    where-    {-# INLINE_LATE step1 #-}-    step1 _ Nothing   = return $ Yield x (Just state)-    step1 gst (Just st) = do-        r <- step gst st-        return $-          case r of-            Yield a s -> Yield a (Just s)-            Skip  s   -> Skip (Just s)-            Stop      -> Stop----------------------------------------------------------------------------------- Unfolding----------------------------------------------------------------------------------- Adapted from vector package-{-# INLINE_NORMAL unfoldrM #-}-unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-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--{-# INLINE_LATE unfoldr #-}-unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a-unfoldr f = unfoldrM (return . f)----------------------------------------------------------------------------------- From values---------------------------------------------------------------------------------{-# INLINE_NORMAL repeatM #-}-repeatM :: Monad m => m a -> Stream m a-repeatM x = Stream (\_ _ -> x >>= \r -> return $ Yield r ()) ()--{-# INLINE_NORMAL repeat #-}-repeat :: Monad m => a -> Stream m a-repeat x = Stream (\_ _ -> return $ Yield x ()) ()---- Adapted from the vector package-{-# INLINE_NORMAL replicateM #-}-replicateM :: forall m a. Monad m => Int -> m a -> Stream m a-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)--{-# 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-enumerateFromStepNum from stride = Stream step 0-    where-    {-# INLINE_LATE step #-}-    step _ !i = return $ (Yield $! (from + i * stride)) $! (i + 1)--{-# 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---------------------------------------------------------------------------------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---- XXX This can perhaps be simplified and written in terms of--- enumeratFromStepIntegral as we have done in unfolds. But anyway we should be--- replacing the stream generation module with unfolds.-{-# INLINE_NORMAL enumerateFromThenToIntegral #-}-enumerateFromThenToIntegral-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-enumerateFromThenToIntegral from next to-    | next >= from = enumerateFromThenToIntegralUp from next to-    | otherwise    = enumerateFromThenToIntegralDn from next to--{-# INLINE_NORMAL enumerateFromThenIntegral #-}-enumerateFromThenIntegral-    :: (Monad m, Integral a, Bounded a)-    => a -> a -> Stream m a-enumerateFromThenIntegral from next =-    if next > from-    then enumerateFromThenToIntegralUp from next maxBound-    else enumerateFromThenToIntegralDn from next minBound---- | Can be used to enumerate unbounded integrals. This does not check for--- overflow or underflow for bounded integrals.----{-# INLINE_NORMAL enumerateFromStepIntegral #-}-enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a-enumerateFromStepIntegral from stride =-    from `seq` stride `seq` Stream step from-    where-        {-# INLINE_LATE step #-}-        step _ !x = return $ Yield x $! (x + stride)---- | Enumerate upwards from @from@ to @to@. We are assuming that "to" is--- constrained by the type to be within max/min bounds.-{-# INLINE enumerateFromToIntegral #-}-enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a-enumerateFromToIntegral from to =-    takeWhile (<= to) $ enumerateFromStepIntegral from 1--{-# 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.-{-# 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--{-# INLINE_NORMAL enumerateFromThenToFractional #-}-enumerateFromThenToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> a -> Stream m a-enumerateFromThenToFractional from next to =-    takeWhile predicate $ enumerateFromThenNum from next-    where-    mid = (next - from) / 2-    predicate | next >= from  = (<= to + mid)-              | otherwise     = (>= to + mid)----------------------------------------------------------------------------------- Time Enumeration---------------------------------------------------------------------------------{-# INLINE_NORMAL times #-}-times :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)-times 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------------------------------------------------------------------------------------ From Generators----------------------------------------------------------------------------------{-# INLINE_NORMAL fromIndicesM #-}-fromIndicesM :: Monad m => (Int -> m a) -> Stream m a-fromIndicesM gen = Stream step 0-  where-    {-# INLINE_LATE step #-}-    step _ i = do-       x <- gen i-       return $ Yield x (i + 1)--{-# 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----------------------------------------------------------------------------------{-# INLINE_NORMAL iterateM #-}-iterateM :: Monad m => (a -> m a) -> m a -> Stream m a-iterateM step = Stream (\_ st -> st >>= \(!x) -> return $ Yield x (step x))--{-# INLINE_NORMAL iterate #-}-iterate :: Monad m => (a -> a) -> a -> Stream m a-iterate step st = iterateM (return . step) (return st)------------------------------------------------------------------------------------ From containers------------------------------------------------------------------------------------ XXX we need the MonadAsync constraint because of a rewrite rule.--- | Convert a list of monadic actions to a 'Stream'-{-# INLINE_LATE fromListM #-}-fromListM :: MonadAsync m => [m a] -> Stream m a-fromListM = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ (m:ms) = m >>= \x -> return $ Yield x ms-    step _ []     = return Stop
− src/Streamly/Internal/Data/Stream/StreamD/Lift.hs 
@@ -1,112 +0,0 @@--- |--- 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-      hoist-    , generally -- XXX generalize--    -- * Transform Inner Monad-    , liftInner-    , runReaderT-    , evalStateT-    , runStateT-    )-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 Data.Functor.Identity (Identity(..))-import Streamly.Internal.Data.SVar.Type (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------------------------------------------------------------------------------------ Generalize Inner Monad----------------------------------------------------------------------------------{-# INLINE_NORMAL hoist #-}-hoist :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a-hoist 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--{-# INLINE generally #-}-generally :: Monad m => Stream Identity a -> Stream m a-generally = hoist (return . runIdentity)------------------------------------------------------------------------------------ Transform Inner Monad----------------------------------------------------------------------------------{-# 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--{-# 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--{-# 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--{-# 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
− src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs 
@@ -1,2468 +0,0 @@--- |--- 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-    -- unfoldManyInterleave.-    , InterleaveState(..)-    , interleave-    , interleaveMin-    , interleaveSuffix-    , interleaveInfix--    -- *** 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 unfoldManyRoundRobin.-    , roundRobin -- interleaveFair?/ParallelFair--    -- *** Zipping-    -- | Zip corresponding elements of two streams.-    , zipWith-    , zipWithM--    -- *** Merging-    -- | Interleave elements from two streams based on a condition.-    , mergeBy-    , mergeByM--    -- ** 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 (..)-    , unfoldManyInterleave-    , unfoldManyRoundRobin--    -- *** Interpose-    -- | Like unfoldMany but intersperses an effect between the streams. A-    -- special case of gintercalate.-    , interpose-    , interposeSuffix--    -- *** Intercalate-    -- | Like unfoldMany but intersperses streams from another source between-    -- the streams from the first source.-    , gintercalate-    , gintercalateSuffix--    -- * 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 m a b) -> t m a -> t m b-    -- @--    -- ** Folding-    -- | Apply folds on a stream.-    , foldMany-    , refoldMany-    , 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-    , parseIterate--    -- ** Grouping-    -- | Group segments of a stream and fold. Special case of parsing.-    , chunksOf-    , groupsBy-    , groupsRollingBy--    -- ** Splitting-    -- | A special case of parsing.-    , wordsBy-    , splitOnSeq-    , splitOnSuffixSeq-    , sliceOnSuffix--    -- * Transform (Nested Containers)-    -- | Opposite to compact in ArrayStream-    , splitInnerBy-    , splitInnerBySuffix-    , intersectBySorted-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Exception (assert)-import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bits (shiftR, shiftL, (.|.), (.&.))-#if __GLASGOW_HASKELL__ >= 801-import Data.Functor.Identity ( Identity )-#endif-import Data.Word (Word32)-import Foreign.Storable (Storable(..))-import Fusion.Plugin.Types (Fuse(..))-import GHC.Types (SPEC(..))--import Streamly.Internal.Data.Array.Foreign.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.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Array.Foreign.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.Foreign as RB--import Streamly.Internal.Data.Stream.StreamD.Type--import Prelude hiding (concatMap, mapM, zipWith)----------------------------------------------------------------------------------- Appending---------------------------------------------------------------------------------data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2---- Note that this could be much faster compared to the CPS stream. However, as--- the number of streams being composed increases this may become expensive.--- Need to see where the breaking point is between the two.----{-# 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--{-# 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--{-# 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--{-# INLINE_NORMAL interleaveSuffix #-}-interleaveSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveSuffix (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--{-# INLINE_NORMAL interleaveInfix #-}-interleaveInfix :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveInfix (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---------------------------------------------------------------------------------{-# 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----------------------------------------------------------------------------------- Zipping---------------------------------------------------------------------------------{-# 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--#if __GLASGOW_HASKELL__ >= 801-{-# RULES "zipWithM xs xs"-    forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-}-#endif--{-# 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))----------------------------------------------------------------------------------- Merging---------------------------------------------------------------------------------{-# 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--{-# 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)------------------------------------------------------------------------------------ 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 unfoldManyInterleave. Intead--- 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 concatPairsWith, 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.------ >>> input = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]--- >>> Stream.toList $ Stream.unfoldManyInterleave Unfold.fromList input--- [1,2,3,4,5,5,4,3,2,1]------ Note that this is order of magnitude more efficient than "concatPairsWith--- wSerial"-{-# INLINE_NORMAL unfoldManyInterleave #-}-unfoldManyInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldManyInterleave (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 unfoldManyInterleave this one switches streams on Skips.----{-# INLINE_NORMAL unfoldManyRoundRobin #-}-unfoldManyRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldManyRoundRobin (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 interposeSuffix #-}-interposeSuffix-    :: Monad m-    => m c -> Unfold m b c -> Stream m b -> Stream m c-interposeSuffix-    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)--{-# 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 interpose #-}-interpose :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c-interpose-    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)-    -}----------------------------------------------------------------------------------- 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---- | Interleave streams (full streams, not the elements) unfolded from two--- input streams and concat. Stop when the first stream stops. If the second--- stream ends before the first one then first stream still keeps running alone--- without any interleaving with the second stream.------    [a1, a2, ... an]                   [b1, b2 ...]--- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...]--- => [streamA1, streamB1, streamA2...StreamAn, streamBn]--- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...]----{-# 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---- | Interleave streams (full streams, not the elements) unfolded from two--- input streams and concat. Stop when the first stream stops. If the second--- stream ends before the first one then first stream still keeps running alone--- without any interleaving with the second stream.------    [a1, a2, ... an]                   [b1, b2 ...]--- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...]--- => [streamA1, streamB1, streamA2...StreamAn, streamBn]--- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...]----{-# 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)-    -}----------------------------------------------------------------------------------- Folding---------------------------------------------------------------------------------{-# 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--{-# 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-    | ParseChunksInitLeftOver inpBuf-    | ParseChunksStream st inpBuf !pst-    | ParseChunksBuf inpBuf st inpBuf !pst-    | ParseChunksYield x (ParseChunksState x inpBuf st pst)--{-# INLINE_NORMAL parseMany #-}-parseMany-    :: MonadThrow m-    => PRD.Parser m a b-    -> Stream m a-    -> Stream m b-parseMany (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 pb next-                    PRD.IError err -> throwM $ ParseError err-            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 pb next-            PRD.IError err -> throwM $ ParseError err--    -- 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 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 b (ParseChunksInit src s)-                    PR.Error err -> throwM $ ParseError err-            Skip s -> return $ Skip $ ParseChunksStream s buf pst-            Stop   -> do-                b <- extract pst-                let src = Prelude.reverse buf-                return $ Skip $-                    ParseChunksYield b (ParseChunksInitLeftOver src)--    -- 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 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 b (ParseChunksInit src s)-            PR.Error err -> throwM $ ParseError err--    stepOuter _ (ParseChunksYield a next) = return $ Yield a next--{-# ANN type ConcatParseState Fuse #-}-data ConcatParseState b inpBuf st p m a =-      ConcatParseInit inpBuf st p-    | ConcatParseInitLeftOver inpBuf-    | forall s. ConcatParseStream st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m b)-    | forall s. ConcatParseBuf inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m b)-    | ConcatParseYield b (ConcatParseState b inpBuf st p m a)--{-# INLINE_NORMAL parseIterate #-}-parseIterate-    :: MonadThrow m-    => (b -> PRD.Parser m a b)-    -> b-    -> Stream m a-    -> Stream m b-parseIterate 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 pb next-            PRD.IError err -> throwM $ ParseError err--    -- 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 pb next-            PRD.IError err -> throwM $ ParseError err--    -- 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 b (ConcatParseInit src s (func b))-                    PR.Error err -> throwM $ ParseError err-            Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract-            Stop   -> do-                b <- extract pst-                let src = Prelude.reverse buf-                return $ Skip $ ConcatParseYield b (ConcatParseInitLeftOver src)--    -- 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 b-                                    (ConcatParseInit src s (func b))-            PR.Error err -> throwM $ ParseError err--    stepOuter _ (ConcatParseYield a next) = return $ Yield a next----------------------------------------------------------------------------------- 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, 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 (undefined :: 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, 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 (undefined :: 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----------------------------------------------------------------------------------- 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
− src/Streamly/Internal/Data/Stream/StreamD/Step.hs 
@@ -1,39 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Step--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.StreamD.Step-    (-    -- * The stream type-      Step (..)-    )-where--import Fusion.Plugin.Types (Fuse(..))---- | A stream is a succession of 'Step's. A 'Yield' produces a single value and--- the next state of the stream. 'Stop' indicates there are no more values in--- the stream.-{-# ANN type Step Fuse #-}-data Step s a = Yield a s | Skip s | Stop--instance Functor (Step s) where-    {-# INLINE fmap #-}-    fmap f (Yield x s) = Yield (f x) s-    fmap _ (Skip s) = Skip s-    fmap _ Stop = Stop--{--fromPure :: Monad m => a -> s -> m (Step s a)-fromPure a = return . Yield a--skip :: Monad m => s -> m (Step s a)-skip = return . Skip--stop :: Monad m => m (Step s a)-stop = return Stop--}
− src/Streamly/Internal/Data/Stream/StreamD/Transform.hs 
@@ -1,1240 +0,0 @@--- |--- 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-    , tapRate-    , pollCounts--    -- * Folding-    , foldrS-    , foldrT-    , foldlS-    , foldlT--    -- * Scanning By 'Fold'-    , postscanOnce -- XXX rename to postscan-    , scanOnce     -- XXX rename to scan--    -- * 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.-    , filter-    , filterM-    , deleteBy-    , uniq--    -- * Trimming-    -- | Produce a subset of the stream trimmed at ends.-    , take-    , takeByTime-    , takeWhile-    , takeWhileM-    , drop-    , dropByTime-    , dropWhile-    , dropWhileM--    -- * Inserting Elements-    -- | Produce a superset of the stream.-    , insertBy-    , intersperse-    , intersperseM-    , intersperseSuffix-    , intersperseSuffixBySpan--    -- * Inserting Side Effects-    , intersperseM_-    , intersperseSuffix_--    -- * Reordering-    -- | Produce strictly the same set but reordered.-    , reverse-    -- , reverse'--    -- * Position Indexing-    , indexed-    , indexedR--    -- * Searching-    , findIndices-    , slicesBy--    -- * Rolling map-    -- | Map using the previous element.-    , rollingMap-    , rollingMapM--    -- * Maybe Streams-    , mapMaybe-    , mapMaybeM-    )-where--#include "inline.hs"--import Control.Concurrent (killThread, threadDelay)-import Control.Exception (AsyncException)-import Control.Monad (void, when)-import Control.Monad.Catch (MonadCatch, throwM)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.IORef (newIORef, mkWeakIORef)-import Data.Maybe (fromJust, isJust)-import GHC.Types (SPEC(..))-import qualified Control.Monad.Catch as MC--import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Control.ForkLifted (fork, forkManaged)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Pipe.Type (Pipe(..), PipeState(..))-import Streamly.Internal.Data.SVar.Type (defState, adaptState)-import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)-import Streamly.Internal.Data.Time.Units-       (TimeUnit64, toRelTime64, diffAbsTime64)--import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.IORef.Prim as Prim-import qualified Streamly.Internal.Data.Pipe.Type as Pipe--import Prelude hiding-       ( drop, dropWhile, filter, map, mapM, reverse-       , scanl, scanl1, sequence, take, takeWhile)--import Streamly.Internal.Data.Stream.StreamD.Type----------------------------------------------------------------------------------- Piping---------------------------------------------------------------------------------{-# 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---------------------------------------------------------------------------------{-# 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---- 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---------------------------------------------------------------------------------{-# 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-{-# 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--{-# INLINE_NORMAL pollCounts #-}-pollCounts-    :: MonadAsync m-    => (a -> Bool)-    -> (Stream m Int -> Stream m Int)-    -> Fold m Int b-    -> Stream m a-    -> Stream m a-pollCounts predicate transf fld (Stream step state) = Stream step' Nothing-  where--    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        -- As long as we are using an "Int" for counts lockfree reads from-        -- Var should work correctly on both 32-bit and 64-bit machines.-        -- However, an Int on a 32-bit machine may overflow quickly.-        countVar <- liftIO $ Prim.newIORef (0 :: Int)-        tid <- forkManaged-            $ void $ fold fld-            $ transf $ Prim.toStreamD countVar-        return $ Skip (Just (countVar, tid, state))--    step' gst (Just (countVar, tid, st)) = do-        r <- step gst st-        case r of-            Yield x s -> do-                when (predicate x) $ liftIO $ Prim.modifyIORef' countVar (+ 1)-                return $ Yield x (Just (countVar, tid, s))-            Skip s -> return $ Skip (Just (countVar, tid, s))-            Stop -> do-                liftIO $ killThread tid-                return Stop--{-# INLINE_NORMAL tapRate #-}-tapRate ::-       (MonadAsync m, MonadCatch m)-    => Double-    -> (Int -> m b)-    -> Stream m a-    -> Stream m a-tapRate samplingRate action (Stream step state) = Stream step' Nothing-  where-    {-# NOINLINE loop #-}-    loop countVar prev = do-        i <--            MC.catch-                (do liftIO $ threadDelay (round $ samplingRate * 1000000)-                    i <- liftIO $ Prim.readIORef countVar-                    let !diff = i - prev-                    void $ action diff-                    return i)-                (\(e :: AsyncException) -> do-                     i <- liftIO $ Prim.readIORef countVar-                     let !diff = i - prev-                     void $ action diff-                     throwM (MC.toException e))-        loop countVar i--    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        countVar <- liftIO $ Prim.newIORef 0-        tid <- fork $ loop countVar 0-        ref <- liftIO $ newIORef ()-        _ <- liftIO $ mkWeakIORef ref (killThread tid)-        return $ Skip (Just (countVar, tid, state, ref))--    step' gst (Just (countVar, tid, st, ref)) = do-        r <- step gst st-        case r of-            Yield x s -> do-                liftIO $ Prim.modifyIORef' countVar (+ 1)-                return $ Yield x (Just (countVar, tid, s, ref))-            Skip s -> return $ Skip (Just (countVar, tid, s, ref))-            Stop -> do-                liftIO $ killThread tid-                return Stop----------------------------------------------------------------------------------- Scanning with a Fold---------------------------------------------------------------------------------data ScanState s f = ScanInit s | ScanDo s !f | ScanDone--{-# INLINE_NORMAL postscanOnce #-}-postscanOnce :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b-postscanOnce (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 scanOnce #-}-scanOnce :: Monad m-    => FL.Fold m a b -> Stream m a -> Stream m b-scanOnce (FL.Fold fstep initial extract) (Stream sstep state) =-    Stream step (ScanInit state)--    where--    {-# INLINE_LATE step #-}-    step _ (ScanInit st) = do-        res <- initial-        case res of-            FL.Partial fs -> do-                !b <- extract fs-                return $ Yield b $ ScanDo st fs-            FL.Done b -> return $ 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----------------------------------------------------------------------------------- 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)---- 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 (Just (state1, initial))--    where--    {-# INLINE_LATE step #-}-    step gst (Just (st, acc)) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield x s -> do-                old <- acc-                y <- fstep old x-                y `seq` return (Yield y (Just (s, return y)))-            Skip s -> return $ Skip $ Just (s, acc)-            Stop -> acc >>= done >>= \res -> return (Yield res Nothing)-    step _ Nothing = 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)--{-# 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 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 >>= \x -> x `seq` return x) `consM`-        postscanlMAfter' fstep initial done s--{-# 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-{-# 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--{-# INLINE scanl1' #-}-scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a-scanl1' f = scanl1M' (\x y -> return (f x y))------------------------------------------------------------------------------------ Filtering------------------------------------------------------------------------------------ Adapted from the vector package-{-# 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--{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-filter f = filterM (return . f)---- Adapted from the vector package-{-# INLINE_NORMAL uniq #-}-uniq :: (Eq a, Monad m) => Stream m a -> Stream m a-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--{-# INLINE_NORMAL deleteBy #-}-deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a-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----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- XXX using getTime in the loop can be pretty expensive especially for--- computations where iterations are lightweight. We have the following--- options:------ 1) Run a timeout thread updating a flag asynchronously and check that--- flag here, that way we can have a cheap termination check.------ 2) Use COARSE clock to get time with lower resolution but more efficiently.------ 3) Use rdtscp/rdtsc to get time directly from the processor, compute the--- termination value of rdtsc in the beginning and then in each iteration just--- get rdtsc and check if we should terminate.----data TakeByTime st s-    = TakeByTimeInit st-    | TakeByTimeCheck st s-    | TakeByTimeYield st s--{-# INLINE_NORMAL takeByTime #-}-takeByTime :: (MonadIO m, TimeUnit64 t) => t -> Stream m a -> Stream m a-takeByTime duration (Stream step1 state1) = Stream step (TakeByTimeInit state1)-    where--    lim = toRelTime64 duration--    {-# INLINE_LATE step #-}-    step _ (TakeByTimeInit _) | lim == 0 = return Stop-    step _ (TakeByTimeInit st) = do-        t0 <- liftIO $ getTime Monotonic-        return $ Skip (TakeByTimeYield st t0)-    step _ (TakeByTimeCheck st t0) = do-        t <- liftIO $ getTime Monotonic-        return $-            if diffAbsTime64 t t0 > lim-            then Stop-            else Skip (TakeByTimeYield st t0)-    step gst (TakeByTimeYield st t0) = do-        r <- step1 gst st-        return $ case r of-             Yield x s -> Yield x (TakeByTimeCheck s t0)-             Skip s -> Skip (TakeByTimeCheck s t0)-             Stop -> Stop--data DropByTime st s x-    = DropByTimeInit st-    | DropByTimeGen st s-    | DropByTimeCheck st s x-    | DropByTimeYield st--{-# INLINE_NORMAL dropByTime #-}-dropByTime :: (MonadIO m, TimeUnit64 t) => t -> Stream m a -> Stream m a-dropByTime duration (Stream step1 state1) = Stream step (DropByTimeInit state1)-    where--    lim = toRelTime64 duration--    {-# INLINE_LATE step #-}-    step _ (DropByTimeInit st) = do-        t0 <- liftIO $ getTime Monotonic-        return $ Skip (DropByTimeGen st t0)-    step gst (DropByTimeGen st t0) = do-        r <- step1 gst st-        return $ case r of-             Yield x s -> Skip (DropByTimeCheck s t0 x)-             Skip s -> Skip (DropByTimeGen s t0)-             Stop -> Stop-    step _ (DropByTimeCheck st t0 x) = do-        t <- liftIO $ getTime Monotonic-        if diffAbsTime64 t t0 <= lim-        then return $ Skip $ DropByTimeGen st t0-        else return $ Yield x $ DropByTimeYield st-    step gst (DropByTimeYield st) = do-        r <- step1 gst st-        return $ case r of-             Yield x s -> Yield x (DropByTimeYield s)-             Skip s -> Skip (DropByTimeYield s)-             Stop -> Stop---- Adapted from the vector package-{-# 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--{-# INLINE_NORMAL dropWhileM #-}-dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-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)--{-# INLINE dropWhile #-}-dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-dropWhile f = dropWhileM (return . f)----------------------------------------------------------------------------------- Inserting Elements---------------------------------------------------------------------------------{-# 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--{-# 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)--{-# INLINE intersperse #-}-intersperse :: Monad m => a -> Stream m a -> Stream m a-intersperse a = intersperseM (return a)--{-# 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)--data SuffixState s a-    = SuffixElem s-    | SuffixSuffix s-    | SuffixYield a (SuffixState s a)--{-# INLINE_NORMAL intersperseSuffix #-}-intersperseSuffix :: forall m a. Monad m => m a -> Stream m a -> Stream m a-intersperseSuffix 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--{-# INLINE_NORMAL intersperseSuffix_ #-}-intersperseSuffix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseSuffix_ 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---- | intersperse after every n items-{-# INLINE_NORMAL intersperseSuffixBySpan #-}-intersperseSuffixBySpan :: forall m a. Monad m-    => Int -> m a -> Stream m a -> Stream m a-intersperseSuffixBySpan 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----------------------------------------------------------------------------------- Reordering----------------------------------------------------------------------------------- We can implement reverse as:------ > reverse = foldlS (flip cons) nil------ However, this implementation is unusable because of the horrible performance--- of cons. So we just convert it to a list first and then stream from the--- list.------ XXX Maybe we can use an Array instead of a list here?-{-# INLINE_NORMAL reverse #-}-reverse :: Monad m => Stream m a -> Stream m a-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---- Much faster reverse for Storables-{--{-# INLINE_NORMAL reverse' #-}-reverse' :: forall m a. (MonadIO m, Storable a) => Stream m a -> Stream m a--- This commented implementation copies the whole stream into one single array--- and then streams from that array, this has exactly the same performance as--- the chunked code in IsStream.Common.reverse' .  Though this could be problematic due to--- unbounded large allocations. However, if we use an idiomatic implementation--- of arraysOf instead of the custom implementation then the chunked code--- becomes worse by 6 times. Need to investigate if that can be improved.-import Foreign.ForeignPtr (touchForeignPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Foreign.Ptr (Ptr, plusPtr)-import Streamly.Internal.Data.Array.Foreign.Mut.Type (sizeOfElem)-reverse' m = Stream step Nothing-    where-    {-# INLINE_LATE step #-}-    step _ Nothing = do-        arr <- A.fromStreamD m-        let p = A.aEnd arr `plusPtr` negate (sizeOfElem (undefined :: a))-        return $ Skip $ Just (A.aStart arr, p)--    step _ (Just (start, p)) | p < unsafeForeignPtrToPtr start = return Stop--    step _ (Just (start, p)) = do-        let !x = A.unsafeInlineIO $ do-                    r <- peek p-                    touchForeignPtr start-                    return r-            next = p `plusPtr` negate (sizeOfElem (undefined :: a))-        return $ Yield x (Just (start, next))--}----------------------------------------------------------------------------------- Position Indexing----------------------------------------------------------------------------------- Adapted from the vector package-{-# INLINE_NORMAL indexed #-}-indexed :: Monad m => Stream m a -> Stream m (Int, a)-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-{-# INLINE_NORMAL indexedR #-}-indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)-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----------------------------------------------------------------------------------- Searching---------------------------------------------------------------------------------{-# 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--{-# 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 = RollingMapInit s | RollingMapGo s a--{-# INLINE rollingMapM #-}-rollingMapM :: Monad m => (a -> a -> m b) -> Stream m a -> Stream m b-rollingMapM f (Stream step1 state1) = Stream step (RollingMapInit state1)-    where-    step gst (RollingMapInit st) = do-        r <- step1 (adaptState gst) st-        return $ case r of-            Yield x s -> Skip $ RollingMapGo s x-            Skip s -> Skip $ RollingMapInit s-            Stop   -> Stop--    step gst (RollingMapGo s1 x1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield x s -> do-                !res <- f x x1-                return $ Yield res $ RollingMapGo s x-            Skip s -> return $ Skip $ RollingMapGo s x1-            Stop   -> return Stop--{-# INLINE rollingMap #-}-rollingMap :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b-rollingMap f = rollingMapM (\x y -> return $ f x y)----------------------------------------------------------------------------------- Maybe Streams----------------------------------------------------------------------------------- XXX Will this always fuse properly?-{-# INLINE_NORMAL mapMaybe #-}-mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b-mapMaybe f = fmap fromJust . filter isJust . map f--{-# INLINE_NORMAL mapMaybeM #-}-mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b-mapMaybeM f = fmap fromJust . filter isJust . mapM f
− src/Streamly/Internal/Data/Stream/StreamD/Type.hs 
@@ -1,1034 +0,0 @@-#include "inline.hs"---- |--- 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 concatMap if we-    -- use the pattern synonym "Stream".-    , Stream (Stream, UnStream)--    -- * Primitives-    , nilM-    , consM-    , uncons--    -- * From Unfold-    , unfold--    -- * From Values-    , fromPure-    , fromEffect--    -- * From Containers-    , fromList--    -- * Conversions From/To-    , fromStreamK-    , toStreamK--    -- * Running a 'Fold'-    , fold-    , fold_-    , foldOn--    -- * Right Folds-    , foldrT-    , foldrM-    , foldrMx-    , foldr-    , foldrS--    -- * Left Folds-    , foldl'-    , foldlM'-    , foldlx'-    , foldlMx'--    -- * Special Folds-    , drain--    -- * To Containers-    , toList--    -- * Multi-stream folds-    , eqBy-    , cmpBy--    -- * Transformations-    , map-    , mapM-    , take-    , takeWhile-    , takeWhileM-    , takeEndBy-    , takeEndByM--    -- * Nesting-    , ConcatMapUState (..)-    , unfoldMany-    , concatMap-    , concatMapM-    , FoldMany (..) -- for inspection testing-    , FoldManyPost (..)-    , foldMany-    , foldManyPost-    , refoldMany-    , chunksOf-    )-where--import Control.Applicative (liftA2)-import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Trans.Class (lift, MonadTrans)-import Data.Functor (($>))-import Data.Functor.Identity (Identity(..))-import Fusion.Plugin.Types (Fuse(..))-import GHC.Base (build)-import GHC.Types (SPEC(..))-import Prelude hiding (map, mapM, foldr, take, concatMap, takeWhile)--import Streamly.Internal.Data.Fold.Type (Fold(..))-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-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K----------------------------------------------------------------------------------- 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.Stream m a -> s -> m (Step s a)) s--unShare :: Stream m a -> Stream m a-unShare (UnStream step state) = UnStream step' state-    where step' gst = step (adaptState gst)--pattern Stream :: (State K.Stream m a -> s -> m (Step s a)) -> s -> Stream m a-pattern Stream step state <- (unShare -> UnStream step state)-    where Stream = UnStream--#if __GLASGOW_HASKELL__ >= 802-{-# COMPLETE Stream #-}-#endif----------------------------------------------------------------------------------- Primitives----------------------------------------------------------------------------------- | An empty 'Stream' with a side effect.-{-# INLINE_NORMAL nilM #-}-nilM :: Applicative m => m b -> Stream m a-nilM m = Stream (\_ _ -> m $> Stop) ()--{-# 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---- | Does not fuse, has the same performance as the StreamK version.-{-# INLINE_NORMAL uncons #-}-uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))-uncons (UnStream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s -> return $ Just (x, Stream step s)-            Skip  s   -> go s-            Stop      -> return Nothing----------------------------------------------------------------------------------- From 'Unfold'---------------------------------------------------------------------------------data UnfoldState s = UnfoldNothing | UnfoldJust s---- | Convert an 'Unfold' into a 'Stream' by supplying it a seed.----{-# 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.-{-# 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.-{-# 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.--- | Convert a list of pure values to a 'Stream'-{-# INLINE_LATE fromList #-}-fromList :: Applicative m => [a] -> Stream m a-fromList = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ (x:xs) = pure $ Yield x xs-    step _ []     = pure Stop----------------------------------------------------------------------------------- Conversions From/To----------------------------------------------------------------------------------- | Convert a CPS encoded StreamK to direct style step encoded StreamD-{-# INLINE_LATE fromStreamK #-}-fromStreamK :: Applicative m => K.Stream 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.Stream 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'---------------------------------------------------------------------------------{-# INLINE_NORMAL fold #-}-fold :: Monad m => Fold m a b -> Stream m a -> m b-fold fld strm = do-    (b, _) <- fold_ fld strm-    return b--{-# INLINE_NORMAL fold_ #-}-fold_ :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)-fold_ (Fold fstep begin done) (Stream step state) = do-    res <- begin-    case res of-        FL.Partial fs -> go SPEC fs state-        FL.Done fb -> return $! (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 $! (b, Stream step s)-                    FL.Partial fs1 -> go SPEC fs1 s-            Skip s -> go SPEC fs s-            Stop -> do-                b <- done fs-                return $! (b, Stream (\ _ _ -> return Stop) ())--{-# INLINE_NORMAL foldOn #-}-foldOn :: Monad m => Fold m a b -> Stream m a -> Fold m a b-foldOn (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----------------------------------------------------------------------------------- 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] :: SerialT IO Bool)----{-# 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---- 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.----{-# 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 = do-        -- defState??-        r <- fromEffect $ step defState st-        case r of-          Yield x s -> f x (go SPEC s)-          Skip s    -> go SPEC s-          Stop      -> final---- Right fold to some transformer (T) monad.  This can be useful to implement--- stateless combinators like map, filtering, insertions, takeWhile, dropWhile.----{-# 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----------------------------------------------------------------------------------- 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----------------------------------------------------------------------------------- | Run a streaming composition, discard 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---------------------------------------------------------------------------------{-# INLINE_NORMAL toList #-}-toList :: Monad m => Stream m a -> m [a]-toList = 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" 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.-{-# 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.--- | Map a monadic function over a 'Stream'-{-# 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)--instance Functor m => Functor (Stream m) where-    {-# INLINE fmap #-}-    fmap f (Stream step state) = Stream step' state-      where-        {-# INLINE_LATE step' #-}-        step' gst st = fmap (fmap f) (step (adaptState gst) st)--    {-# INLINE (<$) #-}-    (<$) = fmap . const------------------------------------------------------------------------------------ Filtering------------------------------------------------------------------------------------ Adapted from the vector package.-{-# 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.-{-# INLINE_NORMAL takeWhileM #-}-takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-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--{-# 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)----------------------------------------------------------------------------------- Combine N Streams - concatAp---------------------------------------------------------------------------------{-# INLINE_NORMAL concatAp #-}-concatAp :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b-concatAp (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 apSequence #-}-apSequence :: Functor f => Stream f a -> Stream f b -> Stream f b-apSequence (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 apDiscardSnd #-}-apDiscardSnd :: Functor f => Stream f a -> Stream f b -> Stream f a-apDiscardSnd (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 (<*>) #-}-    (<*>) = concatAp--#if MIN_VERSION_base(4,10,0)-    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)-#endif--    {-# INLINE (*>) #-}-    (*>) = apSequence--    {-# INLINE (<*) #-}-    (<*) = apDiscardSnd----------------------------------------------------------------------------------- Combine N Streams - unfoldMany----------------------------------------------------------------------------------- Define a unique structure to use in inspection testing-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'.--{-# 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.-{-# 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)--{-# INLINE concatMap #-}-concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b-concatMap f = concatMapM (return . f)---- 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 #-}---- 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 (>>) #-}-    (>>) = (*>)----------------------------------------------------------------------------------- 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---- | Like foldMany but with the following differences:------ * If the stream is empty the default value of the fold would still be--- emitted in the output.--- * At the end of the stream if the last application of the fold did not--- receive any input it would still yield the default fold accumulator as the--- last value.----{-# 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---- | Apply a fold multiple times until the stream ends. If the stream is empty--- the output would be empty.------ @foldMany f = parseMany (fromFold f)@------ A terminating fold may terminate even without accepting a single input. So--- we run the fold's initial action before evaluating the stream. However, this--- means that if later the stream does not yield anything we have to discard--- the fold's initial result which could have generated an effect.----{-# 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 chunksOf #-}-chunksOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b-chunksOf n f = foldMany (FL.take n f)---- Keep the argument order consistent with consumeIterateM.------ | 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----------------------------------------------------------------------------------- Other instances---------------------------------------------------------------------------------instance MonadTrans Stream where-    {-# INLINE lift #-}-    lift = fromEffect--instance (MonadThrow m) => MonadThrow (Stream m) where-    throwM = lift . throwM
− src/Streamly/Internal/Data/Stream/StreamDK.hs 
@@ -1,156 +0,0 @@-#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Stream.StreamDK--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC-----module Streamly.Internal.Data.Stream.StreamDK-    (-    -- * Stream Type--      Stream-    , Step (..)--    -- * Construction-    , nil-    , cons-    , consM-    , unfoldr-    , unfoldrM-    , replicateM--    -- * Folding-    , uncons-    , foldrS--    -- * Specific Folds-    , drain-    )-where--import Streamly.Internal.Data.Stream.StreamDK.Type (Stream(..), Step(..))------------------------------------------------------------------------------------ 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/StreamDK/Type.hs 
@@ -1,104 +0,0 @@--- |--- Module      : Streamly.StreamDK.Type--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ A CPS style stream using a constructor based representation instead of a--- function based representation.------ Streamly internally uses two fundamental stream representations, (1) streams--- with an open or arbitrary control flow (we call it StreamK), (2) streams--- with a structured or closed loop control flow (we call it StreamD). The--- higher level stream types can use any of these representations under the--- hood and can interconvert between the two.------ StreamD:------ StreamD is a non-recursive data type in which the state of the stream and--- the step function are separate. When the step function is called, a stream--- element and the new stream state is yielded. The generated element and the--- state are passed to the next consumer in the loop. The state is threaded--- around in the loop until control returns back to the original step function--- to run the next step. This creates a structured closed loop representation--- (like "for" loops in C) with state of each step being hidden/abstracted or--- existential within that step. This creates a loop representation identical--- to the "for" or "while" loop constructs in imperative languages, the states--- of the steps combined together constitute the state of the loop iteration.------ Internally most combinators use a closed loop representation because it--- provides very high efficiency due to stream fusion. The performance of this--- representation is competitive to the C language implementations.------ Pros and Cons of StreamD:------ 1) stream-fusion: This representation can be optimized very efficiently by--- the compiler because the state is explicitly separated from step functions,--- represented using pure data constructors and visible to the compiler, the--- stream steps can be fused using case-of-case transformations and the state--- can be specialized using spec-constructor optimization, yielding a C like--- tight loop/state machine with no constructors, the state is used unboxed and--- therefore no unnecessary allocation.------ 2) Because of a closed representation consing too many elements in this type--- of stream does not scale, it will have quadratic performance slowdown. Each--- cons creates a layer that needs to return the control back to the caller.--- Another implementation of cons is possible but that will have to box/unbox--- the state and will not fuse. So effectively cons breaks fusion.------ 3) unconsing an item from the stream breaks fusion, we have to "pause" the--- loop, rebox and save the state.------ 3) Exception handling is easy to implement in this model because control--- flow is structured in the loop and cannot be arbitrary. Therefore,--- implementing "bracket" is natural.------ 4) Round-robin scheduling for co-operative multitasking is easy to implement.------ 5) It fuses well with the direct style Fold implementation.------ StreamK/StreamDK:------ StreamDK i.e. the stream defined in this module, like StreamK, is a--- recursive data type which has no explicit state defined using constructors,--- each step yields an element and a computation representing the rest of the--- stream.  Stream state is part of the function representing the rest of the--- stream.  This creates an open computation representation, or essentially a--- continuation passing style computation.  After the stream step is executed,--- the caller is free to consume the produced element and then send the control--- wherever it wants, there is no restriction on the control to return back--- somewhere, the control is free to go anywhere. The caller may decide not to--- consume the rest of the stream. This representation is more like a "goto"--- based implementation in imperative languages.------ Pros and Cons of StreamK:------ 1) The way StreamD can be optimized using stream-fusion, this type can be--- optimized using foldr/build fusion. However, foldr/build has not yet been--- fully implemented for StreamK/StreamDK.------ 2) Using cons is natural in this representation, unlike in StreamD it does--- not have a quadratic slowdown. Currently, we in fact wrap StreamD in StreamK--- to support a better cons operation.------ 3) Similarly, uncons is natural in this representation.------ 4) Exception handling is not easy to implement because of the "goto" nature--- of CPS.------ 5) Composable folds are not implemented/proven, however, intuition says that--- a push style CPS representation should be able to be used along with StreamK--- to efficiently implement composable folds.--module Streamly.Internal.Data.Stream.StreamDK.Type-    ( Step(..)-    , Stream (..)-    )-where---- 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))
− src/Streamly/Internal/Data/Stream/StreamK.hs 
@@ -1,956 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Stream.StreamK--- 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.------ @--- import qualified Streamly.Internal.Data.Stream.StreamK as K--- @----module Streamly.Internal.Data.Stream.StreamK-    (-    -- * The stream type-      Stream(..)--    -- * 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-    , foldrT--    , foldl'-    , foldlM'-    , foldlS-    , foldlT-    , foldlx'-    , foldlMx'-    , fold--    -- ** 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--    -- ** Map and Filter-    , mapMaybe--    -- ** Zipping-    , zipWith-    , zipWithM--    -- ** Merging-    , mergeBy-    , mergeByM--    -- ** Nesting-    , concatMapWith-    , concatMap-    , bindWith-    , concatPairsWith-    , apWith-    , apSerial-    , apSerialDiscardFst-    , apSerialDiscardSnd--    -- ** Transformation comprehensions-    , the--    -- * Semigroup Style Composition-    , serial--    -- * Utilities-    , consM-    , withLocal-    , mfix-    )-where--import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad (void, join)-import Streamly.Internal.Data.SVar.Type (adaptState, defState)--import qualified Streamly.Internal.Data.Fold.Type as FL--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)--import Streamly.Internal.Data.Stream.StreamK.Type---- $setup--- >>> :m------------------------------------------------------------------------------------ Generation----------------------------------------------------------------------------------{-# INLINE unfoldrM #-}-unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> Stream m a-unfoldrM = unfoldrMWith consM-{---- 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 :: (IsStream t, MonadAsync m) =>-    (b -> Maybe (m a, b)) -> b -> Stream m a-unfoldrA = undefined--}------------------------------------------------------------------------------------ Special generation----------------------------------------------------------------------------------repeatM :: Monad m => m a -> Stream m a-repeatM = repeatMWith consM--{-# INLINE replicateM #-}-replicateM :: Monad m => Int -> m a -> Stream m a-replicateM = replicateMWith consM-{-# INLINE replicate #-}-replicate :: Int -> a -> Stream 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) -> Stream m a-fromIndicesM = fromIndicesMWith consM-{-# INLINE fromIndices #-}-fromIndices :: (Int -> a) -> Stream m a-fromIndices gen = go 0-  where-    go n = gen n `cons` go (n + 1)--{-# INLINE iterate #-}-iterate :: (a -> a) -> a -> Stream m a-iterate step = go-    where-        go !s = cons s (go (step s))--{-# INLINE iterateM #-}-iterateM :: Monad m => (a -> m a) -> m a -> Stream m a-iterateM = iterateMWith consM------------------------------------------------------------------------------------ Conversions----------------------------------------------------------------------------------{-# INLINE fromList #-}-fromList :: [a] -> Stream m a-fromList = fromFoldable------------------------------------------------------------------------------------ Elimination by Folding------------------------------------------------------------------------------------ | Lazy right associative fold.-{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b-foldr step acc = foldrM (\x xs -> xs >>= \b -> return (step x b)) (return 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 -> Stream 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--{-# INLINE foldr1 #-}-foldr1 :: Monad m => (a -> a -> a) -> Stream 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) -> Stream 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--{-# INLINABLE fold #-}-fold :: Monad m => FL.Fold m a b -> Stream 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---- | Like 'foldl'' but with a monadic step function.-{-# INLINE foldlM' #-}-foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b-foldlM' step begin = foldlMx' step begin return---- | 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 -> Stream 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----------------------------------------------------------------------------------- Specialized folds---------------------------------------------------------------------------------{-# INLINE head #-}-head :: Monad m => Stream 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 -> Stream 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 -> Stream 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) -> Stream 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) -> Stream 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 => Stream m a -> m (Maybe a)-last = foldlx' (\_ y -> Just y) Nothing id--{-# INLINE minimum #-}-minimum :: (Monad m, Ord a) => Stream 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) -> Stream 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) => Stream 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) -> Stream 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 => Stream 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 -> Stream 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) -> Stream 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) -> Stream m a -> m (Maybe a)-find p = findM (return . p)--{-# INLINE findIndices #-}-findIndices :: (a -> Bool) -> Stream m a -> Stream 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) -> Stream 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) -> Stream m a -> Stream m b-mapM = mapMWith consM----------------------------------------------------------------------------------- Converting folds---------------------------------------------------------------------------------{-# INLINABLE toList #-}-toList :: Monad m => Stream 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) -> Stream m a -> Stream 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) -> Stream m a -> Stream 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 -> Stream m a -> Stream m b-scanl' step begin = scanlx' step begin id------------------------------------------------------------------------------------ Filtering----------------------------------------------------------------------------------{-# INLINE filter #-}-filter :: (a -> Bool) -> Stream m a -> Stream 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 -> Stream m a -> Stream 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) -> Stream m a -> Stream 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 -> Stream m a -> Stream 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) -> Stream m a -> Stream 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 => Stream m (m a) -> Stream 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 -> Stream m a -> Stream 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 -> Stream m a -> Stream m a-intersperse a = intersperseM (return a)--{-# INLINE insertBy #-}-insertBy :: (a -> a -> Ordering) -> a -> Stream m a -> Stream 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 -> Stream m a -> Stream 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) -> Stream m a -> Stream 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.------ @since 0.1.0-{-# 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))---- | Zip two streams serially using a monadic zipping function.------ @since 0.1.0-{-# INLINE zipWithM #-}-zipWithM :: Monad m =>-    (a -> b -> m c) -> Stream m a -> Stream m b -> Stream 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) -> Stream m a -> Stream m a -> Stream 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) -> Stream m a -> Stream m a -> Stream 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) => Stream 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 :: Stream m a -> Stream m a -> Stream 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-    => Stream m a -> (e -> Stream m a) -> Stream 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--}
− src/Streamly/Internal/Data/Stream/StreamK/Type.hs 
@@ -1,1320 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--#include "inline.hs"---- |--- 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-    (-    -- * The stream type-      Stream (..)-    , toStreamK-    , fromStreamK--    -- * foldr/build-    , mkStream-    , foldStream-    , foldStreamShared-    , foldrM-    , foldrS-    , foldrSShared-    , foldrSM-    , build-    , buildS-    , buildM-    , buildSM-    , augmentS-    , augmentSM--    -- * Construction-    , fromStopK-    , fromYieldK-    , consK-    , cons-    , (.:)-    , consM-    , consMBy-    , nil-    , nilM--    -- * Generation-    , fromEffect-    , fromPure-    , unfoldr-    , unfoldrMWith-    , repeat-    , repeatMWith-    , replicateMWith-    , fromIndicesMWith-    , iterateMWith-    , fromFoldable-    , fromFoldableM-    , mfix--    -- * Elimination-    , uncons-    , foldl'-    , foldlx'-    , drain-    , null-    , tail-    , init--    -- * Transformation-    , conjoin-    , serial-    , map-    , mapMWith-    , mapMSerial-    , unShare-    , concatMapWith-    , concatMap-    , bindWith-    , concatPairsWith-    , apWith-    , apSerial-    , apSerialDiscardFst-    , apSerialDiscardSnd-    , foldlS-    , reverse--    -- * Reader-    , withLocal-    )-where--import Control.Monad (ap, (>=>))-import Control.Monad.Reader.Class (MonadReader(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Function (fix)-#if __GLASGOW_HASKELL__ < 804-import Data.Semigroup (Semigroup(..))-#endif-import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)-import Prelude hiding-    (map, mapM, concatMap, foldr, repeat, null, reverse, tail, init)-import qualified Prelude----------------------------------------------------------------------------------- Basic stream type----------------------------------------------------------------------------------- | The type @Stream m a@ represents a monadic stream of values of type 'a'--- constructed using actions in monad 'm'. It uses stop, singleton and yield--- continuations equivalent to the following direct style type:------ @--- data Stream m a = Stop | Singleton a | Yield a (Stream 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 Stream type parameter from State as it is always constant.--- We can remove it from SVar as well--newtype Stream m a =-    MkStream (forall r.-               State Stream m a         -- state-            -> (a -> Stream m a -> m r) -- yield-            -> (a -> m r)               -- singleton-            -> m r                      -- stop-            -> m r-            )--{-# INLINE fromStreamK #-}-fromStreamK :: Stream m a -> Stream m a-fromStreamK = id--{-# INLINE toStreamK #-}-toStreamK :: Stream m a -> Stream m a-toStreamK = id--mkStream-    :: (forall r. State Stream m a-        -> (a -> Stream m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r)-    -> Stream 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 -> Stream 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 -> Stream m a-fromYieldK k = mkStream $ \_ _ sng _ -> k sng---- | Add a yield function at the head of the stream.-consK :: YieldK m a -> Stream m a -> Stream 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.--- | Construct a stream by adding a pure value at the head of an existing--- stream. For serial streams this is the same as @(return a) \`consM` r@ but--- more efficient. For concurrent streams this is not concurrent whereas--- 'consM' is concurrent. For example:------ @--- > toList $ 1 \`cons` 2 \`cons` 3 \`cons` nil--- [1,2,3]--- @------ @since 0.1.0-{-# INLINE_NORMAL cons #-}-cons :: a -> Stream m a -> Stream m a-cons a r = mkStream $ \_ yield _ _ -> yield a r--infixr 5 .:---- | Operator equivalent of 'cons'.------ @--- > toList $ 1 .: 2 .: 3 .: nil--- [1,2,3]--- @------ @since 0.1.1-{-# INLINE (.:) #-}-(.:) :: a -> Stream m a -> Stream m a-(.:) = cons---- | An empty stream.------ @--- > toList nil--- []--- @------ @since 0.1.0-{-# INLINE_NORMAL nil #-}-nil :: Stream m a-nil = mkStream $ \_ _ _ stp -> stp---- | An empty stream producing a side effect.------ @--- > toList (nilM (print "nil"))--- "nil"--- []--- @------ /Pre-release/-{-# INLINE_NORMAL nilM #-}-nilM :: Applicative m => m b -> Stream m a-nilM m = mkStream $ \_ _ _ stp -> m *> stp--{-# INLINE_NORMAL fromPure #-}-fromPure :: a -> Stream m a-fromPure a = mkStream $ \_ _ single _ -> single a--{-# INLINE_NORMAL fromEffect #-}-fromEffect :: Monad m => m a -> Stream 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.-{-# 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 r = MkStream $ \_ yld _ _ -> m >>= (`yld` r)---- XXX specialize to IO?-{-# INLINE consMBy #-}-consMBy :: Monad m =>-    (Stream m a -> Stream m a -> Stream m a) -> m a -> Stream m a -> Stream 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 Stream m a-    -> (a -> Stream m a -> m r)-    -> (a -> m r)-    -> m r-    -> Stream 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 Stream m a-    -> (a -> Stream m a -> m r)-    -> (a -> m r)-    -> m r-    -> Stream 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 Stream m b-        -> (b -> Stream m b -> m r)-        -> (b -> m r)-        -> m r-        -> Stream m b-        -> m r)-    -> (a -> Stream m b -> Stream m b)-    -> Stream m b-    -> Stream m a-    -> Stream 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 -> Stream m b -> Stream m b)-    -> Stream m b-    -> Stream m a-    -> Stream 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 #-}---- | Lazy right associative fold to a stream.-{-# INLINE_NORMAL foldrS #-}-foldrS ::-       (a -> Stream m b -> Stream m b)-    -> Stream m b-    -> Stream m a-    -> Stream 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 Stream m b-        -> (b -> Stream m b -> m r)-        -> (b -> m r)-        -> m r-        -> Stream m b-        -> m r)-    -> (m a -> Stream m b -> Stream m b)-    -> Stream m b-    -> Stream m a-    -> Stream 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 -> Stream m b -> Stream m b)-    -> Stream m b-    -> Stream m a-    -> Stream 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 -> Stream m b -> Stream m b)-    -> Stream m b-    -> Stream m a-    -> Stream 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) -> 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 #-}--{-# 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 -> Stream m a -> Stream m a) -> Stream m a -> Stream m a)-    -> Stream m a-buildS g = g cons nil--{-# RULES "foldrS/buildS"-      forall k z-        (g :: (a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-      foldrS k z (buildS g) = g k z #-}--{-# RULES "foldrS/cons/buildS"-      forall k z x-        (g :: (a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-      foldrS k z (x `cons` buildS g) = k x (g k z) #-}--{-# RULES "foldrSShared/buildS"-      forall k z-        (g :: (a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-      foldrSShared k z (buildS g) = g k z #-}--{-# RULES "foldrSShared/cons/buildS"-      forall k z x-        (g :: (a -> Stream m a -> Stream m a) -> Stream m a -> Stream 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 -> Stream m a -> Stream m a) -> Stream m a -> Stream m a)-    -> Stream m a-buildSM g = g consM nil--{-# RULES "foldrSM/buildSM"-     forall k z-        (g :: (m a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-     foldrSM k z (buildSM g) = g k z #-}--{-# RULES "foldrSMShared/buildSM"-     forall k z-        (g :: (m a -> Stream m a -> Stream m a) -> Stream m a -> Stream 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 -> Stream m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )-    -> Stream 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 -> Stream m a -> Stream m a)-    -> (forall r. (a -> Stream m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )-    -> Stream 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 -> Stream m a -> Stream m a) -> Stream m a -> Stream m a)-    -> Stream m a-    -> Stream m a-augmentS g xs = g cons xs--{-# RULES "augmentS/nil"-    forall (g :: (a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-    augmentS g nil = buildS g-    #-}--{-# RULES "foldrS/augmentS"-    forall k z xs-        (g :: (a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-    foldrS k z (augmentS g xs) = g k (foldrS k z xs)-    #-}--{-# RULES "augmentS/buildS"-    forall (g :: (a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a)-           (h :: (a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-    augmentS g (buildS h) = buildS (\c n -> g c (h c n))-    #-}--{-# INLINE_NORMAL augmentSM #-}-augmentSM :: Monad m =>-       ((m a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a)-    -> Stream m a -> Stream m a-augmentSM g xs = g consM xs--{-# RULES "augmentSM/nil"-    forall-        (g :: (m a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-    augmentSM g nil = buildSM g-    #-}--{-# RULES "foldrSM/augmentSM"-    forall k z xs-        (g :: (m a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a).-    foldrSM k z (augmentSM g xs) = g k (foldrSM k z xs)-    #-}--{-# RULES "augmentSM/buildSM"-    forall-        (g :: (m a -> Stream m a -> Stream m a) -> Stream m a -> Stream m a)-        (h :: (m a -> Stream m a -> Stream m a) -> Stream m a -> Stream 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 -> Stream 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 Stream m a-        -> (a -> Stream m a -> m b)-        -> (a -> m b)-        -> m b-        -> Stream m a-        -> m b)-    -> (a -> m b -> m b)-    -> m b-    -> ((a -> Stream 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 -> Stream 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 -> Stream 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) -> Stream m a -> m b-foldlx' step begin done m = get $ go m begin-    where-    {-# NOINLINE get #-}-    get :: Stream 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 :: Stream m a -> x -> Stream 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 -> Stream 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 => Stream 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 => Stream 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 `serial`---- | Appends two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.----{-# INLINE serial #-}-serial :: Stream m a -> Stream m a -> Stream 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-serial 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 => Stream m a -> Stream m a -> Stream m a-conjoin xs = augmentSM (\c n -> foldrSM c n xs)--instance Semigroup (Stream m a) where-    (<>) = serial----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance Monoid (Stream m a) where-    mempty = nil-    mappend = (<>)------------------------------------------------------------------------------------ Functor------------------------------------------------------------------------------------ Note eta expanded-{-# INLINE_LATE mapFB #-}-mapFB :: forall b m a.-       (b -> Stream m b -> Stream m b)-    -> (a -> b)-    -> a-    -> Stream m b-    -> Stream 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) -> Stream m a -> Stream 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) -> Stream m a -> Stream m b-mapMSerial f xs = buildSM (\c n -> foldrSMShared (mapMFB c f) n xs)--{-# INLINE mapMWith #-}-mapMWith ::-       (m b -> Stream m b -> Stream m b)-    -> (a -> m b)-    -> Stream m a-    -> Stream 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 (Stream m) where-    fmap = map------------------------------------------------------------------------------------ Transformers----------------------------------------------------------------------------------instance MonadTrans Stream where-    {-# INLINE lift #-}-    lift = fromEffect------------------------------------------------------------------------------------ Nesting------------------------------------------------------------------------------------ | Detach a stream from an SVar-{-# INLINE unShare #-}-unShare :: Stream m a -> Stream 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 apWith #-}-apWith ::-       (Stream m b -> Stream m b -> Stream m b)-    -> Stream m (a -> b)-    -> Stream m a-    -> Stream m b-apWith 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--{-# INLINE apSerial #-}-apSerial ::-       Stream m (a -> b)-    -> Stream m a-    -> Stream m b-apSerial 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 apSerialDiscardFst #-}-apSerialDiscardFst ::-       Stream m a-    -> Stream m b-    -> Stream m b-apSerialDiscardFst 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 apSerialDiscardSnd #-}-apSerialDiscardSnd ::-       Stream m a-    -> Stream m b-    -> Stream m a-apSerialDiscardSnd 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---- 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 ::-       (Stream m b -> Stream m b -> Stream m b)-    -> Stream m a-    -> (a -> Stream m b)-    -> Stream 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. For example, the concat function--- could be 'serial', 'parallel', 'async', 'ahead' or any other zip or merge--- function.------ @since 0.7.0-{-# 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--{-# INLINE concatMap #-}-concatMap :: (a -> Stream m b) -> Stream m a -> Stream m b-concatMap = concatMapWith serial--{---- 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)--}---- | See 'Streamly.Internal.Data.Stream.IsStream.concatPairsWith' for--- documentation.----{-# INLINE concatPairsWith #-}-concatPairsWith-    ::-       (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> Stream m a-    -> Stream m b-concatPairsWith 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 (Stream m) where-    {-# INLINE pure #-}-    pure = fromPure-    {-# INLINE (<*>) #-}-    (<*>) = ap---- 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 (Stream 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--}----------------------------------------------------------------------------------- MonadReader---------------------------------------------------------------------------------{-# INLINABLE withLocal #-}-withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a-withLocal f m =-    mkStream $ \st yld sng stp ->-        let single = local f . sng-            yieldk a r = local f $ yld a (withLocal f r)-        in foldStream st yieldk single (local f stp) m------------------------------------------------------------------------------------ Generation----------------------------------------------------------------------------------{-# INLINE unfoldr #-}-unfoldr :: (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--{-# INLINE unfoldrMWith #-}-unfoldrMWith :: Monad m =>-       (m a -> Stream m a -> Stream m a)-    -> (b -> m (Maybe (a, b)))-    -> b-    -> Stream 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---- | Generate an infinite stream by repeating a pure value.------ /Pre-release/-{-# INLINE repeat #-}-repeat :: a -> Stream 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 -> Stream m a -> Stream m a) -> Int -> m a -> Stream 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 -> Stream m a -> Stream m a) -> (Int -> m a) -> Stream 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 -> Stream m a -> Stream m a) -> (a -> m a) -> m a -> Stream 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 => Stream m a -> m a-headPartial = foldrM (\x _ -> return x) (error "head of nil")--{-# INLINE tailPartial #-}-tailPartial :: Stream m a -> Stream 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--{-# INLINE mfix #-}-mfix :: Monad m => (m a -> Stream m a) -> Stream 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' 'cons' 'nil'--- @------ Construct a stream from a 'Foldable' containing pure values:------ @since 0.2.0-{-# INLINE fromFoldable #-}-fromFoldable :: Foldable f => f a -> Stream m a-fromFoldable = Prelude.foldr cons nil--{-# INLINE fromFoldableM #-}-fromFoldableM :: (Foldable f, Monad m) => f (m a) -> Stream m a-fromFoldableM = Prelude.foldr consM nil------------------------------------------------------------------------------------ Deconstruction----------------------------------------------------------------------------------{-# INLINE uncons #-}-uncons :: Applicative m => Stream m a -> m (Maybe (a, Stream 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 => Stream m a -> m (Maybe (Stream m a))-tail =-    let stop      = pure Nothing-        single _  = pure $ Just nil-        yieldk _ r = pure $ Just r-    in foldStream defState yieldk single stop--{-# INLINE init #-}-init :: Applicative m => Stream m a -> m (Maybe (Stream 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 ::-    (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream 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 :: Stream m a -> Stream m a-reverse = foldlS (flip cons) nil
+ src/Streamly/Internal/Data/Stream/Time.hs view
@@ -0,0 +1,1014 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Time+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Time+    (+    -- * Imports for Examples+    -- $setup++    -- * Timers+      periodic -- XXX Should go to Streamly.Data.Stream+    , ticks -- XXX Should go to Streamly.Data.Stream+    , ticksRate+    , interject++    -- * Trimming+    , takeInterval+    , takeLastInterval+    , dropInterval+    , dropLastInterval++    -- * Chunking+    , intervalsOf+    , boundedIntervalsOf+    , timedGroupsOf+    , timedChunksOf+    , timedChunksOf'++    -- * Sampling+    , sampleIntervalEnd+    , sampleIntervalStart+    , sampleBurst+    , sampleBurstEnd+    , sampleBurstStart++    -- * Windowed Sessions+    , classifySessionsByGeneric+    , classifySessionsBy+    , classifySessionsOf+    , classifyKeepAliveSessions++    -- XXX This should go in the concurrent module+    -- * Buffering+    -- | Evaluate strictly using a buffer of results.  When the buffer becomes+    -- full we can block, drop the new elements, drop the oldest element and+    -- insert the new at the end.+    , bufferLatest+    , bufferLatestN+    , bufferOldestN++    -- * Deprecated+    , groupsOfTimeout+    )+where++import Control.Concurrent (threadDelay)+import Control.Exception (assert)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Heap (Entry(..))+import Data.Kind (Type)+import Data.Map (Map)+import Data.Maybe (isNothing)+import Data.Proxy (Proxy(..))+import Streamly.Data.Fold (Fold)+import Streamly.Data.Array (Unbox)+import Streamly.Internal.Data.Array (Array)+import Streamly.Internal.Data.Fold (Fold (..))+import Streamly.Internal.Data.IsMap (IsMap(..))+import Streamly.Internal.Data.Channel.Types (Rate)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Stream.Channel.Type (rate)+import Streamly.Internal.Data.Time.Units+    ( AbsTime+    , MilliSecond64(..)+    , addToAbsTime+    , toAbsTime+    , toRelTime+    )+import Streamly.Internal.Data.Time.Units (NanoSecond64(..), toRelTime64)++import qualified Data.Heap as H+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Fold as Fold (Step(..))+import qualified Streamly.Internal.Data.IsMap as IsMap+import qualified Streamly.Internal.Data.Stream as Stream+    ( scanlMAfter'+    , timeIndexed+    , timestamped+    )++import Streamly.Internal.Data.Stream.Concurrent++-- $setup+--+-- Imports for example snippets in this module.+--+-- >>> :m+-- >>> import Control.Concurrent (threadDelay)+-- >>> import qualified Streamly.Data.Array as Array+-- >>> 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.Stream.Prelude as Stream+-- >>> import qualified Streamly.Internal.Data.Stream as Stream (delayPost, timestamped)+-- >>> import qualified Streamly.Internal.Data.Stream.Concurrent as Stream (parListEagerFst)+-- >>> import qualified Streamly.Internal.Data.Stream.Time as Stream+-- >>> import Prelude hiding (concatMap, concat)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}++--------------------------------------------------------------------------------+-- Combinators+--------------------------------------------------------------------------------++-- | Generate a stream by running an action periodically at the specified time+-- interval.+--+{-# INLINE periodic #-}+periodic :: MonadIO m => m a -> Double -> Stream m a+periodic action n = Stream.repeatM timed++    where++    timed = liftIO (threadDelay (round $ n * 1000000)) >> action++-- | Generate a tick stream consisting of '()' elements, each tick is generated+-- after the specified time delay given in seconds.+--+-- >>> ticks = Stream.periodic (return ())+--+{-# INLINE ticks #-}+ticks :: MonadIO m => Double -> Stream m ()+ticks = periodic (return ())++-- | Generate a tick stream, ticks are generated at the specified 'Rate'. The+-- rate is adaptive, the tick generation speed can be increased or decreased at+-- different times to achieve the specified rate.  The specific behavior for+-- different styles of 'Rate' specifications is documented under 'Rate'.  The+-- effective maximum rate achieved by a stream is governed by the processor+-- speed.+--+-- >>> tickStream = Stream.repeatM (return ())+-- >>> ticksRate r = Stream.parBuffered (Stream.rate (Just r)) tickStream+--+{-# INLINE ticksRate #-}+ticksRate :: MonadAsync m => Rate -> Stream m ()+ticksRate r = parBuffered (rate (Just r)) $ Stream.repeatM (return ())++-- XXX The case when the interval is 0, we should run only the stream being+-- interjected.++-- | Intersperse a monadic action into the input stream after every @n@+-- seconds.+--+-- Definition:+--+-- >>> interject n f xs = Stream.parListEagerFst [xs, Stream.periodic f n]+--+-- Example:+--+-- >>> s = Stream.fromList "hello"+-- >>> input = Stream.mapM (\x -> threadDelay 1000000 >> putChar x) s+-- >>> Stream.fold Fold.drain $ Stream.interject (putChar ',') 1.05 input+-- h,e,l,l,o+--+{-# INLINE interject #-}+interject :: MonadAsync m => m a -> Double -> Stream m a -> Stream m a+interject f n xs = parListEagerFst [xs, periodic f n]++-- XXX No element should be yielded if the duration is zero.++-- | @takeInterval interval@ runs the stream only upto the specified time+-- @interval@ in seconds.+--+-- The interval starts when the stream is evaluated for the first time.+--+{-# INLINE takeInterval #-}+takeInterval :: MonadAsync m => Double -> Stream m a -> Stream m a+takeInterval d =+    Stream.catMaybes+        . Stream.takeWhile isNothing+        . interject (return Nothing) d . fmap Just++-- | Take time interval @i@ seconds at the end of the stream.+--+-- O(n) space, where n is the number elements taken.+--+-- /Unimplemented/+{-# INLINE takeLastInterval #-}+takeLastInterval :: -- MonadAsync m =>+    Double -> Stream m a -> Stream m a+takeLastInterval = undefined++-- XXX All elements should be yielded if the duration is zero.++-- | @dropInterval interval@ drops all the stream elements that are generated+-- before the specified @interval@ in seconds has passed.+--+-- The interval begins when the stream is evaluated for the first time.+--+{-# INLINE dropInterval #-}+dropInterval :: MonadAsync m => Double -> Stream m a -> Stream m a+dropInterval d =+    Stream.catMaybes+        . Stream.dropWhile isNothing+        . interject (return Nothing) d . fmap Just++-- | Drop time interval @i@ seconds at the end of the stream.+--+-- O(n) space, where n is the number elements dropped.+--+-- /Unimplemented/+{-# INLINE dropLastInterval #-}+dropLastInterval :: -- MonadAsync m =>+    Int -> Stream m a -> Stream m a+dropLastInterval = undefined++-- | Group the input stream into windows of @n@ second each and then fold each+-- group using the provided fold function.+--+-- If the fold terminates before the interval is over, the next collection is+-- started, thus multiple collection can happen in the same interval. If the+-- fold does not terminate before the interval is over, the fold will be forced+-- to terminate at the interval end.+--+-- Example:+--+-- >>> twoPerSec = Stream.parBuffered (Stream.constRate 2) $ Stream.enumerateFrom 1+-- >>> intervals = Stream.intervalsOf 1 Fold.toList twoPerSec+-- >>> Stream.fold Fold.toList $ Stream.take 2 intervals+-- [...,...]+--+{-# INLINE intervalsOf #-}+intervalsOf :: MonadAsync m => Double -> Fold m a b -> Stream m a -> Stream m b+intervalsOf n f xs =+    Stream.foldMany+        (Fold.takeEndBy isNothing (Fold.catMaybes f))+        (interject (return Nothing) n (fmap Just xs))++-- | Like 'intervalsOf' but with an additional argument to limit the number of+-- collected items to a max limit. If the limit is reached, the fold output is+-- emitted and the next interval is started.+--+-- An alternative behavior would be to emit multiple elements in the same+-- interval if the size is exceeded, keeping the intervals fixed. That can be+-- achieved by using 'intervalsOf' and using a fold that terminates on the+-- limit.+--+-- /Unimplemented/+{-# INLINE boundedIntervalsOf #-}+boundedIntervalsOf :: -- MonadAsync m =>+    Int -> Double -> Int -> Fold m a b -> Stream m a -> Stream m b+boundedIntervalsOf _len _time _f _xs = undefined++-- XXX This can be implemented more efficiently by sharing a Clock.Timer across+-- parallel threads and resetting it whenever a span is emitted.++-- | Like 'groupsOf' but if the group is not completed within the specified+-- time interval then emit whatever we have collected till now. The group+-- timeout is reset whenever a group is emitted. The granularity of the clock+-- is 100 ms.+--+-- Note that it will not emit any output unless at least one item has been+-- collected in the group. The time interval is only for timing out the already+-- collected but not yet complete group.+--+-- >>> s = Stream.delayPost 0.3 $ Stream.fromList [1..1000]+-- >>> f = Stream.fold (Fold.drainMapM print) $ Stream.timedGroupsOf 1 5 Fold.toList s+--+-- /Pre-release/+{-# INLINE timedGroupsOf #-}+timedGroupsOf :: MonadAsync m+    => Double -> Int -> Fold m a b -> Stream m a -> Stream m b+timedGroupsOf timeout n f =+      fmap snd+    . classifySessionsBy+        0.1 False (const (return False)) timeout (Fold.take n f)+    . Stream.timestamped+    . fmap ((),)++{-# Deprecated groupsOfTimeout "Please use timedGroupsOf instead." #-}+{-# INLINE groupsOfTimeout #-}+groupsOfTimeout :: MonadAsync m+    => Int -> Double -> Fold m a b -> Stream m a -> Stream m b+groupsOfTimeout n timeout = timedGroupsOf timeout n++-- Ideally this should be in an array module, but we do not have one in+-- streamly package.++-- | Like 'chunksOf' from the Array module but emits the chunk after the+-- timeout even if we have not yet collected the requested size.+{-# INLINE timedChunksOf #-}+timedChunksOf :: (MonadAsync m, Unbox a) =>+    Double -> Int -> Stream m a -> Stream m (Array a)+timedChunksOf timeout n = timedGroupsOf timeout n (Array.unsafeCreateOf n)++-- | Like 'timedChunksOf' but creates pinned arrays. If the chunks are smaller+-- than LARGE_OBJECT_THRESHOLD then this routine may be useful for better+-- performance if the arrays are to be sent for IO. This will avoid a copy for+-- pinning by the IO routines.+{-# INLINE timedChunksOf' #-}+timedChunksOf' :: (MonadAsync m, Unbox a) =>+    Double -> Int -> Stream m a -> Stream m (Array a)+timedChunksOf' timeout n =+    timedGroupsOf timeout n (Array.unsafeCreateOf' n)++------------------------------------------------------------------------------+-- Windowed classification+------------------------------------------------------------------------------++-- TODO: To mark the position in space or time we can have Indexed or+-- TimeStamped types. That can make it easy to deal with the position indices+-- or timestamps.++------------------------------------------------------------------------------+-- Keyed Sliding Windows+------------------------------------------------------------------------------++{-+{-# INLINABLE classifySlidingChunks #-}+classifySlidingChunks+    :: (IsStream t, MonadAsync m, Ord k)+    => Int              -- ^ window size+    -> Int              -- ^ window slide+    -> Fold m a b       -- ^ Fold to be applied to window events+    -> t m (k, a, Bool) -- ^ window key, data, close event+    -> t m (k, b)+classifySlidingChunks wsize wslide (Fold step initial extract) str+    = undefined++-- XXX Another variant could be to slide the window on an event, e.g. in TCP we+-- slide the send window when an ack is received and we slide the receive+-- window when a sequence is complete. Sliding is stateful in case of TCP,+-- sliding releases the send buffer or makes data available to the user from+-- the receive buffer.+{-# INLINABLE classifySlidingSessions #-}+classifySlidingSessions+    :: (IsStream t, MonadAsync m, Ord k)+    => Double         -- ^ timer tick in seconds+    -> Double         -- ^ time window size+    -> Double         -- ^ window slide+    -> Fold m a b     -- ^ Fold to be applied to window events+    -> t m (k, a, Bool, AbsTime) -- ^ window key, data, close flag, timestamp+    -> t m (k, b)+classifySlidingSessions tick interval slide (Fold step initial extract) str+    = undefined+-}++------------------------------------------------------------------------------+-- Sliding Window Buffers+------------------------------------------------------------------------------++-- These buffered versions could be faster than concurrent incremental folds of+-- all overlapping windows as in many cases we may not need all the values to+-- compute the fold, we can just compute the result using the old value and new+-- value.  However, we may need the buffer once in a while, for example for+-- string search we usually compute the hash incrementally but when the hash+-- matches the hash of the pattern we need to compare the whole string.+--+-- XXX we should be able to implement sequence based splitting combinators+-- using this combinator.++{-+-- | Buffer n elements of the input in a ring buffer. When t new elements are+-- collected, slide the window to remove the same number of oldest elements,+-- insert the new elements, and apply an incremental fold on the sliding+-- window, supplying the outgoing elements, the new ring buffer as arguments.+slidingChunkBuffer+    :: (IsStream t, Monad m, Ord a, Unboxed a)+    => Int -- window size+    -> Int -- window slide+    -> Fold m (RingArray a, Array a) b+    -> t m a+    -> t m b+slidingChunkBuffer = undefined++-- Buffer n seconds worth of stream elements of the input in a radix tree.+-- Every t seconds, remove the items that are older than n seconds, and apply+-- an incremental fold on the sliding window, supplying the outgoing elements,+-- and the new radix tree buffer as arguments.+slidingSessionBuffer+    :: (IsStream t, Monad m, Ord a, Unboxed a)+    => Int    -- window size+    -> Int    -- tick size+    -> Fold m (RTree a, Array a) b+    -> t m a+    -> t m b+slidingSessionBuffer = undefined+-}++------------------------------------------------------------------------------+-- Keyed Session Windows+------------------------------------------------------------------------------++{-+-- | Keyed variable size space windows. Close the window if we do not receive a+-- window event in the next "spaceout" elements.+{-# INLINABLE classifyChunksBy #-}+classifyChunksBy+    :: (IsStream t, MonadAsync m, Ord k)+    => Int   -- ^ window spaceout (spread)+    -> Bool  -- ^ reset the spaceout when a chunk window element is received+    -> Fold m a b       -- ^ Fold to be applied to chunk window elements+    -> t m (k, a, Bool) -- ^ chunk key, data, last element+    -> t m (k, b)+classifyChunksBy spanout reset (Fold step initial extract) str = undefined++-- | Like 'classifyChunksOf' but the chunk size is reset if an element is+-- received within the chunk size window. The chunk gets closed only if no+-- element is received within the chunk window.+--+{-# INLINABLE classifyKeepAliveChunks #-}+classifyKeepAliveChunks+    :: (IsStream t, MonadAsync m, Ord k)+    => Int   -- ^ window spaceout (spread)+    -> Fold m a b       -- ^ Fold to be applied to chunk window elements+    -> t m (k, a, Bool) -- ^ chunk key, data, last element+    -> t m (k, b)+classifyKeepAliveChunks spanout = classifyChunksBy spanout True+-}++data SessionState t m f s b = SessionState+    { sessionCurTime :: !AbsTime  -- ^ time since last event+    , sessionEventTime :: !AbsTime -- ^ time as per last event+    -- We can use the Map size instead of maintaining a count, but if we have+    -- to switch to HashMap then it can be useful.+    , sessionCount :: !Int -- ^ total number of sessions in progress+    , sessionTimerHeap :: H.Heap (H.Entry AbsTime (Key f)) -- ^ heap for timeouts+    , sessionKeyValueMap :: f s -- ^ Stored sessions for keys+    , sessionOutputStream :: t (m :: Type -> Type) (Key f, b) -- ^ Completed sessions+    }++data SessionEntry s = LiveSession !AbsTime !s | ZombieSession++-- delete from map and output the fold accumulator+ejectEntry :: (Monad m, IsMap f) =>+    (acc -> m b)+    -> heap+    -> f entry+    -> Stream m (Key f, b)+    -> Int+    -> acc+    -> Key f+    -> m (heap, f entry, Stream m (Key f, b), Int)+ejectEntry extract hp mp out cnt acc key = do+    sess <- extract acc+    let out1 = Stream.cons (key, sess) out+    let mp1 = IsMap.mapDelete key mp+    return (hp, mp1, out1, cnt - 1)++{-# NOINLINE flush #-}+flush :: (Monad m, IsMap f) =>+       (s -> m b)+    -> SessionState Stream m f (SessionEntry s) b+    -> m (SessionState Stream m f (SessionEntry s) b)+flush extract session@SessionState{..} = do+    (hp', mp', out, count) <-+        ejectAll+            ( sessionTimerHeap+            , sessionKeyValueMap+            , Stream.nil+            , sessionCount+            )+    return $ session+        { sessionCount = count+        , sessionTimerHeap = hp'+        , sessionKeyValueMap = mp'+        , sessionOutputStream = out+        }++    where++    ejectAll (hp, mp, out, !cnt) = do+        let hres = H.uncons hp+        case hres of+            Just (Entry _ key, hp1) -> do+                r <- case IsMap.mapLookup key mp of+                    Nothing -> return (hp1, mp, out, cnt)+                    Just ZombieSession ->+                        return (hp1, IsMap.mapDelete key mp, out, cnt)+                    Just (LiveSession _ acc) ->+                        ejectEntry extract hp1 mp out cnt acc key+                ejectAll r+            Nothing -> do+                assert (IsMap.mapNull mp) (return ())+                return (hp, mp, out, cnt)++{-# NOINLINE ejectOne #-}+ejectOne :: (IsMap f, Monad m) =>+       Bool+    -> (acc -> m b)+    -> ( H.Heap (Entry AbsTime (Key f))+       , f (SessionEntry acc)+       , Stream m (Key f, b)+       , Int+       )+    -> m ( H.Heap (Entry AbsTime (Key f))+         , f (SessionEntry acc)+         , Stream m (Key f, b), Int+         )+ejectOne reset extract = go++    where++    go (hp, mp, out, !cnt) = do+        let hres = H.uncons hp+        case hres of+            Just (Entry expiry key, hp1) ->+                case IsMap.mapLookup key mp of+                    Nothing -> go (hp1, mp, out, cnt)+                    Just ZombieSession ->+                        go (hp1, IsMap.mapDelete key mp, out, cnt)+                    Just (LiveSession expiry1 acc) -> do+                        if not reset || expiry1 <= expiry+                        then ejectEntry extract hp1 mp out cnt acc key+                        else+                            -- reset the session timeout and continue+                            let hp2 = H.insert (Entry expiry1 key) hp1+                            in go (hp2, mp, out, cnt)+            Nothing -> do+                assert (IsMap.mapNull mp) (return ())+                return (hp, mp, out, cnt)++{-# NOINLINE ejectExpired #-}+ejectExpired :: (IsMap f, Monad m) =>+       Bool+    -> (Int -> m Bool)+    -> (acc -> m b)+    -> SessionState Stream m f (SessionEntry acc) b+    -> AbsTime+    -> m (SessionState Stream m f (SessionEntry acc) b)+ejectExpired reset ejectPred extract session@SessionState{..} curTime = do+    (hp', mp', out, count) <-+        ejectLoop+            sessionTimerHeap sessionKeyValueMap Stream.nil sessionCount+    return $ session+        { sessionCurTime = curTime+        , sessionCount = count+        , sessionTimerHeap = hp'+        , sessionKeyValueMap = mp'+        , sessionOutputStream = out+        }++    where++    ejectLoop hp mp out !cnt = do+        let hres = H.uncons hp+        case hres of+            Just (Entry expiry key, hp1) -> do+                (eject, force) <-+                    if curTime >= expiry+                    then return (True, False)+                    else do+                        r <- ejectPred cnt+                        return (r, r)+                if eject+                then+                    case IsMap.mapLookup key mp of+                        Nothing -> ejectLoop hp1 mp out cnt+                        Just ZombieSession ->+                            ejectLoop hp1 (IsMap.mapDelete key mp) out cnt+                        Just (LiveSession expiry1 acc) -> do+                            if expiry1 <= curTime || not reset || force+                            then do+                                (hp2,mp1,out1,cnt1) <-+                                    ejectEntry extract hp1 mp out cnt acc key+                                ejectLoop hp2 mp1 out1 cnt1+                            else+                                -- reset the session timeout and continue+                                let hp2 = H.insert (Entry expiry1 key) hp1+                                in ejectLoop hp2 mp out cnt+                else return (hp, mp, out, cnt)+            Nothing -> do+                assert (IsMap.mapNull mp) (return ())+                return (hp, mp, out, cnt)++-- XXX Use mutable IORef in accumulator+{-# INLINE classifySessionsByGeneric #-}+classifySessionsByGeneric+    :: forall m f a b. (MonadAsync m, IsMap f)+    => Proxy (f :: (Type -> Type))+    -> Double         -- ^ timer tick in seconds+    -> Bool           -- ^ reset the timer when an event is received+    -> (Int -> m Bool) -- ^ predicate to eject sessions based on session count+    -> Double         -- ^ session timeout in seconds+    -> Fold m a b  -- ^ Fold to be applied to session data+    -> Stream m (AbsTime, (Key f, a)) -- ^ timestamp, (session key, session+                                      -- data)+    -> Stream m (Key f, b) -- ^ session key, fold result+classifySessionsByGeneric _ tick reset ejectPred tmout+    (Fold step initial extract final) input =+    Stream.unfoldEach (Unfold.lmap sessionOutputStream Unfold.fromStream)+        $ Stream.scanlMAfter' sstep (return szero) (flush final)+        $ interject (return Nothing) tick+        $ fmap Just input++    where++    timeoutMs = toRelTime (round (tmout * 1000) :: MilliSecond64)+    tickMs = toRelTime (round (tick * 1000) :: MilliSecond64)+    szero = SessionState+        { sessionCurTime = toAbsTime (0 :: MilliSecond64)+        , sessionEventTime = toAbsTime (0 :: MilliSecond64)+        , sessionCount = 0+        , sessionTimerHeap = H.empty+        , sessionKeyValueMap = IsMap.mapEmpty :: f s+        , sessionOutputStream = Stream.nil+        }++    -- We can eject sessions based on the current session count to limit+    -- memory consumption. There are two possible strategies:+    --+    -- 1) Eject old sessions or sessions beyond a certain/lower timeout+    -- threshold even before timeout, effectively reduce the timeout.+    -- 2) Drop creation of new sessions but keep accepting new events for the+    -- old ones.+    --+    -- We use the first strategy as of now.++    -- Got a new stream input element+    sstep session@SessionState{..} (Just (timestamp, (key, value))) = do+        -- XXX instead of a heap we could use a timer wheel.+        --+        -- XXX if the key is an Int, we can also use an IntMap for slightly+        -- better performance.+        --+        -- How it works:+        --+        -- Values for each key are collected in a map using the supplied fold.+        -- When we insert a key in the Map we insert an entry into the heap as+        -- well with the session expiry as the sort key.  The Map entry+        -- consists of the fold result, and the expiry time of the session. If+        -- "reset" is True the expiry time is readjusted whenever a new event+        -- is processed. If the fold terminates and a new session is started+        -- for the same key the expiry time is set to the first timestamp of+        -- the new session.+        --+        -- The heap must have at most one entry for any given key. The heap is+        -- processed periodically to remove the expired entries.  We pick up an+        -- expired entry from the top of the heap and if the session has+        -- expired based on the expiry time in the Map entry then we remove the+        -- session from the Map and yield its fold output. Otherwise, we+        -- reinsert the entry into the heap based on the current expiry in the+        -- Map entry.+        --+        -- If an entry is removed from the Map and not removed from the heap+        -- and in the meantime it is inserted again in the Map (using the same+        -- key) then how do we avoid inserting multiple entries in the heap?+        -- For this reason we maintain the invariant that the Map entry is+        -- removed only when the heap entry is removed. Even if the fold has+        -- finished we still keep a dummy Map entry (ZombieSession) until the+        -- heap entry is removed. That way if we have a Map entry we do not+        -- insert a heap entry because we know it is already there.+        -- XXX The ZombieSession mechanism does not work as expected as we+        -- ignore ZombieSession when inserting a new entry. Anyway, we can+        -- remove this mechanism as at most only two heap entries may be+        -- created and they will be ultimately cleaned up.+        --+        -- Heap processing needs the map and map processing needs the heap,+        -- therefore we cannot separate the two for modularity unless we have a+        -- way to achieve mutual recursion.+        --+        let curTime = max sessionEventTime timestamp+            mOld = IsMap.mapLookup key sessionKeyValueMap+        let done fb = do+                -- deleting a key from the heap is expensive, so we never+                -- delete a key from heap, we just purge it from the Map and it+                -- gets purged from the heap on timeout. We just need an extra+                -- lookup in the Map when the key is purged from the heap, that+                -- should not be expensive.+                --+                let (mp, cnt) = case mOld of+                        Just (LiveSession _ _) ->+                            ( IsMap.mapInsert+                                key ZombieSession sessionKeyValueMap+                            , sessionCount - 1+                            )+                        _ -> (sessionKeyValueMap, sessionCount)+                return $ session+                    { sessionCurTime = curTime+                    , sessionEventTime = curTime+                    , sessionCount = cnt+                    , sessionKeyValueMap = mp+                    , sessionOutputStream = Stream.fromPure (key, fb)+                    }+            partial fs1 = do+                let expiry = addToAbsTime timestamp timeoutMs+                (hp1, mp1, out1, cnt1) <- do+                        let vars = (sessionTimerHeap, sessionKeyValueMap,+                                           Stream.nil, sessionCount)+                        case mOld of+                            -- inserting new entry+                            Nothing -> do+                                -- Eject a session from heap and map if needed+                                eject <- ejectPred sessionCount+                                (hp, mp, out, cnt) <-+                                    if eject+                                    then ejectOne reset extract vars+                                    else return vars++                                -- Insert the new session in heap+                                let hp' = H.insert (Entry expiry key) hp+                                 in return (hp', mp, out, cnt + 1)+                            -- updating old entry+                            Just _ -> return vars++                let acc = LiveSession expiry fs1+                    mp2 = IsMap.mapInsert key acc mp1+                return $ SessionState+                    { sessionCurTime = curTime+                    , sessionEventTime = curTime+                    , sessionCount = cnt1+                    , sessionTimerHeap = hp1+                    , sessionKeyValueMap = mp2+                    , sessionOutputStream = out1+                    }+        res0 <- do+            case mOld of+                Just (LiveSession _ acc) -> return $ Fold.Partial acc+                _ -> initial+        case res0 of+            Fold.Done _ ->+                error $ "classifySessionsBy: "+                    ++ "The supplied fold must consume at least one input"+            Fold.Partial fs -> do+                res <- step fs value+                case res of+                    Fold.Done fb -> done fb+                    Fold.Partial fs1 -> partial fs1++    -- Got a timer tick event+    sstep sessionState@SessionState{..} Nothing =+        let curTime = addToAbsTime sessionCurTime tickMs+        in ejectExpired reset ejectPred extract sessionState curTime++-- | @classifySessionsBy tick keepalive predicate timeout fold stream@+-- classifies an input event @stream@ consisting of  @(timestamp, (key,+-- value))@ into sessions based on the @key@, folding all the values+-- corresponding to the same key into a session using the supplied @fold@.+--+-- When the fold terminates or a @timeout@ occurs, a tuple consisting of the+-- session key and the folded value is emitted in the output stream. The+-- timeout is measured from the first event in the session.  If the @keepalive@+-- option is set to 'True' the timeout is reset to 0 whenever an event is+-- received.+--+-- The @timestamp@ in the input stream is an absolute time from some epoch,+-- characterizing the time when the input event was generated.  The notion of+-- current time is maintained by a monotonic event time clock using the+-- timestamps seen in the input stream. The latest timestamp seen till now is+-- used as the base for the current time.  When no new events are seen, a timer+-- is started with a clock resolution of @tick@ seconds. This timer is used to+-- detect session timeouts in the absence of new events.+--+-- To ensure an upper bound on the memory used the number of sessions can be+-- limited to an upper bound. If the ejection @predicate@ returns 'True', the+-- oldest session is ejected before inserting a new session.+--+-- When the stream ends any buffered sessions are ejected immediately.+--+-- If a session key is received even after a session has finished, another+-- session is created for that key.+--+-- >>> :{+-- Stream.fold (Fold.drainMapM print)+--     $ Stream.classifySessionsBy 1 False (const (return False)) 3 (Fold.take 3 Fold.toList)+--     $ Stream.timestamped+--     $ Stream.delay 0.1+--     $ Stream.fromList ((,) <$> [1,2,3] <*> ['a','b','c'])+-- :}+-- (1,"abc")+-- (2,"abc")+-- (3,"abc")+--+-- /Pre-release/+{-# INLINE classifySessionsBy #-}+classifySessionsBy+    :: (MonadAsync m, Ord k)+    => Double         -- ^ timer tick in seconds+    -> Bool           -- ^ reset the timer when an event is received+    -> (Int -> m Bool) -- ^ predicate to eject sessions based on session count+    -> Double         -- ^ session timeout in seconds+    -> Fold m a b  -- ^ Fold to be applied to session data+    -> Stream m (AbsTime, (k, a)) -- ^ timestamp, (session key, session data)+    -> Stream m (k, b) -- ^ session key, fold result+classifySessionsBy = classifySessionsByGeneric (Proxy :: Proxy (Map k))++-- | Same as 'classifySessionsBy' with a timer tick of 1 second and keepalive+-- option set to 'True'.+--+-- @+-- classifyKeepAliveSessions = classifySessionsBy 1 True+-- @+--+-- /Pre-release/+--+{-# INLINE classifyKeepAliveSessions #-}+classifyKeepAliveSessions ::+       (MonadAsync m, Ord k)+    => (Int -> m Bool) -- ^ predicate to eject sessions on session count+    -> Double -- ^ session inactive timeout+    -> Fold m a b -- ^ Fold to be applied to session payload data+    -> Stream m (AbsTime, (k, a)) -- ^ timestamp, (session key, session data)+    -> Stream m (k, b)+classifyKeepAliveSessions = classifySessionsBy 1 True++------------------------------------------------------------------------------+-- Keyed tumbling windows+------------------------------------------------------------------------------++-- Tumbling windows is a special case of sliding windows where the window slide+-- is the same as the window size. Or it can be a special case of session+-- windows where the reset flag is set to False.++-- XXX instead of using the early termination flag in the stream, we can use an+-- early terminating fold instead.++{-+-- | Split the stream into fixed size chunks of specified size. Within each+-- such chunk fold the elements in buckets identified by the keys. A particular+-- bucket fold can be terminated early if a closing flag is encountered in an+-- element for that key.+--+-- @since 0.7.0+{-# INLINABLE classifyChunksOf #-}+classifyChunksOf+    :: (IsStream t, MonadAsync m, Ord k)+    => Int              -- ^ window size+    -> Fold m a b       -- ^ Fold to be applied to window events+    -> t m (k, a, Bool) -- ^ window key, data, close event+    -> t m (k, b)+classifyChunksOf wsize = classifyChunksBy wsize False+-}++-- | Same as 'classifySessionsBy' with a timer tick of 1 second and keepalive+-- option set to 'False'.+--+-- >>> classifySessionsOf = Stream.classifySessionsBy 1 False+--+-- /Pre-release/+--+{-# INLINE classifySessionsOf #-}+classifySessionsOf ::+       (MonadAsync m, Ord k)+    => (Int -> m Bool) -- ^ predicate to eject sessions on session count+    -> Double -- ^ time window size+    -> Fold m a b -- ^ Fold to be applied to session data+    -> Stream m (AbsTime, (k, a)) -- ^ timestamp, (session key, session data)+    -> Stream m (k, b)+classifySessionsOf = classifySessionsBy 1 False++------------------------------------------------------------------------------+-- Sampling+------------------------------------------------------------------------------++-- | Continuously evaluate the input stream and sample the last event in each+-- time window of @n@ seconds.+--+-- This is also known as @throttle@ in some libraries.+--+-- >>> sampleIntervalEnd n = Stream.catMaybes . Stream.intervalsOf n Fold.latest+--+{-# INLINE sampleIntervalEnd #-}+sampleIntervalEnd :: MonadAsync m => Double -> Stream m a -> Stream m a+sampleIntervalEnd n = Stream.catMaybes . intervalsOf n Fold.latest++-- | Like 'sampleInterval' but samples at the beginning of the time window.+--+-- >>> sampleIntervalStart n = Stream.catMaybes . Stream.intervalsOf n Fold.one+--+{-# INLINE sampleIntervalStart #-}+sampleIntervalStart :: MonadAsync m => Double -> Stream m a -> Stream m a+sampleIntervalStart n = Stream.catMaybes . intervalsOf n Fold.one++data BurstState t x =+      BurstNone+    | BurstWait !t !x+    | BurstDone !x+    | BurstDoneNext !x !t !x++{-# INLINE sampleBurst #-}+sampleBurst :: MonadAsync m => Bool -> Double -> Stream m a -> Stream m a+sampleBurst sampleAtEnd gap xs =+    -- XXX Ideally we should schedule a timer event exactly after gap time,+    -- but the tick stream should work well as long as the timer+    -- granularity is small enough compared to the gap.+    Stream.mapMaybe extract+        $ Stream.scanl (Scanl.mkScanl step BurstNone)+        $ Stream.timeIndexed+        $ interject (return Nothing) 0.01 (fmap Just xs)++    where++    gap1 = toRelTime64 (NanoSecond64 (round (gap * 10^(9::Int))))++    {-# INLINE step #-}+    step BurstNone (t1, Just x1) = BurstWait t1 x1+    step BurstNone _ = BurstNone++    step (BurstDone _) (t1, Just x1) = BurstWait t1 x1+    step (BurstDone _) _ = BurstNone++    step old@(BurstWait t0 x0) (t1, Nothing)+        | t1 - t0 >= gap1 = BurstDone x0+        | otherwise = old+    -- This can happen due to scheduling delays, if we received back to+    -- back events spaced by more than the timeout without an+    -- intervening timeout event then we emit the old event instead of+    -- replacing it by the new.+    step (BurstWait t0 x0) (t1, Just x1)+        | t1 - t0 >= gap1 = BurstDoneNext x0 t1 x1+        | sampleAtEnd = BurstWait t1 x1+        | otherwise = BurstWait t1 x0++    step (BurstDoneNext _ t0 x0) (t1, Nothing)+        | t1 - t0 >= gap1 = BurstDone x0+        | otherwise =  BurstWait t0 x0+    step (BurstDoneNext _ t0 x0) (t1, Just x1)+        | t1 - t0 >= gap1 = BurstDoneNext x0 t1 x1+        | sampleAtEnd = BurstWait t1 x1+        | otherwise = BurstWait t1 x0++    {-# INLINE extract #-}+    extract (BurstDoneNext x _ _) = Just x+    extract (BurstDone x) = Just x+    extract _ = Nothing++-- | Sample one event at the end of each burst of events.  A burst is a group+-- of events close together in time, it ends when an event is spaced by more+-- than the specified time interval (in seconds) from the previous event.+--+-- This is known as @debounce@ in some libraries.+--+-- The clock granularity is 10 ms.+--+{-# INLINE sampleBurstEnd #-}+sampleBurstEnd :: MonadAsync m => Double -> Stream m a -> Stream m a+sampleBurstEnd = sampleBurst True++-- | Like 'sampleBurstEnd' but samples the event at the beginning of the burst+-- instead of at the end of it.+--+{-# INLINE sampleBurstStart #-}+sampleBurstStart :: MonadAsync m => Double -> Stream m a -> Stream m a+sampleBurstStart = sampleBurst False++------------------------------------------------------------------------------+-- Lossy Buffering+------------------------------------------------------------------------------++-- XXX We could use 'maxBuffer Block/Drop/Rotate/Sample' instead. However we+-- may want to have the evaluation rate independent of the sampling rate. To+-- support that we can decouple evaluation and sampling in independent stages.+-- The sampling stage would strictly evaluate and sample, the evaluation stage+-- would control the evaluation rate.+--+-- bufferLatest - evaluate retaining only the latest element. Fork a thread+-- that keeps writing the stream to an IORef, another parallel thread reads+-- from the IORef.+--+-- bufferLatestN - Fork a thread that keeps writing to a sliding ring buffer,+-- and the stream unfolds the entire buffer when it is read, and the empty+-- buffer starts filling again in the same way.+--+-- bufferOldestN - Fork a thread that keeps writing to a buffer until it is+-- filled and keeps dropping once it is filled. When the stream is read the+-- buffer is unfolded to a stream and the empty buffer starts filling again.++-- | Evaluate the input stream continuously and keep only the oldest @n@+-- elements in the buffer, discard the new ones when the buffer is full.  When+-- the output stream is evaluated the collected buffer is streamed and the+-- buffer starts filling again.+--+-- /Unimplemented/+--+{-# INLINE bufferOldestN #-}+bufferOldestN :: -- MonadAsync m =>+    Int -> Stream m a -> Stream m a+bufferOldestN = undefined++-- | Evaluate the input stream continuously and keep only the latest @n@+-- elements in a ring buffer, keep discarding the older ones to make space for+-- the new ones.  When the output stream is evaluated the buffer collected till+-- now is streamed and it starts filling again.+--+-- /Unimplemented/+--+{-# INLINE bufferLatestN #-}+bufferLatestN :: -- MonadAsync m =>+    Int -> Stream m a -> Stream m a+bufferLatestN = undefined++-- | Always produce the latest available element from the stream without any+-- delay. The stream is continuously evaluated at the highest possible rate and+-- only the latest element is retained for sampling.+--+-- /Unimplemented/+--+{-# INLINE bufferLatest #-}+bufferLatest :: -- MonadAsync m =>+    Stream m a -> Stream m (Maybe a)+bufferLatest = undefined
src/Streamly/Internal/Data/Stream/Zip.hs view
@@ -1,5 +1,12 @@+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.Zip -- Copyright   : (c) 2017 Composewell Technologies@@ -12,8 +19,11 @@ -- To run examples in this module: -- -- >>> import qualified Streamly.Prelude as Stream+-- >>> import qualified Streamly.Internal.Data.Stream as D+-- >>> import qualified Streamly.Data.Fold as Fold -- module Streamly.Internal.Data.Stream.Zip+    {-# DEPRECATED "Use \"Streamly.Data.Stream.MkType\" instead." #-}     (       ZipSerialM (..)     , ZipSerial@@ -21,12 +31,16 @@     , zipWithK     , zipWithMK +    , ZipConcurrent (..)+     -- * Deprecated     , ZipStream     ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Control.DeepSeq (NFData(..)) #if MIN_VERSION_deepseq(1,4,3) import Control.DeepSeq (NFData1(..))@@ -38,27 +52,29 @@ #if __GLASGOW_HASKELL__ < 808 import Data.Semigroup (Semigroup(..)) #endif-import GHC.Exts (IsList(..), IsString(..))+import GHC.Exts (IsList(..), IsString(..), oneShot) import Text.Read        ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec        , readListPrecDefault)-import Streamly.Internal.BaseCompat ((#.), errorWithoutStackTrace, oneShot)+import Streamly.Internal.BaseCompat ((#.)) import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe) import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream)+import Streamly.Internal.Data.Stream.Concurrent (MonadAsync, parZipWith) -import qualified Streamly.Internal.Data.Stream.Prelude as P-    (cmpBy, eqBy, foldl', foldr, fromList, toList)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream.Common as P+import qualified Streamly.Internal.Data.StreamK as K+import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Stream.Serial as Serial -import Prelude hiding (map, repeat, zipWith, errorWithoutStackTrace)+import Prelude hiding (map, repeat, zipWith)  #include "Instances.hs"  -- $setup -- >>> import qualified Streamly.Prelude as Stream+-- >>> import qualified Streamly.Internal.Data.Stream as D+-- >>> import qualified Streamly.Data.Fold as Fold -- >>> import Control.Concurrent (threadDelay) -- >>> :{ --  delay n = do@@ -133,3 +149,27 @@  FOLDABLE_INSTANCE(ZipSerialM) TRAVERSABLE_INSTANCE(ZipSerialM)++-------------------------------------------------------------------------------+-- ZipConcurrent+-------------------------------------------------------------------------------++newtype ZipConcurrent m a = ZipConcurrent {getZipConcurrent :: D.Stream m a}+      deriving (Functor)++-- | An IO stream whose applicative instance zips streams concurrently. Note+-- that it uses the default concurrency options.+--+-- >>> s = ZipConcurrent $ D.fromList [1, 2, 3]+-- >>> x = (,,) <$> s <*> s <*> s+-- >>> D.fold Fold.toList (getZipConcurrent x)+-- [(1,1,1),(2,2,2),(3,3,3)]+--+-- @since 0.9.0++instance MonadAsync m => Applicative (ZipConcurrent m) where+    pure = ZipConcurrent . D.repeat++    {-# INLINE (<*>) #-}+    ZipConcurrent m1 <*> ZipConcurrent m2 =+        ZipConcurrent $ parZipWith id id m1 m2
src/Streamly/Internal/Data/Stream/ZipAsync.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} {-# LANGUAGE UndecidableInstances #-}  -- |@@ -13,6 +14,7 @@ -- >>> import qualified Streamly.Prelude as Stream -- module Streamly.Internal.Data.Stream.ZipAsync+    {-# DEPRECATED "Use \"Streamly.Data.Stream.MkType\" instead." #-}     ( ZipAsyncM(..)     , ZipAsync     , consMZipAsync@@ -21,19 +23,17 @@     ) where -#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup (Semigroup(..))-#endif import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream) -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamK as K-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.StreamK as K+    (mkStream, foldStream, zipWithM, consM)+import qualified Streamly.Internal.Data.Stream as D (fromStreamK) import qualified Streamly.Internal.Data.Stream.Serial as Serial import qualified Streamly.Internal.Data.Stream.SVar.Eliminate as SVar import qualified Streamly.Internal.Data.Stream.SVar.Generate as SVar+import qualified Streamly.Internal.Data.Stream.Serial as Stream+    (fromStreamK, toStreamK) import Streamly.Internal.Data.SVar  import Prelude hiding (map, repeat, zipWith, errorWithoutStackTrace)@@ -41,6 +41,7 @@ #include "Instances.hs"  -- $setup+-- >>> :set -fno-warn-deprecations -- >>> import qualified Streamly.Prelude as Stream -- >>> import Control.Concurrent (threadDelay) -- >>> :{@@ -63,7 +64,8 @@ zipAsyncWithMK f m1 m2 = K.mkStream $ \st yld sng stp -> do     sv <- newParallelVar StopNone (adaptState st)     SVar.toSVarParallel (adaptState st) sv $ D.fromStreamK m2-    K.foldStream st yld sng stp $ K.zipWithM f m1 (getSerialT (SVar.fromSVar sv))+    K.foldStream st yld sng stp+        $ K.zipWithM f m1 (Stream.toStreamK (SVar.fromSVar sv))  -- XXX Should we rename this to zipParWith or zipParallelWith? This can happen -- along with the change of behvaior to end the stream concurrently.@@ -122,10 +124,11 @@  instance Monad m => Functor (ZipAsyncM m) where     {-# INLINE fmap #-}-    fmap f (ZipAsyncM m) = ZipAsyncM $ getSerialT $ fmap f (SerialT m)+    fmap f (ZipAsyncM m) =+        ZipAsyncM $ Stream.toStreamK $ fmap f (Stream.fromStreamK m)  instance MonadAsync m => Applicative (ZipAsyncM m) where-    pure = ZipAsyncM . getSerialT . Serial.repeat+    pure = ZipAsyncM . Stream.toStreamK . Serial.repeat      {-# INLINE (<*>) #-}     ZipAsyncM m1 <*> ZipAsyncM m2 = ZipAsyncM $ zipAsyncWithK id m1 m2
− src/Streamly/Internal/Data/Time.hs 
@@ -1,74 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Time--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Time utilities for reactive programming.--module Streamly.Internal.Data.Time-{-# DEPRECATED-   "Please use the \"rate\" combinator instead of the functions in this module"-  #-}-    ( periodic-    , withClock-    )-where--import Control.Monad (when)-import Control.Concurrent (threadDelay)---- | Run an action forever periodically at the given frequency specified in per--- second (Hz).------ @since 0.1.0-{-# DEPRECATED periodic "Please use the \"rate\" combinator instead" #-}-periodic :: Int -> IO () -> IO ()-periodic freq action = do-    action-    threadDelay (1000000 `div` freq)-    periodic freq action---- | Run a computation on every clock tick, the clock runs at the specified--- frequency. It allows running a computation at high frequency efficiently by--- maintaining a local clock and adjusting it with the provided base clock at--- longer intervals.  The first argument is a base clock returning some notion--- of time in microseconds. The second argument is the frequency in per second--- (Hz). The third argument is the action to run, the action is provided the--- local time as an argument.------ @since 0.1.0-{-# DEPRECATED withClock "Please use the \"rate\" combinator instead" #-}-withClock :: IO Int -> Int -> (Int -> IO ()) -> IO ()-withClock clock freq action = do-    t <- clock-    go t period period t 0--    where--    period = 1000000 `div` freq--    -- Note that localTime is roughly but not exactly equal to (lastAdj + tick-    -- * n).  That is because we do not abruptly adjust the clock skew instead-    -- we adjust the tick size.-    go lastAdj delay tick localTime n = do-        action localTime-        when (delay > 0) $ threadDelay delay--        if n == freq-        then do-            (t, newTick, newDelay) <- adjustClock lastAdj localTime delay-            go t newDelay newTick (localTime + newTick) 0-        else go lastAdj delay tick (localTime + tick) (n + 1)--    -- Adjust the tick size rather than the clock to avoid abrupt changes-    -- resulting in jittery behavior at the end of every interval.-    adjustClock lastAdj localTime delay = do-        baseTime <- clock-        let newTick    = period + (baseTime - localTime) `div` freq-            lastPeriod = (baseTime - lastAdj) `div` freq-            newDelay   = max 0 (delay + period - lastPeriod)-        return (baseTime, newTick, newDelay)
− src/Streamly/Internal/Data/Time/Clock.hs 
@@ -1,180 +0,0 @@--- |--- 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.Prim as Prim----------------------------------------------------------------------------------- Async clock---------------------------------------------------------------------------------{-# INLINE updateTimeVar #-}-updateTimeVar :: Clock -> Prim.IORef MicroSecond64 -> IO ()-updateTimeVar clock timeVar = do-    t <- fromAbsTime <$> getTime clock-    Prim.modifyIORef' timeVar (const t)--{-# INLINE updateWithDelay #-}-updateWithDelay :: RealFrac a =>-    Clock -> a -> Prim.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, Prim.IORef MicroSecond64)-asyncClock clock g = do-    timeVar <- Prim.newIORef 0-    updateTimeVar clock timeVar-    tid <- forkIOManaged $ forever (updateWithDelay clock g timeVar)-    return (tid, timeVar)--{-# INLINE readClock #-}-readClock :: (ThreadId, Prim.IORef MicroSecond64) -> IO MicroSecond64-readClock (_, timeVar) = Prim.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 -> Prim.IORef MicroSecond64 -> IO ()-resetTimerExpiry clock period timeVar = do-    t <- getTime clock-    let t1 = addToAbsTime t (toRelTime period)-    Prim.modifyIORef' timeVar (const (fromAbsTime t1))--{-# INLINE processTimerTick #-}-processTimerTick :: RealFrac a =>-    Clock -> a -> Prim.IORef MicroSecond64 -> MVar () -> IO () -> IO ()-processTimerTick clock precision timeVar mvar reset = do-    threadDelay (delayTime precision)-    t <- fromAbsTime <$> getTime clock-    expiry <- Prim.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 <- Prim.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 
@@ -1,36 +0,0 @@-/*- * 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 
@@ -1,252 +0,0 @@-{-# 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, Typeable)------------------------------------------------------------------------------------ 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 
@@ -1,115 +0,0 @@-/*- * 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 
@@ -1,11 +0,0 @@-#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 
@@ -1,155 +0,0 @@-{-# LANGUAGE CPP                         #-}-{-# LANGUAGE ScopedTypeVariables         #-}--{-# 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 
@@ -1,410 +0,0 @@-{-# 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 Data.Primitive.Types (Prim(..))-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-             , Prim-             )---- | 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-             , Prim-             )---- | 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-             , Prim-             )------------------------------------------------------------------------------------ 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 
@@ -1,44 +0,0 @@--- |--- 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' (..)-    , 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/Unfold.hs 
@@ -1,1151 +0,0 @@-#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Unfold--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ To run the examples in this module:------ >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold------ = 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.---- Open control flow style streams can also have two representations. StreamK--- is a producer style representation. We can also have a consumer style--- representation. We can use that for composable folds in StreamK--- representation.------- = 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.Prelude.concatMap' combinator which uses @a -> t m b@--- (where @t@ is a stream type) to generate streams is much less efficient--- compared to 'Streamly.Prelude.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-    (-    -- * Unfold Type-      Step(..)-    , Unfold--    -- * Unfolds-    -- One to one correspondence with-    -- "Streamly.Internal.Data.Stream.IsStream.Generate"-    -- ** Basic Constructors-    , mkUnfoldM-    , mkUnfoldrM-    , unfoldrM-    , unfoldr-    , functionM-    , function-    , identity-    , nilM-    , 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--    , fromStream-    , fromStreamK-    , fromStreamD--    -- * Combinators-    -- ** Mapping on Input-    , lmap-    , lmapM-    , supply-    , supplyFirst-    , supplySecond-    , discardFirst-    , discardSecond-    , swap-    -- coapply-    -- comonad--    -- * Folding-    , fold--    -- ** Mapping on Output-    , map-    , mapM-    , mapMWithInput-    , scanlM'-    , scan-    , foldMany-    -- pipe--    -- ** Either Wrapped Input-    , either--    -- ** Filtering-    , takeWhileM-    , takeWhile-    , take-    , filter-    , filterM-    , drop-    , dropWhile-    , dropWhileM--    -- ** Zipping-    , zipWithM-    , zipWith--    -- ** Cross product-    , crossWithM-    , crossWith-    , cross-    , apply--    -- ** Nesting-    , ConcatState (..)-    , many-    , concatMapM-    , bind--    -- ** Resource Management-    , gbracket_-    , gbracket-    , before-    , after-    , after_-    , finally-    , finally_-    , bracket-    , bracket_--    -- ** Exceptions-    , onException-    , handle-    )-where--import Control.Exception (Exception, mask_)-import Control.Monad.Catch (MonadCatch)-import Data.Functor (($>))-import GHC.Types (SPEC(..))-import Streamly.Internal.Control.Concurrent (MonadRunInIO, MonadAsync, withRunInIO)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.IOFinalizer-    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)-import Streamly.Internal.Data.Stream.Serial (SerialT(..))-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 Streamly.Internal.Data.Unfold.Enumeration-import Streamly.Internal.Data.Unfold.Type-import Prelude-       hiding (map, mapM, takeWhile, take, filter, const, zipWith-              , drop, dropWhile, either)---- $setup--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold--- >>> import qualified Streamly.Prelude as Stream----- | 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---- | Apply a fold multiple times on the output of an unfold.------ /Unimplemented/-foldMany :: -- Monad m =>-    Fold m b c -> Unfold m a b -> Unfold m a c-foldMany = undefined---- | Apply a monadic function to each element of the stream and replace it--- with the output of the resulting action.------ /Since: 0.8.0/----{-# INLINE_NORMAL mapM #-}-mapM :: Monad m => (b -> m c) -> Unfold m a b -> Unfold m a c-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--{-# INLINE_NORMAL mapMWithInput #-}-mapMWithInput :: Monad m => (a -> b -> m c) -> Unfold m a b -> Unfold m a c-mapMWithInput 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------------------------------------------------------------------------------------ Either------------------------------------------------------------------------------------ | Make an unfold operate on values wrapped in an @Either a a@ type. 'Right--- a' translates to 'Right b' and 'Left a' translates to 'Left b'.------ /Internal/-{-# INLINE_NORMAL either #-}-either :: Applicative m => Unfold m a b -> Unfold m (Either a a) (Either b b)-either (Unfold step1 inject1) = Unfold step inject--    where--    inject (Left a) = (, Left) <$> inject1 a-    inject (Right a) = (, Right) <$> inject1 a--    {-# INLINE_LATE step #-}-    step (st, f) = do-        (\case-            Yield x s -> Yield (f x) (s, f)-            Skip s -> Skip (s, f)-            Stop -> Stop) <$> step1 st---- | Scan the output of an 'Unfold' to change it in a stateful manner.------ /Pre-release/-{-# INLINE_NORMAL scan #-}-scan :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c-scan (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---- | Scan the output of an 'Unfold' to change it in a stateful manner.------ /Unimplemented/-{-# INLINE_NORMAL scanlM' #-}-scanlM' :: Monad m => (b -> a -> m b) -> m b -> Unfold m c a -> Unfold m c b-scanlM' f z = scan (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.Stream 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---- XXX Using Unfold.fromStreamD seems to be faster (using cross product test--- case) than using fromStream even if it is implemented using fromStreamD.--- Check if StreamK to StreamD rewrite rules are working correctly when--- implementing fromStream using fromStreamD.------ | Convert a stream into an 'Unfold'. Note that a stream converted to an--- 'Unfold' may not be as efficient as an 'Unfold' in some situations.------ /Since: 0.8.0/----{-# INLINE_NORMAL fromStream #-}-fromStream :: Monad m => Unfold m (SerialT m a) a-fromStream = lmap getSerialT fromStreamK------------------------------------------------------------------------------------ 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---- | 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---- 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'------ /Since: 0.8.0/----{-# INLINE_LATE fromList #-}-fromList :: Monad m => Unfold m [a] a-fromList = Unfold step pure--    where--    {-# INLINE_LATE step #-}-    step (x:xs) = pure $ Yield x xs-    step [] = pure Stop---- | Convert a list of monadic values to a 'Stream'------ /Since: 0.8.0/----{-# INLINE_LATE fromListM #-}-fromListM :: Monad m => Unfold m [m a] a-fromListM = Unfold step pure--    where--    {-# INLINE_LATE step #-}-    step (x:xs) = (`Yield` xs) <$> x-    step [] = pure Stop----------------------------------------------------------------------------------- Specialized Generation----------------------------------------------------------------------------------- | Generates a stream replicating the seed @n@ times.------ /Since: 0.8.0/----{-# INLINE replicateM #-}-replicateM :: Monad m => Int -> Unfold m (m a) a-replicateM n = Unfold step inject--    where--    inject action = pure (action, n)--    {-# INLINE_LATE step #-}-    step (action, i) =-        if i <= 0-        then pure Stop-        else (\x -> Yield x (action, i - 1)) <$> action---- | Generates an infinite stream repeating the seed.------ /Since: 0.8.0/----{-# INLINE repeatM #-}-repeatM :: Monad 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.------ /Since: 0.8.0/----{-# INLINE iterateM #-}-iterateM :: Monad 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]------ /Since: 0.8.0/----{-# INLINE_NORMAL take #-}-take :: Monad 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.------ /Since: 0.8.0/----{-# 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.------ /Since: 0.8.0/----{-# 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@.------ /Since: 0.8.0/----{-# INLINE_NORMAL drop #-}-drop :: Monad 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.------ /Since: 0.8.0/----{-# 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.------ /Since: 0.8.0/----{-# INLINE dropWhile #-}-dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b-dropWhile f = dropWhileM (return . f)----------------------------------------------------------------------------------- Exceptions----------------------------------------------------------------------------------- | Like 'gbracket' 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.--- * does not require a 'MonadAsync' constraint.------ /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 gbracket #-}-gbracket-    :: MonadRunInIO m-    => (a -> m c)                           -- ^ before-    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)-    -> (c -> m d)                           -- ^ after, on normal stop, or GC-    -> 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-        -- Mask asynchronous exceptions to make the execution of 'bef' and-        -- the registration of 'aft' atomic. See comment in 'D.gbracketIO'.-        (r, ref) <- withRunInIO $ \run -> mask_ $ run $ 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 <- exc $ 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.-                r <- clearingIOFinalizer ref (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 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 after #-}-after :: MonadRunInIO 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-        ref <- 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 'finally' with following differences:------ * action @a -> m c@ won't run if the stream is garbage collected---   after partial evaluation.--- * does not require a 'MonadAsync' constraint.------ /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 finally #-}-finally :: (MonadAsync m, 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-        ref <- 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 'bracket' 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.--- * does not require a 'MonadAsync' constraint.------ /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 bracket #-}-bracket :: (MonadAsync m, 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-        -- Mask asynchronous exceptions to make the execution of 'bef' and-        -- the registration of 'aft' atomic. See comment in 'D.gbracketIO'.-        (r, ref) <- withRunInIO $ \run -> mask_ $ run $ 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 
@@ -1,573 +0,0 @@--- |--- 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.Prelude 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.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.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.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.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 = supplySecond 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.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 = supplySecond 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.Prelude as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom (0 :: Int)-    -- [0,1,2,3]-    ---    -- @-    ---    -- For 'Fractional' types, enumeration is numerically stable. However, no-    -- overflow or underflow checks are performed.-    ---    -- @-    -- >>> Stream.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.Prelude as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (0, 4)-    -- [0,1,2,3,4]-    ---    -- @-    ---    -- For 'Fractional' types, the last element is equal to the specified @to@-    -- value after rounding to the nearest integral value.-    ---    -- @-    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4)-    -- [1.1,2.1,3.1,4.1]-    ---    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4.6)-    -- [1.1,2.1,3.1,4.1,5.1]-    ---    -- @-    ---    -- /Pre-release/-    enumerateFromTo :: Monad m => Unfold m (a, a) a--    -- | 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.Prelude as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0, 2)-    -- [0,2,4,6]-    ---    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0,(-2))-    -- [0,-2,-4,-6]-    ---    -- @-    ---    -- /Pre-release/-    enumerateFromThen :: Monad m => Unfold m (a, a) a--    -- | 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.Prelude as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, 2, 6)-    -- [0,2,4,6]-    ---    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, (-2), (-6))-    -- [0,-2,-4,-6]-    ---    -- @-    ---    -- /Pre-release/-    enumerateFromThenTo :: Monad m => Unfold m (a, a, a) a------------------------------------------------------------------------------------ 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/Exception.hs view
@@ -0,0 +1,214 @@+-- |+-- Module      : Streamly.Internal.Data.Unfold.Exception+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Lifted resource management primitives.++module Streamly.Internal.Data.Unfold.Exception+    (+      gbracket+    , after+    , finally+    , bracket+    )+where++#include "inline.hs"++import Control.Exception (mask_)+import Control.Monad.Catch (MonadCatch)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, MonadAsync, withRunInIO)+import Streamly.Internal.Data.IOFinalizer.Lifted+    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)+import qualified Control.Monad.Catch as MC++import Streamly.Internal.Data.Unfold++-- | 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 gbracket #-}+gbracket+    :: MonadRunInIO m+    => (a -> m c)                           -- ^ before+    -> (c -> m d)                           -- ^ after, on normal stop, or GC+    -> Unfold m (c, e) b                    -- ^ on exception+    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)+    -> Unfold m c b                         -- ^ unfold to run+    -> Unfold m a b+gbracket bef aft (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) <- withRunInIO $ \run -> mask_ $ run $ 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 <- 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.+                r <- clearingIOFinalizer ref (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++-- | 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 after #-}+after :: MonadRunInIO 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+        ref <- 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++-- | 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 finally #-}+finally :: (MonadAsync m, 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+        ref <- 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++-- | 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 bracket #-}+bracket :: (MonadAsync m, 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+        -- Mask asynchronous exceptions to make the execution of 'bef' and+        -- the registration of 'aft' atomic. See comment in 'D.gbracketIO'.+        (r, ref) <- withRunInIO $ \run -> mask_ $ run $ 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
+ src/Streamly/Internal/Data/Unfold/Prelude.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Unfold.Prelude+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Unfold.Prelude+    (+      module Streamly.Internal.Data.Unfold.Exception+    -- * Deprecated+    , module Streamly.Internal.Data.Unfold.SVar+    )+where++import Streamly.Internal.Data.Unfold.Exception+import Streamly.Internal.Data.Unfold.SVar
src/Streamly/Internal/Data/Unfold/SVar.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module      : Streamly.Internal.Data.Unfold.SVar -- Copyright   : (c) 2019 Composewell Technologies@@ -7,6 +8,7 @@ -- Portability : GHC -- module Streamly.Internal.Data.Unfold.SVar+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (       fromSVar     , fromProducer@@ -21,19 +23,15 @@ import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef) import Data.Maybe (isNothing) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))+import Streamly.Internal.Data.Stream (Step(..)) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import Streamly.Internal.Data.SVar (printSVar, cleanupSVar, sendStopToProducer)+import Streamly.Internal.Data.Unfold (Unfold(..)) import System.Mem (performMajorGC)  import qualified Control.Monad.Catch as MC  import Streamly.Internal.Data.SVar.Type-import Streamly.Internal.Data.Unfold.Type-import Prelude-       hiding (map, mapM, takeWhile, take, filter, const, zipWith-              , drop, dropWhile, either)- ------------------------------------------------------------------------------- -- Generation from SVar -------------------------------------------------------------------------------
− src/Streamly/Internal/Data/Unfold/Type.hs 
@@ -1,777 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Unfold.Type--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ To run the examples in this module:------ >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold--module Streamly.Internal.Data.Unfold.Type-    ( Unfold (..)--    -- * Basic Constructors-    , mkUnfoldM-    , mkUnfoldrM-    , unfoldrM-    , unfoldr-    , functionM-    , function-    , identity--    -- * From Values-    , fromEffect-    , fromPure--    -- * Transformations-    , lmap-    , lmapM-    , map-    , supply-    , supplyFirst-    , supplySecond--    -- * Trimming-    , takeWhileMWithInput-    , takeWhileM-    , takeWhile--    -- * Nesting-    , ConcatState (..)-    , many-    , manyInterleave--    -- Applicative-    , apSequence-    , apDiscardSnd-    , crossWithM-    , crossWith-    , cross-    , apply--    -- 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, concatMap, zipWith, takeWhile)---- $setup--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold----------------------------------------------------------------------------------- Monadic Unfolds----------------------------------------------------------------------------------- The order of arguments allows 'Category' and 'Arrow' instances but precludes--- contravariant and contra-applicative.------ 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 called "read".------ | 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@.------ @since 0.7.0--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.------ /Since: 0.8.0/----{-# 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]------ /Since: 0.8.0/----{-# 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)--- @------ /Since: 0.8.0/-{-# 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)--- @------ /Since: 0.8.0/-{-# 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.------ @--- supply a = Unfold.lmap (Prelude.const a)--- @------ /Pre-release/----{-# INLINE_NORMAL supply #-}-supply :: a -> Unfold m a b -> Unfold m Void b-supply 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.------ @--- supplyFirst a = Unfold.lmap (a, )--- @------ /Pre-release/----{-# INLINE_NORMAL supplyFirst #-}-supplyFirst :: a -> Unfold m (a, b) c -> Unfold m b c-supplyFirst 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.------ @--- supplySecond b = Unfold.lmap (, b)--- @------ /Pre-release/----{-# INLINE_NORMAL supplySecond #-}-supplySecond :: b -> Unfold m (a, b) c -> Unfold m a c-supplySecond 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.------ /Since: 0.8.0/----{-# 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.------ /Since: 0.8.0/----{-# INLINE takeWhile #-}-takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b-takeWhile f = takeWhileM (return . f)----------------------------------------------------------------------------------- Functor----------------------------------------------------------------------------------- | Map a function on the output of the unfold (the type @b@).------ /Pre-release/-{-# INLINE_NORMAL map #-}-map :: Functor m => (b -> c) -> Unfold m a b -> Unfold m a c-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----------------------------------------------------------------------------------- | 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---- | 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---- | Outer product discarding the first element.------ /Unimplemented/----{-# INLINE_NORMAL apSequence #-}-apSequence :: -- Monad m =>-    Unfold m a b -> Unfold m a c -> Unfold m a c-apSequence (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined---- | Outer product discarding the second element.------ /Unimplemented/----{-# INLINE_NORMAL apDiscardSnd #-}-apDiscardSnd :: -- Monad m =>-    Unfold m a b -> Unfold m a c -> Unfold m a b-apDiscardSnd (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined--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.------ /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 (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)]------ /Since: 0.8.0/----{-# 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'.------ > cross = crossWith (,)------ To cross the streams from a tuple we can write:------ @--- crossProduct :: Monad m => Unfold m a b -> Unfold m c d -> Unfold m (a, c) (b, d)--- crossProduct u1 u2 = cross (lmap fst u1) (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 (,)--apply :: Monad m => Unfold m a (b -> c) -> Unfold m a b -> Unfold m a c-apply u1 u2 = fmap (\(a, b) -> a b) (cross u1 u2)--{---- | Example:------ >>> rlist = Unfold.lmap fst Unfold.fromList--- >>> llist = Unfold.lmap snd Unfold.fromList--- >>> Stream.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))---- | 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.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.------ /Since: 0.8.0/--{-# 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------ /Since: 0.8.0/--{-# 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 second unfold to each output element of the first unfold and--- flatten the output in a single stream.------ /Since: 0.8.0/----{-# INLINE_NORMAL many #-}-many :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c-many (Unfold step1 inject1) (Unfold step2 inject2) = 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 (.) #-}-    (.) = flip 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)------ /Since: 0.8.0/----{-# 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.IsStream.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 
@@ -1,403 +0,0 @@-#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-    (-    -- ** Read from Directory-      read-    , readFiles-    , readDirs-    , readEither-    -- , readWithBufferOf--    , toStream-    , toEither-    , toFiles-    , toDirs-      {--    , toStreamWithBufferOf--    , readChunks-    , readChunksWithBufferOf--    , toChunksWithBufferOf-    , toChunks--    , write-    , writeWithBufferOf--    -- Byte stream write (Streams)-    , fromStream-    , fromStreamWithBufferOf--    -- -- * Array Write-    , writeArray-    , writeChunks-    , writeChunksWithBufferOf--    -- -- * Array stream Write-    , fromChunks-    , fromChunksWithBufferOf-    -}-    )-where--import Control.Monad.IO.Class (MonadIO(..))-import Data.Either (isRight, isLeft)--- import Data.Word (Word8)--- import Foreign.ForeignPtr (withForeignPtr)--- import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)--- import Foreign.Ptr (minusPtr, plusPtr)--- import Foreign.Storable (Storable(..))--- import GHC.ForeignPtr (mallocPlainForeignPtrBytes)--- import System.IO (Handle, hGetBufSome, hPutBuf)-import Prelude hiding (read)---- import Streamly.Data.Fold (Fold)-import Streamly.Internal.BaseCompat (fromLeft, fromRight)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--- import Streamly.Internal.Data.Array.Foreign.Type---        (Array(..), writeNUnsafe, defaultChunkSize, shrinkToFit,---         lpackArraysChunksOf)--- import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Stream.IsStream.Type (IsStream)--- import Streamly.String (encodeUtf8, decodeUtf8, foldLines)---- import qualified Streamly.Data.Fold as FL--- import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Unfold as UF--- import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS-import qualified Streamly.Internal.Data.Stream.IsStream as S--- import qualified Streamly.Data.Array.Foreign as A--- import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified System.Directory as Dir--{--{-# 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-                , aEnd   = p `plusPtr` n-                , aBound = 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 :: (IsStream t, MonadIO m)-    => Int -> Handle -> t 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 :: (IsStream t, MonadIO m) => Int -> Handle -> t 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 :: (IsStream t, MonadIO m) => Handle -> t 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.Foreign.Type.defaultChunkSize'. The--- size of arrays in the resulting stream are therefore less than or equal to--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize'.------ @since 0.7.0-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m Handle (Array Word8)-readChunks = UF.supplyFirst readChunksWithBufferOf defaultChunkSize------------------------------------------------------------------------------------ Read File to Stream------------------------------------------------------------------------------------ TODO for concurrent streams implement readahead IO. We can send multiple--- read requests at the same time. For serial case we can use async IO. We can--- also control the read throughput in mbps or IOPS.---- | 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 :: (IsStream t, MonadIO m) => Int -> Handle -> t m Word8-toStreamWithBufferOf chunkSize h = AS.concat $ toChunksWithBufferOf chunkSize h--}---- XXX exception handling---  | Raw read of a directory------  /Internal/----{-# INLINE read #-}-read :: MonadIO m => Unfold m String String-read =-    -- XXX use proper streaming read of the dir-    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 readEither #-}-readEither :: MonadIO m => Unfold m String (Either String String)-readEither =-      UF.mapMWithInput classify-    $ UF.filter (\x -> x /= "." && x /= "..")-    -- XXX use proper streaming read of the dir-    $ UF.lmapM (liftIO . Dir.getDirectoryContents) UF.fromList-    where-    classify dir x = do-        r <- liftIO $ Dir.doesDirectoryExist (dir ++ "/" ++ x)-        return $ if r then Left x else Right x------- | Read files only.------  /Internal/----{-# INLINE readFiles #-}-readFiles :: MonadIO m => Unfold m String String-readFiles = UF.map (fromRight undefined) $ UF.filter isRight readEither---- | Read directories only. Filter out "." and ".." entries.------  /Internal/----{-# INLINE readDirs #-}-readDirs :: MonadIO m => Unfold m String String-readDirs = UF.map (fromLeft undefined) $ UF.filter isLeft readEither---- | Raw read of a directory.------ /Pre-release/-{-# INLINE toStream #-}-toStream :: (IsStream t, MonadIO m) => String -> t m String-toStream = S.unfold read---- | Read directories as Left and files as Right. Filter out "." and ".."--- entries.------ /Pre-release/-{-# INLINE toEither #-}-toEither :: (IsStream t, MonadIO m)-    => String -> t m (Either String String)-toEither = S.unfold readEither---- | Read files only.------  /Internal/----{-# INLINE toFiles #-}-toFiles :: (IsStream t, MonadIO m) => String -> t m String-toFiles = S.unfold readFiles---- | Read directories only.------  /Internal/----{-# INLINE toDirs #-}-toDirs :: (IsStream t, MonadIO m) => String -> t m String-toDirs = S.unfold 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 aEnd `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 -> SerialT 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 -> SerialT 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 -> SerialT m Word8 -> m ()-fromStreamWithBufferOf n h m = fromChunks h $ S.arraysOf n m--- fromStreamWithBufferOf n h m = fromChunks h $ AS.arraysOf 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.Foreign.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 -> SerialT 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.chunksOf 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.Foreign.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/Event.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.FileSystem.Event -- Copyright   : (c) 2020 Composewell Technologies@@ -20,7 +22,12 @@ -- * "Streamly.Internal.FileSystem.Event.Linux" -- * "Streamly.Internal.FileSystem.Event.Windows" +-- XXX Need to ensure that the signatures of the exported APIs are same on all+-- platforms.++ module Streamly.Internal.FileSystem.Event+    {-# DEPRECATED "Use the streamly-fsevents package." #-}     (     -- * Creating a Watch @@ -47,8 +54,8 @@  import Data.List.NonEmpty (NonEmpty) import Data.Word (Word8)-import Streamly.Internal.Data.Array.Foreign (Array)-import Streamly.Prelude (SerialT)+import Streamly.Data.Array (Array)+import Streamly.Data.Stream (Stream)  #if defined(CABAL_OS_DARWIN) import Streamly.Internal.FileSystem.Event.Darwin (Event)@@ -115,7 +122,7 @@ -- -- /Pre-release/ ---watch :: NonEmpty (Array Word8) -> SerialT IO Event+watch :: NonEmpty (Array Word8) -> Stream IO Event #if defined(CABAL_OS_DARWIN) watch = Event.watchRecursive #else@@ -129,7 +136,7 @@ -- -- /Pre-release/ ---_watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event+_watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event _watchRecursive = Event.watchRecursive  -------------------------------------------------------------------------------
+ src/Streamly/Internal/FileSystem/Event/Darwin.c view
@@ -0,0 +1,287 @@+/*+ * Code adapted from the Haskell "hfsevents" package.+ *+ * Copyright (c) 2012, Luite Stegeman+ *+ */++#include <config.h>++#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS++#include <CoreServices/CoreServices.h>+#include <pthread.h>+#include <unistd.h>+#include <FileSystem/Event/Darwin.h>++/*+ * For reference documentaion see:+ * https://developer.apple.com/documentation/coreservices/file_system_events?language=objc+ * https://developer.apple.com/library/archive/documentation/Darwin/Conceptual/FSEvents_ProgGuide/UsingtheFSEventsFramework/UsingtheFSEventsFramework.html+ *+ * An OS thread is started which runs the event loop. A pipe is created+ * and the events are sent to the pipes. The receiver can read the pipe+ * output end to get the events.+ */++/******************************************************************************+ * Create Flags+ *****************************************************************************/++UInt32 FSEventStreamCreateFlagNoDefer () {+  return kFSEventStreamCreateFlagNoDefer;+}+UInt32 FSEventStreamCreateFlagWatchRoot () {+  return kFSEventStreamCreateFlagWatchRoot;+}+UInt32 FSEventStreamCreateFlagFileEvents () {+  return kFSEventStreamCreateFlagFileEvents;+}+UInt32 FSEventStreamCreateFlagIgnoreSelf () {+  return kFSEventStreamCreateFlagIgnoreSelf;+}+#if 0+UInt32 FSEventStreamCreateFlagFullHistory = kFSEventStreamCreateFlagFullHistory;+#endif++/******************************************************************************+ * Event Flags+ *****************************************************************************/++UInt32 FSEventStreamEventFlagEventIdsWrapped () {+  return kFSEventStreamEventFlagEventIdsWrapped;+}+UInt32 FSEventStreamEventFlagMustScanSubDirs () {+  return kFSEventStreamEventFlagMustScanSubDirs;+}+UInt32 FSEventStreamEventFlagKernelDropped () {+  return kFSEventStreamEventFlagKernelDropped;+}+UInt32 FSEventStreamEventFlagUserDropped () {+  return kFSEventStreamEventFlagUserDropped;+}+UInt32 FSEventStreamEventFlagHistoryDone () {+  return kFSEventStreamEventFlagHistoryDone;+}+UInt32 FSEventStreamEventFlagRootChanged () {+  return kFSEventStreamEventFlagRootChanged;+}+UInt32 FSEventStreamEventFlagMount () {+  return kFSEventStreamEventFlagMount;+}+UInt32 FSEventStreamEventFlagUnmount () {+  return kFSEventStreamEventFlagUnmount;+}+UInt32 FSEventStreamEventFlagItemChangeOwner () {+  return kFSEventStreamEventFlagItemChangeOwner;+}+UInt32 FSEventStreamEventFlagItemInodeMetaMod () {+  return kFSEventStreamEventFlagItemInodeMetaMod;+}+UInt32 FSEventStreamEventFlagItemFinderInfoMod () {+  return kFSEventStreamEventFlagItemFinderInfoMod;+}+UInt32 FSEventStreamEventFlagItemXattrMod () {+  return kFSEventStreamEventFlagItemXattrMod;+}+UInt32 FSEventStreamEventFlagItemCreated () {+  return kFSEventStreamEventFlagItemCreated;+}+UInt32 FSEventStreamEventFlagItemRemoved () {+  return kFSEventStreamEventFlagItemRemoved;+}+UInt32 FSEventStreamEventFlagItemRenamed () {+  return kFSEventStreamEventFlagItemRenamed;+}+UInt32 FSEventStreamEventFlagItemModified () {+  return kFSEventStreamEventFlagItemModified;+}+#if __MAC_OS_X_VERSION_MIN_REQUIRED >= 101300+UInt32 FSEventStreamEventFlagItemCloned () {+  return kFSEventStreamEventFlagItemCloned;+}+#endif+UInt32 FSEventStreamEventFlagItemIsDir () {+  return kFSEventStreamEventFlagItemIsDir;+}+UInt32 FSEventStreamEventFlagItemIsFile () {+  return kFSEventStreamEventFlagItemIsFile;+}+UInt32 FSEventStreamEventFlagItemIsSymlink () {+  return kFSEventStreamEventFlagItemIsSymlink;+}+#if __MAC_OS_X_VERSION_MIN_REQUIRED >= 101000+UInt32 FSEventStreamEventFlagItemIsHardlink () {+  return kFSEventStreamEventFlagItemIsHardlink;+}+#endif+UInt32 FSEventStreamEventFlagItemIsLastHardlink () {+  return kFSEventStreamEventFlagItemIsLastHardlink;+}++/******************************************************************************+ * Event watch+ *****************************************************************************/++/* Write an event to the pipe input fd */+static void writeEvent(int fd, UInt64 eventId, UInt64 eventFlags, char* path)+{+    UInt64 buf[3];+    /* XXX Is the path string in UTF-8? */+    size_t len = strlen(path);++    buf[0] = eventId;+    buf[1] = eventFlags;+    buf[2] = (UInt64)len;+    write(fd, buf, 3 * sizeof(UInt64));+    write(fd, path, len);+}++struct watch+{+    FSEventStreamRef eventStream;+    dispatch_queue_t queue;+    int writefd;+};++/* Just writes the event to the pipe input fd */+static void watchCallback+    ( ConstFSEventStreamRef streamRef+    , void *clientCallBackInfo+    , size_t n+    , void *eventPaths+    , const FSEventStreamEventFlags eventFlags[]+    , const FSEventStreamEventId eventIds[]+    )+{+    int i;+    struct watch *w = clientCallBackInfo;+    char **paths = eventPaths;++    for (i = 0; i < n; i++) {+        writeEvent(w->writefd, eventIds[i], eventFlags[i], paths[i]);+    }+}++#define MAX_WATCH_PATHS 4096++static void free_cffolders(CFStringRef *cffolders, int n) {+    int i;+    for (i = 0; i < n; i++) {+        CFRelease (cffolders[i]);+    }+    free(cffolders);+}++int createWatch+    ( struct pathName* folders+    , int n  /* number of entries in folders */+    , UInt32 createFlags+    , UInt64 since+    , double latency+    , int* fd+    , void** wp+    )+{+    if (n > MAX_WATCH_PATHS) {+      return -1;+    }++    int pfds[2];+    if (pipe (pfds)) {+      return -1;+    }++    /*+     * XXX We can possibly use since == 0 to get all events since+     * beginning of time+     */+    if (!since) {+      since = kFSEventStreamEventIdSinceNow;+    }++    struct watch *w = malloc(sizeof(struct watch));+    if (!w) {+      goto cleanup_pipe;+    }++    /* Setup paths array */+    CFStringRef *cffolders = malloc(n * sizeof(CFStringRef));+    if (!cffolders) {+      goto cleanup_watch;+    }++    /* Create event stream using paths and context*/+    int i;+    for(i = 0; i < n; i++) {+      cffolders[i] = CFStringCreateWithBytes+          ( NULL+          , folders[i].pathBytes+          , folders[i].pathLen+          , kCFStringEncodingUTF8+          , false+          );+      if (!cffolders[i]) {+          free_cffolders(cffolders, i);+          goto cleanup_watch;+      }+    }+    CFArrayRef paths = CFArrayCreate(NULL, (const void **)cffolders, n, NULL);+    if (!paths) {+      free_cffolders(cffolders, n);+      goto cleanup_watch;+    }++    FSEventStreamContext ctx;+    ctx.version = 0;+    ctx.info = (void*)w;+    ctx.retain = NULL;+    ctx.release = NULL;+    ctx.copyDescription = NULL;++    w->eventStream = FSEventStreamCreate+        (NULL, &watchCallback, &ctx, paths, since, latency, createFlags);+    free_cffolders(cffolders, n);+    CFRelease(paths);++    if(w->eventStream == NULL) {+      goto cleanup_watch;+    }++    w->queue = dispatch_queue_create("com.composewell.streamly", NULL);+    if (!w->queue) {+      goto cleanup_es;+    }++    w->writefd = pfds[1];+    *fd = pfds[0];+    *wp = w;+    FSEventStreamSetDispatchQueue(w->eventStream, w->queue);+    FSEventStreamStart(w->eventStream);+    return 0;++cleanup_es:+    FSEventStreamRelease(w->eventStream);+cleanup_watch:+    free(w);+cleanup_pipe:+    close(pfds[0]);+    close(pfds[1]);+    return -1;+}++/******************************************************************************+ * Stop a watch event loop+ *****************************************************************************/++void destroyWatch(struct watch* w) {+    /* Stop and invalidate the event stream */+    FSEventStreamFlushSync(w->eventStream);+    FSEventStreamStop(w->eventStream);+    FSEventStreamInvalidate(w->eventStream);+    dispatch_release(w->queue);+    FSEventStreamRelease(w->eventStream);+    close(w->writefd);+    free(w);+}+#endif
src/Streamly/Internal/FileSystem/Event/Darwin.hs view
@@ -14,7 +14,7 @@ -- -- @ -- {-\# LANGUAGE MagicHash #-}--- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchRecursive' [Array.fromCString\# "path"#]+-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchRecursive' [Array.fromList "path"] -- @ -- -- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)@@ -87,12 +87,12 @@ #if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS  module Streamly.Internal.FileSystem.Event.Darwin+    {-# DEPRECATED "Use the streamly-fsevents package." #-}     (     -- * Creating a Watch      -- ** Default configuration       Config (..)-    , Switch (..)     , defaultConfig      -- ** Watch Behavior@@ -163,7 +163,6 @@  import Control.Concurrent (MVar, newMVar, takeMVar, putMVar) import Control.Monad (when)-import Control.Monad.IO.Class (liftIO) import Data.Bits ((.|.), (.&.), complement) import Data.Functor.Identity (runIdentity) import Data.List.NonEmpty (NonEmpty)@@ -174,25 +173,26 @@ import Foreign.Ptr (Ptr, castPtr) import Foreign.Storable (Storable(..)) import GHC.IO.Handle.FD (fdToHandle)-import Streamly.Prelude (SerialT)+import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Cont (contListMap) import Streamly.Internal.Data.Parser (Parser)-import Streamly.Internal.Data.Array.Foreign.Type (Array(..))+import Streamly.Internal.Data.Array (Array(..)) import System.IO (Handle, hClose)  import qualified Data.List.NonEmpty as NonEmpty+import qualified Streamly.Data.Fold as FL import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Stream.IsStream as S+import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Unicode.Stream as U import qualified Streamly.Internal.FileSystem.Handle as FH-import qualified Streamly.Internal.Data.Array.Foreign as A+import qualified Streamly.Internal.Data.Array as A  ------------------------------------------------------------------------------- -- Subscription to events -------------------------------------------------------------------------------  -- XXX Add a recursive option to Config--- Keep setRecursiveMode Off as undefined for now until we implement it.+-- Keep setRecursiveMode False as undefined for now until we implement it. -- -- | Watch configuration, used to specify the events of interest and the -- behavior of the watch.@@ -233,28 +233,22 @@ setEventBatching batchInfo cfg =     let (t, status) =             case batchInfo of-                Throttle sec | sec < 0 -> (0, On)-                Throttle sec -> (sec, On)-                Batch sec | sec < 0 -> (0, Off)-                Batch sec -> (sec, Off)+                Throttle sec | sec < 0 -> (0, True)+                Throttle sec -> (sec, True)+                Batch sec | sec < 0 -> (0, False)+                Batch sec -> (sec, False)     in setFlag kFSEventStreamCreateFlagNoDefer status $ cfg {latency = t}  ------------------------------------------------------------------------------- -- Boolean settings ------------------------------------------------------------------------------- --- | Whether a setting is 'On' or 'Off'.------ /Pre-release/----data Switch = On | Off--setFlag :: Word32 -> Switch -> Config -> Config+setFlag :: Word32 -> Bool -> Config -> Config setFlag mask status cfg@Config{..} =     let flags =-            case status of-                On -> createFlags .|. mask-                Off -> createFlags .&. complement mask+            if status+            then createFlags .|. mask+            else createFlags .&. complement mask     in cfg {createFlags = flags}  foreign import ccall safe@@ -267,26 +261,26 @@ -- | Any changes to the path (delete, rename, or create) of an object are -- reported as events for its parent directory. Such events are not reported -- for the watch root itself because its parent is not being watched. When--- 'setRootPathEvents' is 'On', an 'isRootPathEvent' event is generated with an+-- 'setRootPathEvents' is 'True', an 'isRootPathEvent' event is generated with an -- eventId 0 if the watch root is deleted, renamed or created. -- -- Note: We have observed that an 'isDeleted' event occurs for the root path -- (when it is a regular dir and not symlink) even when this option is off. ----- /default: Off/+-- /default: False/ -- -- /macOS 10.5+/ -- -- /Pre-release/ ---setRootPathEvents :: Switch -> Config -> Config+setRootPathEvents :: Bool -> Config -> Config setRootPathEvents = setFlag kFSEventStreamCreateFlagWatchRoot  foreign import ccall safe     "FSEventStreamCreateFlagFileEvents"     kFSEventStreamCreateFlagFileEvents :: Word32 --- | When this is 'Off' only events for the watched directories are reported.+-- | When this is 'False' only events for the watched directories are reported. -- For example, when a file is created inside a directory it is reported as an -- event, the path name in the event is the path of the directory being watched -- and not of the specific item for which the event occurred.  Events cannot be@@ -294,33 +288,33 @@ -- if an event is a "create" or "delete", we only know that some event ocurred -- under the watched directory hierarchy. ----- When it is 'On' the path reported in the event is the path of the item and+-- When it is 'True' the path reported in the event is the path of the item and -- not the of the directory in which it is contained. We can use the event -- accessor functions to determine the event type and the path type etc. ----- /default: On/+-- /default: True/ -- -- /macOS 10.7+/ -- -- /Pre-release/ ---setFileEvents :: Switch -> Config -> Config+setFileEvents :: Bool -> Config -> Config setFileEvents = setFlag kFSEventStreamCreateFlagFileEvents  foreign import ccall safe     "FSEventStreamCreateFlagIgnoreSelf"     kFSEventStreamCreateFlagIgnoreSelf :: Word32 --- | When this is 'On' events generated by the current process are not+-- | When this is 'True' events generated by the current process are not -- reported. ----- /default: Off/+-- /default: False/ -- -- /macOS 10.6+/ -- -- /Pre-release/ ---setIgnoreSelf :: Switch -> Config -> Config+setIgnoreSelf :: Bool -> Config -> Config setIgnoreSelf = setFlag kFSEventStreamCreateFlagIgnoreSelf  #if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY@@ -328,26 +322,26 @@     "FSEventStreamCreateFlagFullHistory"     kFSEventStreamCreateFlagFullHistory :: Word32 --- | When this is 'On' all events since the beginning of time are reported.+-- | When this is 'True' all events since the beginning of time are reported. ----- /default: Off/+-- /default: False/ -- -- /macOS 10.15+/ -- -- /Pre-release/ ---setFullHistory :: Switch -> Config -> Config+setFullHistory :: Bool -> Config -> Config setFullHistory = setFlag kFSEventStreamCreateFlagFullHistory #endif --- | Set all tunable events 'On' or 'Off'. Equivalent to setting:+-- | Set all tunable events 'True' or 'False'. Equivalent to setting: -- -- * setRootPathEvents -- * setFileEvents -- -- /Pre-release/ ---setAllEvents :: Switch -> Config -> Config+setAllEvents :: Bool -> Config -> Config setAllEvents s =       setRootPathEvents s     . setFileEvents s@@ -359,17 +353,17 @@ -- | The default settings are: -- -- * 'setEventBatching' ('Batch' 0.0)--- * 'setFileEvents' 'On'--- * 'setRootPathEvents' 'Off'--- * 'setIgnoreSelf' 'Off'+-- * 'setFileEvents' 'True'+-- * 'setRootPathEvents' 'False'+-- * 'setIgnoreSelf' 'False' #if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY--- * 'setFullHistory' 'Off'+-- * 'setFullHistory' 'False' #endif -- -- /Pre-release/ -- defaultConfig :: Config-defaultConfig = setFileEvents On $ Config+defaultConfig = setFileEvents True $ Config     { latency = 0.0     , createFlags = 0     }@@ -458,8 +452,8 @@      withPathName :: Array Word8 -> (PathName -> IO a) -> IO a     withPathName arr act = do-        A.asPtrUnsafe arr $ \ptr ->-            let pname = PathName (castPtr ptr) (fromIntegral (A.length arr))+        A.unsafePinnedAsPtr arr $ \ptr byteLen ->+            let pname = PathName (castPtr ptr) (fromIntegral byteLen)             in act pname      withPathNames = contListMap withPathName withArray@@ -496,23 +490,23 @@ -- XXX should we use a magic in the header to avoid any issues due to -- misalignment of records? Can that ever happen? ---readOneEvent :: Parser IO Word8 Event+readOneEvent :: Parser Word8 IO Event readOneEvent = do-    arr <- PR.takeEQ 24 (A.writeN 24)+    arr <- PR.takeEQ 24 (A.createOf 24)     let arr1 = A.unsafeCast arr :: Array Word64-        eid = A.unsafeIndex 0 arr1-        eflags = A.unsafeIndex 1 arr1-        pathLen = fromIntegral $ A.unsafeIndex 2 arr1-    path <- PR.takeEQ pathLen (A.writeN pathLen)+        eid = A.unsafeGetIndex 0 arr1+        eflags = A.unsafeGetIndex 1 arr1+        pathLen = fromIntegral $ A.unsafeGetIndex 2 arr1+    path <- PR.takeEQ pathLen (A.createOf pathLen)     return $ Event         { eventId = eid         , eventFlags = fromIntegral eflags         , eventAbsPath = path         } -watchToStream :: Watch -> SerialT IO Event+watchToStream :: Watch -> Stream IO Event watchToStream (Watch handle _ _) =-    S.parseMany readOneEvent $ S.unfold FH.read handle+    S.catRights $ S.parseMany readOneEvent $ S.unfold FH.reader handle  -- XXX Write tests for all the points in macOS specific behavior. --@@ -559,33 +553,33 @@ -- @ -- {-\# LANGUAGE MagicHash #-} -- watchWith---      ('setIgnoreSelf' 'On' . 'setRootPathEvents' 'On')---      [Array.fromCString\# "path"#]+--      ('setIgnoreSelf' 'True' . 'setRootPathEvents' 'True')+--      [Array.fromList "path"] -- @ -- -- /Pre-release/ -- watchWith ::-    (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event-watchWith f paths = S.bracket before after watchToStream+    (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event+watchWith f paths = S.bracketIO before after watchToStream      where -    before = liftIO $ openWatch (f defaultConfig) paths-    after = liftIO . closeWatch+    before = openWatch (f defaultConfig) paths+    after = closeWatch  -- | Same as 'watchWith' using 'defaultConfig' and recursive mode. -- -- >>> watchRecursive = watchWith id ---watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event+watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event watchRecursive = watchWith id  -- | Same as 'watchWith' using defaultConfig and non-recursive mode. -- -- /Unimplemented/ ---watch :: NonEmpty (Array Word8) -> SerialT IO Event+watch :: NonEmpty (Array Word8) -> Stream IO Event watch _paths = undefined  -------------------------------------------------------------------------------@@ -719,7 +713,7 @@ -- object itself. Note that the object may become unreachable or deleted after -- a change of path. ----- /Applicable only when 'setRootPathEvents' is 'On'/+-- /Applicable only when 'setRootPathEvents' is 'True'/ -- -- /Occurs only for the watched path/ --@@ -763,7 +757,7 @@ isUnmounted = getFlag kFSEventStreamEventFlagUnmount  ---------------------------------------------------------------------------------- Metadata change Events (applicable only when 'setFileEvents' is 'On')+-- Metadata change Events (applicable only when 'setFileEvents' is 'True') -------------------------------------------------------------------------------  foreign import ccall safe@@ -776,7 +770,7 @@ -- Note that this event may be generated even if the metadata is changed to the -- same value again. ----- /Applicable only when 'setFileEvents' is 'On'/+-- /Applicable only when 'setFileEvents' is 'True'/ -- -- /Can occur for watched path or a file inside it/ --@@ -797,7 +791,7 @@ -- modification time. It does not occur when the link count of a file changes -- (as of macOS 10.15.1). ----- /Applicable only when 'setFileEvents' is 'On'/+-- /Applicable only when 'setFileEvents' is 'True'/ -- -- /Can occur for watched path or a file inside it/ --@@ -815,7 +809,7 @@ -- | Determine whether the event indicates finder information metadata change -- for an object contained within the monitored path. ----- /Applicable only when 'setFileEvents' is 'On'/+-- /Applicable only when 'setFileEvents' is 'True'/ -- -- /macOS 10.7+/ --@@ -831,7 +825,7 @@ -- | Determine whether the event indicates extended attributes metadata change -- for an object contained within the monitored path. ----- /Applicable only when 'setFileEvents' is 'On'/+-- /Applicable only when 'setFileEvents' is 'True'/ -- -- /Can occur for watched path or a file inside it/ --@@ -843,7 +837,7 @@ isXAttrsModified = getFlag kFSEventStreamEventFlagItemXattrMod  ---------------------------------------------------------------------------------- CRUD Events (applicable only when 'setFileEvents' is 'On')+-- CRUD Events (applicable only when 'setFileEvents' is 'True') -------------------------------------------------------------------------------  foreign import ccall safe@@ -865,7 +859,7 @@ -- only an 'isAttrsModified' event occurs and there is no 'isCreated' -- event. However, this seems to have been fixed on 10.15.6. ----- /Applicable only when 'setFileEvents' is 'On'/+-- /Applicable only when 'setFileEvents' is 'True'/ -- -- /Can occur for watched path or a file inside it/ --@@ -883,7 +877,7 @@ -- | Determine whether the event indicates deletion of an object within the -- monitored path. This is true when a file or a hardlink is deleted. ----- Applicable only when 'setFileEvents' is 'On'.+-- Applicable only when 'setFileEvents' is 'True'. -- -- /Can occur for watched path or a file inside it/ --@@ -902,7 +896,7 @@ -- monitored path. This event is generated when a file is renamed within the -- watched directory or if it is moved out of or in the watched directory. ----- /Applicable only when 'setFileEvents' is 'On'/+-- /Applicable only when 'setFileEvents' is 'True'/ -- -- /Can occur for watched path or a file inside it/ --@@ -920,7 +914,7 @@ -- | Determine whether the event indicates modification of an object within the -- monitored path. This event is generated only for files and not directories. ----- Applicable only when 'setFileEvents' is 'On'.+-- Applicable only when 'setFileEvents' is 'True'. -- -- /macOS 10.7+/ --@@ -938,7 +932,7 @@ -- monitored path. The "Duplicate" command in the "File" menu of the "Finder" -- application generates a "clone" event. ----- Applicable only when 'setFileEvents' is 'On'.+-- Applicable only when 'setFileEvents' is 'True'. -- -- /macOS 10.13+/ --@@ -949,7 +943,7 @@ #endif  ---------------------------------------------------------------------------------- Information about path type (applicable only when 'setFileEvents' is 'On')+-- Information about path type (applicable only when 'setFileEvents' is 'True') -------------------------------------------------------------------------------  foreign import ccall safe@@ -958,7 +952,7 @@  -- | Determine whether the event is for a directory path. ----- Applicable only when 'setFileEvents' is 'On'.+-- Applicable only when 'setFileEvents' is 'True'. -- -- /macOS 10.7+/ --@@ -973,7 +967,7 @@  -- | Determine whether the event is for a file path. ----- Applicable only when 'setFileEvents' is 'On'.+-- Applicable only when 'setFileEvents' is 'True'. -- -- /macOS 10.7+/ --@@ -988,7 +982,7 @@  -- | Determine whether the event is for a symbolic link path. ----- Applicable only when 'setFileEvents' is 'On'.+-- Applicable only when 'setFileEvents' is 'True'. -- -- /macOS 10.7+/ --@@ -1008,7 +1002,7 @@ -- which has or had more than one link in the past is removed. This is not true -- if a file never had more than one link. ----- Applicable only when 'setFileEvents' is 'On'.+-- Applicable only when 'setFileEvents' is 'True'. -- -- /macOS 10.10+/ --@@ -1026,7 +1020,7 @@ -- is true when a file has had more than one link and now the last link is -- removed. In that case both 'isHardLink' and 'isLastHardLink" would be true. ----- Applicable only when 'setFileEvents' is 'On'.+-- Applicable only when 'setFileEvents' is 'True'. -- -- /macOS 10.10+/ --@@ -1043,7 +1037,7 @@ -- | Convert an 'Event' record to a String representation. showEvent :: Event -> String showEvent ev@Event{..} =-    let path = runIdentity $ S.toList $ U.decodeUtf8' $ A.toStream eventAbsPath+    let path = runIdentity $ S.fold FL.toList $ U.decodeUtf8' $ A.read eventAbsPath     in "--------------------------"         ++ "\nId = " ++ show eventId         ++ "\nPath = " ++ show path
− src/Streamly/Internal/FileSystem/Event/Darwin.m 
@@ -1,294 +0,0 @@-/*- * Code adapted from the Haskell "hfsevents" package.- *- * Copyright (c) 2012, Luite Stegeman- *- */--#include <config.h>--#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS--#include <CoreServices/CoreServices.h>-#include <pthread.h>-#include <unistd.h>-#include <FileSystem/Event/Darwin.h>--/*- * For reference documentaion see:- * https://developer.apple.com/documentation/coreservices/file_system_events?language=objc- * https://developer.apple.com/library/archive/documentation/Darwin/Conceptual/FSEvents_ProgGuide/UsingtheFSEventsFramework/UsingtheFSEventsFramework.html- *- * An OS thread is started which runs the event loop. A pipe is created- * and the events are sent to the pipes. The receiver can read the pipe- * output end to get the events.- */--/******************************************************************************- * Create Flags- *****************************************************************************/--UInt32 FSEventStreamCreateFlagNoDefer () {-  return kFSEventStreamCreateFlagNoDefer;-}-UInt32 FSEventStreamCreateFlagWatchRoot () {-  return kFSEventStreamCreateFlagWatchRoot;-}-UInt32 FSEventStreamCreateFlagFileEvents () {-  return kFSEventStreamCreateFlagFileEvents;-}-UInt32 FSEventStreamCreateFlagIgnoreSelf () {-  return kFSEventStreamCreateFlagIgnoreSelf;-}-#if 0-UInt32 FSEventStreamCreateFlagFullHistory = kFSEventStreamCreateFlagFullHistory;-#endif--/******************************************************************************- * Event Flags- *****************************************************************************/--UInt32 FSEventStreamEventFlagEventIdsWrapped () {-  return kFSEventStreamEventFlagEventIdsWrapped;-}-UInt32 FSEventStreamEventFlagMustScanSubDirs () {-  return kFSEventStreamEventFlagMustScanSubDirs;-}-UInt32 FSEventStreamEventFlagKernelDropped () {-  return kFSEventStreamEventFlagKernelDropped;-}-UInt32 FSEventStreamEventFlagUserDropped () {-  return kFSEventStreamEventFlagUserDropped;-}-UInt32 FSEventStreamEventFlagHistoryDone () {-  return kFSEventStreamEventFlagHistoryDone;-}-UInt32 FSEventStreamEventFlagRootChanged () {-  return kFSEventStreamEventFlagRootChanged;-}-UInt32 FSEventStreamEventFlagMount () {-  return kFSEventStreamEventFlagMount;-}-UInt32 FSEventStreamEventFlagUnmount () {-  return kFSEventStreamEventFlagUnmount;-}-UInt32 FSEventStreamEventFlagItemChangeOwner () {-  return kFSEventStreamEventFlagItemChangeOwner;-}-UInt32 FSEventStreamEventFlagItemInodeMetaMod () {-  return kFSEventStreamEventFlagItemInodeMetaMod;-}-UInt32 FSEventStreamEventFlagItemFinderInfoMod () {-  return kFSEventStreamEventFlagItemFinderInfoMod;-}-UInt32 FSEventStreamEventFlagItemXattrMod () {-  return kFSEventStreamEventFlagItemXattrMod;-}-UInt32 FSEventStreamEventFlagItemCreated () {-  return kFSEventStreamEventFlagItemCreated;-}-UInt32 FSEventStreamEventFlagItemRemoved () {-  return kFSEventStreamEventFlagItemRemoved;-}-UInt32 FSEventStreamEventFlagItemRenamed () {-  return kFSEventStreamEventFlagItemRenamed;-}-UInt32 FSEventStreamEventFlagItemModified () {-  return kFSEventStreamEventFlagItemModified;-}-#if __MAC_OS_X_VERSION_MIN_REQUIRED >= 101300-UInt32 FSEventStreamEventFlagItemCloned () {-  return kFSEventStreamEventFlagItemCloned;-}-#endif-UInt32 FSEventStreamEventFlagItemIsDir () {-  return kFSEventStreamEventFlagItemIsDir;-}-UInt32 FSEventStreamEventFlagItemIsFile () {-  return kFSEventStreamEventFlagItemIsFile;-}-UInt32 FSEventStreamEventFlagItemIsSymlink () {-  return kFSEventStreamEventFlagItemIsSymlink;-}-#if __MAC_OS_X_VERSION_MIN_REQUIRED >= 101000-UInt32 FSEventStreamEventFlagItemIsHardlink () {-  return kFSEventStreamEventFlagItemIsHardlink;-}-#endif-UInt32 FSEventStreamEventFlagItemIsLastHardlink () {-  return kFSEventStreamEventFlagItemIsLastHardlink;-}--/******************************************************************************- * Event watch- *****************************************************************************/--/* Write an event to the pipe input fd */-static void writeEvent(int fd, UInt64 eventId, UInt64 eventFlags, char* path) -{-    UInt64 buf[3];-    buf[0] = eventId;-    buf[1] = eventFlags;-    /* XXX Is the path string in UTF-8? */-    buf[2] = (UInt64)strlen(path);-    write(fd, buf, 3 * sizeof(UInt64));-    write(fd, path, strlen(path));-}--/* thread state */-struct watch-{-    FSEventStreamRef eventStream;-    CFRunLoopRef runLoop;-    int writefd;-    pthread_mutex_t mut;-};--/* Just writes the event to the pipe input fd */-static void watchCallback-    ( ConstFSEventStreamRef streamRef-    , void *clientCallBackInfo-    , size_t n-    , void *eventPaths-    , const FSEventStreamEventFlags eventFlags[]-    , const FSEventStreamEventId eventIds[]-    )-{-    int i;-    struct watch *w = clientCallBackInfo;-    char **paths = eventPaths;--    for (i = 0; i < n; i++) {-        writeEvent(w->writefd, eventIds[i], eventFlags[i], paths[i]);-    }-}--/******************************************************************************- * Start a watch event loop- *****************************************************************************/--/* Event loop run in a pthread */-static void *watchRunLoop(void *vw)-{-    struct watch* w = (struct watch*) vw;-    CFRunLoopRef rl = CFRunLoopGetCurrent();-    CFRetain(rl);-    w->runLoop = rl;-    FSEventStreamScheduleWithRunLoop(w->eventStream, rl, kCFRunLoopDefaultMode);-    FSEventStreamStart(w->eventStream);-    pthread_mutex_unlock(&w->mut);-    CFRunLoopRun();-    pthread_exit(NULL);-}--#define MAX_WATCH_PATHS 4096--int createWatch-    ( struct pathName* folders-    , int n  /* number of entries in folders */-    , UInt32 createFlags-    , UInt64 since-    , double latency-    , int* fd-    , void** wp-    )-{-    if (n > MAX_WATCH_PATHS) {-      return -1;-    }--    int pfds[2];-    if (pipe (pfds)) {-      return -1;-    }--    /*-     * XXX We can possibly use since == 0 to get all events since-     * beginning of time-     */-    if (!since) {-      since = kFSEventStreamEventIdSinceNow;-    }--    /* Setup paths array */-    CFStringRef *cffolders = malloc(n * sizeof(CFStringRef));-    int i;-    for(i = 0; i < n; i++) {-      cffolders[i] = CFStringCreateWithBytes-          ( NULL-          , folders[i].pathBytes-          , folders[i].pathLen-          , kCFStringEncodingUTF8-          , false-          );-    }-    CFArrayRef paths = CFArrayCreate(NULL, (const void **)cffolders, n, NULL);--    /* Setup context */-    struct watch *w = malloc(sizeof(struct watch));-    FSEventStreamContext ctx;-    ctx.version = 0;-    ctx.info = (void*)w;-    ctx.retain = NULL;-    ctx.release = NULL;-    ctx.copyDescription = NULL;--    /* Create watch using paths and context*/-    FSEventStreamRef es = FSEventStreamCreate-        (NULL, &watchCallback, &ctx, paths, since, latency, createFlags);--    /* Run the event loop in a pthread */-    int retval;-    if(es != NULL) {-        /* Success */-        w->writefd = pfds[1];-        w->eventStream = es;-        w->runLoop = NULL;--        /* Lock to prevent race against watch destroy */-        pthread_mutex_init(&w->mut, NULL);-        pthread_mutex_lock(&w->mut);-        pthread_t t;-        pthread_create(&t, NULL, &watchRunLoop, (void*)w);--        /* return the out fd and the watch struct */-        *fd = pfds[0];-        *wp = w;-        retval = 0;-    } else {-        /* Failure */-        close(pfds[0]);-        close(pfds[1]);-        free(w);-        retval = -1;-    }--    /* Cleanup */-    for (i = 0; i < n; i++) {-        CFRelease (cffolders[i]);-    }-    free(cffolders);-    CFRelease(paths);-    return retval;-}--/******************************************************************************- * Stop a watch event loop- *****************************************************************************/--void destroyWatch(struct watch* w) {-    /* Stop the loop so the thread will exit */-    pthread_mutex_lock(&w->mut);-    FSEventStreamStop(w->eventStream);-    FSEventStreamInvalidate(w->eventStream);-    CFRunLoopStop(w->runLoop);-    CFRelease(w->runLoop);-    FSEventStreamRelease(w->eventStream);-    close(w->writefd);-    pthread_mutex_unlock(&w->mut);--    /* Cleanup */-    pthread_mutex_destroy(&w->mut);-    free(w);-}-#endif
src/Streamly/Internal/FileSystem/Event/Linux.hs view
@@ -13,7 +13,7 @@ -- occurring under the watched paths. -- -- @--- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchPaths' [Array.fromCString\# "dir"#]+-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchPaths' [Array.fromList "dir"] -- @ -- -- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)@@ -59,12 +59,12 @@  #if HAVE_DECL_IN_EXCL_UNLINK module Streamly.Internal.FileSystem.Event.Linux+    {-# DEPRECATED "Use the streamly-fsevents package." #-}     (     -- * Subscribing to events      -- ** Default configuration       Config (..)-    , Switch (..)     , defaultConfig      -- ** Watch Behavior@@ -152,7 +152,7 @@ where  import Control.Monad (void, when)-import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.IO.Class (MonadIO) import Data.Bits ((.|.), (.&.), complement) import Data.Char (ord) import Data.Foldable (foldlM)@@ -170,32 +170,34 @@ import Foreign.Ptr (Ptr) import Foreign.Storable (peek, peekByteOff, sizeOf) import GHC.IO.Device (IODeviceType(Stream))-import GHC.IO.FD (fdFD, mkFD)+import GHC.IO.FD (fdFD, FD(..)) import GHC.IO.Handle.FD (mkHandleFromFD)-import Streamly.Prelude (SerialT)-import Streamly.Internal.Data.Parser (Parser)-import Streamly.Internal.Data.Array.Foreign.Type (Array(..), byteLength)+import Streamly.Data.Stream (Stream)+import Streamly.Data.Parser (Parser) import System.Directory (doesDirectoryExist) import System.IO (Handle, hClose, IOMode(ReadMode))-#if !MIN_VERSION_base(4,10,0)-import Control.Concurrent.MVar (readMVar)-import Data.Typeable (cast)-import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)-import GHC.IO.FD (FD)-import GHC.IO.Handle.Types (Handle__(..), Handle(FileHandle, DuplexHandle))-#else import GHC.IO.Handle.FD (handleToFd)-#endif +import Streamly.Internal.Data.Array (Array(..), byteLength)+import Streamly.Internal.FileSystem.Path (Path)+ import qualified Data.IntMap.Lazy as Map import qualified Data.List.NonEmpty as NonEmpty-import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Data.Fold as FL+import qualified Streamly.Data.Array as A (fromList, createOf, getIndex)+import qualified Streamly.Data.Stream as S+import qualified Streamly.FileSystem.Handle as FH+import qualified Streamly.Unicode.Stream as U+import qualified Streamly.Internal.FileSystem.Path as Path++import qualified Streamly.Internal.Data.Array as A+    ( asCStringUnsafe, unsafePinnedAsPtr+    , unsafeSliceOffLen, read+    )+import qualified Streamly.Internal.FileSystem.DirIO as Dir+    (readDirs, followSymlinks) import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.FileSystem.Dir as Dir-import qualified Streamly.Internal.FileSystem.Handle as FH-import qualified Streamly.Internal.Unicode.Stream as U+    (takeEQ, fromEffect, fromFold)  ------------------------------------------------------------------------------- -- Subscription to events@@ -215,22 +217,12 @@ -- Boolean settings ------------------------------------------------------------------------------- --- | Whether a setting is 'On' or 'Off'.------ /Pre-release/----data Switch = On | Off deriving (Show, Eq)--toggle :: Switch -> Switch-toggle On = Off-toggle Off = On--setFlag :: Word32 -> Switch -> Config -> Config+setFlag :: Word32 -> Bool -> Config -> Config setFlag mask status cfg@Config{..} =     let flags =-            case status of-                On -> createFlags .|. mask-                Off -> createFlags .&. complement mask+            if status+            then createFlags .|. mask+            else createFlags .&. complement mask     in cfg {createFlags = flags}  -------------------------------------------------------------------------------@@ -240,12 +232,12 @@ -- | Watch the whole directory tree recursively instead of watching just one -- level of directory. ----- /default: Off/+-- /default: False/ -- -- /Pre-release/ ---setRecursiveMode :: Switch -> Config -> Config-setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec == On}+setRecursiveMode :: Bool -> Config -> Config+setRecursiveMode recursive cfg@Config{} = cfg {watchRec = recursive}  foreign import capi     "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32@@ -256,12 +248,12 @@ -- Note that the path location in the events is through the original symbolic -- link path rather than the resolved path. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setFollowSymLinks :: Switch -> Config -> Config-setFollowSymLinks s = setFlag iN_DONT_FOLLOW (toggle s)+setFollowSymLinks :: Bool -> Config -> Config+setFollowSymLinks s = setFlag iN_DONT_FOLLOW (not s)  foreign import capi     "sys/inotify.h value IN_EXCL_UNLINK" iN_EXCL_UNLINK :: Word32@@ -269,11 +261,11 @@ -- | If an object moves out of the directory being watched then stop watching -- it. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setUnwatchMoved :: Switch -> Config -> Config+setUnwatchMoved :: Bool -> Config -> Config setUnwatchMoved = setFlag iN_EXCL_UNLINK  #if HAVE_DECL_IN_MASK_CREATE@@ -290,7 +282,7 @@ -- /Pre-release/ -- data WhenExists =-      AddIfExists -- ^ Do not set an existing setting to 'Off' only set to 'On'+      AddIfExists -- ^ Do not set an existing setting to 'False' only set to 'True'     | ReplaceIfExists -- ^ Replace the existing settings with new settings #if HAVE_DECL_IN_MASK_CREATE     | FailIfExists -- ^ Fail the API@@ -306,10 +298,10 @@ setWhenExists :: WhenExists -> Config -> Config setWhenExists val cfg =     case val of-        AddIfExists -> setFlag iN_MASK_ADD On cfg-        ReplaceIfExists -> setFlag iN_MASK_ADD Off cfg+        AddIfExists -> setFlag iN_MASK_ADD True cfg+        ReplaceIfExists -> setFlag iN_MASK_ADD False cfg #if HAVE_DECL_IN_MASK_CREATE-        FailIfExists -> setFlag iN_MASK_CREATE On cfg+        FailIfExists -> setFlag iN_MASK_CREATE True cfg #endif  foreign import capi@@ -317,11 +309,11 @@  -- | Watch the object only for one event and then remove it from the watch. ----- /default: Off/+-- /default: False/ -- -- /Pre-release/ ---setOneShot :: Switch -> Config -> Config+setOneShot :: Bool -> Config -> Config setOneShot = setFlag iN_ONESHOT  foreign import capi@@ -330,11 +322,11 @@ -- | Watch the object only if it is a directory. This provides a race-free way -- to ensure that the watched object is a directory. ----- /default: Off/+-- /default: False/ -- -- /Pre-release/ ---setOnlyDir :: Switch -> Config -> Config+setOnlyDir :: Bool -> Config -> Config setOnlyDir = setFlag iN_ONLYDIR  -------------------------------------------------------------------------------@@ -346,11 +338,11 @@  -- | Report when the watched path itself gets deleted. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setRootDeleted :: Switch -> Config -> Config+setRootDeleted :: Bool -> Config -> Config setRootDeleted = setFlag iN_DELETE_SELF  foreign import capi@@ -358,20 +350,20 @@  -- | Report when the watched root path itself gets renamed. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setRootMoved :: Switch -> Config -> Config+setRootMoved :: Bool -> Config -> Config setRootMoved = setFlag iN_MOVE_SELF  -- | Report when the watched root path itself gets deleted or renamed. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setRootPathEvents :: Switch -> Config -> Config+setRootPathEvents :: Bool -> Config -> Config setRootPathEvents = setFlag (iN_DELETE_SELF .|. iN_MOVE_SELF)  foreign import capi@@ -380,11 +372,11 @@ -- | Report when the metadata e.g. owner, permission modes, modifications times -- of an object changes. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setAttrsModified :: Switch -> Config -> Config+setAttrsModified :: Bool -> Config -> Config setAttrsModified = setFlag iN_ATTRIB  foreign import capi@@ -392,11 +384,11 @@  -- | Report when a file is accessed. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setAccessed :: Switch -> Config -> Config+setAccessed :: Bool -> Config -> Config setAccessed = setFlag iN_ACCESS  foreign import capi@@ -404,11 +396,11 @@  -- | Report when a file is opened. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setOpened :: Switch -> Config -> Config+setOpened :: Bool -> Config -> Config setOpened = setFlag iN_OPEN  foreign import capi@@ -416,11 +408,11 @@  -- | Report when a file that was opened for writes is closed. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setWriteClosed :: Switch -> Config -> Config+setWriteClosed :: Bool -> Config -> Config setWriteClosed = setFlag iN_CLOSE_WRITE  foreign import capi@@ -428,11 +420,11 @@  -- | Report when a file that was opened for not writing is closed. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setNonWriteClosed :: Switch -> Config -> Config+setNonWriteClosed :: Bool -> Config -> Config setNonWriteClosed = setFlag iN_CLOSE_NOWRITE  foreign import capi@@ -440,11 +432,11 @@  -- | Report when a file is created. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setCreated :: Switch -> Config -> Config+setCreated :: Bool -> Config -> Config setCreated = setFlag iN_CREATE  foreign import capi@@ -452,11 +444,11 @@  -- | Report when a file is deleted. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setDeleted :: Switch -> Config -> Config+setDeleted :: Bool -> Config -> Config setDeleted = setFlag iN_DELETE  foreign import capi@@ -464,11 +456,11 @@  -- | Report the source of a move. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setMovedFrom :: Switch -> Config -> Config+setMovedFrom :: Bool -> Config -> Config setMovedFrom = setFlag iN_MOVED_FROM  foreign import capi@@ -476,11 +468,11 @@  -- | Report the target of a move. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setMovedTo :: Switch -> Config -> Config+setMovedTo :: Bool -> Config -> Config setMovedTo = setFlag iN_MOVED_TO  foreign import capi@@ -488,14 +480,14 @@  -- | Report when a file is modified. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setModified :: Switch -> Config -> Config+setModified :: Bool -> Config -> Config setModified = setFlag iN_MODIFY --- | Set all tunable events 'On' or 'Off'. Equivalent to setting:+-- | Set all tunable events 'True' or 'False'. Equivalent to setting: -- -- * setRootDeleted -- * setRootMoved@@ -512,7 +504,7 @@ -- -- /Pre-release/ ---setAllEvents :: Switch -> Config -> Config+setAllEvents :: Bool -> Config -> Config setAllEvents s =       setRootDeleted s     . setRootMoved s@@ -536,30 +528,30 @@ -- -- | The default configuration settings are: ----- * 'setFollowSymLinks' 'On'--- * 'setUnwatchMoved' 'On'--- * 'setOneShot' 'Off'--- * 'setOnlyDir' 'Off'+-- * 'setFollowSymLinks' 'True'+-- * 'setUnwatchMoved' 'True'+-- * 'setOneShot' 'False'+-- * 'setOnlyDir' 'False' -- * 'setWhenExists' 'AddIfExists' -- -- The tunable events enabled by default are: ----- * setCreated On--- * setDeleted On--- * setMovedFrom On--- * setMovedTo On--- * setModified On+-- * setCreated True+-- * setDeleted True+-- * setMovedFrom True+-- * setMovedTo True+-- * setModified True -- -- /Pre-release/ -- defaultConfig :: Config defaultConfig =       setWhenExists AddIfExists-    $ setCreated On-    $ setDeleted On-    $ setMovedFrom On-    $ setMovedTo On-    $ setModified On+    $ setCreated True+    $ setDeleted True+    $ setMovedFrom True+    $ setMovedTo True+    $ setModified True     $ Config         { watchRec = False         , createFlags = 0@@ -587,6 +579,7 @@  newtype WD = WD CInt deriving Show +-- XXX Use inotify_init1? and IN_NONBLOCK? foreign import ccall unsafe     "sys/inotify.h inotify_init" c_inotify_init :: IO CInt @@ -598,23 +591,34 @@ createWatch :: IO Watch createWatch = do     rawfd <- throwErrnoIfMinus1 "createWatch" c_inotify_init-    -- we could use fdToHandle but it cannot determine the fd type-    -- automatically for the inotify fd-    (fd, fdType) <--        mkFD-            rawfd-            ReadMode-            (Just (Stream, 0, 0))  -- (IODeviceType, CDev, CIno)-            False                  -- not a socket-            False                  -- non-blocking is false-    let fdString = "<createWatch file descriptor: " ++ show fd ++ ">"+    -- We could use fdToHandle but it cannot determine the fd type+    -- automatically for the inotify fd because fdStat fails for Stream type+    -- fd.+    --+    -- Do not use mkFD as it locks a regular file causing "resource busy" error+    -- in some test cases.+    let fd =+            FD+                { fdFD = rawfd+#if !defined(mingw32_HOST_OS)+                , fdIsNonBlocking = 0+#else+                , fdIsSocket_ = 0+#endif+              }++    -- XXX Do we need non-blocking IO?+    -- With non-blocking IO it fails because GHC-9.10 uses fdStat in+    -- FD.setNonBlockingMode to determine the fd type which fails for Stream+    -- type fd. However, without non-blocking IO "select" has a limitation on+    -- the number of FDs being watched (1024).     h <-         mkHandleFromFD            fd-           fdType-           fdString+           Stream+           ("<createWatch fd: " ++ show fd ++ ">")            ReadMode-           True    -- use non-blocking IO+           False    -- use non-blocking IO            Nothing -- TextEncoding (binary)     emptyMapRef <- newIORef Map.empty     return $ Watch h emptyMapRef@@ -627,29 +631,11 @@ -- separated bytes. So these may fail or convert the path in an unexpected -- manner. We should ultimately remove all usage of these. -toUtf8 :: MonadIO m => String -> m (Array Word8)-toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList+toUtf8 :: MonadIO m => Path -> m (Array Word8)+toUtf8 path = pure $ Path.toArray path  utf8ToString :: Array Word8 -> String-utf8ToString = runIdentity . S.toList . U.decodeUtf8' . A.toStream--#if !MIN_VERSION_base(4,10,0)--- | Turn an existing Handle into a file descriptor. This function throws an--- IOError if the Handle does not reference a file descriptor.-handleToFd :: Handle -> IO FD-handleToFd h = case h of-    FileHandle _ mv -> do-      Handle__{haDevice = dev} <- readMVar mv-      case cast dev of-        Just fd -> return fd-        Nothing -> throwErr "not a file descriptor"-    DuplexHandle{} -> throwErr "not a file handle"--    where--    throwErr msg = ioException $ IOError (Just h)-      InappropriateType "handleToFd" msg Nothing Nothing-#endif+utf8ToString = runIdentity . S.fold FL.toList . U.decodeUtf8' . A.read  -- | Add a trailing "/" at the end of the path if there is none. Do not add a -- "/" if the path is empty.@@ -658,26 +644,28 @@ ensureTrailingSlash path =     if byteLength path /= 0     then-        let mx = A.getIndex path (byteLength path - 1)+        let mx = A.getIndex (byteLength path - 1) path          in case mx of             Nothing -> error "ensureTrailingSlash: Bug: Invalid index"             Just x ->-                if x /= fromIntegral (ord '/')-                then path <> A.fromCString# "/"#+                if x /= forwardSlashByte+                then path <> forwardSlash                 else path     else path+    where forwardSlash = A.fromList [ forwardSlashByte ]+          forwardSlashByte = fromIntegral (ord '/')  removeTrailingSlash :: Array Word8 -> Array Word8 removeTrailingSlash path =     if byteLength path /= 0     then         let n = byteLength path - 1-            mx = A.getIndex path n+            mx = A.getIndex n path          in case mx of             Nothing -> error "removeTrailingSlash: Bug: Invalid index"             Just x ->                 if x == fromIntegral (ord '/')-                then A.getSliceUnsafe 0 n path+                then A.unsafeSliceOffLen 0 n path                 else path     else path @@ -727,7 +715,7 @@     --     -- XXX The file may have even got deleted and then recreated which we will     -- never get to know, document this.-    wd <- A.unsafeAsCString absPath $ \pathPtr ->+    wd <- A.asCStringUnsafe absPath $ \pathPtr ->             throwErrnoIfMinus1 ("addToWatch: " ++ utf8ToString absPath) $                 c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags) @@ -742,13 +730,16 @@     -- XXX Ensure that we generate events that we may have missed while we were     -- adding the dirs. That may generate spurious events though.     ---    -- XXX toDirs currently uses paths as String, we need to convert it+    -- XXX readDirs currently uses paths as String, we need to convert it     -- to "/" separated by byte arrays.-    pathIsDir <- doesDirectoryExist $ utf8ToString absPath+    let p = Path.unsafeFromArray absPath+    -- XXX Need a FileSystem.Stat module to remove this+    pathIsDir <- doesDirectoryExist (Path.toString p)     when (watchRec && pathIsDir) $ do-        S.mapM_ (\p -> addToWatch cfg watch0 root (appendPaths path p))-            $ S.mapM toUtf8-            $ Dir.toDirs $ utf8ToString absPath+        let f = addToWatch cfg watch0 root . appendPaths path+            in S.fold (FL.drainMapM f)+                $ S.mapM toUtf8+                $ Dir.readDirs (Dir.followSymlinks True) p  foreign import ccall unsafe     "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch@@ -832,11 +823,11 @@ -- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need -- to measure the perf. ---readOneEvent :: Config -> Watch -> Parser IO Word8 Event+readOneEvent :: Config -> Watch -> Parser Word8 IO Event readOneEvent cfg  wt@(Watch _ wdMap) = do     let headerLen = sizeOf (undefined :: CInt) + 12-    arr <- PR.takeEQ headerLen (A.writeN headerLen)-    (ewd, eflags, cookie, pathLen) <- PR.fromEffect $ A.asPtrUnsafe arr readHeader+    arr <- PR.takeEQ headerLen (A.createOf headerLen)+    (ewd, eflags, cookie, pathLen) <- PR.fromEffect $ A.unsafePinnedAsPtr arr readHeader     -- XXX need the "initial" in parsers to return a step type so that "take 0"     -- can return without an input. otherwise if pathLen is 0 we will keep     -- waiting to read one more char before we return this event.@@ -849,7 +840,7 @@             pth <-                 PR.fromFold                     $ FL.takeEndBy_ (== 0)-                    $ FL.take pathLen (A.writeN pathLen)+                    $ FL.take pathLen (A.createOf pathLen)             let remaining = pathLen - byteLength pth - 1             when (remaining /= 0) $ PR.takeEQ remaining FL.drain             return pth@@ -881,7 +872,7 @@      where -    readHeader (ptr :: Ptr Word8) = do+    readHeader (ptr :: Ptr Word8) _ = do         let len = sizeOf (undefined :: CInt)         ewd <- peek ptr         eflags <- peekByteOff ptr len@@ -889,7 +880,7 @@         pathLen :: Word32 <- peekByteOff ptr (len + 8)         return (ewd, eflags, cookie, fromIntegral pathLen) -watchToStream :: Config -> Watch -> SerialT IO Event+watchToStream :: Config -> Watch -> Stream IO Event watchToStream cfg wt@(Watch handle _) = do     -- Do not use too small a buffer. As per inotify man page:     --@@ -901,7 +892,7 @@     --          sizeof(struct inotify_event) + NAME_MAX + 1     --     -- will be sufficient to read at least one event.-    S.parseMany (readOneEvent cfg wt) $ S.unfold FH.read handle+    S.catRights $ S.parseMany (readOneEvent cfg wt) $ S.unfold FH.reader handle  -- XXX We should not go across the mount points of network file systems or file -- systems that are known to not generate any events.@@ -933,31 +924,31 @@ -- -- @ -- watchwith---      ('setFollowSymLinks' On . 'setUnwatchMoved' Off)---      [Array.fromCString\# "dir"#]+--      ('setFollowSymLinks' True . 'setUnwatchMoved' False)+--      [Array.fromList "dir"] -- @ -- -- /Pre-release/ ---watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event-watchWith f paths = S.bracket before after (watchToStream cfg)+watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event+watchWith f paths = S.bracketIO before after (watchToStream cfg)      where      cfg = f defaultConfig-    before = liftIO $ openWatch cfg paths-    after = liftIO . closeWatch+    before = openWatch cfg paths+    after = closeWatch  -- | Same as 'watchWith' using 'defaultConfig' and recursive mode. ----- >>> watchRecursive = watchWith (setRecursiveMode On)+-- >>> watchRecursive = watchWith (setRecursiveMode True) -- -- See 'watchWith' for pitfalls and bugs when using recursive watch on Linux. -- -- /Pre-release/ ---watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event-watchRecursive = watchWith (setRecursiveMode On)+watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event+watchRecursive = watchWith (setRecursiveMode True)  -- | Same as 'watchWith' using defaultConfig and non-recursive mode. --@@ -965,7 +956,7 @@ -- -- /Pre-release/ ---watch :: NonEmpty (Array Word8) -> SerialT IO Event+watch :: NonEmpty (Array Word8) -> Stream IO Event watch = watchWith id  -------------------------------------------------------------------------------@@ -1264,7 +1255,7 @@ isModified = getFlag iN_MODIFY  ---------------------------------------------------------------------------------- Information about path type (applicable only when 'setFileEvents' is 'On')+-- Information about path type (applicable only when 'setFileEvents' is 'True') -------------------------------------------------------------------------------  foreign import capi
src/Streamly/Internal/FileSystem/Event/Windows.hs view
@@ -18,7 +18,7 @@ -- -- @ -- {-\# LANGUAGE MagicHash #-}--- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchRecursive' [Array.fromCString\# "path"#]+-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchRecursive' [Array.fromList "path"] -- @ -- -- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)@@ -43,12 +43,12 @@ -- * Minimum supported server: Windows Server 2003 [desktop apps | UWP apps  module Streamly.Internal.FileSystem.Event.Windows+    {-# DEPRECATED "Use the streamly-fsevents package." #-}     (     -- * Subscribing to events      -- ** Default configuration       Config-    , Switch (..)     , defaultConfig      -- ** Watch Behavior@@ -90,8 +90,8 @@     ) where -import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Bits ((.|.), (.&.), complement)+import Data.Char (ord) import Data.Functor.Identity (runIdentity) import Data.List.NonEmpty (NonEmpty) import Data.Word (Word8)@@ -99,7 +99,6 @@ import Foreign.Marshal.Alloc (alloca, allocaBytes) import Foreign.Storable (peekByteOff) import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)-import Streamly.Prelude (SerialT, parallel) import System.Win32.File     ( FileNotificationFlag     , LPOVERLAPPED@@ -118,12 +117,19 @@     , oPEN_EXISTING     ) import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)++import Streamly.Data.Array (Array)+import Streamly.Data.Stream (Stream)+import Streamly.Data.Stream.Prelude (eager)+ import qualified Data.List.NonEmpty as NonEmpty-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Unicode.Stream as U-import qualified Streamly.Internal.Unicode.Utf8 as UTF8-import qualified Streamly.Internal.Data.Array.Foreign as A-import Streamly.Internal.Data.Array.Foreign (Array)+import qualified Streamly.Data.Array as A (fromList)+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.Stream.Prelude as S+import qualified Streamly.Unicode.Stream as U+import qualified Streamly.Internal.Unicode.Utf8 as UTF8 (pack, toArray)+import qualified Streamly.Internal.Data.Array as A (read)  -- | Watch configuration, used to specify the events of interest and the -- behavior of the watch.@@ -139,28 +145,22 @@ -- Boolean settings ------------------------------------------------------------------------------- --- | Whether a setting is 'On' or 'Off'.------ /Pre-release/----data Switch = On | Off deriving (Show, Eq)--setFlag :: DWORD -> Switch -> Config -> Config+setFlag :: DWORD -> Bool -> Config -> Config setFlag mask status cfg@Config{..} =     let flags =-            case status of-                On -> createFlags .|. mask-                Off -> createFlags .&. complement mask+            if status+            then createFlags .|. mask+            else createFlags .&. complement mask     in cfg {createFlags = flags}  -- | Set watch event on directory recursively. ----- /default: Off/+-- /default: False/ -- -- /Pre-release/ ---setRecursiveMode :: Switch -> Config -> Config-setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec == On}+setRecursiveMode :: Bool -> Config -> Config+setRecursiveMode recursive cfg@Config{} = cfg {watchRec = recursive}  -- | Generate notify events on file create, rename or delete. --@@ -168,11 +168,11 @@ -- directory or subtree causes a change notification wait operation to return. -- Changes include renaming, creating, or deleting a file. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setFileNameEvents :: Switch -> Config -> Config+setFileNameEvents :: Bool -> Config -> Config setFileNameEvents = setFlag fILE_NOTIFY_CHANGE_FILE_NAME  -- | Generate notify events on directory create, rename or delete.@@ -181,21 +181,21 @@ -- directory or subtree causes a change notification wait operation to return. -- Changes include creating or deleting a directory. ----- /default: On/+-- /default: True/ -- -- /Pre-release/ ---setDirNameEvents :: Switch -> Config -> Config+setDirNameEvents :: Bool -> Config -> Config setDirNameEvents = setFlag fILE_NOTIFY_CHANGE_DIR_NAME  -- | Generate an 'isModified' event on any attribute change in the watched -- directory or subtree. ----- /default: Off/+-- /default: False/ -- -- /Pre-release/ ---setAttrsModified :: Switch -> Config -> Config+setAttrsModified :: Bool -> Config -> Config setAttrsModified = setFlag fILE_NOTIFY_CHANGE_ATTRIBUTES  -- | Generate an 'isModified' event when the file size is changed.@@ -206,11 +206,11 @@ -- written to the disk. For operating systems that use extensive caching, -- detection occurs only when the cache is sufficiently flushed. ----- /default: Off/+-- /default: False/ -- -- /Pre-release/ ---setSizeModified :: Switch -> Config -> Config+setSizeModified :: Bool -> Config -> Config setSizeModified = setFlag fILE_NOTIFY_CHANGE_SIZE  -- | Generate an 'isModified' event when the last write timestamp of the file@@ -223,24 +223,24 @@ -- that use extensive caching, detection occurs only when the cache is -- sufficiently flushed. ----- /default: Off/+-- /default: False/ -- -- /Pre-release/ ---setLastWriteTimeModified :: Switch -> Config -> Config+setLastWriteTimeModified :: Bool -> Config -> Config setLastWriteTimeModified = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE  -- | Generate an 'isModified' event when any security-descriptor change occurs -- in the watched directory or subtree. ----- /default: Off/+-- /default: False/ -- -- /Pre-release/ ---setSecurityModified :: Switch -> Config -> Config+setSecurityModified :: Bool -> Config -> Config setSecurityModified = setFlag fILE_NOTIFY_CHANGE_SECURITY --- | Set all tunable events 'On' or 'Off'. Equivalent to setting:+-- | Set all tunable events 'True' or 'False'. Equivalent to setting: -- -- * setFileNameEvents -- * setDirNameEvents@@ -251,7 +251,7 @@ -- -- /Pre-release/ ---setAllEvents :: Switch -> Config -> Config+setAllEvents :: Bool -> Config -> Config setAllEvents s =       setFileNameEvents s     . setDirNameEvents s@@ -262,19 +262,19 @@  -- | The tunable events that are enabled by default are: ----- * setFileNameEvents On--- * setDirNameEvents On--- * setSizeModified On--- * setLastWriteTimeModified On+-- * setFileNameEvents True+-- * setDirNameEvents True+-- * setSizeModified True+-- * setLastWriteTimeModified True -- -- /Pre-release/ -- defaultConfig :: Config defaultConfig =-      setFileNameEvents On-    $ setDirNameEvents On-    $ setSizeModified On-    $ setLastWriteTimeModified On+      setFileNameEvents True+    $ setDirNameEvents True+    $ setSizeModified True+    $ setLastWriteTimeModified True     $ Config {watchRec = False, createFlags = 0}  getConfigFlag :: Config -> DWORD@@ -410,34 +410,37 @@ fILE_ACTION_RENAMED_NEW_NAME  :: FileAction fILE_ACTION_RENAMED_NEW_NAME  =  5 -eventStreamAggr :: (HANDLE, FilePath, Config) -> SerialT IO Event+eventStreamAggr :: (HANDLE, FilePath, Config) -> Stream IO Event eventStreamAggr (handle, rootPath, cfg) =  do     let recMode = getConfigRecMode cfg         flagMasks = getConfigFlag cfg-    S.concatMap S.fromList $ S.repeatM+        repeatM = S.sequence . S.repeat+    S.concatMap S.fromList $ repeatM         $ readDirectoryChanges rootPath handle recMode flagMasks  pathsToHandles ::-    NonEmpty FilePath -> Config -> SerialT IO (HANDLE, FilePath, Config)+    NonEmpty FilePath -> Config -> Stream IO (HANDLE, FilePath, Config) pathsToHandles paths cfg = do     let pathStream = S.fromList (NonEmpty.toList paths)         st2 = S.mapM getWatchHandle pathStream-    S.map (\(h, f) -> (h, f, cfg)) st2+    fmap (\(h, f) -> (h, f, cfg)) st2  ------------------------------------------------------------------------------- -- Utilities -------------------------------------------------------------------------------  utf8ToString :: Array Word8 -> FilePath-utf8ToString = runIdentity . S.toList . U.decodeUtf8 . A.toStream+utf8ToString = runIdentity . S.fold Fold.toList . U.decodeUtf8 . A.read  utf8ToStringList :: NonEmpty (Array Word8) -> NonEmpty FilePath utf8ToStringList = NonEmpty.map utf8ToString  -- | Close a Directory handle. ---closePathHandleStream :: SerialT IO (HANDLE, FilePath, Config) -> IO ()-closePathHandleStream = S.mapM_ (\(h, _, _) -> closeHandle h)+closePathHandleStream :: Stream IO (HANDLE, FilePath, Config) -> IO ()+closePathHandleStream =+    let f (h, _, _) = closeHandle h+        in S.fold (Fold.drainMapM f)  -- XXX -- Document the path treatment for Linux/Windows/macOS modules.@@ -464,29 +467,29 @@ -- -- @ -- watchWith---  ('setAttrsModified' On . 'setLastWriteTimeModified' Off)---  [Array.fromCString\# "dir"#]+--  ('setAttrsModified' True . 'setLastWriteTimeModified' False)+--  [Array.fromList "dir"] -- @ -- -- /Pre-release/ ---watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event+watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event watchWith f paths =-     S.bracket before after (S.concatMapWith parallel eventStreamAggr)+    S.bracketIO before after (S.parConcatMap (eager True) eventStreamAggr)      where      before = return $ pathsToHandles (utf8ToStringList paths) $ f defaultConfig-    after = liftIO . closePathHandleStream+    after = closePathHandleStream  -- | Same as 'watchWith' using 'defaultConfig' and recursive mode. ----- >>> watchRecursive = watchWith (setRecursiveMode On)+-- >>> watchRecursive = watchWith (setRecursiveMode True) -- -- /Pre-release/ ---watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event-watchRecursive = watchWith (setRecursiveMode On)+watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event+watchRecursive = watchWith (setRecursiveMode True)  -- | Same as 'watchWith' using defaultConfig and non-recursive mode. --@@ -494,7 +497,7 @@ -- -- /Pre-release/ ---watch :: NonEmpty (Array Word8) -> SerialT IO Event+watch :: NonEmpty (Array Word8) -> Stream IO Event watch = watchWith id  getFlag :: DWORD -> Event -> Bool@@ -527,7 +530,8 @@ -- /Pre-release/ -- getAbsPath :: Event -> Array Word8-getAbsPath ev = getRoot ev <> A.fromCString# "\\"# <> getRelPath ev+getAbsPath ev = getRoot ev <> backSlash <> getRelPath ev+    where backSlash = A.fromList [ fromIntegral (ord '\\') ]  -- XXX need to document the exact semantics of these. --
src/Streamly/Internal/FileSystem/FD.hs view
@@ -118,11 +118,8 @@  import Control.Monad.IO.Class (MonadIO(..)) import Data.Word (Word8)-import Foreign.ForeignPtr (withForeignPtr) -- import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Foreign.Ptr (plusPtr, castPtr)-import Foreign.Storable (Storable(..))-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)+import Foreign.Ptr (castPtr) -- import System.IO (Handle, hGetBufSome, hPutBuf) import System.IO (IOMode) import Prelude hiding (read)@@ -130,27 +127,34 @@ import qualified GHC.IO.FD as FD import qualified GHC.IO.Device as RawIO -import Streamly.Internal.Data.Array.Foreign.Type-    (Array(..), byteLength, unsafeFreeze, asPtrUnsafe)-import Streamly.Internal.Data.Array.Foreign.Mut.Type (fromForeignPtrUnsafe)+import Streamly.Data.Array (Array, Unbox)+import Streamly.Data.Stream (Stream)++import Streamly.Internal.Data.Array (byteLength, unsafeFreeze, unsafePinnedAsPtr) import Streamly.Internal.System.IO (defaultChunkSize)-import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream, mkStream, fromStreamD)+ #if !defined(mingw32_HOST_OS)+{- import Streamly.Internal.Data.Stream.IsStream.Type (toStreamD) import Streamly.Internal.System.IOVec (groupIOVecsOf) import qualified Streamly.Internal.FileSystem.FDIO as RawIO hiding (write) import qualified Streamly.Internal.System.IOVec.Type as RawIO+-} #endif -- import Streamly.Data.Fold (Fold) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) -import qualified Streamly.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS-import qualified Streamly.Prelude as S-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Data.Array as A+import qualified Streamly.Data.Fold as FL+import qualified Streamly.Internal.Data.MutArray as MArray+    (MutArray(..), unsafePinnedAsPtr, pinnedNewBytes)+import qualified Streamly.Internal.Data.Array.Stream as AS+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Stream as D+    (Stream(..), Step(..))+import qualified Streamly.Internal.Data.StreamK as K (mkStream) + ------------------------------------------------------------------------------- -- References -------------------------------------------------------------------------------@@ -214,20 +218,17 @@ {-# INLINABLE readArrayUpto #-} readArrayUpto :: Int -> Handle -> IO (Array Word8) readArrayUpto size (Handle fd) = do-    ptr <- mallocPlainForeignPtrBytes size-    -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    withForeignPtr ptr $ \p -> do-        -- n <- hGetBufSome h p size+    arr <-+        MArray.unsafeCreateWithPtr' size $ \p ->+             -- n <- hGetBufSome h p size #if MIN_VERSION_base(4,15,0)-        n <- RawIO.read fd p 0 size+            RawIO.read fd p 0 size #else-        n <- RawIO.read fd p size+            RawIO.read fd p size #endif-        -- XXX shrink only if the diff is significant-        -- Use unsafeFreezeWithShrink-        return-            $ unsafeFreeze-            $ fromForeignPtrUnsafe ptr (p `plusPtr` n) (p `plusPtr` size)+    -- XXX shrink only if the diff is significant+    -- Use unsafeFreezeWithShrink+    pure $ unsafeFreeze arr  ------------------------------------------------------------------------------- -- Array IO (output)@@ -237,10 +238,10 @@ -- -- @since 0.7.0 {-# INLINABLE writeArray #-}-writeArray :: Storable a => Handle -> Array a -> IO ()+writeArray :: Unbox a => Handle -> Array a -> IO () writeArray _ arr | A.length arr == 0 = return () writeArray (Handle fd) arr =-    asPtrUnsafe arr $ \p ->+    unsafePinnedAsPtr arr $ \p ->     -- RawIO.writeAll fd (castPtr p) aLen #if MIN_VERSION_base(4,15,0)     RawIO.write fd (castPtr p) 0 aLen@@ -250,7 +251,7 @@     {-     -- Experiment to compare "writev" based IO with "write" based IO.     iov <- A.newArray 1-    let iov' = iov {aEnd = aBound iov}+    let iov' = iov {arrEnd = arrBound iov}     A.writeIndex iov' 0 (RawIO.IOVec (castPtr p) (fromIntegral aLen))     RawIO.writevAll fd (unsafeForeignPtrToPtr (aStart iov')) 1     -}@@ -258,6 +259,7 @@     aLen = byteLength arr  #if !defined(mingw32_HOST_OS)+{- -- | Write an array of 'IOVec' to a file handle. -- -- @since 0.7.0@@ -265,8 +267,9 @@ writeIOVec :: Handle -> Array RawIO.IOVec -> IO () writeIOVec _ iov | A.length iov == 0 = return () writeIOVec (Handle fd) iov =-    asPtrUnsafe iov $ \p ->+    unsafePinnedAsPtr iov $ \p ->         RawIO.writevAll fd p (A.length iov)+-} #endif  -------------------------------------------------------------------------------@@ -277,21 +280,21 @@ -- The maximum size of a single array is specified by @size@. The actual size -- read may be less than or equal to @size@. {-# INLINE _readArraysOfUpto #-}-_readArraysOfUpto :: (IsStream t, MonadIO m)-    => Int -> Handle -> t m (Array Word8)-_readArraysOfUpto size h = go+_readArraysOfUpto :: (MonadIO m)+    => Int -> Handle -> Stream m (Array Word8)+_readArraysOfUpto size h = S.fromStreamK go   where     -- XXX use cons/nil instead-    go = mkStream $ \_ yld _ stp -> do+    go = K.mkStream $ \_ yld _ stp -> do         arr <- liftIO $ readArrayUpto size h         if A.length arr == 0         then stp         else yld arr go  {-# INLINE_NORMAL readArraysOfUpto #-}-readArraysOfUpto :: (IsStream t, MonadIO m)-    => Int -> Handle -> t m (Array Word8)-readArraysOfUpto size h = fromStreamD (D.Stream step ())+readArraysOfUpto :: (MonadIO m)+    => Int -> Handle -> Stream m (Array Word8)+readArraysOfUpto size h = D.Stream step ()   where     {-# INLINE_LATE step #-}     step _ _ = do@@ -312,7 +315,7 @@ -- -- @since 0.7.0 {-# INLINE readArrays #-}-readArrays :: (IsStream t, MonadIO m) => Handle -> t m (Array Word8)+readArrays :: (MonadIO m) => Handle -> Stream m (Array Word8) readArrays = readArraysOfUpto defaultChunkSize  -------------------------------------------------------------------------------@@ -328,11 +331,11 @@ -- as EOF is encountered. -- {-# INLINE readInChunksOf #-}-readInChunksOf :: (IsStream t, MonadIO m) => Int -> Handle -> t m Word8+readInChunksOf :: (MonadIO m) => Int -> Handle -> Stream m Word8 readInChunksOf chunkSize h = AS.concat $ readArraysOfUpto chunkSize h  -- TODO--- read :: (IsStream t, MonadIO m, Storable a) => Handle -> t m a+-- read :: (MonadIO m, Unbox a) => Handle -> Stream m a -- -- > read = 'readByChunks' A.defaultChunkSize -- | Generate a stream of elements of the given type from a file 'Handle'. The@@ -340,7 +343,7 @@ -- -- @since 0.7.0 {-# INLINE read #-}-read :: (IsStream t, MonadIO m) => Handle -> t m Word8+read :: (MonadIO m) => Handle -> Stream m Word8 read = AS.concat . readArrays  -------------------------------------------------------------------------------@@ -351,8 +354,8 @@ -- -- @since 0.7.0 {-# INLINE writeArrays #-}-writeArrays :: (MonadIO m, Storable a) => Handle -> SerialT m (Array a) -> m ()-writeArrays h = S.mapM_ (liftIO . writeArray h)+writeArrays :: (MonadIO m, Unbox a) => Handle -> Stream m (Array a) -> m ()+writeArrays h = S.fold (FL.drainMapM (liftIO . writeArray h))  -- | Write a stream of arrays to a handle after coalescing them in chunks of -- specified size. The chunk size is only a maximum and the actual writes could@@ -361,17 +364,18 @@ -- -- @since 0.7.0 {-# INLINE writeArraysPackedUpto #-}-writeArraysPackedUpto :: (MonadIO m, Storable a)-    => Int -> Handle -> SerialT m (Array a) -> m ()+writeArraysPackedUpto :: (MonadIO m, Unbox a)+    => Int -> Handle -> Stream m (Array a) -> m () writeArraysPackedUpto n h xs = writeArrays h $ AS.compact n xs  #if !defined(mingw32_HOST_OS)+{- -- XXX this is incomplete -- | Write a stream of 'IOVec' arrays to a handle. -- -- @since 0.7.0 {-# INLINE writev #-}-writev :: MonadIO m => Handle -> SerialT m (Array RawIO.IOVec) -> m ()+writev :: MonadIO m => Handle -> Stream m (Array RawIO.IOVec) -> m () writev h = S.mapM_ (liftIO . writeIOVec h)  -- XXX this is incomplete@@ -383,9 +387,10 @@ -- @since 0.7.0 {-# INLINE _writevArraysPackedUpto #-} _writevArraysPackedUpto :: MonadIO m-    => Int -> Handle -> SerialT m (Array a) -> m ()+    => Int -> Handle -> Stream m (Array a) -> m () _writevArraysPackedUpto n h xs =     writev h $ fromStreamD $ groupIOVecsOf n 512 (toStreamD xs)+-} #endif  -- GHC buffer size dEFAULT_FD_BUFFER_SIZE=8192 bytes.@@ -402,8 +407,8 @@ -- -- @since 0.7.0 {-# INLINE writeInChunksOf #-}-writeInChunksOf :: MonadIO m => Int -> Handle -> SerialT m Word8 -> m ()-writeInChunksOf n h m = writeArrays h $ AS.arraysOf n m+writeInChunksOf :: MonadIO m => Int -> Handle -> Stream m Word8 -> m ()+writeInChunksOf n h m = writeArrays h $ AS.chunksOf n m  -- > write = 'writeInChunksOf' A.defaultChunkSize --@@ -413,12 +418,12 @@ -- -- @since 0.7.0 {-# INLINE write #-}-write :: MonadIO m => Handle -> SerialT m Word8 -> m ()+write :: MonadIO m => Handle -> Stream m Word8 -> m () write = writeInChunksOf defaultChunkSize  {- {-# INLINE write #-}-write :: (MonadIO m, Storable a) => Handle -> SerialT m a -> m ()+write :: (MonadIO m, Unboxed a) => Handle -> Stream m a -> m () write = toHandleWith A.defaultChunkSize -} @@ -434,7 +439,7 @@ -- -- @since 0.7.0 {-# INLINE readUtf8 #-}-readUtf8 :: (IsStream t, MonadIO m) => Handle -> t m Char+readUtf8 :: (MonadIO m) => Handle -> Stream m Char readUtf8 = decodeUtf8 . read  -- |@@ -445,7 +450,7 @@ -- -- @since 0.7.0 {-# INLINE writeUtf8 #-}-writeUtf8 :: MonadIO m => Handle -> SerialT m Char -> m ()+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@@ -456,7 +461,7 @@ -- -- @since 0.7.0 {-# INLINE writeUtf8ByLines #-}-writeUtf8ByLines :: (IsStream t, MonadIO m) => Handle -> t m Char -> m ()+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@@ -464,7 +469,7 @@ -- -- @since 0.7.0 {-# INLINE readLines #-}-readLines :: (IsStream t, MonadIO m) => Handle -> Fold m Char b -> t m b+readLines :: (MonadIO m) => Handle -> Fold m Char b -> Stream m b readLines h f = foldLines (readUtf8 h) f  -------------------------------------------------------------------------------@@ -477,8 +482,8 @@ -- -- @since 0.7.0 {-# INLINE readFrames #-}-readFrames :: (IsStream t, MonadIO m, Storable a)-    => Array a -> Handle -> Fold m a b -> t m b+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@@ -486,8 +491,8 @@ -- -- @since 0.7.0 {-# INLINE writeByFrames #-}-writeByFrames :: (IsStream t, MonadIO m, Storable a)-    => Array a -> Handle -> t m a -> m ()+writeByFrames :: (MonadIO m, Unboxed a)+    => Array a -> Handle -> Stream m a -> m () writeByFrames = undefined  -------------------------------------------------------------------------------@@ -504,7 +509,7 @@ -- -- @since 0.7.0 {-# INLINE readIndex #-}-readIndex :: Storable a => Handle -> Int -> Maybe a+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@@ -524,8 +529,8 @@ -- chunk is aligned with @chunkSize@ from second chunk onwards. -- {-# INLINE readSliceWith #-}-readSliceWith :: (IsStream t, MonadIO m, Storable a)-    => Int -> Handle -> Int -> Int -> t m a+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@@ -534,8 +539,8 @@ -- -- @since 0.7.0 {-# INLINE readSlice #-}-readSlice :: (IsStream t, MonadIO m, Storable a)-    => Handle -> Int -> Int -> t m a+readSlice :: (MonadIO m, Unboxed a)+    => Handle -> Int -> Int -> Stream m a readSlice = readSliceWith defaultChunkSize  -- | @readSliceRev h i count@ streams a slice from the file handle @h@ starting@@ -544,15 +549,15 @@ -- -- @since 0.7.0 {-# INLINE readSliceRev #-}-readSliceRev :: (IsStream t, MonadIO m, Storable a)-    => Handle -> Int -> Int -> t m a+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. -- -- @since 0.7.0 {-# INLINE writeIndex #-}-writeIndex :: (MonadIO m, Storable a) => Handle -> Int -> a -> m ()+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@@@ -561,8 +566,8 @@ -- -- @since 0.7.0 {-# INLINE writeSlice #-}-writeSlice :: (IsStream t, Monad m, Storable a)-    => Handle -> Int -> Int -> t m a -> m ()+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@@@ -571,7 +576,7 @@ -- -- @since 0.7.0 {-# INLINE writeSliceRev #-}-writeSliceRev :: (IsStream t, Monad m, Storable a)-    => Handle -> Int -> Int -> t m a -> m ()+writeSliceRev :: (Monad m, Unboxed a)+    => Handle -> Int -> Int -> Stream m a -> m () writeSliceRev arr i len s = undefined -}
src/Streamly/Internal/FileSystem/FDIO.hs view
@@ -27,9 +27,7 @@ import Control.Concurrent (threadWaitWrite) import Data.Int (Int64) import Foreign.C.Error (throwErrnoIfMinus1RetryMayBlock)-#if __GLASGOW_HASKELL__ >= 802 import Foreign.C.Types (CBool(..))-#endif import System.Posix.Internals (c_write, c_safe_write) import Streamly.Internal.System.IOVec.Type (c_writev, c_safe_writev) #endif@@ -59,13 +57,8 @@  -- "poll"s the fd for data to become available or timeout -- See cbits/inputReady.c in base package-#if __GLASGOW_HASKELL__ >= 804 foreign import ccall unsafe "fdReady"     unsafe_fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt-#else-foreign import ccall safe "fdReady"-    unsafe_fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt-#endif  writeNonBlocking :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt writeNonBlocking loc !fd !buf !off !len
− src/Streamly/Internal/FileSystem/File.hs 
@@ -1,610 +0,0 @@-#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--    -- ** Read From File-    , readWithBufferOf-    , read-    -- , readShared-    -- , readUtf8-    -- , readLines-    -- , readFrames--    , toBytes--    -- -- * Array Read-    , readChunksWithBufferOf-    , readChunksFromToWith-    , readChunks--    , toChunksWithBufferOf-    , toChunks--    -- ** Write To File-    , write-    -- , writeUtf8-    -- , writeUtf8ByLines-    -- , writeByFrames-    , writeWithBufferOf--    , fromBytes-    , fromBytesWithBufferOf--    -- -- * Array Write-    , putChunk-    , writeChunks-    , fromChunks--    -- ** Append To File-    , append-    , appendWithBufferOf-    -- , appendShared-    , appendArray-    , appendChunks-    )-where--import Control.Monad.Catch (MonadCatch)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Foreign.Storable (Storable(..))-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.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.Data.Array.Foreign.Type (Array(..), writeNUnsafe)-import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Stream.IsStream.Type (IsStream)--- import Streamly.Data.Fold (Fold)--- import Streamly.String (encodeUtf8, decodeUtf8, foldLines)-import Streamly.Internal.System.IO (defaultChunkSize)--import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Unfold as UF-import qualified Streamly.Internal.FileSystem.Handle as FH-import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS-import qualified Streamly.Internal.Data.Stream.IsStream as S------------------------------------------------------------------------------------ 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 :: (IsStream t, MonadCatch m, MonadAsync m)-    => FilePath -> IOMode -> (Handle -> t m a) -> t m a-withFile file mode = S.bracket (liftIO $ openFile file mode) (liftIO . 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 :: (MonadCatch m, MonadAsync m)-    => Unfold m Handle a -> Unfold m FilePath a-usingFile =-    UF.bracket (\file -> liftIO $ openFile file ReadMode)-               (liftIO . hClose)--{-# INLINE usingFile2 #-}-usingFile2 :: (MonadCatch m, MonadAsync m)-    => Unfold m (x, Handle) a -> Unfold m (x, FilePath) a-usingFile2 = UF.bracket before after--    where--    before (x, file) =  do-        h <- liftIO $ openFile file ReadMode-        return (x, h)--    after (_, h) = liftIO $ hClose h--{-# INLINE usingFile3 #-}-usingFile3 :: (MonadCatch m, MonadAsync m)-    => Unfold m (x, y, z, Handle) a -> Unfold m (x, y, z, FilePath) a-usingFile3 = UF.bracket before after--    where--    before (x, y, z, file) =  do-        h <- liftIO $ openFile file ReadMode-        return (x, y, z, h)--    after (_, _, _, h) = liftIO $ hClose h------------------------------------------------------------------------------------ Array IO (Input)------------------------------------------------------------------------------------ TODO readArrayOf------------------------------------------------------------------------------------ Array IO (output)------------------------------------------------------------------------------------ | Write an array to a file. Overwrites the file if it exists.------ @since 0.7.0-{-# INLINABLE putChunk #-}-putChunk :: Storable a => FilePath -> Array a -> IO ()-putChunk file arr = SIO.withFile file WriteMode (`FH.putChunk` arr)---- | append an array to a file.------ @since 0.7.0-{-# INLINABLE appendArray #-}-appendArray :: Storable a => FilePath -> Array a -> IO ()-appendArray file arr = SIO.withFile file AppendMode (`FH.putChunk` arr)------------------------------------------------------------------------------------ Stream of Arrays IO------------------------------------------------------------------------------------ | @toChunksWithBufferOf 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@.-{-# INLINE toChunksWithBufferOf #-}-toChunksWithBufferOf :: (IsStream t, MonadCatch m, MonadAsync m)-    => Int -> FilePath -> t m (Array Word8)-toChunksWithBufferOf size file =-    withFile file ReadMode (FH.toChunksWithBufferOf size)---- XXX read 'Array a' instead of Word8------ | @toChunks 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@.------ > toChunks = toChunksWithBufferOf defaultChunkSize------ @since 0.7.0-{-# INLINE toChunks #-}-toChunks :: (IsStream t, MonadCatch m, MonadAsync m)-    => FilePath -> t m (Array Word8)-toChunks = toChunksWithBufferOf defaultChunkSize------------------------------------------------------------------------------------ Read File to Stream------------------------------------------------------------------------------------ TODO for concurrent streams implement readahead IO. We can send multiple--- read requests at the same time. For serial case we can use async IO. We can--- also control the read throughput in mbps or IOPS.---- | Unfold the tuple @(bufsize, filepath)@ into a stream of 'Word8' arrays.--- Read requests to the IO device are performed using a buffer of size--- @bufsize@. The size of an array in the resulting stream is always less than--- or equal to @bufsize@.------ /Pre-release/----{-# INLINE readChunksWithBufferOf #-}-readChunksWithBufferOf :: (MonadCatch m, MonadAsync m)-    => Unfold m (Int, FilePath) (Array Word8)-readChunksWithBufferOf = usingFile2 FH.readChunksWithBufferOf---- | 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 readChunksFromToWith #-}-readChunksFromToWith :: (MonadCatch m, MonadAsync m) =>-    Unfold m (Int, Int, Int, FilePath) (Array Word8)-readChunksFromToWith = usingFile3 FH.readChunksFromToWith---- | 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.Foreign.Type.defaultChunkSize'. The--- size of arrays in the resulting stream are therefore less than or equal to--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize'.------ /Pre-release/-{-# INLINE readChunks #-}-readChunks :: (MonadCatch m, MonadAsync m) => Unfold m FilePath (Array Word8)-readChunks = usingFile FH.readChunks---- | Unfolds the tuple @(bufsize, filepath)@ into a byte stream, read requests--- to the IO device are performed using buffers of @bufsize@.------ /Pre-release/-{-# INLINE readWithBufferOf #-}-readWithBufferOf :: (MonadCatch m, MonadAsync m) => Unfold m (Int, FilePath) Word8-readWithBufferOf = usingFile2 FH.readWithBufferOf---- | Unfolds a file path into a byte stream. IO requests to the device are--- performed in sizes of--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize'.------ @since 0.7.0-{-# INLINE read #-}-read :: (MonadCatch m, MonadAsync m) => Unfold m FilePath Word8-read = UF.many (usingFile FH.readChunks) A.read---- | 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 toBytes #-}-toBytes :: (IsStream t, MonadCatch m, MonadAsync m) => FilePath -> t m Word8-toBytes file = AS.concat $ withFile file ReadMode FH.toChunks--{---- | 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 :: (IsStream t, MonadIO m) => Handle -> t m Word8-readShared = undefined--}------------------------------------------------------------------------------------ Writing----------------------------------------------------------------------------------{-# INLINE fromChunksMode #-}-fromChunksMode :: (MonadAsync m, MonadCatch m, Storable a)-    => IOMode -> FilePath -> SerialT m (Array a) -> m ()-fromChunksMode mode file xs = S.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.------ @since 0.7.0-{-# INLINE fromChunks #-}-fromChunks :: (MonadAsync m, MonadCatch m, Storable a)-    => FilePath -> SerialT 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.------ @since 0.7.0-{-# INLINE fromBytesWithBufferOf #-}-fromBytesWithBufferOf :: (MonadAsync m, MonadCatch m)-    => Int -> FilePath -> SerialT m Word8 -> m ()-fromBytesWithBufferOf n file xs = fromChunks file $ AS.arraysOf n xs---- > write = 'writeWithBufferOf' 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 :: (MonadAsync m, MonadCatch m) => FilePath -> SerialT m Word8 -> m ()-fromBytes = fromBytesWithBufferOf defaultChunkSize--{--{-# INLINE write #-}-write :: (MonadIO m, Storable a) => Handle -> SerialT 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, Storable a)-    => FilePath -> Fold m (Array a) ()-writeChunks path = Fold step initial extract-    where-    initial = do-        h <- liftIO (openFile path WriteMode)-        fld <- FL.initialize (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---- | @writeWithBufferOf 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 writeWithBufferOf #-}-writeWithBufferOf :: (MonadIO m, MonadCatch m)-    => Int -> FilePath -> Fold m Word8 ()-writeWithBufferOf n path =-    FL.chunksOf n (writeNUnsafe n) (writeChunks path)---- > write = 'writeWithBufferOf' A.defaultChunkSize------ | Write a byte stream to a file. Accumulates the input in chunks of up to--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize' before writing to--- the IO device.------ /Pre-release/----{-# INLINE write #-}-write :: (MonadIO m, MonadCatch m) => FilePath -> Fold m Word8 ()-write = writeWithBufferOf defaultChunkSize---- | Append a stream of arrays to a file.------ @since 0.7.0-{-# INLINE appendChunks #-}-appendChunks :: (MonadAsync m, MonadCatch m, Storable a)-    => FilePath -> SerialT 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.------ @since 0.7.0-{-# INLINE appendWithBufferOf #-}-appendWithBufferOf :: (MonadAsync m, MonadCatch m)-    => Int -> FilePath -> SerialT m Word8 -> m ()-appendWithBufferOf n file xs = appendChunks file $ AS.arraysOf 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.------ @since 0.7.0-{-# INLINE append #-}-append :: (MonadAsync m, MonadCatch m) => FilePath -> SerialT m Word8 -> m ()-append = appendWithBufferOf defaultChunkSize--{---- | Like 'append' but the file is not locked for exclusive writes.------ @since 0.7.0-{-# INLINE appendShared #-}-appendShared :: MonadIO m => Handle -> SerialT 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 :: (IsStream t, MonadIO m) => Handle -> t 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 -> SerialT 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 :: (IsStream t, MonadIO m) => Handle -> t 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 :: (IsStream t, MonadIO m) => Handle -> Fold m Char b -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Array a -> Handle -> Fold m a b -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Array a -> Handle -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Int -> Handle -> Int -> Int -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Handle -> Int -> Int -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Handle -> Int -> Int -> t 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 :: (IsStream t, Monad m, Storable a)-    => Handle -> Int -> Int -> t 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 :: (IsStream t, Monad m, Storable a)-    => Handle -> Int -> Int -> t m a -> m ()-writeSliceRev arr i len s = undefined--}
− src/Streamly/Internal/FileSystem/Handle.hs 
@@ -1,737 +0,0 @@-#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--- 'readChunksWithBufferOf' 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--- 'writeMaybesWithBufferOf' 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--    -- * Byte Stream Read-    , read-    -- , readUtf8-    -- , readLines-    -- , readFrames-    , readWithBufferOf--    , toBytes-    , toBytesWithBufferOf--    -- * Chunked Stream Read-    , readChunks-    , readChunksWithBufferOf--    , toChunksWithBufferOf-    , toChunks--    -- * Byte Stream Write-    -- Byte stream write (Folds)-    , write-    , consumer-    -- , writeUtf8-    -- , writeUtf8ByLines-    -- , writeByFrames-    -- , writeLines-    , writeWithBufferOf-    , writeMaybesWithBufferOf--    , putBytes-    , putBytesWithBufferOf--    -- * Chunked Stream Write-    , writeChunks-    , writeChunksWithBufferOf--    , putChunksWithBufferOf-    , 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-    , readChunksFromToWith-    -- , 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-    )-where--import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Function ((&))-import Data.Maybe (isNothing, fromJust)-import Data.Word (Word8)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (minusPtr, plusPtr)-import Foreign.Storable (Storable(..))-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)-import System.IO (Handle, SeekMode(..), hGetBufSome, hPutBuf, hSeek)-import Prelude hiding (read)--import Streamly.Internal.Data.Array.Foreign.Mut.Type (touch)-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.Foreign.Type-       (Array(..), writeNUnsafe, unsafeFreezeWithShrink, byteLength)-import Streamly.Internal.Data.Array.Foreign.Mut.Type (fromForeignPtrUnsafe)-import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream, mkStream, fromStreamD)-import Streamly.Internal.Data.Array.Stream.Foreign (lpackArraysChunksOf)--- import Streamly.String (encodeUtf8, decodeUtf8, foldLines)-import Streamly.Internal.System.IO (defaultChunkSize)--import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS-import qualified Streamly.Internal.Data.Refold.Type as Refold-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Unfold as UF---- $setup--- >>> import qualified Streamly.Data.Array.Foreign as Array--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.FileSystem.Handle as Handle--- >>> import qualified Streamly.Prelude as Stream------ >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold (supplyFirst)--- >>> 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.------ @since 0.8.1-{-# INLINABLE getChunk #-}-getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)-getChunk size h = liftIO $ do-    ptr <- mallocPlainForeignPtrBytes size-    -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    withForeignPtr ptr $ \p -> do-        n <- hGetBufSome h p size-        -- XXX shrink only if the diff is significant-        return $-            unsafeFreezeWithShrink $-            fromForeignPtrUnsafe ptr (p `plusPtr` n) (p `plusPtr` 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------------------------------------------------------------------------------------ | @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 :: (IsStream t, MonadIO m)-    => Int -> Handle -> t m (Array Word8)-_toChunksWithBufferOf size h = go-  where-    -- XXX use cons/nil instead-    go = mkStream $ \_ yld _ stp -> do-        arr <- getChunk size h-        if byteLength 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@.------ >>> toChunksWithBufferOf size h = Stream.unfold Handle.readChunksWithBufferOf (size, h)------ @since 0.7.0-{-# INLINE_NORMAL toChunksWithBufferOf #-}-toChunksWithBufferOf :: (IsStream t, MonadIO m) =>-    Int -> Handle -> t m (Array Word8)-{--toChunksWithBufferOf size h =-     S.repeatM (getChunk size h)-   & S.takeWhile ((/= 0) . byteLength)--}-toChunksWithBufferOf size h = fromStreamD (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@.------ @since 0.7.0-{-# INLINE_NORMAL readChunksWithBufferOf #-}-readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Handle) (Array Word8)-readChunksWithBufferOf =-     UF.lmap (uncurry getChunk) UF.repeatM-   & UF.takeWhile ((/= 0) . byteLength)-{--readChunksWithBufferOf = Unfold step return--    where--    {-# INLINE_LATE step #-}-    step (size, h) = do-        arr <- getChunk size h-        return $-            case byteLength arr of-                0 -> D.Stop-                _ -> D.Yield arr (size, h)--}---- There are two ways to implement this.------ 1. Idiomatic: use a scan on the output of readChunksWithBufferOf to total--- the array lengths and trim the last array to correct size.--- 2. Simply implement it from scratch like readChunksWithBufferOf.------ 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 readChunksFromToWith #-}-readChunksFromToWith :: MonadIO m =>-    Unfold m (Int, Int, Int, Handle) (Array Word8)-readChunksFromToWith = 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)---- 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 = Handle.toChunksWithBufferOf IO.defaultChunkSize------ @since 0.7.0-{-# INLINE toChunks #-}-toChunks :: (IsStream t, MonadIO m) => Handle -> t 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.Foreign.Type.defaultChunkSize'. The--- size of arrays in the resulting stream are therefore less than or equal to--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize'.------ >>> readChunks = Unfold.supplyFirst IO.defaultChunkSize Handle.readChunksWithBufferOf------ @since 0.7.0-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m Handle (Array Word8)-readChunks = UF.supplyFirst defaultChunkSize readChunksWithBufferOf------------------------------------------------------------------------------------ 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@.------ >>> readWithBufferOf = Unfold.many Handle.readChunksWithBufferOf Array.read------ @since 0.7.0-{-# INLINE readWithBufferOf #-}-readWithBufferOf :: MonadIO m => Unfold m (Int, Handle) Word8-readWithBufferOf = UF.many readChunksWithBufferOf A.read---- | @toBytesWithBufferOf bufsize handle@ reads a byte stream from a file--- handle, reads are performed in chunks of up to @bufsize@.------ >>> toBytesWithBufferOf size h = Stream.unfoldMany Array.read $ Handle.toChunksWithBufferOf size h------ /Pre-release/-{-# INLINE toBytesWithBufferOf #-}-toBytesWithBufferOf :: (IsStream t, MonadIO m) => Int -> Handle -> t m Word8-toBytesWithBufferOf size h = AS.concat $ toChunksWithBufferOf size h---- TODO--- Generate a stream of elements of the given type from a file 'Handle'.--- read :: (IsStream t, MonadIO m, Storable a) => Handle -> t m a------ | Unfolds a file handle into a byte stream. IO requests to the device are--- performed in sizes of--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize'.------ >>> read = Unfold.many Handle.readChunks Array.read------ @since 0.7.0-{-# INLINE read #-}-read :: MonadIO m => Unfold m Handle Word8-read = UF.many readChunks A.read---- | Generate a byte stream from a file 'Handle'.------ >>> toBytes h = Stream.unfoldMany Array.read $ Handle.toChunks h------ /Pre-release/-{-# INLINE toBytes #-}-toBytes :: (IsStream t, MonadIO m) => Handle -> t m Word8-toBytes = AS.concat . toChunks------------------------------------------------------------------------------------ Writing-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Array IO (output)------------------------------------------------------------------------------------ | Write an 'Array' to a file handle.------ @since 0.8.1-{-# INLINABLE putChunk #-}-putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()-putChunk _ arr | A.length arr == 0 = return ()-putChunk h Array{..} =-    liftIO $ hPutBuf h arrStart aLen >> touch arrContents--    where--    aLen = aEnd `minusPtr` arrStart------------------------------------------------------------------------------------ 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.mapM_ (Handle.putChunk h)------ @since 0.7.0-{-# INLINE putChunks #-}-putChunks :: (MonadIO m, Storable a)-    => Handle -> SerialT m (Array a) -> m ()-putChunks h = S.mapM_ (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.------ | @putChunksWithBufferOf 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 putChunksWithBufferOf #-}-putChunksWithBufferOf :: (MonadIO m, Storable a)-    => Int -> Handle -> SerialT m (Array a) -> m ()-putChunksWithBufferOf n h xs = putChunks h $ AS.compact n xs---- | @putBytesWithBufferOf 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.------ >>> putBytesWithBufferOf n h m = Handle.putChunks h $ Stream.arraysOf n m------ @since 0.7.0-{-# INLINE putBytesWithBufferOf #-}-putBytesWithBufferOf :: MonadIO m => Int -> Handle -> SerialT m Word8 -> m ()-putBytesWithBufferOf n h m = putChunks h $ S.arraysOf n m--- putBytesWithBufferOf n h m = putChunks h $ AS.arraysOf n m---- | Write a byte stream to a file handle. Accumulates the input in chunks of--- up to 'Streamly.Internal.Data.Array.Foreign.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.putBytesWithBufferOf IO.defaultChunkSize------ @since 0.7.0-{-# INLINE putBytes #-}-putBytes :: MonadIO m => Handle -> SerialT m Word8 -> m ()-putBytes = putBytesWithBufferOf 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)------ @since 0.7.0-{-# INLINE writeChunks #-}-writeChunks :: (MonadIO m, Storable a) => Handle -> Fold m (Array a) ()-writeChunks h = FL.drainBy (putChunk h)---- | Like writeChunks but uses the experimental 'Refold' API.------ /Internal/-{-# INLINE consumeChunks #-}-consumeChunks :: (MonadIO m, Storable a) => Refold m Handle (Array a) ()-consumeChunks = Refold.drainBy putChunk---- XXX lpackArraysChunksOf should be written idiomatically------ | @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.---- XXX Maybe we should have a Fold.arraysOf like we have Stream.arraysOf------ | @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.------ >>> writeWithBufferOf n h = Fold.chunksOf n (Array.writeNUnsafe n) (Handle.writeChunks h)------ @since 0.7.0-{-# INLINE writeWithBufferOf #-}-writeWithBufferOf :: MonadIO m => Int -> Handle -> Fold m Word8 ()-writeWithBufferOf n h = FL.chunksOf n (writeNUnsafe n) (writeChunks h)---- | 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 writeMaybesWithBufferOf #-}-writeMaybesWithBufferOf :: (MonadIO m )-    => Int -> Handle -> Fold m (Maybe Word8) ()-writeMaybesWithBufferOf n h =-    let writeNJusts = FL.lmap fromJust $ A.writeN n-        writeOnNothing = FL.takeEndBy_ isNothing writeNJusts-    in FL.many writeOnNothing (writeChunks h)---- | Like 'writeWithBufferOf'  but uses the experimental 'Refold' API.------ /Internal/-{-# INLINE consumerWithBufferOf #-}-consumerWithBufferOf :: MonadIO m => Int -> Refold m Handle Word8 ()-consumerWithBufferOf n =-    FL.refoldMany (FL.take n $ writeNUnsafe n) consumeChunks---- | Write a byte stream to a file handle. Accumulates the input in chunks of--- up to 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize' before writing--- to the IO device.------ >>> write = Handle.writeWithBufferOf IO.defaultChunkSize------ @since 0.7.0-{-# INLINE write #-}-write :: MonadIO m => Handle -> Fold m Word8 ()-write = writeWithBufferOf defaultChunkSize---- | Like 'write'  but uses the experimental 'Refold' API.------ /Internal/-{-# INLINE consumer #-}-consumer :: MonadIO m => Refold m Handle Word8 ()-consumer = consumerWithBufferOf defaultChunkSize--{--{-# INLINE write #-}-write :: (MonadIO m, Storable a) => Handle -> SerialT m a -> m ()-write = toHandleWith A.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.------ @since 0.7.0-{-# INLINE readUtf8 #-}-readUtf8 :: (IsStream t, MonadIO m) => Handle -> t 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 -> SerialT 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 :: (IsStream t, MonadIO m) => Handle -> t 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 :: (IsStream t, MonadIO m) => Handle -> Fold m Char b -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Array a -> Handle -> Fold m a b -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Array a -> Handle -> t 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 -> SerialT 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 -> SerialT 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.------ @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 :: (IsStream t, MonadIO m, Storable a)-    => Int -> Handle -> Int -> Int -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Handle -> Int -> Int -> t 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@.------ @since 0.7.0-{-# INLINE readSliceRev #-}-readSliceRev :: (IsStream t, MonadIO m, Storable a)-    => Handle -> Int -> Int -> t 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 :: (IsStream t, Monad m, Storable a)-    => Handle -> Int -> Int -> t 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 :: (IsStream t, Monad m, Storable a)-    => Handle -> Int -> Int -> t m a -> m ()-writeSliceRev arr i len s = undefined--}
− src/Streamly/Internal/Foreign/Malloc.hs 
@@ -1,49 +0,0 @@-#include "inline.hs"---- |--- Module      : Streamly.Internal.Foreign.Malloc--- Copyright   : (c) 2019 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Foreign.Malloc-    (-      mallocForeignPtrAlignedBytes-    , mallocForeignPtrAlignedUnmanagedBytes-    )-where----- We use GHC malloc by default--import Foreign.ForeignPtr (ForeignPtr, newForeignPtr_)-import Foreign.Marshal.Alloc (mallocBytes)-#ifdef USE_C_MALLOC-import Foreign.ForeignPtr (newForeignPtr)-import Foreign.Marshal.Alloc (finalizerFree)-#endif--import qualified GHC.ForeignPtr as GHC--{-# INLINE mallocForeignPtrAlignedBytes #-}-mallocForeignPtrAlignedBytes :: Int -> Int -> IO (GHC.ForeignPtr a)-#ifdef USE_C_MALLOC-mallocForeignPtrAlignedBytes size _alignment = do-    p <- mallocBytes size-    newForeignPtr finalizerFree p-#else-mallocForeignPtrAlignedBytes =-    GHC.mallocPlainForeignPtrAlignedBytes-#endif---- memalign alignment size--- foreign import ccall unsafe "stdlib.h posix_memalign" _memalign :: CSize -> CSize -> IO (Ptr a)--mallocForeignPtrAlignedUnmanagedBytes :: Int -> Int -> IO (ForeignPtr a)-mallocForeignPtrAlignedUnmanagedBytes size _alignment = do-    -- XXX use posix_memalign/aligned_alloc for aligned allocation-    p <- mallocBytes size-    newForeignPtr_ p
src/Streamly/Internal/Network/Inet/TCP.hs view
@@ -1,5 +1,3 @@-#include "inline.hs"- -- | -- Module      : Streamly.Internal.Network.Inet.TCP -- Copyright   : (c) 2019 Composewell Technologies@@ -13,19 +11,25 @@  module Streamly.Internal.Network.Inet.TCP     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * TCP Servers-    -- ** Unfolds-      acceptOnAddr+    -- ** Streams+      accept+    , acceptLocal+    , acceptOnAddr     , acceptOnAddrWith-    , acceptOnPort-    , acceptOnPortWith-    , acceptOnPortLocal -    -- ** Streams-    , connectionsOnAddr-    , connectionsOnAddrWith-    , connectionsOnPort-    , connectionsOnLocalHost+    -- ** Unfolds+    , acceptor+    , acceptorLocal+    , acceptorWith+    , acceptorOnAddr+    , acceptorOnAddrWith      -- * TCP clients     -- | IP Address based operations.@@ -34,12 +38,12 @@      -- ** Unfolds     , usingConnection-    , read+    , reader      -- ** Streams     , withConnection     -- *** Source-    , toBytes+    , read     -- , readUtf8     -- , readLines     -- , readFrames@@ -68,7 +72,8 @@     , putChunks      -- ** Transformation-    , processBytes+    , pipeBytes+    , pipeChunks     {-     -- ** Sink Servers @@ -90,9 +95,15 @@     , datagrams     , datagramsOn     -}++    -- * Deprecated+    , acceptorOnPort+    , acceptorOnPortLocal     ) where +#include "inline.hs"+ import Control.Exception (onException) import Control.Monad.Catch (MonadCatch, MonadMask, bracket) import Control.Monad.IO.Class (MonadIO(..))@@ -105,35 +116,46 @@  import Streamly.Internal.Control.Concurrent (MonadAsync) import Streamly.Internal.Control.ForkLifted (fork)-import Streamly.Internal.Data.Array.Foreign.Type (Array(..), writeNUnsafe)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.IsStream.Type (IsStream)-import Streamly.Internal.Data.Stream.Serial (SerialT)+import Streamly.Data.Array (Array)+import Streamly.Internal.Data.Fold ( Fold(..) )+import Streamly.Data.Stream (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.Network.Socket (SockSpec(..), accept, connections)+import Streamly.Data.MutByteArray (Unbox)+import Streamly.Data.Unfold (Unfold)+import Streamly.Internal.Network.Socket (SockSpec(..)) import Streamly.Internal.System.IO (defaultChunkSize)  import qualified Control.Monad.Catch as MC import qualified Network.Socket as Net -import qualified Streamly.Internal.Data.Unfold as UF-import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Stream.IsStream as S+import qualified Streamly.Data.Array as A+import qualified Streamly.Data.Fold as FL+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.Unfold as UF+import qualified Streamly.Internal.Data.Array as A+    (chunksOf', unsafeCreateOf')+import qualified Streamly.Internal.Data.Unfold as UF (bracketIO)+import qualified Streamly.Internal.Data.Fold as FL (Step(..), reduce)++import qualified Streamly.Internal.Data.Stream.Lifted as S (bracket) import qualified Streamly.Internal.Network.Socket as ISK +-- $setup+-- >>> :m+--+-- >>> import qualified Streamly.Data.Unfold as Unfold+-- >>> import qualified Streamly.Network.Inet.TCP as TCP+ ------------------------------------------------------------------------------- -- Accept (unfolds) ------------------------------------------------------------------------------- -{-# INLINE acceptOnAddrWith #-}-acceptOnAddrWith+{-# INLINE acceptorOnAddrWith #-}+acceptorOnAddrWith     :: MonadIO m     => [(SocketOption, Int)]     -> Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket-acceptOnAddrWith opts = UF.lmap f accept+acceptorOnAddrWith opts = UF.lmap f ISK.acceptor     where     f (addr, port) =         (maxListenQueue@@ -150,54 +172,65 @@ -- @ipAddr@ is the local IP address and @port@ is the local port on which -- connections are accepted. ----- @since 0.7.0-{-# INLINE acceptOnAddr #-}-acceptOnAddr+{-# INLINE acceptorOnAddr #-}+acceptorOnAddr     :: MonadIO m     => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket-acceptOnAddr = acceptOnAddrWith []+acceptorOnAddr = acceptorOnAddrWith [] -{-# INLINE acceptOnPortWith #-}-acceptOnPortWith :: MonadIO m+{-# INLINE acceptorWith #-}+acceptorWith :: MonadIO m     => [(SocketOption, Int)]     -> Unfold m PortNumber Socket-acceptOnPortWith opts = UF.supplyFirst (0,0,0,0) (acceptOnAddrWith opts)+acceptorWith opts = UF.first (0,0,0,0) (acceptorOnAddrWith opts) --- | Like 'acceptOnAddr' but binds on the IPv4 address @0.0.0.0@ i.e.  on all+-- | Like 'acceptorOnAddr' but binds on the IPv4 address @0.0.0.0@ i.e.  on all -- IPv4 addresses/interfaces of the machine and listens for TCP connections on -- the specified port. ----- > acceptOnPort = UF.supplyFirst acceptOnAddr (0,0,0,0)+-- >>> acceptor = Unfold.first (0,0,0,0) TCP.acceptorOnAddr ----- @since 0.7.0-{-# INLINE acceptOnPort #-}-acceptOnPort :: MonadIO m => Unfold m PortNumber Socket-acceptOnPort = UF.supplyFirst (0,0,0,0) acceptOnAddr+{-# INLINE acceptor #-}+acceptor :: MonadIO m => Unfold m PortNumber Socket+acceptor = UF.first (0,0,0,0) acceptorOnAddr --- | Like 'acceptOnAddr' but binds on the localhost IPv4 address @127.0.0.1@.--- The server can only be accessed from the local host, it cannot be accessed--- from other hosts on the network.+{-# DEPRECATED acceptorOnPort "Use \"acceptor\" instead." #-}+{-# INLINE acceptorOnPort #-}+acceptorOnPort :: MonadIO m => Unfold m PortNumber Socket+acceptorOnPort = acceptor++-- | Like 'acceptor' but binds on the localhost IPv4 address @127.0.0.1@. The+-- server can only be accessed from the local host, it cannot be accessed from+-- other hosts on the network. ----- > acceptOnPortLocal = UF.supplyFirst acceptOnAddr (127,0,0,1)+-- >>> acceptorLocal = Unfold.first (127,0,0,1) TCP.acceptorOnAddr ----- @since 0.7.0-{-# INLINE acceptOnPortLocal #-}-acceptOnPortLocal :: MonadIO m => Unfold m PortNumber Socket-acceptOnPortLocal = UF.supplyFirst (127,0,0,1) acceptOnAddr+{-# INLINE acceptorLocal #-}+acceptorLocal :: MonadIO m => Unfold m PortNumber Socket+acceptorLocal = UF.first (127,0,0,1) acceptorOnAddr +{-# DEPRECATED acceptorOnPortLocal "Use \"acceptorLocal\" instead." #-}+{-# INLINE acceptorOnPortLocal #-}+acceptorOnPortLocal :: MonadIO m => Unfold m PortNumber Socket+acceptorOnPortLocal = acceptorLocal+ ------------------------------------------------------------------------------- -- Accept (streams) ------------------------------------------------------------------------------- -{-# INLINE connectionsOnAddrWith #-}-connectionsOnAddrWith-    :: MonadAsync m+-- | Like 'acceptOnAddr' but with the ability to specify a list of socket+-- options.+--+-- /Pre-release/+{-# INLINE acceptOnAddrWith #-}+acceptOnAddrWith+    :: MonadIO m     => [(SocketOption, Int)]     -> (Word8, Word8, Word8, Word8)     -> PortNumber-    -> SerialT m Socket-connectionsOnAddrWith opts addr port =-    connections maxListenQueue SockSpec+    -> Stream m Socket+acceptOnAddrWith opts addr port =+    ISK.accept maxListenQueue SockSpec         { sockFamily = AF_INET         , sockType = Stream         , sockProto = defaultProtocol@@ -205,39 +238,40 @@         }         (SockAddrInet port (tupleToHostAddress addr)) --- | Like 'connections' but binds on the specified IPv4 address of the machine--- and listens for TCP connections on the specified port.+-- | Like 'accept' but binds on the specified IPv4 address. --+-- >>> acceptOnAddr = TCP.acceptOnAddrWith []+-- -- /Pre-release/-{-# INLINE connectionsOnAddr #-}-connectionsOnAddr-    :: MonadAsync m+{-# INLINE acceptOnAddr #-}+acceptOnAddr+    :: MonadIO m     => (Word8, Word8, Word8, Word8)     -> PortNumber-    -> SerialT m Socket-connectionsOnAddr = connectionsOnAddrWith []+    -> Stream m Socket+acceptOnAddr = acceptOnAddrWith [] --- | Like 'connections' but binds on the IPv4 address @0.0.0.0@ i.e.  on all--- IPv4 addresses/interfaces of the machine and listens for TCP connections on--- the specified port.+-- | Start a TCP stream server that binds on the IPV4 address @0.0.0.0@ and+-- listens for TCP connections from remote hosts on the specified server port.+-- The server generates a stream of connected sockets. ----- > connectionsOnPort = connectionsOnAddr (0,0,0,0)+-- >>> accept = TCP.acceptOnAddr (0,0,0,0) -- -- /Pre-release/-{-# INLINE connectionsOnPort #-}-connectionsOnPort :: MonadAsync m => PortNumber -> SerialT m Socket-connectionsOnPort = connectionsOnAddr (0,0,0,0)+{-# INLINE accept #-}+accept :: MonadIO m => PortNumber -> Stream m Socket+accept = acceptOnAddr (0,0,0,0) --- | Like 'connections' but binds on the localhost IPv4 address @127.0.0.1@.+-- | Like 'accept' but binds on the localhost IPv4 address @127.0.0.1@. -- The server can only be accessed from the local host, it cannot be accessed -- from other hosts on the network. ----- > connectionsOnLocalHost = connectionsOnAddr (127,0,0,1)+-- >>> acceptLocal = TCP.acceptOnAddr (127,0,0,1) -- -- /Pre-release/-{-# INLINE connectionsOnLocalHost #-}-connectionsOnLocalHost :: MonadAsync m => PortNumber -> SerialT m Socket-connectionsOnLocalHost = connectionsOnAddr (127,0,0,1)+{-# INLINE acceptLocal #-}+acceptLocal :: MonadIO m => PortNumber -> Stream m Socket+acceptLocal = acceptOnAddr (127,0,0,1)  ------------------------------------------------------------------------------- -- TCP Clients@@ -246,7 +280,6 @@ -- | Connect to the specified IP address and port number. Returns a connected -- socket or throws an exception. ----- @since 0.7.0 connect :: (Word8, Word8, Word8, Word8) -> PortNumber -> IO Socket connect addr port = do     sock <- socket AF_INET Stream defaultProtocol@@ -282,9 +315,7 @@ usingConnection :: (MonadCatch m, MonadAsync m)     => Unfold m Socket a     -> Unfold m ((Word8, Word8, Word8, Word8), PortNumber) a-usingConnection =-    UF.bracket (\(addr, port) -> liftIO $ connect addr port)-               (liftIO . Net.close)+usingConnection = UF.bracketIO (\(addr, port) -> connect addr port) Net.close  ------------------------------------------------------------------------------- -- Connect (streams)@@ -299,10 +330,12 @@ -- -- /Pre-release/ {-# INLINE withConnection #-}-withConnection :: (IsStream t, MonadCatch m, MonadAsync m)-    => (Word8, Word8, Word8, Word8) -> PortNumber -> (Socket -> t m a) -> t m a-withConnection addr port =-    S.bracket (liftIO $ connect addr port) (liftIO . Net.close)+withConnection :: (MonadCatch m, MonadAsync m)+    => (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> (Socket -> Stream m a)+    -> Stream m a+withConnection addr port = S.bracketIO (connect addr port) Net.close  ------------------------------------------------------------------------------- -- Read Addr to Stream@@ -310,19 +343,22 @@  -- | Read a stream from the supplied IPv4 host address and port number. ----- @since 0.7.0-{-# INLINE read #-}-read :: (MonadCatch m, MonadAsync m)+{-# INLINE reader #-}+reader :: (MonadCatch m, MonadAsync m)     => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Word8-read = UF.many (usingConnection ISK.readChunks) A.read+reader = UF.unfoldEach A.reader (usingConnection ISK.chunkReader) +{-# INLINE concatChunks #-}+concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+concatChunks = S.unfoldEach A.reader+ -- | Read a stream from the supplied IPv4 host address and port number. ----- @since 0.7.0-{-# INLINE toBytes #-}-toBytes :: (IsStream t, MonadCatch m, MonadAsync m)-    => (Word8, Word8, Word8, Word8) -> PortNumber -> t m Word8-toBytes addr port = AS.concat $ withConnection addr port ISK.toChunks+-- /Pre-release/+{-# INLINE read #-}+read :: (MonadCatch m, MonadAsync m)+    => (Word8, Word8, Word8, Word8) -> PortNumber -> Stream m Word8+read addr port = concatChunks $ withConnection addr port ISK.readChunks  ------------------------------------------------------------------------------- -- Writing@@ -331,87 +367,89 @@ -- | Write a stream of arrays to the supplied IPv4 host address and port -- number. ----- @since 0.7.0+-- /Pre-release/ {-# INLINE putChunks #-} putChunks     :: (MonadCatch m, MonadAsync m)     => (Word8, Word8, Word8, Word8)     -> PortNumber-    -> SerialT m (Array Word8)+    -> Stream m (Array Word8)     -> m () putChunks addr port xs =-    S.drain $ withConnection addr port (\sk -> S.fromEffect $ ISK.putChunks sk xs)+    S.fold FL.drain+        $ withConnection addr port (\sk -> S.fromEffect $ ISK.putChunks sk xs)  -- | Write a stream of arrays to the supplied IPv4 host address and port -- number. ----- @since 0.7.0 {-# INLINE writeChunks #-} writeChunks-    :: (MonadAsync m, MonadCatch m)+    :: (MonadIO m, MonadCatch m)     => (Word8, Word8, Word8, Word8)     -> PortNumber     -> Fold m (Array Word8) ()-writeChunks addr port = Fold step initial extract+writeChunks addr port = Fold step initial extract final     where     initial = do         skt <- liftIO (connect addr port)-        fld <- FL.initialize (ISK.writeChunks skt)+        fld <- FL.reduce (ISK.writeChunks skt)                     `MC.onException` liftIO (Net.close skt)         return $ FL.Partial (Tuple' fld skt)     step (Tuple' fld skt) x = do-        r <- FL.snoc fld x `MC.onException` liftIO (Net.close skt)+        r <- FL.addOne x fld `MC.onException` liftIO (Net.close skt)         return $ FL.Partial (Tuple' r skt)-    extract (Tuple' (Fold _ initial1 extract1) skt) = do++    extract _ = return ()++    final (Tuple' (Fold _ initial1 _ final1) skt) = do         liftIO $ Net.close skt         res <- initial1         case res of-            FL.Partial fs -> extract1 fs-            FL.Done fb -> return fb+            FL.Partial fs -> final1 fs+            FL.Done () -> return ()  -- | 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. ----- @since 0.7.0+-- /Pre-release/ {-# INLINE putBytesWithBufferOf #-} putBytesWithBufferOf     :: (MonadCatch m, MonadAsync m)     => Int     -> (Word8, Word8, Word8, Word8)     -> PortNumber-    -> SerialT m Word8+    -> Stream m Word8     -> m ()-putBytesWithBufferOf n addr port m = putChunks addr port $ AS.arraysOf n m+putBytesWithBufferOf n addr port m =+    putChunks addr port $ A.chunksOf' n m  -- | 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. ----- @since 0.7.0 {-# INLINE writeWithBufferOf #-} writeWithBufferOf-    :: (MonadAsync m, MonadCatch m)+    :: (MonadIO m, MonadCatch m)     => Int     -> (Word8, Word8, Word8, Word8)     -> PortNumber     -> Fold m Word8 () writeWithBufferOf n addr port =-    FL.chunksOf n (writeNUnsafe n) (writeChunks addr port)+    FL.groupsOf n (A.unsafeCreateOf' n) (writeChunks addr port)  -- | Write a stream to the supplied IPv4 host address and port number. ----- @since 0.7.0+-- /Pre-release/ {-# INLINE putBytes #-} putBytes :: (MonadCatch m, MonadAsync m)-    => (Word8, Word8, Word8, Word8) -> PortNumber -> SerialT m Word8 -> m ()+    => (Word8, Word8, Word8, Word8) -> PortNumber -> Stream m Word8 -> m () putBytes = putBytesWithBufferOf defaultChunkSize  -- | Write a stream to the supplied IPv4 host address and port number. ----- @since 0.7.0 {-# INLINE write #-}-write :: (MonadAsync m, MonadCatch m)+write :: (MonadIO m, MonadCatch m)     => (Word8, Word8, Word8, Word8) -> PortNumber -> Fold m Word8 () write = writeWithBufferOf defaultChunkSize @@ -421,22 +459,23 @@  {-# INLINE withInputConnect #-} withInputConnect-    :: (IsStream t, MonadCatch m, MonadAsync m)+    :: (MonadCatch m, MonadAsync m)     => (Word8, Word8, Word8, Word8)     -> PortNumber-    -> SerialT m Word8-    -> (Socket -> t m a)-    -> t m a-withInputConnect addr port input f = S.bracket pre post handler+    -> Stream m a+    -> (Socket -> Stream m a)+    -> (Socket -> Stream m a -> m ())+    -> Stream m a+withInputConnect addr port input fread fwrite = S.bracket pre post handler      where      pre = do         sk <- liftIO $ connect addr port-        tid <- fork (ISK.putBytes sk input)+        tid <- fork (fwrite sk input)         return (sk, tid) -    handler (sk, _) = f sk+    handler (sk, _) = fread sk      -- XXX kill the thread immediately?     post (sk, _) = liftIO $ Net.close sk@@ -447,11 +486,24 @@ -- -- /Pre-release/ ---{-# INLINE processBytes #-}-processBytes-    :: (IsStream t, MonadAsync m, MonadCatch m)+{-# INLINE pipeBytes #-}+pipeBytes+    :: (MonadAsync m, MonadCatch m)     => (Word8, Word8, Word8, Word8)     -> PortNumber-    -> SerialT m Word8-    -> t m Word8-processBytes addr port input = withInputConnect addr port input ISK.toBytes+    -> Stream m Word8+    -> Stream m Word8+pipeBytes addr port input = withInputConnect addr port input ISK.read ISK.putBytes++-- | This is similar to pipeBytes, but works on chunks of data.+--+-- /Pre-release/+--+{-# INLINE pipeChunks #-}+pipeChunks+    :: (MonadAsync m, MonadCatch m)+    => (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+pipeChunks addr port input = withInputConnect addr port input ISK.readChunks ISK.putChunks
src/Streamly/Internal/Network/Socket.hs view
@@ -11,67 +11,68 @@ -- module Streamly.Internal.Network.Socket     (-    SockSpec (..)+      SockSpec (..)     -- * Use a socket     , forSocketM     , withSocket      -- * Accept connections     , accept-    , connections+    , acceptor++    -- * Connect     , connect     , connectFrom      -- * Read from connection-    , read-    , readWithBufferOf-    -- , readUtf8-    -- , readLines-    -- , readFrames-    -- , readByChunks+    , getChunk -    -- -- * Array Read-    -- , readArrayUpto-    -- , readChunksUpto-    , readChunk+    -- ** Streams+    , read+    , readWith     , readChunks-    , readChunksWithBufferOf+    , readChunksWith -    , toChunksWithBufferOf-    , toChunks-    , toBytes+    -- ** Unfolds+    , reader+    , readerWith+    , chunkReader+    , chunkReaderWith      -- * Write to connection+    , putChunk++    -- ** Folds     , write-    -- , writeUtf8-    -- , writeUtf8ByLines-    -- , writeByFrames-    , writeWithBufferOf-    , writeMaybesWithBufferOf+    , writeWith+    , writeChunks+    , writeChunksWith+    , writeMaybesWith +    -- ** Stream writes     , putChunks-    , putBytesWithBufferOf+    , putBytesWith     , putBytes -    -- -- * Array Write-    , writeChunk-    , writeChunks-    , writeChunksWithBufferOf-     -- reading/writing datagrams++    -- * Deprecated+    , readWithBufferOf+    , readChunksWithBufferOf+    , writeWithBufferOf+    , writeChunksWithBufferOf     ) where  import Control.Concurrent (threadWaitWrite, rtsSupportsBoundThreads) import Control.Exception (onException)+import Control.Monad (forM_, when) import Control.Monad.Catch (MonadCatch, finally, MonadMask) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (forM_, when) import Data.Maybe (isNothing, fromJust) import Data.Word (Word8)-import Foreign.Ptr (minusPtr, plusPtr, Ptr, castPtr)-import Foreign.Storable (Storable(..))-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)+import Foreign.Ptr (plusPtr, Ptr, castPtr)+import Streamly.Data.MutByteArray (Unbox) import Network.Socket        (Socket, SocketOption(..), Family(..), SockAddr(..),         ProtocolNumber, withSocketsDo, SocketType(..), socket, bind,@@ -85,35 +86,36 @@  import qualified Network.Socket as Net -import Streamly.Internal.BaseCompat-import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Array.Foreign.Mut.Type-    (fromForeignPtrUnsafe, touch)-import Streamly.Internal.Data.Array.Foreign.Type (Array(..))-import Streamly.Internal.Data.Array.Stream.Foreign (lpackArraysChunksOf)-import Streamly.Internal.Data.Fold (Fold)-import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream, mkStream, fromStreamD)-import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Array (Array(..))+import Streamly.Data.Fold (Fold)+import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Unfold (Unfold(..)) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize) -import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Foreign.Type as A-import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Unfold as UF+import qualified Streamly.Data.Array as A+import qualified Streamly.Data.Fold as FL+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.Unfold as UF+import qualified Streamly.Internal.Data.Array as A+    ( unsafeFreeze, unsafePinnedAsPtr, chunksOf',+      createOf', unsafeCreateOf, scanCompactMin )+import qualified Streamly.Internal.Data.MutArray as MArray+    (unsafeCreateWithPtr')+import qualified Streamly.Internal.Data.Stream as S (fromStreamK, Stream(..), Step(..))+import qualified Streamly.Internal.Data.StreamK as K (mkStream) +-- $setup+-- >>> :m+-- >>> import Streamly.Internal.System.IO (defaultChunkSize)+-- >>> import qualified Streamly.Internal.Network.Socket as Socket+ -- | @'forSocketM' action socket@ runs the monadic computation @action@ passing -- the socket handle to it.  The handle will be closed on exit from -- 'forSocketM', whether by normal termination or by raising an exception.  If -- closing the handle raises an exception, then this exception will be raised -- by 'forSocketM' rather than any exception raised by 'action'. ----- @since 0.8.0 {-# INLINE forSocketM #-} forSocketM :: (MonadMask m, MonadIO m) => (Socket -> m ()) -> Socket -> m () forSocketM f sk = finally (f sk) (liftIO (Net.close sk))@@ -125,9 +127,9 @@ -- -- /Internal/ {-# INLINE withSocket #-}-withSocket :: (IsStream t, MonadAsync m, MonadCatch m)-    => Socket -> (Socket -> t m a) -> t m a-withSocket sk f = S.finally (liftIO $ Net.close sk) (f sk)+withSocket :: (MonadIO m, MonadCatch m) =>+    Socket -> (Socket -> Stream m a) -> Stream m a+withSocket sk f = S.finallyIO (Net.close sk) (f sk)  ------------------------------------------------------------------------------- -- Accept (Unfolds)@@ -136,6 +138,9 @@ -- XXX Protocol specific socket options should be separated from socket level -- options. --+-- NOTE: the socket config is specified as a record and not by composing+-- functions because all the fields are mandatory except the sockOpts field.+ -- | Specify the socket protocol details. data SockSpec = SockSpec     {@@ -169,7 +174,7 @@      step listener = do         r <- liftIO (Net.accept listener `onException` Net.close listener)-        return $ D.Yield r listener+        return $ S.Yield r listener  -- | Unfold a three tuple @(listenQLen, spec, addr)@ into a stream of connected -- protocol sockets corresponding to incoming connections. @listenQLen@ is the@@ -177,10 +182,9 @@ -- protocol and options specification and @addr@ is the protocol address where -- the server listens for incoming connections. ----- @since 0.7.0-{-# INLINE accept #-}-accept :: MonadIO m => Unfold m (Int, SockSpec, SockAddr) Socket-accept = UF.map fst listenTuples+{-# INLINE acceptor #-}+acceptor :: MonadIO m => Unfold m (Int, SockSpec, SockAddr) Socket+acceptor = fmap fst listenTuples  {-# INLINE connectCommon #-} connectCommon :: SockSpec -> Maybe SockAddr -> SockAddr -> IO Socket@@ -220,8 +224,8 @@ -------------------------------------------------------------------------------  {-# INLINE recvConnectionTuplesWith #-}-recvConnectionTuplesWith :: MonadAsync m-    => Int -> SockSpec -> SockAddr -> SerialT m (Socket, SockAddr)+recvConnectionTuplesWith :: MonadIO m+    => Int -> SockSpec -> SockAddr -> Stream m (Socket, SockAddr) recvConnectionTuplesWith tcpListenQ spec addr = S.unfoldrM step Nothing     where     step Nothing = do@@ -239,15 +243,17 @@ -- argument is the maximum number of pending connections in the backlog. -- -- /Pre-release/-{-# INLINE connections #-}-connections :: MonadAsync m => Int -> SockSpec -> SockAddr -> SerialT m Socket-connections tcpListenQ spec addr =+{-# INLINE accept #-}+accept :: MonadIO m => Int -> SockSpec -> SockAddr -> Stream m Socket+accept tcpListenQ spec addr =     fst <$> recvConnectionTuplesWith tcpListenQ spec addr  ------------------------------------------------------------------------------- -- Array IO (Input) ------------------------------------------------------------------------------- +-- XXX add an API that compacts the arrays to an exact size.+ {-# INLINABLE readArrayUptoWith #-} readArrayUptoWith     :: (h -> Ptr Word8 -> Int -> IO Int)@@ -255,26 +261,19 @@     -> h     -> IO (Array Word8) readArrayUptoWith f size h = do-    ptr <- mallocPlainForeignPtrBytes size-    -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    unsafeWithForeignPtr ptr $ \p -> do-        n <- f h p size-        let v = A.unsafeFreeze-                $ fromForeignPtrUnsafe ptr (p `plusPtr` n) (p `plusPtr` size)--        -- XXX shrink only if the diff is significant-        -- A.shrinkToFit v-        return v+    arr <- MArray.unsafeCreateWithPtr' size $ \p -> f h p size+    -- XXX shrink only if the diff is significant+    -- unsafeFreezeWithShrink+    pure $ A.unsafeFreeze arr  -- | Read a byte array from a file handle up to a maximum of the requested -- size. If no data is available on the handle it blocks until some data -- becomes available. If data is available then it immediately returns that -- data without blocking. ----- @since 0.8.0-{-# INLINABLE readChunk #-}-readChunk :: Int -> Socket -> IO (Array Word8)-readChunk = readArrayUptoWith recvBuf+{-# INLINABLE getChunk #-}+getChunk :: Int -> Socket -> IO (Array Word8)+getChunk = readArrayUptoWith recvBuf  ------------------------------------------------------------------------------- -- Array IO (output)@@ -300,146 +299,144 @@     when (sent >= 0) $ sendAll s (p `plusPtr` sent) (len - sent)  {-# INLINABLE writeArrayWith #-}-writeArrayWith :: Storable a+writeArrayWith :: Unbox a     => (h -> Ptr Word8 -> Int -> IO ())     -> h     -> Array a     -> IO () writeArrayWith _ _ arr | A.length arr == 0 = return ()-writeArrayWith f h Array{..} =-    f h (castPtr arrStart) aLen >> touch arrContents--    where--    aLen = aEnd `minusPtr` arrStart+writeArrayWith f h arr =+    A.unsafePinnedAsPtr arr $ \ptr byteLen -> f h (castPtr ptr) byteLen --- | Write an Array to a file handle.+-- | Write an Array to a socket. ----- @since 0.8.0-{-# INLINABLE writeChunk #-}-writeChunk :: Storable a => Socket -> Array a -> IO ()-writeChunk = writeArrayWith sendAll+{-# INLINABLE putChunk #-}+putChunk :: Unbox a => Socket -> Array a -> IO ()+putChunk = writeArrayWith sendAll  ------------------------------------------------------------------------------- -- Stream of Arrays IO -------------------------------------------------------------------------------  {-# INLINE _readChunksUptoWith #-}-_readChunksUptoWith :: (IsStream t, MonadIO m)+_readChunksUptoWith :: (MonadIO m)     => (Int -> h -> IO (Array Word8))-    -> Int -> h -> t m (Array Word8)-_readChunksUptoWith f size h = go+    -> Int -> h -> Stream m (Array Word8)+_readChunksUptoWith f size h = S.fromStreamK go   where     -- XXX use cons/nil instead-    go = mkStream $ \_ yld _ stp -> do+    go = K.mkStream $ \_ yld _ stp -> do         arr <- liftIO $ f size h         if A.length arr == 0         then stp         else yld arr go --- | @toChunksWithBufferOf size h@ reads a stream of arrays from file handle @h@.--- The maximum size of a single array is limited to @size@.--- 'fromHandleArraysUpto' ignores the prevailing 'TextEncoding' and 'NewlineMode'--- on the 'Handle'.-{-# INLINE_NORMAL toChunksWithBufferOf #-}-toChunksWithBufferOf :: (IsStream t, MonadIO m)-    => Int -> Socket -> t m (Array Word8)--- toChunksWithBufferOf = _readChunksUptoWith readChunk-toChunksWithBufferOf size h = fromStreamD (D.Stream step ())+-- | @readChunksWith bufsize socket@ reads a stream of arrays from @socket@.+-- The maximum size of a single array is limited to @bufsize@.+--+-- /Pre-release/+{-# INLINE_NORMAL readChunksWith #-}+readChunksWith :: MonadIO m => Int -> Socket -> Stream m (Array Word8)+-- readChunksWith = _readChunksUptoWith readChunk+readChunksWith size h = S.Stream step ()     where     {-# INLINE_LATE step #-}     step _ _ = do-        arr <- liftIO $ readChunk size h+        arr <- liftIO $ getChunk size h         return $             case A.length arr of-                0 -> D.Stop-                _ -> D.Yield arr ()+                0 -> S.Stop+                _ -> S.Yield arr () --- XXX read 'Array a' instead of Word8+-- | Read a stream of byte arrays from a socket. The maximum size of a single+-- array is limited to @defaultChunkSize@. ----- | @toChunks h@ reads a stream of arrays from socket handle @h@.--- The maximum size of a single array is limited to @defaultChunkSize@.+-- >>> readChunks = Socket.readChunksWith defaultChunkSize ----- @since 0.7.0-{-# INLINE toChunks #-}-toChunks :: (IsStream t, MonadIO m) => Socket -> t m (Array Word8)-toChunks = toChunksWithBufferOf defaultChunkSize+-- /Pre-release/+{-# INLINE readChunks #-}+readChunks :: MonadIO m => Socket -> Stream m (Array Word8)+readChunks = readChunksWith defaultChunkSize  -- | Unfold the tuple @(bufsize, socket)@ into a stream of 'Word8' arrays. -- Read requests to the socket 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, Socket) (Array Word8)-readChunksWithBufferOf = Unfold step return+{-# INLINE_NORMAL chunkReaderWith #-}+chunkReaderWith :: MonadIO m => Unfold m (Int, Socket) (Array Word8)+chunkReaderWith = Unfold step return     where     {-# INLINE_LATE step #-}     step (size, h) = do-        arr <- liftIO $ readChunk size h+        arr <- liftIO $ getChunk size h         return $             case A.length arr of-                0 -> D.Stop-                _ -> D.Yield arr (size, h)+                0 -> S.Stop+                _ -> S.Yield arr (size, h) +-- | Same as 'chunkReaderWith'+--+{-# DEPRECATED readChunksWithBufferOf "Please use 'chunkReaderWith' instead" #-}+{-# INLINE_NORMAL readChunksWithBufferOf #-}+readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Socket) (Array Word8)+readChunksWithBufferOf = chunkReaderWith+ -- | Unfolds a socket into a stream of 'Word8' arrays. Requests to the socket -- are performed using a buffer of size--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize'. The+-- '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.Foreign.Type.defaultChunkSize'.+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. ----- @since 0.7.0-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m Socket (Array Word8)-readChunks = UF.supplyFirst defaultChunkSize readChunksWithBufferOf+{-# INLINE chunkReader #-}+chunkReader :: MonadIO m => Unfold m Socket (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.+{-# INLINE concatChunks #-}+concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+concatChunks = S.unfoldEach A.reader -{---- | @readWithBufferOf bufsize handle@ reads a byte stream from a file--- handle, reads are performed in chunks of up to @bufsize@.  The stream ends--- as soon as EOF is encountered.+-- | Generate a byte stream from a socket using a buffer of the given size. ---{-# INLINE readWithBufferOf #-}-readWithBufferOf :: (IsStream t, MonadIO m) => Int -> Handle -> t m Word8-readWithBufferOf chunkSize h = A.flattenArrays $ readChunksUpto chunkSize h--}+-- /Pre-release/+{-# INLINE readWith #-}+readWith :: MonadIO m => Int -> Socket -> Stream m Word8+readWith size = concatChunks . readChunksWith size --- TODO--- read :: (IsStream t, MonadIO m, Storable a) => Handle -> t m a+-- | Generate a byte stream from a socket. ----- > read = 'readByChunks' defaultChunkSize--- | Generate a stream of elements of the given type from a socket. The--- stream ends when EOF is encountered.+-- >>> read = Socket.readWith defaultChunkSize ----- @since 0.7.0-{-# INLINE toBytes #-}-toBytes :: (IsStream t, MonadIO m) => Socket -> t m Word8-toBytes = AS.concat . toChunks+-- /Pre-release/+{-# INLINE read #-}+read :: MonadIO m => Socket -> Stream m Word8+read = readWith defaultChunkSize  -- | Unfolds the tuple @(bufsize, socket)@ into a byte stream, read requests -- to the socket are performed using buffers of @bufsize@. ----- @since 0.7.0+{-# INLINE readerWith #-}+readerWith :: MonadIO m => Unfold m (Int, Socket) Word8+readerWith = UF.unfoldEach A.reader chunkReaderWith++-- | Same as 'readWith'+--+{-# DEPRECATED readWithBufferOf "Please use 'readerWith' instead" #-} {-# INLINE readWithBufferOf #-} readWithBufferOf :: MonadIO m => Unfold m (Int, Socket) Word8-readWithBufferOf = UF.many readChunksWithBufferOf A.read+readWithBufferOf = readerWith  -- | Unfolds a 'Socket' into a byte stream.  IO requests to the socket are -- performed in sizes of--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize'.+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. ----- @since 0.7.0-{-# INLINE read #-}-read :: MonadIO m => Unfold m Socket Word8-read = UF.supplyFirst defaultChunkSize readWithBufferOf+{-# INLINE reader #-}+reader :: MonadIO m => Unfold m Socket Word8+reader = UF.first defaultChunkSize readerWith  ------------------------------------------------------------------------------- -- Writing@@ -447,31 +444,39 @@  -- | Write a stream of arrays to a handle. ----- @since 0.7.0 {-# INLINE putChunks #-}-putChunks :: (MonadIO m, Storable a)-    => Socket -> SerialT m (Array a) -> m ()-putChunks h = S.mapM_ (liftIO . writeChunk h)+putChunks :: (MonadIO m, Unbox a)+    => Socket -> Stream m (Array a) -> m ()+putChunks h = S.fold (FL.drainMapM (liftIO . putChunk h))  -- | Write a stream of arrays to a socket.  Each array in the stream is written -- to the socket as a separate IO request. ----- @since 0.7.0 {-# INLINE writeChunks #-}-writeChunks :: (MonadIO m, Storable a) => Socket -> Fold m (Array a) ()-writeChunks h = FL.drainBy (liftIO . writeChunk h)+writeChunks :: (MonadIO m, Unbox a) => Socket -> Fold m (Array a) ()+writeChunks h = FL.drainMapM (liftIO . putChunk h) --- | @writeChunksWithBufferOf bufsize socket@ writes a stream of arrays to+-- | @writeChunksWith bufsize socket@ writes a stream of arrays to -- @socket@ after coalescing the adjacent arrays in chunks of @bufsize@. -- Multiple arrays are coalesed as long as the total size remains below the -- specified size.  It never splits an array, if a single array is bigger than -- the specified size it emitted as it is. ----- @since 0.8.0+{-# INLINE writeChunksWith #-}+writeChunksWith :: (MonadIO m, Unbox a)+    => Int -> Socket -> Fold m (Array a) ()+-- writeChunksWith n h = A.lCompactBySizeGE n (writeChunks h)+writeChunksWith n h =+   FL.postscanl (A.scanCompactMin n)+    $ FL.catMaybes (writeChunks h)++-- | Same as 'writeChunksWith'+--+{-# DEPRECATED writeChunksWithBufferOf "Please use 'writeChunksWith' instead" #-} {-# INLINE writeChunksWithBufferOf #-}-writeChunksWithBufferOf :: (MonadIO m, Storable a)+writeChunksWithBufferOf :: (MonadIO m, Unbox a)     => Int -> Socket -> Fold m (Array a) ()-writeChunksWithBufferOf n h = lpackArraysChunksOf n (writeChunks h)+writeChunksWithBufferOf = writeChunksWith  -- GHC buffer size dEFAULT_FD_BUFFER_SIZE=8192 bytes. --@@ -485,126 +490,50 @@ -- be written to the IO device as soon as we collect the specified number of -- input elements. ----- @since 0.7.0-{-# INLINE putBytesWithBufferOf #-}-putBytesWithBufferOf :: MonadIO m => Int -> Socket -> SerialT m Word8 -> m ()-putBytesWithBufferOf n h m = putChunks h $ AS.arraysOf n m+{-# INLINE putBytesWith #-}+putBytesWith :: MonadIO m => Int -> Socket -> Stream m Word8 -> m ()+putBytesWith n h m = putChunks h $ A.chunksOf' n m  -- | Write a byte stream to a socket. Accumulates the input in chunks of -- specified number of bytes before writing. ----- @since 0.7.0+{-# INLINE writeWith #-}+writeWith :: MonadIO m => Int -> Socket -> Fold m Word8 ()+writeWith n h = FL.groupsOf n (A.unsafeCreateOf n) (writeChunks h)++-- | Same as 'writeWith'+--+{-# DEPRECATED writeWithBufferOf "Please use 'writeWith' instead" #-} {-# INLINE writeWithBufferOf #-} writeWithBufferOf :: MonadIO m => Int -> Socket -> Fold m Word8 ()-writeWithBufferOf n h = FL.chunksOf n (A.writeNUnsafe n) (writeChunks h)+writeWithBufferOf = writeWith  -- | Write a stream of 'Maybe' values. Keep buffering the 'Just' values in an -- array. Write the array to the 'Handle' as soon as a 'Nothing' is encountered -- or the buffer size exceeds the specified limit. -- -- /Pre-release/-{-# INLINE writeMaybesWithBufferOf #-}-writeMaybesWithBufferOf :: (MonadIO m )+{-# INLINE writeMaybesWith #-}+writeMaybesWith :: (MonadIO m )     => Int -> Socket -> Fold m (Maybe Word8) ()-writeMaybesWithBufferOf n h =-    let writeNJusts = FL.lmap fromJust $ A.writeN n+writeMaybesWith n h =+    let writeNJusts = FL.lmap fromJust $ A.createOf' n         writeOnNothing = FL.takeEndBy_ isNothing writeNJusts     in FL.many writeOnNothing (writeChunks h) --- > write = 'writeWithBufferOf' defaultChunkSize--- -- | Write a byte stream to a file handle. Combines the bytes in chunks of size -- up to 'defaultChunkSize' before writing.  Note that the write behavior -- depends on the 'IOMode' and the current seek position of the handle. ----- @since 0.7.0 {-# INLINE putBytes #-}-putBytes :: MonadIO m => Socket -> SerialT m Word8 -> m ()-putBytes = putBytesWithBufferOf defaultChunkSize+putBytes :: MonadIO m => Socket -> Stream m Word8 -> m ()+putBytes = putBytesWith defaultChunkSize  -- | Write a byte stream to a socket. Accumulates the input in chunks of -- up to 'defaultChunkSize' bytes before writing. ----- @--- write = 'writeWithBufferOf' 'defaultChunkSize'--- @+-- >>> write = Socket.writeWith defaultChunkSize ----- @since 0.7.0 {-# INLINE write #-} write :: MonadIO m => Socket -> Fold m Word8 ()-write = writeWithBufferOf defaultChunkSize--{--{-# INLINE write #-}-write :: (MonadIO m, Storable a) => Handle -> SerialT m a -> m ()-write = toHandleWith defaultChunkSize--}------------------------------------------------------------------------------------ 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 :: (IsStream t, MonadIO m) => Handle -> t 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 -> SerialT 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 :: (IsStream t, MonadIO m) => Handle -> t 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 :: (IsStream t, MonadIO m) => Handle -> Fold m Char b -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Array a -> Handle -> Fold m a b -> t 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 :: (IsStream t, MonadIO m, Storable a)-    => Array a -> Handle -> t m a -> m ()-writeByFrames = undefined--}+write = writeWith defaultChunkSize
− src/Streamly/Internal/System/IO.hs 
@@ -1,56 +0,0 @@-{-# 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-    )--where------------------------------------------------------------------------------------ Imports----------------------------------------------------------------------------------import Foreign.Storable (Storable(sizeOf))-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 (undefined :: Word)---- | 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/System/IOVec.hs view
@@ -15,8 +15,10 @@     , c_writev     , c_safe_writev #if !defined(mingw32_HOST_OS)+{-     , groupIOVecsOf     , groupIOVecsOfMut+-} #endif     ) where@@ -24,16 +26,18 @@ #include "inline.hs"  #if !defined(mingw32_HOST_OS)+{- import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import Foreign.Ptr (castPtr)-import Streamly.Internal.Data.Array.Foreign.Mut.Type (length)+import Streamly.Internal.Data.MutArray (length) import Streamly.Internal.Data.SVar.Type (adaptState)-import Streamly.Internal.Data.Array.Foreign.Mut.Type (Array(..))+import Streamly.Internal.Data.MutArray (Array(..)) -import qualified Streamly.Internal.Data.Array.Foreign.Type as Array-import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MArray-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutArray.Type as MArray+import qualified Streamly.Internal.Data.Stream as D+-} #endif  import Streamly.Internal.System.IOVec.Type@@ -41,6 +45,7 @@ import Prelude hiding (length)  #if !defined(mingw32_HOST_OS)+{- data GatherState s arr     = GatherInitial s     | GatherBuffering s arr Int@@ -64,11 +69,11 @@     step' gst (GatherInitial st) = do         when (n <= 0) $             -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.Array.Foreign.Mut.Type.groupIOVecsOf: the size of "+            error $ "Streamly.Internal.Data.MutArray.Type.groupIOVecsOf: the size of "                  ++ "groups [" ++ show n ++ "] must be a natural number"         when (maxIOVLen <= 0) $             -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.Array.Foreign.Mut.Type.groupIOVecsOf: the number of "+            error $ "Streamly.Internal.Data.MutArray.Type.groupIOVecsOf: the number of "                  ++ "IOVec entries [" ++ show n ++ "] must be a natural number"         r <- step (adaptState gst) st         case r of@@ -123,4 +128,5 @@     D.map Array.unsafeFreeze         $ groupIOVecsOfMut n maxIOVLen         $ D.map Array.unsafeThaw str+-} #endif
− src/Streamly/Internal/Unicode/Array/Char.hs 
@@ -1,92 +0,0 @@--- |--- Module      : Streamly.Internal.Unicode.Array.Char--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Unicode.Array.Char-    (-    -- * Streams of Strings-      lines-    , words-    , unlines-    , unwords-    )-where--import Control.Monad.IO.Class (MonadIO)-import Streamly.Prelude (MonadAsync)-import Prelude hiding (String, lines, words, unlines, unwords)-import Streamly.Data.Array.Foreign (Array)-import Streamly.Internal.Data.Stream.IsStream (IsStream)--import qualified Streamly.Internal.Unicode.Stream as S-import qualified Streamly.Data.Array.Foreign as A---- $setup--- >>> :m--- >>> :set -XOverloadedStrings--- >>> import Prelude hiding (String, lines, words, unlines, unwords)--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Internal.Unicode.Array.Char 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.toList $ Unicode.lines $ Stream.fromList "lines\nthis\nstring\n\n\n"--- ["lines","this","string","",""]----{-# INLINE lines #-}-lines :: (MonadIO m, IsStream t) => t m Char -> t 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.toList $ Unicode.words $ Stream.fromList "A  newline\nis considered white space?"--- ["A","newline","is","considered","white","space?"]----{-# INLINE words #-}-words :: (MonadIO m, IsStream t) => t m Char -> t 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.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, IsStream t) => t m (Array Char) -> t m Char-unlines = S.unlines A.read---- | Flattens the stream of @Array Char@, after appending a separating--- space to each string.------ 'unwords' is an inverse operation to 'words'.------ >>> Stream.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 :: (MonadAsync m, IsStream t) => t m (Array Char) -> t m Char-unwords = S.unwords A.read
− src/Streamly/Internal/Unicode/Array/Prim/Pinned.hs 
@@ -1,91 +0,0 @@--- |--- Module      : Streamly.Internal.Unicode.Array.Prim.Pinned--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Unicode.Array.Prim.Pinned-    (-    -- * Streams of Strings-      lines-    , words-    , unlines-    , unwords-    )-where--import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Prelude (MonadAsync)-import Prelude hiding (String, lines, words, unlines, unwords)-import Streamly.Internal.Data.Stream.IsStream (IsStream)-import Streamly.Internal.Data.Array.Prim.Pinned (Array)--import qualified Streamly.Internal.Unicode.Stream as S-import qualified Streamly.Internal.Data.Array.Prim.Pinned as A---- $setup--- >>> :m--- >>> :set -XOverloadedStrings--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Internal.Unicode.Array.Prim.Pinned 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.toList $ Unicode.lines $ Stream.fromList "lines\nthis\nstring\n\n\n"--- [fromListN 5 "lines",fromListN 4 "this",fromListN 6 "string",fromListN 0 "",fromListN 0 ""]----{-# INLINE lines #-}-lines :: (MonadIO m, IsStream t) => t m Char -> t 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.toList $ Unicode.words $ Stream.fromList "A  newline\nis considered white space?"--- [fromListN 1 "A",fromListN 7 "newline",fromListN 2 "is",fromListN 10 "considered",fromListN 5 "white",fromListN 6 "space?"]----{-# INLINE words #-}-words :: (MonadIO m, IsStream t) => t m Char -> t 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.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 :: (MonadAsync m, IsStream t) => t m (Array Char) -> t m Char-unlines = S.unlines A.read---- | Flattens the stream of @Array Char@, after appending a separating--- space to each string.------ 'unwords' is an inverse operation to 'words'.------ >>> Stream.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 :: (MonadAsync m, IsStream t) => t m (Array Char) -> t m Char-unwords = S.unwords A.read
src/Streamly/Internal/Unicode/Char.hs view
@@ -6,12 +6,20 @@ -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC++-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif+-- XXX This module should have the reader/writer unfold/refold and read/write+-- stream/fold routines to convert a char to/from stream. -- module Streamly.Internal.Unicode.Char     (     -- * Predicates-      isAsciiAlpha+      isAsciiAlpha -- XXX Remove or move to unicode-data +    -- XXX move to Unicode.Char.Case?     -- * Unicode aware operations     {-       toCaseFold@@ -20,6 +28,7 @@     , toTitle     -} +    -- XXX Move to Unicode.Stream.Normalize or Unicode.Normalize?     -- * Unicode normalization     , NormalizationMode(..)     , normalize@@ -29,12 +38,8 @@ #include "inline.hs"  import Data.Char (isAsciiUpper, isAsciiLower, chr, ord)-import Data.Typeable (Typeable)- import Unicode.Char (DecomposeMode(..))-import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream, fromStreamD, toStreamD)-import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))+import Streamly.Internal.Data.Stream (Stream(..), Step (..))  import qualified Unicode.Char as Char @@ -85,7 +90,7 @@     | NFKD   -- ^ Compatibility decomposition.     | NFC    -- ^ Canonical decomposition followed by canonical composition.     | NFKC   -- ^ Compatibility decomposition followed by canonical composition.-      deriving (Eq, Show, Enum, Typeable)+      deriving (Eq, Show, Enum)  ------------------------------------------------------------------------------- -- Normalization combinators@@ -222,13 +227,13 @@                 Stop -> Skip $ YieldList rbuf ComposeStop      {-# INLINE initHangul #-}-    initHangul c st = ComposeJamo (Hangul c) st+    initHangul c = ComposeJamo (Hangul c)      {-# INLINE initJamo #-}-    initJamo c st = ComposeJamo (Jamo c) st+    initJamo c = ComposeJamo (Jamo c)      {-# INLINE initReg #-}-    initReg !c st = ComposeReg 0 [c] st+    initReg !c = ComposeReg 0 [c]      {-# INLINE composeNone #-}     composeNone ch st@@ -315,5 +320,9 @@ normalizeD NFC = partialComposeD . decomposeD False Canonical normalizeD NFKC = partialComposeD . decomposeD False Kompat -normalize :: (IsStream t, Monad m) => NormalizationMode -> t m Char -> t m Char-normalize mode = fromStreamD . normalizeD mode  . toStreamD+normalize ::+       Monad m+    => NormalizationMode+    -> Stream m Char+    -> Stream m Char+normalize = normalizeD
− src/Streamly/Internal/Unicode/Char/Parser.hs 
@@ -1,214 +0,0 @@--- |--- Module      : Streamly.Internal.Unicode.Char.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.---- XXX Add explicit export list.-module Streamly.Internal.Unicode.Char.Parser-    ( alpha-    , alphaNum-    , ascii-    , asciiLower-    , asciiUpper-    , char-    , decimal-    , digit-    , double-    , hexadecimal-    , hexDigit-    , latin1-    , letter-    , lower-    , mark-    , number-    , octDigit-    , print-    , punctuation-    , separator-    , signed-    , space-    , symbol-    , upper-    )-where--import Control.Applicative (Alternative(..))-import Control.Monad.Catch (MonadCatch)-import Data.Bits (Bits, (.|.), shiftL)-import Data.Char (ord)-import Prelude hiding (print)-import Streamly.Internal.Data.Parser (Parser)--import qualified Data.Char as Char-import qualified Streamly.Internal.Data.Parser as Parser-import qualified Streamly.Internal.Data.Fold as Fold------------------------------------------------------------------------------------- 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.Char.Parser.Latin1.----#define CHAR_PARSER_SIG(NAME)         NAME :: MonadCatch m => Parser m Char Char--- XXX Need to use the predicates from Unicode.Char module/unicode-data package-#define CHAR_PARSER(NAME, PREDICATE)  NAME = Parser.satisfy Char.PREDICATE---- XXX Add haddock documentation--- XXX Add INLINE pragmas--CHAR_PARSER_SIG(space)-CHAR_PARSER(space,isSpace)--CHAR_PARSER_SIG(lower)-CHAR_PARSER(lower,isLower)--CHAR_PARSER_SIG(upper)-CHAR_PARSER(upper,isUpper)--CHAR_PARSER_SIG(alpha)-CHAR_PARSER(alpha,isAlpha)--CHAR_PARSER_SIG(alphaNum)-CHAR_PARSER(alphaNum,isAlphaNum)--CHAR_PARSER_SIG(print)-CHAR_PARSER(print,isPrint)--CHAR_PARSER_SIG(digit)-CHAR_PARSER(digit,isDigit)--CHAR_PARSER_SIG(octDigit)-CHAR_PARSER(octDigit,isOctDigit)--CHAR_PARSER_SIG(hexDigit)-CHAR_PARSER(hexDigit,isHexDigit)--CHAR_PARSER_SIG(letter)-CHAR_PARSER(letter,isLetter)--CHAR_PARSER_SIG(mark)-CHAR_PARSER(mark,isMark)--CHAR_PARSER_SIG(number)-CHAR_PARSER(number,isNumber)--CHAR_PARSER_SIG(punctuation)-CHAR_PARSER(punctuation,isPunctuation)--CHAR_PARSER_SIG(symbol)-CHAR_PARSER(symbol,isSymbol)--CHAR_PARSER_SIG(separator)-CHAR_PARSER(separator,isSeparator)--CHAR_PARSER_SIG(ascii)-CHAR_PARSER(ascii,isAscii)--CHAR_PARSER_SIG(latin1)-CHAR_PARSER(latin1,isLatin1)--CHAR_PARSER_SIG(asciiUpper)-CHAR_PARSER(asciiUpper,isAsciiUpper)--CHAR_PARSER_SIG(asciiLower)-CHAR_PARSER(asciiLower,isAsciiLower)------------------------------------------------------------------------------------- Character parsers------------------------------------------------------------------------------------- | Match a specific character.-{-# INLINE char #-}-char :: MonadCatch m => Char -> Parser m Char Char-char c = Parser.satisfy (== c)------------------------------------------------------------------------------------- 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 :: (MonadCatch m, Integral a) => Parser m Char 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 :: (MonadCatch m, Integral a, Bits a) => Parser m Char 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, MonadCatch m) => Parser m Char a -> Parser m Char 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 m Char Double-double = undefined
− src/Streamly/Internal/Unicode/Stream.hs 
@@ -1,1082 +0,0 @@--- |--- 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-    , decodeUtf8Arrays-    , decodeUtf8Arrays'-    , decodeUtf8Arrays_--    -- * Elimination (Encoding)-    -- ** Latin1 Encoding-    , encodeLatin1-    , encodeLatin1'-    , encodeLatin1_--    -- ** UTF-8 Encoding-    , 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-    , decodeUtf8ArraysD-    , decodeUtf8ArraysD'-    , decodeUtf8ArraysD_--    -- * Deprecations-    , decodeUtf8Lax-    , encodeLatin1Lax-    , encodeUtf8Lax-    )-where--#include "inline.hs"--import Control.Monad.Catch (MonadThrow, MonadCatch)-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Bits (shiftR, shiftL, (.|.), (.&.))-import Data.Char (chr, ord)-import Data.Word (Word8)-import Foreign.Storable (Storable(..))-import Fusion.Plugin.Types (Fuse(..))-import GHC.Base (assert, unsafeChr)-import GHC.IO.Encoding.Failure (isSurrogate)-import GHC.Ptr (Ptr (..), plusPtr)-import System.IO.Unsafe (unsafePerformIO)-import Streamly.Internal.Data.Array.Foreign (Array)-import Streamly.Internal.Data.Array.Foreign.Mut.Type (ArrayContents, touch)-import Streamly.Internal.Data.Fold (Fold)-import Streamly.Internal.Data.Stream.IsStream.Type-    (IsStream, fromStreamD, toStreamD, adapt)-import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))-import Streamly.Internal.Data.SVar (adaptState)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (unsafeInlineIO)--import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Streamly.Internal.Data.Parser as Parser-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD-import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK-import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Array.Foreign.Type as A-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.StreamD as D--import Prelude hiding (lines, words, unlines, unwords)---- $setup--- >>> :m--- >>> import Prelude hiding (lines, words, unlines, unwords)--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> 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.------ /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/------ @since 0.8.0-{-# INLINE decodeLatin1 #-}-decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char-decodeLatin1 = S.map (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.------ @since 0.8.0-{-# INLINE encodeLatin1' #-}-encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8-encodeLatin1' = S.map 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.------ /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/------ /Since: 0.8.0 (Lenient Behaviour)/-{-# INLINE encodeLatin1 #-}-encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8-encodeLatin1 = S.map (fromIntegral . ord)---- | Like 'encodeLatin1' but drops the input characters beyond 255.------ @since 0.8.0-{-# INLINE encodeLatin1_ #-}-encodeLatin1_ :: (IsStream t, Monad m) => t m Char -> t m Word8-encodeLatin1_ = S.map (fromIntegral . ord) . S.filter (<= chr 255)---- | Same as 'encodeLatin1'----{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}-{-# INLINE encodeLatin1Lax #-}-encodeLatin1Lax :: (IsStream t, Monad m) => t m Char -> t 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-  ]--{-# NOINLINE utf8d #-}-utf8d :: A.Array Word8-utf8d =-      unsafePerformIO-    -- Aligning to cacheline makes a barely noticeable difference-    -- XXX currently alignment is not implemented for unmanaged allocation-    $ D.fold (A.writeNAlignedUnmanaged 64 (length decodeTable))-              (D.fromList decodeTable)---- | 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---- 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--    utf8table =-        let end = table `plusPtr` 364-        in A.Array undefined table end :: A.Array Word8-    showByte = "Streamly: decode0: byte: " ++ show byte-    showTable = " table: " ++ show utf8table---- 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--    utf8table =-        let end = table `plusPtr` 364-        in A.Array undefined table end :: A.Array Word8-    showByte = "Streamly: decode1: byte: " ++ show byte-    showState st cp =-        " state: " ++ show st ++-        " codepoint: " ++ show cp ++-        " table: " ++ show utf8table------------------------------------------------------------------------------------ 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-    -> Stream m Word8-    -> Stream m (Either DecodeError Char)-resumeDecodeUtf8EitherD dst codep (Stream step state) =-    let A.Array _ p _ = utf8d-        !ptr = p-        stt =-            if dst == 0-            then UTF8DecodeInit state-            else UTF8Decoding state dst codep-    in Stream (step' ptr) 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-    => Stream m Word8 -> Stream m (Either DecodeError Char)-decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0---- |------ /Pre-release/-{-# INLINE decodeUtf8Either #-}-decodeUtf8Either :: (Monad m, IsStream t)-    => t m Word8 -> t m (Either DecodeError Char)-decodeUtf8Either = fromStreamD . decodeUtf8EitherD . toStreamD---- |------ /Pre-release/-{-# INLINE resumeDecodeUtf8Either #-}-resumeDecodeUtf8Either-    :: (Monad m, IsStream t)-    => DecodeState-    -> CodePoint-    -> t m Word8-    -> t m (Either DecodeError Char)-resumeDecodeUtf8Either st cp =-    fromStreamD . resumeDecodeUtf8EitherD st cp . toStreamD------------------------------------------------------------------------------------ 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 m Word8 Char-parseCharUtf8WithD cfm =-    let A.Array _ ptr _ = utf8d-    in ParserD.Parser (step' ptr) 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 _ = 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' :: MonadThrow 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 ::-       MonadCatch m => CodingFailureMode -> Parser.Parser m Word8 Char-parseCharUtf8With = ParserK.toParserK . 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 -> Stream m Word8 -> Stream m Char-decodeUtf8WithD cfm (Stream step state) =-    let A.Array _ ptr _ = utf8d-    in Stream (step' ptr) (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 => Stream m Word8 -> 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.------ /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/------ /Since: 0.8.0 (Lenient Behaviour)/-{-# INLINE decodeUtf8 #-}-decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char-decodeUtf8 = fromStreamD . decodeUtf8D . toStreamD--{-# INLINE decodeUtf8D' #-}-decodeUtf8D' :: Monad m => Stream m Word8 -> 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.------ @since 0.8.0-{-# INLINE decodeUtf8' #-}-decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char-decodeUtf8' = fromStreamD . decodeUtf8D' . toStreamD--{-# INLINE decodeUtf8D_ #-}-decodeUtf8D_ :: Monad m => Stream m Word8 -> Stream m Char-decodeUtf8D_ = decodeUtf8WithD DropOnCodingFailure---- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.--- Any invalid codepoint encountered is dropped.------ @since 0.8.0-{-# INLINE decodeUtf8_ #-}-decodeUtf8_ :: (Monad m, IsStream t) => t m Word8 -> t m Char-decodeUtf8_ = fromStreamD . decodeUtf8D_ . toStreamD---- | Same as 'decodeUtf8'----{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}-{-# INLINE decodeUtf8Lax #-}-decodeUtf8Lax :: (IsStream t, Monad m) => t m Word8 -> t m Char-decodeUtf8Lax = decodeUtf8------------------------------------------------------------------------------------ Decoding Array Streams----------------------------------------------------------------------------------#ifndef __GHCJS__-{-# ANN type FlattenState Fuse #-}-#endif-data FlattenState s a-    = OuterLoop s !(Maybe (DecodeState, CodePoint))-    | InnerLoopDecodeInit s ArrayContents !(Ptr a) !(Ptr a)-    | InnerLoopDecodeFirst s ArrayContents !(Ptr a) !(Ptr a) Word8-    | InnerLoopDecoding s ArrayContents !(Ptr a) !(Ptr a)-        !DecodeState !CodePoint-    | YAndC !Char (FlattenState s a) -- 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-    -> Stream m (A.Array Word8)-    -> Stream m Char-decodeUtf8ArraysWithD cfm (Stream step state) =-    let A.Array _ ptr _ = utf8d-    in Stream (step' ptr) (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 A.Array {..} s ->-                     Skip (InnerLoopDecodeInit s arrContents arrStart aEnd)-                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 A.Array {..} s ->-                     Skip (InnerLoopDecoding s arrContents arrStart aEnd ds cp)-                Skip s -> Skip (OuterLoop s dst)-                Stop -> Skip inputUnderflow-    step' _ _ (InnerLoopDecodeInit st startf p end)-        | p == end = do-            liftIO $ touch startf-            return $ Skip $ OuterLoop st Nothing-    step' _ _ (InnerLoopDecodeInit st startf p end) = do-        x <- liftIO $ peek 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 startf (p `plusPtr` 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 startf p end x--    step' table _ (InnerLoopDecodeFirst st startf 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 startf (p `plusPtr` 1) end)-                0 -> error "unreachable state"-                _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)-    step' _ _ (InnerLoopDecoding st startf p end sv cp)-        | p == end = do-            liftIO $ touch startf-            return $ Skip $ OuterLoop st (Just (sv, cp))-    step' table _ (InnerLoopDecoding st startf p end statePtr codepointPtr) = do-        x <- liftIO $ peek p-        let (Tuple' sv cp) = decode1 table statePtr codepointPtr x-        return $-            case sv of-                0 ->-                    Skip $-                    YAndC-                        (unsafeChr cp)-                        (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)-                12 ->-                    Skip $-                    transliterateOrError-                        (-                           "Streamly.Internal.Data.Stream.StreamD."-                        ++ "decodeUtf8ArraysWith: Invalid UTF8"-                        ++ " codepoint encountered"-                        )-                        (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)-                _ ->-                    Skip-                    (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)-    step' _ _ (YAndC c s) = return $ Yield c s-    step' _ _ D = return Stop--{-# INLINE decodeUtf8ArraysD #-}-decodeUtf8ArraysD ::-       MonadIO m-    => Stream m (A.Array Word8)-    -> Stream m Char-decodeUtf8ArraysD = decodeUtf8ArraysWithD TransliterateCodingFailure---- |------ /Pre-release/-{-# INLINE decodeUtf8Arrays #-}-decodeUtf8Arrays ::-       (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char-decodeUtf8Arrays =-    fromStreamD . decodeUtf8ArraysD . toStreamD--{-# INLINE decodeUtf8ArraysD' #-}-decodeUtf8ArraysD' ::-       MonadIO m-    => Stream m (A.Array Word8)-    -> Stream m Char-decodeUtf8ArraysD' = decodeUtf8ArraysWithD ErrorOnCodingFailure---- |------ /Pre-release/-{-# INLINE decodeUtf8Arrays' #-}-decodeUtf8Arrays' :: (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char-decodeUtf8Arrays' = fromStreamD . decodeUtf8ArraysD' . toStreamD--{-# INLINE decodeUtf8ArraysD_ #-}-decodeUtf8ArraysD_ ::-       MonadIO m-    => Stream m (A.Array Word8)-    -> Stream m Char-decodeUtf8ArraysD_ = decodeUtf8ArraysWithD DropOnCodingFailure---- |------ /Pre-release/-{-# INLINE decodeUtf8Arrays_ #-}-decodeUtf8Arrays_ ::-       (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char-decodeUtf8Arrays_ =-    fromStreamD . decodeUtf8ArraysD_ . toStreamD------------------------------------------------------------------------------------ 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 => Stream m Char -> 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.------ @since 0.8.0-{-# INLINE encodeUtf8' #-}-encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8-encodeUtf8' = fromStreamD . encodeUtf8D' . toStreamD--{-# 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 => Stream m Char -> 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.------ /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/------ /Since: 0.8.0 (Lenient Behaviour)/-{-# INLINE encodeUtf8 #-}-encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8-encodeUtf8 = fromStreamD . encodeUtf8D . toStreamD--{-# INLINE_NORMAL readCharUtf8_ #-}-readCharUtf8_ :: Monad m => Unfold m Char Word8-readCharUtf8_ = readCharUtf8With WNil--{-# INLINE_NORMAL encodeUtf8D_ #-}-encodeUtf8D_ :: Monad m => Stream m Char -> 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.------ @since 0.8.0-{-# INLINE encodeUtf8_ #-}-encodeUtf8_ :: (Monad m, IsStream t) => t m Char -> t m Word8-encodeUtf8_ = fromStreamD . encodeUtf8D_ . toStreamD---- | Same as 'encodeUtf8'----{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}-{-# INLINE encodeUtf8Lax #-}-encodeUtf8Lax :: (IsStream t, Monad m) => t m Char -> t m Word8-encodeUtf8Lax = encodeUtf8------------------------------------------------------------------------------------ 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 =>-       (SerialT m Char -> SerialT m Word8)-    -> Unfold m a Char-    -> a-    -> m (Array Word8)-encodeObject encode u = S.fold Array.write . encode . S.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, IsStream t) =>-       (SerialT m Char -> SerialT m Word8)-    -> Unfold m a Char-    -> t m a-    -> t m (Array Word8)-encodeObjects encode u = adapt . Serial.mapM (encodeObject encode u) . adapt---- | Encode a stream of 'String' using the supplied encoding scheme. Each--- string is encoded as an @Array Word8@.------ @since 0.8.0-{-# INLINE encodeStrings #-}-encodeStrings :: (MonadIO m, IsStream t) =>-    (SerialT m Char -> SerialT m Word8) -> t m String -> t m (Array Word8)-encodeStrings encode = encodeObjects encode Unfold.fromList--{------------------------------------------------------------------------------------ Utility operations on strings----------------------------------------------------------------------------------strip :: IsStream t => t m Char -> t m Char-strip = undefined--stripTail :: IsStream t => t m Char -> t m Char-stripTail = undefined--}---- | Remove leading whitespace from a string.------ > stripHead = S.dropWhile isSpace------ /Pre-release/-{-# INLINE stripHead #-}-stripHead :: (Monad m, IsStream t) => t m Char -> t m Char-stripHead = S.dropWhile isSpace---- | Fold each line of the stream using the supplied 'Fold'--- and stream the result.------ >>> Stream.toList $ lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")--- ["lines","this","string","",""]------ > lines = S.splitOnSuffix (== '\n')------ /Pre-release/-{-# INLINE lines #-}-lines :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b-lines = S.splitOnSuffix (== '\n')--foreign import ccall unsafe "u_iswspace"-  iswspace :: Int -> Int---- | 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-  | otherwise = iswspace (ord c) /= 0-  where-    uc = fromIntegral (ord c) :: Word---- | Fold each word of the stream using the supplied 'Fold'--- and stream the result.------ >>>  Stream.toList $ words Fold.toList (Stream.fromList "fold these     words")--- ["fold","these","words"]------ > words = S.wordsBy isSpace------ /Pre-release/-{-# INLINE words #-}-words :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b-words = S.wordsBy isSpace---- | 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, IsStream t) => Unfold m a Char -> t m a -> t m Char-unlines = S.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, IsStream t) => Unfold m a Char -> t m a -> t m Char-unwords = S.interpose ' '
src/Streamly/Internal/Unicode/Utf8.hs view
@@ -5,7 +5,12 @@ -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC---++-- XXX We can move this to stream-core/streamly-unicode-core, and provide an+-- additional module in streamly-unicode for case conversions (because it+-- depends on unicode-data). Or just keep all of it in streamly-unicode+-- which will have a dependency on unicode-data.+ module Streamly.Internal.Unicode.Utf8     (     -- * Type@@ -22,13 +27,16 @@ -- Imports -------------------------------------------------------------------------------- -import Control.DeepSeq (NFData) import Data.Word (Word8)-import Streamly.Internal.Data.Array.Foreign.Type (Array)+import Streamly.Data.Array (Array) import System.IO.Unsafe (unsafePerformIO) -import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Stream.IsStream as Stream+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Array as Array+    ( fromStreamN+    , read+    ) import qualified Streamly.Internal.Unicode.Stream as Unicode  --------------------------------------------------------------------------------@@ -36,9 +44,7 @@ --------------------------------------------------------------------------------  -- | A space efficient, packed, unboxed Unicode container.-newtype Utf8 =-    Utf8 (Array Word8)-    deriving (NFData)+newtype Utf8 = Utf8 (Array Word8)  -------------------------------------------------------------------------------- -- Functions@@ -64,4 +70,4 @@ unpack :: Utf8 -> String unpack u =     unsafePerformIO-        $ Stream.toList $ Unicode.decodeUtf8' $ Array.toStream $ toArray u+        $ Stream.fold Fold.toList $ Unicode.decodeUtf8' $ Array.read $ toArray u
− src/Streamly/Memory/Array.hs 
@@ -1,74 +0,0 @@-#include "inline.hs"---- |--- Module      : Streamly.Memory.Array--- Copyright   : (c) 2019 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ This module provides immutable arrays in pinned memory (non GC memory)--- suitable for long lived data storage, random access and for interfacing with--- the operating system.------ Arrays in this module are chunks of pinned memory that hold a sequence of--- 'Storable' values of a given type, they cannot store non-serializable data--- like functions.  Once created an array cannot be modified.  Pinned memory--- allows efficient buffering of long lived data without adding any impact to--- GC. One array is just one pointer visible to GC and it does not have to be--- copied across generations.  Moreover, pinned memory allows communication--- with foreign consumers and producers (e.g. file or network IO) without--- copying the data.------ = Programmer Notes------ To apply a transformation to an array use 'read' to unfold the array into a--- stream, apply a transformation on the stream and then use 'write' to fold it--- back to an array.------ This module is designed to be imported qualified:------ > import qualified Streamly.Array as A------ For experimental APIs see "Streamly.Internal.Data.Array.Foreign".--module Streamly.Memory.Array-    {-# DEPRECATED "Use Streamly.Data.Array.Foreign instead" #-}-    (-      A.Array--    -- * Arrays-    -- ** 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)--    -- ** Elimination-    -- 'GHC.Exts.toList' from "GHC.Exts" can be used to convert an array to a-    -- list.--    , A.toList-    , A.read--    -- ** Random Access-    , A.length-    -- , (!!)-    -- , A.readIndex-    )-where--import Streamly.Internal.Data.Array.Foreign as A
src/Streamly/Network/Inet/TCP.hs view
@@ -7,25 +7,60 @@ -- Stability   : released -- Portability : GHC ----- Combinators to build Inet/TCP clients and servers.+-- Combinators to build Inet\/IPv4/TCP clients and servers. ----- > import qualified Streamly.Network.Inet.TCP as TCP+-- >>> import qualified Streamly.Network.Inet.TCP as TCP --+-- = Examples+--+-- Following is a short example of a concurrent echo server.+--+-- >>> import Control.Monad.Catch (finally)+-- >>> import Data.Function ((&))+-- >>> import Network.Socket (Socket)+-- >>>+-- >>> import qualified Network.Socket as Net+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream+-- >>> import qualified Streamly.Network.Inet.TCP as TCP+-- >>> import qualified Streamly.Network.Socket as Socket+-- >>>+-- >>> :{+-- main :: IO ()+-- main =+--       TCP.accept 8091                            -- Stream IO Socket+--     & Stream.parMapM id (handleExceptions echo)  -- Stream IO ()+--     & Stream.fold Fold.drain                     -- IO ()+--     where+--     echo :: Socket -> IO ()+--     echo sk =+--           Socket.readChunksWith 32768 sk      -- Stream IO (Array Word8)+--         & Stream.fold (Socket.writeChunks sk) -- IO ()+--     handleExceptions :: (Socket -> IO ()) -> Socket -> IO ()+--     handleExceptions f sk = finally (f sk) (Net.close sk)+-- :}  module Streamly.Network.Inet.TCP     (     -- * Accept Connections-      acceptOnAddr-    , acceptOnPort-    , acceptOnPortLocal+    -- ** Streams+      accept+    , acceptLocal+    , acceptOnAddr+    , acceptOnAddrWith +    -- ** Unfolds+    , acceptor+    , acceptorLocal+    , acceptorOnAddr+     -- * Connect to Servers     , connect      {-     -- XXX Expose this as a pipe when we have pipes.     -- * Transformation-    -- , processBytes+    -- , pipeBytes      -- ** Sink Servers @@ -47,6 +82,10 @@     , datagrams     , datagramsOn     -}++    -- * Deprecated+    , acceptorOnPort+    , acceptorOnPortLocal     ) where
src/Streamly/Network/Socket.hs view
@@ -7,18 +7,17 @@ -- Stability   : released -- Portability : GHC ----- This module provides Array and stream based socket operations to connect to--- remote hosts, to receive connections from remote hosts, and to read and--- write streams and arrays of bytes to and from network sockets.+-- This module provides socket based streaming APIs to to receive connections+-- from remote hosts, and to read and write from and to network sockets. ----- For basic socket types and operations please consult the @Network.Socket@+-- For basic socket types and non-streaming operations please consult the @Network.Socket@ -- module of the <http://hackage.haskell.org/package/network network> package. -- -- = Examples ----- To write a server, use the 'accept' unfold to start listening for--- connections from clients.  'accept' supplies a stream of connected sockets.--- We can map an effectful action on this socket stream to handle the+-- To write a server, use the 'accept' stream to start listening for+-- connections from clients.  'accept' generates a stream of connected+-- sockets. We can map an effectful action on this socket stream to handle the -- connections. The action would typically use socket reading and writing -- operations to communicate with the remote host. We can read/write a stream -- of bytes or a stream of chunks of bytes ('Array').@@ -27,48 +26,46 @@ -- this example can be written even more succinctly by using higher level -- operations from "Streamly.Network.Inet.TCP" module. ----- @--- {-\# LANGUAGE FlexibleContexts #-}------ import Data.Function ((&))--- import Network.Socket--- import Streamly.Network.Socket (SockSpec(..))------ import qualified Streamly.Prelude as Stream--- import qualified Streamly.Network.Socket as Socket------ main = do---     let spec = SockSpec---                { sockFamily = AF_INET---                , sockType   = Stream---                , sockProto  = defaultProtocol---                , sockOpts   = []---                }---         addr = SockAddrInet 8090 (tupleToHostAddress (0,0,0,0))---      in server spec addr------     where------     server spec addr =---           Stream.unfold Socket.accept (maxListenQueue, spec, addr) -- ParallelT IO Socket---         & Stream.mapM (Socket.forSocketM echo)                     -- ParallelT IO ()---         & Stream.fromParallel                                      -- SerialT IO ()---         & Stream.drain                                             -- IO ()------     echo sk =---           Stream.unfold Socket.readChunks sk  -- SerialT IO (Array Word8)---         & Stream.fold (Socket.writeChunks sk) -- IO ()--- @+-- >>> :set -XFlexibleContexts+-- >>>+-- >>> import Data.Function ((&))+-- >>> import Network.Socket+-- >>> import Streamly.Network.Socket (SockSpec(..))+-- >>>+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream+-- >>> import qualified Streamly.Network.Socket as Socket+-- >>>+-- >>> :{+--  main :: IO ()+--  main = do+--       let spec = SockSpec+--                  { sockFamily = AF_INET+--                  , sockType   = Stream+--                  , sockProto  = defaultProtocol+--                  , sockOpts   = []+--                  }+--           addr = SockAddrInet 8090 (tupleToHostAddress (0,0,0,0))+--        in server spec addr+--       where+--       server spec addr =+--             Socket.accept maxListenQueue spec addr+--           & Stream.parMapM (Stream.eager True) (Socket.forSocketM echo)+--           & Stream.fold Fold.drain+--       echo sk =+--             Socket.readChunks sk -- Stream IO (Array Word8)+--           & Stream.fold (Socket.writeChunks sk) -- IO ()+-- :} -- -- = Programmer Notes -- -- Read IO requests to connected stream sockets are performed in chunks of--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize'.  Unless+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'.  Unless -- specified otherwise in the API, writes are collected into chunks of--- 'Streamly.Internal.Data.Array.Foreign.Type.defaultChunkSize' before they are--- written to the socket. APIs are provided to control the chunking behavior.+-- 'Streamly.Internal.System.IO.defaultChunkSize' before they are written to+-- the socket. ----- > import qualified Streamly.Network.Socket as Socket+-- >>> import qualified Streamly.Network.Socket as Socket -- -- = See Also --@@ -98,25 +95,61 @@      -- * Accept Connections     , accept+    , acceptor -    -- * Read+    -- * Reads+    -- ** Singleton+    , getChunk++    -- ** Streams     , read-    , readWithBufferOf+    , readWith     , readChunks-    , readChunksWithBufferOf-    , readChunk+    , readChunksWith -    -- * Write+    -- ** Unfolds+    , reader+    , readerWith+    , chunkReader+    , chunkReaderWith++    -- * Writes+    -- ** Singleton+    , putChunk++    -- ** Folds     , write-    , writeWithBufferOf+    , writeWith     , writeChunks-    , writeChunksWithBufferOf-    , writeChunk+    , writeChunksWith      -- * Exceptions     , forSocketM++    -- * Deprecated+    , readChunk+    , writeChunk+    , readWithBufferOf+    , readChunksWithBufferOf+    , writeWithBufferOf+    , writeChunksWithBufferOf     ) where +import Data.Word (Word8)+import Network.Socket (Socket)+import Streamly.Data.Array (Array)+import Streamly.Data.MutByteArray (Unbox)+ import Streamly.Internal.Network.Socket import Prelude hiding (read)++{-# DEPRECATED readChunk "Please use 'getChunk' instead" #-}+{-# INLINABLE readChunk #-}+readChunk :: Int -> Socket -> IO (Array Word8)+readChunk = getChunk++{-# DEPRECATED writeChunk "Please use 'putChunk' instead" #-}+{-# INLINABLE writeChunk #-}+writeChunk :: Unbox a => Socket -> Array a -> IO ()+writeChunk = putChunk
src/Streamly/Prelude.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-deprecations #-}  #include "inline.hs" @@ -318,6 +318,7 @@ -- performance reasons.  module Streamly.Prelude+{-# DEPRECATED "Please use \"Streamly.Data.Stream.Prelude\" from streamly package and \"Streamly.Data.Fold\" from streamly-core package instead." #-}     (     -- * Construction     -- | Functions ending in the general shape @b -> t m a@.@@ -904,6 +905,12 @@     -- * Type Synonyms     , MonadAsync +    -- * Converting from/to Stream/StreamK types+    , fromStream+    , toStream+    , fromStreamK+    , toStreamK+     -- * Stream Type Adapters     -- $adapters     , IsStream ()@@ -919,10 +926,8 @@     , adapt      -- * Deprecated-    , once     , yield     , yieldM-    , each     , scanx     , foldx     , foldxM@@ -938,15 +943,16 @@  import Streamly.Internal.Control.Concurrent (MonadAsync) 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, (!!),+       hiding (Foldable(..), filter, drop, dropWhile, take, takeWhile, zipWith,+               map, mapM, mapM_, sequence, all, any,+               notElem, head, last, tail,+               reverse, iterate, init, and, or, lookup, (!!),                scanl, scanl1, repeat, replicate, concatMap, span)  import Streamly.Internal.Data.Stream.IsStream  -- $setup+-- >>> :set -fno-warn-deprecations -- >>> import qualified Streamly.Data.Fold as Fold -- >>> import qualified Streamly.Prelude as Stream @@ -991,7 +997,7 @@  -- $rightfolds ----- Let's take a closer look at the @foldr@ definition for lists, as given3+-- Let's take a closer look at the @foldr@ definition for lists, as given -- earlier: -- -- @
− src/Streamly/Unicode/Stream.hs 
@@ -1,107 +0,0 @@--- |--- 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.Foreign.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.Prelude.fromList'.  An @Array--- Char@ can be 'Streamly.Prelude.unfold'ed into a stream using the array--- 'Streamly.Data.Array.Foreign.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.Prelude.toList' or using the--- '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.Prelude.fold' the 'Char'--- stream as @Array Char@ using the array 'Streamly.Data.Array.Foreign.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------ @SerialT 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.Char".---- 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'--    -- * 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/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
@@ -1,62 +1,29 @@ /* 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 declaration of `IN_EXCL_UNLINK', and to 0 if+/* Define to 1 if you have the declaration of 'IN_EXCL_UNLINK', and to 0 if    you don't. */ #undef HAVE_DECL_IN_EXCL_UNLINK -/* Define to 1 if you have the declaration of `IN_MASK_CREATE', and to 0 if+/* Define to 1 if you have the declaration of 'IN_MASK_CREATE', and to 0 if    you don't. */ #undef HAVE_DECL_IN_MASK_CREATE  /* Define to 1 if you have the declaration of-   `kFSEventStreamCreateFlagFileEvents', and to 0 if you don't. */+   'kFSEventStreamCreateFlagFileEvents', and to 0 if you don't. */ #undef HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS  /* Define to 1 if you have the declaration of-   `kFSEventStreamCreateFlagFullHistory', and to 0 if you don't. */+   'kFSEventStreamCreateFlagFullHistory', and to 0 if you don't. */ #undef HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY  /* Define to 1 if you have the declaration of-   `kFSEventStreamEventFlagItemCloned', and to 0 if you don't. */+   'kFSEventStreamEventFlagItemCloned', and to 0 if you don't. */ #undef HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMCLONED  /* Define to 1 if you have the declaration of-   `kFSEventStreamEventFlagItemIsHardlink', and to 0 if you don't. */+   'kFSEventStreamEventFlagItemIsHardlink', and to 0 if you don't. */ #undef HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK -/* 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 @@ -74,8 +41,3 @@  /* 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/deprecation.h view
@@ -0,0 +1,9 @@+#define RENAME(_old, _new)                          \+{-# DEPRECATED _old "Please use _new instead." #-}; \+{-# INLINE _old #-}; \+_old = _new++#define RENAME_PRIME(_old, _new)                       \+{-# DEPRECATED _old "Please use _new' instead." #-}; \+{-# INLINE _old #-}; \+_old = _new'
+ src/doctest/DocTestDataFold.hs view
@@ -0,0 +1,19 @@+{- $setup+>>> :m+>>> :set -XFlexibleContexts+>>> import Control.Concurrent (threadDelay)+>>> import Data.List (sortOn)+>>> import Data.HashMap.Strict (HashMap)++>>> import Streamly.Data.Fold (Fold)+>>> import Streamly.Data.Stream (Stream)++>>> import qualified Data.HashMap.Strict as HM+>>> import qualified Streamly.Data.Fold.Prelude as Fold+>>> import qualified Streamly.Data.Stream.Prelude as Stream++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.Fold.Prelude as Fold+-}
+ src/doctest/DocTestDataScanl.hs view
@@ -0,0 +1,7 @@+{- $setup+>>> :m+>>> :set -XFlexibleContexts+>>> import Control.Concurrent (threadDelay)+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.Scanl.Prelude as Scanl+-}
src/inline.hs view
@@ -9,14 +9,14 @@ -- -- {-# INLINE_EARLY unfoldr #-} -- unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a--- unfoldr step seed = fromStreamS (S.unfoldr step seed)+-- 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.Stream m a```+-- 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
streamly.cabal view
@@ -1,43 +1,61 @@-cabal-version:      2.2+cabal-version:      2.4 name:               streamly-version:            0.8.2-synopsis:           Dataflow programming and declarative concurrency+version:            0.11.1+synopsis:           Streaming data pipelines with declarative concurrency description:-  Browse the documentation at https://streamly.composewell.com.+  For upgrading to streamly-0.9.0+ please read the+  <https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md Streamly-0.9.0 upgrade guide>.   .-  Streamly is a streaming framework to build reliable and scalable-  software systems from modular building blocks using dataflow-  programming and declarative concurrency.  Stream fusion optimizations-  in streamly result in high-performance, modular combinatorial-  programming.+  Streamly is a high-performance, beginner-friendly standard library+  for Haskell. It unifies streaming with list transformers and logic+  programming; unifies streaming with concurrency and reactive+  programming; unifies arrays with ring arrays, text, bytestring+  and vector use cases; unifies arrays with builders and binary+  serialization; generalizes parsers to any input type and unifies+  attoparsec, parsec use cases with better performance; provides+  streaming fileIO — all with a clean, consistent, well-integrated and+  streaming enabled API.   .-  Performance with simplicity:+  Streams are designed to have a list like interface — no steep+  learning curve, no complex types. Streamly is designed to build+  general purpose applications in a truly functional manner, from+  simple hello-world to advanced high-performance systems. The design+  emphasizes simplicity, modularity, and code reuse with minimal+  building blocks. Performance is on par with C, tuning is easy, and+  it’s hard to get it wrong.   .-  * Performance on par with C (<https://github.com/composewell/streaming-benchmarks Benchmarks>)-  * API close to standard Haskell lists (<https://github.com/composewell/streamly-examples Examples>)-  * Declarative concurrency with automatic scaling-  * Filesystem, fsnotify, network, and Unicode support included-  * More functionality provided via many ecosystem packages+  Streamly is serial by default, with seamless declarative concurrency+  that scales automatically when needed. It provides prompt and safe+  resource management, works well with other streaming libraries as well+  as core libraries like bytestring and text, and is backed by solid+  documentation.   .-  Unified and powerful abstractions:+  The @streamly@ package is built on top of the @streamly-core@ package+  and offers high-level capabilities such as concurrency, reactive+  programming, time-related combinators, lifted exceptions, and+  networking. It provides streaming with concurrency, and is a more+  powerful, higher-level and more expressive alternative to the @async@+  package.   .-  * Unifies unfolds, arrays, folds, and parsers with streaming-  * Unifies @Data.List@, @list-t@, and @logict@ with streaming-  * Unifies concurrency with standard streaming abstractions-  * Provides time-domain combinators for reactive programming-  * Interworks with bytestring and streaming libraries+  Performant. Unified. Modular. Powerful. Simple.+  .+  Learn more at <https://streamly.composewell.com the streamly website>.  homepage:            https://streamly.composewell.com bug-reports:         https://github.com/composewell/streamly/issues license:             BSD-3-Clause license-file:        LICENSE-tested-with:         GHC==8.0.2-                   , GHC==8.4.4-                   , GHC==8.6.5+tested-with:         GHC==8.6.5                    , GHC==8.8.4                    , GHC==8.10.7-                   , GHC==9.0.1-                   , GHC==9.2.1+                   , GHC==9.0.2+                   , GHC==9.2.8+                   , GHC==9.4.7+                   , GHC==9.6.3+                   , GHC==9.8.1+                   , GHC==9.10.3+                   , GHC==9.12.4+                   , GHC==9.14.1 author:              Composewell Technologies maintainer:          streamly@composewell.com copyright:           2017 Composewell Technologies@@ -49,76 +67,88 @@ build-type:          Configure  extra-source-files:+    bench-test-lib/bench-test-lib.cabal+    bench-test-lib/src/BenchTestLib/DirIO.hs     benchmark/*.hs-    benchmark/bench-report/BenchReport.hs-    benchmark/bench-report/bench-report.cabal-    benchmark/bench-report/bin/bench-runner.sh-    benchmark/bench-report/bin/build-lib.sh-    benchmark/bench-report/cabal.project+    benchmark/bench-runner/Main.hs+    benchmark/bench-runner/bench-runner.cabal     benchmark/Streamly/Benchmark/Data/*.hs+    benchmark/Streamly/Benchmark/Data/Scanl/*.hs+    benchmark/Streamly/Benchmark/Data/Fold/*.hs+    benchmark/Streamly/Benchmark/Data/Serialize/*.hs     benchmark/Streamly/Benchmark/Data/Array/Common.hs     benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs+    benchmark/Streamly/Benchmark/Data/Array/Generic.hs     benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs-    benchmark/Streamly/Benchmark/Data/Array/Foreign.hs-    benchmark/Streamly/Benchmark/Data/Array/Foreign/Mut.hs-    benchmark/Streamly/Benchmark/Data/Array/Prim.hs-    benchmark/Streamly/Benchmark/Data/Array/Prim/Pinned.hs-    benchmark/Streamly/Benchmark/Data/Array/Stream/Foreign.hs-    benchmark/Streamly/Benchmark/Data/Parser/*.hs+    benchmark/Streamly/Benchmark/Data/Array.hs+    benchmark/Streamly/Benchmark/Data/RingArray.hs+    benchmark/Streamly/Benchmark/Data/MutArray.hs+    benchmark/Streamly/Benchmark/Data/Array/Stream.hs+    benchmark/Streamly/Benchmark/Data/Fold/Window.hs     benchmark/Streamly/Benchmark/Data/Stream/*.hs+    benchmark/Streamly/Benchmark/Data/StreamK/*.hs     benchmark/Streamly/Benchmark/FileSystem/*.hs     benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs     benchmark/Streamly/Benchmark/Prelude/*.hs-    benchmark/Streamly/Benchmark/Prelude/Serial/*.hs     benchmark/Streamly/Benchmark/Unicode/*.hs     benchmark/lib/Streamly/Benchmark/*.hs     benchmark/lib/Streamly/Benchmark/Common/*.hs     benchmark/streamly-benchmarks.cabal-    bin/bench.sh-    bin/bench-config.sh     bin/mk-hscope.sh     bin/mk-tags.sh-    bin/targets.sh-    bin/test.sh     configure     configure.ac-    docs/*.hs-    docs/streamly-docs.cabal+    src/doctest/*.hs+    targets/streamly-targets.cabal+    targets/Targets.hs+    test/test-runner/Main.hs+    test/test-runner/test-runner.cabal++    -- This is duplicated     src/Streamly/Internal/Data/Stream/Instances.hs-    src/Streamly/Internal/Data/Stream/PreludeCommon.hs-    src/Streamly/Internal/Data/Time/Clock/config-clock.h-    src/Streamly/Internal/Data/Array/ArrayMacros.h-    src/Streamly/Internal/Data/Array/PrimInclude.hs-    src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs-    src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs+     src/Streamly/Internal/FileSystem/Event/Darwin.h+    src/assert.hs     src/config.h.in     src/inline.hs+    src/deprecation.h     test/Streamly/Test/Data/*.hs     test/Streamly/Test/Data/Array/CommonImports.hs     test/Streamly/Test/Data/Array/Common.hs-    test/Streamly/Test/Data/Array/Prim.hs-    test/Streamly/Test/Data/Array/Prim/Pinned.hs-    test/Streamly/Test/Data/Array/Foreign.hs-    test/Streamly/Test/Data/Array/Stream/Foreign.hs-    test/Streamly/Test/Data/Parser/ParserD.hs+    test/Streamly/Test/Data/Array/Generic.hs+    test/Streamly/Test/Data/Array.hs+    test/Streamly/Test/Data/MutArray.hs+    test/Streamly/Test/Data/RingArray.hs+    test/Streamly/Test/Data/Array/Stream.hs+    test/Streamly/Test/Data/Parser.hs+    test/Streamly/Test/Data/Parser/*.hs+    test/Streamly/Test/Data/ParserK.hs+    test/Streamly/Test/Data/Stream/*.hs     test/Streamly/Test/FileSystem/Event.hs     test/Streamly/Test/FileSystem/Event/Common.hs     test/Streamly/Test/FileSystem/Event/Darwin.hs     test/Streamly/Test/FileSystem/Event/Windows.hs     test/Streamly/Test/FileSystem/Event/Linux.hs-    test/Streamly/Test/FileSystem/Handle.hs+    test/Streamly/Test/FileSystem/*.hs     test/Streamly/Test/Network/Socket.hs     test/Streamly/Test/Network/Inet/TCP.hs     test/Streamly/Test/Prelude.hs     test/Streamly/Test/Prelude/*.hs     test/Streamly/Test/Unicode/*.hs+    test/Streamly/Test/Serialize/*.hs+    test/Streamly/Test/Data/Scanl/*.hs+    test/Streamly/Test/Data/Fold/*.hs     test/lib/Streamly/Test/Common.hs     test/lib/Streamly/Test/Prelude/Common.hs+    test/lib/Streamly/Test/Parser/Common.hs     test/streamly-tests.cabal     test/version-bounds.hs     test/Streamly/Test/Unicode/ucd/NormalizationTest.txt     test/Streamly/Test/Unicode/extra/NormalizationTest.txt+    test/Streamly/Test/Data/Unbox.hs+    test/Streamly/Test/Data/Unbox/*.hs+    test/Streamly/Test/Data/Serialize.hs+    test/Streamly/Test/Data/Serialize/*.hs     benchmark/Streamly/Benchmark/Unicode/data/AllChars.txt     benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txt     benchmark/Streamly/Benchmark/Unicode/data/Japanese.txt@@ -132,14 +162,24 @@     CHANGELOG.md     README.md     benchmark/README.md-    dev/*.md-    dev/*.png-    dev/*.rst     docs/*.md-    docs/*.link-    docs/*.rst-    docs/*.svg-    docs/API-changelog.txt+    docs/diagrams/module-diagram.hs+    docs/Developer/*.link+    docs/Developer/*.md+    docs/Developer/*.png+    docs/Developer/*.rst+    docs/User/*.md+    docs/User/Explanatory/*.md+    docs/User/Explanatory/streaming-pradigms.rst+    docs/User/HowTo/*.md+    docs/User/HowTo/*.svg+    docs/User/Project/*.link+    docs/User/Project/*.md+    docs/User/Project/ApiChangelogs/*.txt+    docs/User/Tutorials/*.md+    docs/User/Tutorials/*.link+    docs/User/Tutorials/*.svg+    docs/User/Tutorials/all-your-base.jpg     test/README.md  extra-tmp-files:@@ -167,8 +207,8 @@   manual: True   default: False -flag dev-  description: Development build+flag internal-dev+  description: DO NOT USE, ONLY FOR INTERNAL USE.   manual: True   default: False @@ -177,21 +217,6 @@   manual: True   default: False -flag no-fusion-  description: Disable rewrite rules for stream fusion-  manual: True-  default: False--flag streamk-  description: Use CPS style streams when possible-  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@@ -202,13 +227,8 @@   manual: True   default: False -flag streamly-core-  description: Build only the core modules-  manual: True-  default: False--flag use-unliftio-  description: Use unliftio-core instead of monad-control+flag internal-use-unliftio+  description: DO NOT USE, ONLY FOR INTERNAL USE.   manual: True   default: False @@ -217,8 +237,6 @@ -------------------------------------------------------------------------------  common compile-options-    default-language: Haskell2010-     if os(darwin)       cpp-options:    -DCABAL_OS_DARWIN @@ -228,50 +246,71 @@     if os(windows)       cpp-options:    -DCABAL_OS_WINDOWS -    if flag(streamk)-      cpp-options:    -DUSE_STREAMK_ONLY--    if flag(no-fusion)-      cpp-options:    -DDISABLE_FUSION--    if flag(dev)+    if flag(internal-dev)       cpp-options:    -DDEVBUILD      if flag(inspection)       cpp-options:    -DINSPECTION -    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 -    ghc-options:      -Wall-                      -Wcompat-                      -Wunrecognised-warning-flags-                      -Widentities-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wredundant-constraints-                      -Wnoncanonical-monad-instances-                      -Wmissing-export-lists-                      -Rghc-timing+    if impl(ghc >= 9.2)+      ghc-options:+        -Wno-missing-kind-signatures+        -Wno-redundant-bang-patterns+        -Wno-operator-whitespace +    if impl(ghc >= 9.8)+      ghc-options:+        -Wno-missing-role-annotations+     if flag(has-llvm)       ghc-options: -fllvm -    if flag(dev)+    if flag(internal-dev)       ghc-options:    -Wmissed-specialisations                       -Wall-missed-specialisations      if flag(limit-build-mem)         ghc-options: +RTS -M1000M -RTS -    if flag(use-unliftio)+    if flag(internal-use-unliftio)       cpp-options: -DUSE_UNLIFTIO  common default-extensions+    default-language: Haskell2010++    -- GHC2024 may include more extensions than we are actually using, see the+    -- full list below. We enable this to ensure that we are able to compile+    -- with this i.e. there is no interference by other extensions.++    -- Don't enforce GHC2024 and GHC2021 but We can support the build with them.++    -- if impl(ghc >= 9.10)+    --   default-language: GHC2024++    -- if impl(ghc >= 9.2) && impl(ghc < 9.10)+    --   default-language: GHC2021++    if impl(ghc >= 8.10)+      default-extensions:+        StandaloneKindSignatures++    -- In GHC 2024     default-extensions:         BangPatterns-        CApiFFI-        CPP         ConstraintKinds         DeriveDataTypeable         DeriveGeneric@@ -283,25 +322,38 @@         InstanceSigs         KindSignatures         LambdaCase-        MagicHash         MultiParamTypeClasses-        PatternSynonyms         RankNTypes-        RecordWildCards         ScopedTypeVariables         TupleSections         TypeApplications-        TypeFamilies-        ViewPatterns+        TypeOperators -        -- MonoLocalBinds, enabled by TypeFamilies, causes performance-        -- regressions. Disable it. This must come after TypeFamilies,-        -- otherwise TypeFamilies will enable it again.-        NoMonoLocalBinds+    -- Not in GHC2024+    default-extensions:+        CApiFFI+        CPP+        MagicHash+        RecordWildCards +        -- TypeFamilies -- required by IsHashMap type class++        -- MonoLocalBinds, enabled by TypeFamilies and GHC2024, was+        -- once found to cause runtime performance regressions which+        -- does not seem to be the case anymore, but need more testing+        -- to confirm.  It is confirmed that it requires more memory+        -- for compilation at least in some cases (Data.Fold.Window+        -- benchmark on GHC-9.10.1 macOS).  Disabling this must come+        -- after TypeFamilies, otherwise TypeFamilies will enable it+        -- again.+        -- NoMonoLocalBinds+         -- UndecidableInstances -- Does not show any perf impact         -- UnboxedTuples        -- interferes with (#.) +    if impl(ghc >= 8.6)+      default-extensions: QuantifiedConstraints+ common optimization-options   if flag(opt)     ghc-options: -O2@@ -310,8 +362,9 @@                  -fmax-worker-args=16    -- For this to be effective it must come after the -O2 option-  if flag(dev) || flag(debug) || !flag(opt)+  if flag(internal-dev) || flag(debug) || !flag(opt)     ghc-options: -fno-ignore-asserts+    cpp-options: -DDEBUG  common threading-options   ghc-options:  -threaded@@ -333,242 +386,145 @@ library     import: lib-options -    if impl(ghc >= 8.6)-      default-extensions: QuantifiedConstraints--    js-sources: jsbits/clock.js     include-dirs:           src+        , src/doctest         , src/Streamly/Internal/Data/Stream-        , src/Streamly/Internal/Data/Array -    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.HashMap                      , Streamly.Internal.Data.Cont-                     , Streamly.Internal.Foreign.Malloc-                     , 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.Channel+                     , Streamly.Internal.Data.Stream.MkType -                     -- XXX Depends on monad-control or unliftio-core+                     -- streamly-concurrent                      , Streamly.Internal.Control.Concurrent                      , Streamly.Internal.Control.ForkLifted-                     , Streamly.Internal.Data.IOFinalizer--                     -- streamly-time-                     , Streamly.Internal.Data.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.Stream.StreamDK.Type-                     , Streamly.Internal.Data.Unfold.Type-                     , Streamly.Internal.Data.Producer.Type-                     , Streamly.Internal.Data.Producer-                     , Streamly.Internal.Data.Producer.Source-                     , Streamly.Internal.Data.Sink.Type-                     , Streamly.Internal.Data.Parser.ParserK.Type-                     , Streamly.Internal.Data.Parser.ParserD.Type-                     , Streamly.Internal.Data.Pipe.Type--                     -- streamly-core-array-types-                    -- Unboxed IORef-                     -- XXX Depends on primitive-                     , Streamly.Internal.Data.IORef.Prim-                     -- May depend on streamly-core-stream-                     , Streamly.Internal.Data.Array.Foreign.Mut.Type-                     , Streamly.Internal.Data.Array.Foreign.Mut-                     , Streamly.Internal.Data.Array.Foreign.Type-                     , Streamly.Internal.Data.Array.Mut.Type+                     , Streamly.Internal.Data.Atomics+                     , Streamly.Internal.Data.IOFinalizer.Lifted -                     -- streamly-core-streams-                     -- 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-                     , Streamly.Internal.Data.Stream.StreamDK                      , Streamly.Internal.Data.Stream.Prelude--                     , Streamly.Internal.Data.Parser.ParserD.Tee-                     , Streamly.Internal.Data.Parser.ParserD+                     , Streamly.Internal.Data.Unfold.Prelude+                     , Streamly.Internal.Data.Fold.Prelude+                     , Streamly.Internal.Data.Scanl.Prelude -                     -- streamly-core-data-                     , Streamly.Internal.Data.Unfold-                     , Streamly.Internal.Data.Unfold.Enumeration-                     , Streamly.Internal.Data.Fold.Tee-                     , Streamly.Internal.Data.Fold-                     , Streamly.Internal.Data.Sink-                     , Streamly.Internal.Data.Parser-                     , Streamly.Internal.Data.Pipe-                     , Streamly.Internal.Data.Stream.Serial-                     , Streamly.Internal.Data.Stream.Zip-                     , Streamly.Internal.Data.List+                     -- streamly-unicode (depends on unicode-data)+                     , Streamly.Internal.Unicode.Utf8+                     , Streamly.Internal.Unicode.Char -                     -- streamly-core-data-arrays-                     -- XXX Depends on primitive-                     , Streamly.Internal.Data.Array-                     , Streamly.Internal.Data.Array.Foreign-                     , Streamly.Internal.Data.Array.Stream.Mut.Foreign-                     , Streamly.Internal.Data.Array.Stream.Fold.Foreign+                     -- streamly-network+                     , Streamly.Internal.Network.Socket+                     , Streamly.Internal.Network.Inet.TCP -                    -- Ring Arrays-                     , Streamly.Internal.Data.Ring.Foreign-                     -- XXX Depends on primitive-                     , Streamly.Internal.Data.Ring+                     -- Exposed modules+                     , Streamly.Data.Stream.MkType+                     , Streamly.Data.Stream.Prelude+                     , Streamly.Data.Fold.Prelude+                     , Streamly.Data.Scanl.Prelude -                     -- Only used for benchmarks-                     , Streamly.Internal.Data.Stream.StreamK+                     -- Network/IO+                     , Streamly.Network.Socket+                     , Streamly.Network.Inet.TCP -                     -- streamly-core exposed modules-                     , Streamly.Data.Fold-                     , Streamly.Data.Fold.Tee+                     -- Deprecated                      , Streamly.Data.Array.Foreign--    if !flag(streamly-core)-        exposed-modules:-                     -- XXX To be moved to streamly-core-                       Streamly.Data.Unfold--                     -- XXX To be removed or put under dev flag-                     , Streamly.Internal.Data.Array.Prim.Mut.Type-                     , Streamly.Internal.Data.Array.Prim.Type-                     , Streamly.Internal.Data.Array.Prim.Pinned.Mut.Type-                     , Streamly.Internal.Data.Array.Prim.Pinned.Type-                     , Streamly.Internal.Data.SmallArray.Type-                     , Streamly.Internal.Data.Array.Prim-                     , Streamly.Internal.Data.Array.Prim.Pinned-                     , Streamly.Internal.Data.SmallArray+                     , Streamly.Data.Fold.Tee+                     , Streamly.Prelude -                     -- streamly-concurrent-                     , Streamly.Internal.Data.Atomics-                     , Streamly.Internal.Data.SVar.Worker-                     , Streamly.Internal.Data.SVar.Dispatch-                     , Streamly.Internal.Data.SVar.Pull+                     -- Deprecated Internal modules                      , Streamly.Internal.Data.SVar--                     , Streamly.Internal.Data.Unfold.SVar-                     , Streamly.Internal.Data.Fold.SVar-                     , Streamly.Internal.Data.Fold.Async-                     , Streamly.Internal.Data.Stream.SVar.Generate-                     , Streamly.Internal.Data.Stream.SVar.Eliminate+                     , Streamly.Internal.Data.Stream.SVar +                     , Streamly.Internal.Data.Stream.Serial+                     , Streamly.Internal.Data.Stream.Zip                      , Streamly.Internal.Data.Stream.Async                      , Streamly.Internal.Data.Stream.Parallel                      , Streamly.Internal.Data.Stream.Ahead                      , Streamly.Internal.Data.Stream.ZipAsync -                     , Streamly.Internal.Data.Stream.IsStream.Type-                     , Streamly.Internal.Data.Stream.IsStream.Combinators-                     , Streamly.Internal.Data.Stream.IsStream.Common-                     , Streamly.Internal.Data.Stream.IsStream.Enumeration-                     , Streamly.Internal.Data.Stream.IsStream.Generate-                     , Streamly.Internal.Data.Stream.IsStream.Eliminate-                     , Streamly.Internal.Data.Stream.IsStream.Transform-                     , Streamly.Internal.Data.Stream.IsStream.Expand-                     , Streamly.Internal.Data.Stream.IsStream.Reduce-                     , Streamly.Internal.Data.Stream.IsStream.Exception-                     , Streamly.Internal.Data.Stream.IsStream.Lift-                     , Streamly.Internal.Data.Stream.IsStream.Top                      , Streamly.Internal.Data.Stream.IsStream -                     , Streamly.Internal.Data.Array.Stream.Foreign--                     -- streamly-serde-                     , Streamly.Internal.Data.Binary.Decode--                     -- streamly-unicode-                     , Streamly.Internal.Unicode.Stream-                     , Streamly.Internal.Unicode.Utf8-                     , Streamly.Internal.Unicode.Char-                     , Streamly.Internal.Unicode.Char.Parser-                     , Streamly.Internal.Unicode.Array.Char-                     , Streamly.Internal.Unicode.Array.Prim.Pinned--                     -- streamly-filesystem-                     , Streamly.Internal.System.IOVec.Type+    if !impl(ghcjs) && flag(internal-dev)+        other-modules:+                       Streamly.Internal.System.IOVec.Type                      , Streamly.Internal.System.IOVec-                     , Streamly.Internal.FileSystem.Handle-                     , Streamly.Internal.FileSystem.Dir-                     , Streamly.Internal.FileSystem.File                      , Streamly.Internal.FileSystem.FDIO                      , Streamly.Internal.FileSystem.FD -                     -- streamly-console-                     , Streamly.Internal.Console.Stdio+    if flag(internal-dev)+        exposed-modules: Streamly.Internal.Data.SmallArray+        -- Exposed modules show up on hackage irrespective of the flag, so keep+        -- it hidden.+        other-modules:  Streamly.Data.SmallArray+                      , Streamly.Internal.Data.SmallArray.Type -                     -- streamly-network-                     , Streamly.Internal.Network.Socket-                     , Streamly.Internal.Network.Inet.TCP+    if os(windows)+          exposed-modules: Streamly.Internal.FileSystem.Event.Windows -                     -- Exposed modules-                     , Streamly.Prelude+    if os(darwin)+          include-dirs:  src/Streamly/Internal+          c-sources: src/Streamly/Internal/FileSystem/Event/Darwin.c+          exposed-modules: Streamly.Internal.FileSystem.Event.Darwin -                     -- Text Processing-                     , Streamly.Unicode.Stream+    if os(linux)+          exposed-modules: Streamly.Internal.FileSystem.Event.Linux -                     -- Filesystem/IO-                     , Streamly.FileSystem.Handle-                     , Streamly.Console.Stdio+    if os(linux) || os(darwin) || os(windows)+          exposed-modules: Streamly.Internal.FileSystem.Event -                     -- Network/IO-                     , Streamly.Network.Socket-                     , Streamly.Network.Inet.TCP+    other-modules:+           Streamly.Internal.Data.Channel.Types+         , Streamly.Internal.Data.Channel.Dispatcher+         , Streamly.Internal.Data.Channel.Worker -                     -- Deprecated-                     , Streamly-                     , Streamly.Data.Unicode.Stream-                     , Streamly.Memory.Array+         , Streamly.Internal.Data.Stream.Channel.Type+         , Streamly.Internal.Data.Stream.Channel.Dispatcher+         , Streamly.Internal.Data.Stream.Channel.Consumer+         , Streamly.Internal.Data.Stream.Channel.Append+         , Streamly.Internal.Data.Stream.Channel.Interleave+         , Streamly.Internal.Data.Stream.Channel.Operations+         , Streamly.Internal.Data.Stream.Channel+         , Streamly.Internal.Data.Stream.Concurrent+         , Streamly.Internal.Data.Stream.Time+         , Streamly.Internal.Data.Stream.Lifted -        other-modules:-                       Streamly.Data.Array-                     , Streamly.Data.Prim.Array-                     , Streamly.Data.SmallArray+         , Streamly.Internal.Data.Fold.Time+         , Streamly.Internal.Data.Fold.Channel.Type+         , Streamly.Internal.Data.Fold.Channel+         , Streamly.Internal.Data.Fold.Concurrent+         , Streamly.Internal.Data.Scanl.Concurrent -        if os(windows)-          exposed-modules: Streamly.Internal.FileSystem.Event.Windows+         , Streamly.Internal.Data.Unfold.Exception+         , Streamly.Internal.Data.Unfold.SVar -        if os(darwin)-          c-sources: src/Streamly/Internal/FileSystem/Event/Darwin.m-          exposed-modules: Streamly.Internal.FileSystem.Event.Darwin+         -- Deprecated+         , Streamly.Internal.Data.Stream.Common+         , Streamly.Internal.Data.Stream.IsStream.Type+         , Streamly.Internal.Data.Stream.IsStream.Generate+         , Streamly.Internal.Data.Stream.IsStream.Eliminate+         , Streamly.Internal.Data.Stream.IsStream.Transform+         , Streamly.Internal.Data.Stream.IsStream.Expand+         , Streamly.Internal.Data.Stream.IsStream.Reduce+         , Streamly.Internal.Data.Stream.IsStream.Exception+         , Streamly.Internal.Data.Stream.IsStream.Lift+         , Streamly.Internal.Data.Stream.IsStream.Top+         , Streamly.Internal.Data.Stream.IsStream.Combinators+         , Streamly.Internal.Data.Stream.IsStream.Common+         , Streamly.Internal.Data.Stream.IsStream.Enumeration -        if os(linux)-          exposed-modules: Streamly.Internal.FileSystem.Event.Linux+         , Streamly.Internal.Data.Stream.SVar.Generate+         , Streamly.Internal.Data.Stream.SVar.Eliminate -        if os(linux) || os(darwin) || os(windows)-          exposed-modules: Streamly.Internal.FileSystem.Event+         , Streamly.Internal.Data.Fold.SVar +         , Streamly.Internal.Data.SVar.Worker+         , Streamly.Internal.Data.SVar.Dispatch+         , Streamly.Internal.Data.SVar.Pull+     build-depends:                     -- Core libraries shipped with ghc, the min and max                     -- constraints of these libraries should match with@@ -576,50 +532,63 @@                     -- packages depending on the "ghc" package (packages                     -- depending on doctest is a common example) can                     -- depend on streamly.-                       base              >= 4.9   && < 4.17-                     , containers        >= 0.5   && < 0.7-                     , deepseq           >= 1.4.1 && < 1.5-                     , directory         >= 1.2.2 && < 1.4-                     , exceptions        >= 0.8   && < 0.11-                     , ghc-prim          >= 0.2   && < 0.9-                     , mtl               >= 2.2   && < 2.3-                     , transformers      >= 0.4   && < 0.7-                     , filepath          >= 1.2.0.0 && < 1.5-+                       base              >= 4.12  && < 4.23                      , fusion-plugin-types >= 0.1 && < 0.2+                     , containers        >= 0.6.0 && < 0.9+                     , deepseq           >= 1.4.4 && < 1.6+                     , exceptions        >= 0.8.0 && < 0.11+                     , mtl               >= 2.2.2 && < 2.4+                     , transformers      >= 0.5.5 && < 0.7+                     , template-haskell  >= 2.14  && < 2.25 -                     -- XXX to be removed-                     , transformers-base >= 0.4   && < 0.5-                     , primitive         >= 0.5.4 && < 0.8+                     -- The core streamly package+                     , streamly-core     >= 0.3.0 && < 0.3.2++                     , hashable          >= 1.3   && < 1.6+                     , unordered-containers >= 0.2 && < 0.3                      , heaps             >= 0.3     && < 0.5-    if flag(use-unliftio)-      build-depends:   unliftio-core     >= 0.2 && < 0.3-    else-      build-depends:   monad-control     >= 1.0 && < 1.1 -    if !flag(streamly-core)-        build-depends:                     -- concurrency-                     , atomic-primops    >= 0.8   && < 0.9-                     , lockfree-queue    >= 0.2.3 && < 0.3+                     , lockfree-queue    >= 0.2.4 && < 0.3 -                     , unicode-data      >= 0.1   && < 0.4+                     , unicode-data      >= 0.1 && < 0.9                      -- Network-                     , network           >= 2.6   && < 3.2+                    -- network version 3.2.8 is broken on windows+                     , network           >= 2.6 && < 3.3  -        if os(windows)-          build-depends: Win32 >= 2.6 && < 2.13+    if impl(ghc < 9.10)+      build-depends:   atomic-primops    >= 0.8   && < 0.9+    else+      build-depends:   atomic-primops    >= 0.8.8 && < 0.9 -        if os(darwin)-          frameworks: Cocoa+    if impl(ghc < 9.6)+      build-depends:   transformers-base >= 0.4   && < 0.5 -  if flag(inspection)-    build-depends:     template-haskell   >= 2.14  && < 2.17-                     , inspection-testing >= 0.4   && < 0.5+    if flag(internal-use-unliftio)+      build-depends:   unliftio-core     >= 0.2 && < 0.3+    else+      build-depends:   monad-control     >= 1.0 && < 1.1 -  -- Array uses a Storable constraint in dev build making several inspection-  -- tests fail-  if flag(dev) && flag(inspection)-    build-depends: inspection-and-dev-flags-cannot-be-used-together+    if flag(internal-dev)+      build-depends: primitive >= 0.5.4 && < 0.10++    -- For FileSystem.Event module+    if os(linux)+      build-depends: directory >= 1.2.2 && < 1.4++    if os(windows)+      build-depends: Win32 >= 2.6 && < 2.15++    if os(darwin)+      build-depends: directory >= 1.2.2 && < 1.4+      frameworks: Cocoa++    if flag(inspection)+      build-depends:   inspection-testing >= 0.4   && < 0.7++    -- Array uses a Storable constraint in dev build making several inspection+    -- tests fail+    if flag(internal-dev) && flag(inspection)+      build-depends: inspection-and-dev-flags-cannot-be-used-together
+ targets/Targets.hs view
@@ -0,0 +1,328 @@+{-# LANGUAGE CPP #-}++module Targets+    ( targets+    )+where++-- Special tags:+-- *_grp groups+-- *_cmp comparison groups+-- noTest not available in tests+-- noBench not available in bench+-- testDevOnly dev only test+targets :: [(String, [String])]+targets =+    [+      -------------------------------------------------------------------------+      -- Alphabetical order+      -------------------------------------------------------------------------++      ("Data.Array",+            [ "array_grp"+            , "array_cmp"+            ]+      )+    , ("Data.Array.Generic",+            [ "array_grp"+            , "array_cmp"+            ]+      )+    , ("Data.Array.Stream",+            [ "infinite_grp"+            , "serial_stream_grp"+            ]+      )+    , ("Data.Binary",+            [ "noBench"+            ]+      )+    , ("Data.Fold",+            [ "infinite_grp"+            , "fold_parser_grp"+            ]+      )+    , ("Data.Fold.Window",+            [ "infinite_grp"+            , "fold_parser_grp"+            ]+      )+    , ("Data.List",+            [ "list_grp"+            , "noBench"+            , "testDevOnly"+            ]+      )+    , ("Data.List.Base",+            [ "list_grp"+            , "noBench"+            ]+      )+    , ("Data.MutArray",+            [ "array_grp"+            , "array_cmp"+            ]+      )+    , ("Data.Parser",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "parser_cmp"+            ]+      )+    , ("Data.ParserK",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "parser_cmp"+            ]+      )+    , ("Data.ParserK.Chunked",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "parser_cmp"+            , "noTest"+            ]+      )+    , ("Data.ParserK.Chunked.Generic",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "parser_cmp"+            , "noTest"+            ]+      )+    , ("Data.RingArray",+            [ "array_grp"+            ]+      )+    , ("Data.Scanl",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "noTest"+            ]+      )+    , ("Data.Scanl.Window",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "noTest"+            ]+      )+    , ("Data.Serialize",+            [ "mut_bytearray_grp"+            ]+      )+    , ("Data.Serialize.Derive.TH",+            [ "mut_bytearray_grp"+            , "noBench"+            ]+      )+    , ("Data.Serialize.ENABLE_constructorTagAsString",+            [ "mut_bytearray_grp"+            , "noBench"+            ]+      )+    , ("Data.SmallArray",+            [ "noBench"+            , "testDevOnly"+            ]+      )+    , ("Data.Stream",+            [ "infinite_grp"+            , "serial_stream_grp"+            , "serial_stream_cmp"+            , "serial_concurrent_cmp"+            ]+      )+    , ("Data.Stream.Adaptive",+            [ "concurrent_stream_grp"+            , "noTest"+            ]+      )+    -- XXX Concurrent and rate benchmarks take a long time with --long, perhaps+    -- need to use smaller stream sizes for these when using --long+    , ("Data.Stream.Concurrent",+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "concurrent_stream_cmp"+            , "serial_concurrent_cmp"+            ]+      )+    , ("Data.Stream.ConcurrentEager",+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "concurrent_stream_cmp"+            , "noTest"+            ]+      )+    , ("Data.Stream.ConcurrentInterleaved",+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "concurrent_stream_cmp"+            , "noTest"+            ]+      )+    , ("Data.Stream.ConcurrentOrdered",+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "concurrent_stream_cmp"+            , "noTest"+            ]+      )+    , ("Data.Stream.ConcurrentThreadHeavy",+            [ "concurrent_stream_grp"+            , "noTest"+            ]+      )+    , ("Data.Stream.Rate",+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "testDevOnly"+            ]+      )+    , ("Data.StreamK",+            [ "infinite_grp"+            , "serial_stream_grp"+            , "serial_stream_cmp"+            , "noTest"+            ]+      )+{-+    -- XXX Need devOnly flag support in BenchRunner+    , ("Data.StreamK.FromStream",+            [ "infinite_grp"+            , "serial_stream_grp"+            , "noTest"+            , "devOnly"+            ]+      )+-}+    , ("Data.Unbox",+            [ "noTest"+            ]+      )+    , ("Data.Unbox.Derive.Generic",+            [ "noBench"+            ]+      )+    , ("Data.Unbox.Derive.TH",+            []+      )+    , ("Data.Unbox.TH",+            [ "noBench"+            ]+      )+    , ("Data.Unfold",+            [ "infinite_grp"+            , "serial_stream_grp"+            ]+      )+    , ("FileSystem.Event",+            [ "noBench"+            ]+      )+#if defined(darwin_HOST_OS)+    , ("FileSystem.Event.Darwin",+            [ "noBench"+            ]+      )+#endif+#if defined(linux_HOST_OS)+    , ("FileSystem.Event.Linux",+            [ "noBench"+            , "testDevOnly"+            ]+      )+#endif+#if defined(mingw32_HOST_OS)+    , ("FileSystem.Event.Windows",+            [ "noBench"+            ]+      )+#endif+    , ("FileSystem.Handle", [])+    , ("FileSystem.DirIO", [])+    , ("Network.Inet.TCP", ["noBench"])+    , ("Network.Socket", ["noBench"])+    , ("Unicode.Char", ["testDevOnly"])+    , ("Unicode.Parser", [])+    , ("Unicode.Stream", [])+    , ("Unicode.Utf8", ["noTest"])+    , ("version-bounds", ["noBench"])++    ---- DEPRECATED ----++    -- test only, no benchmarks+    -- , ("Prelude", ["prelude_other_grp", "noBench"])+    -- , ("Prelude.Fold", ["prelude_other_grp", "noBench"])+    -- Enabled only when use-prelude flag is set+    -- , ("Prelude.Serial",+    --         [ "prelude_serial_grp"+    --         , "infinite_grp"+    --         , "serial_wserial_cmp"+    --         , "noBench"+    --         ]+    --   )+    -- , ("Prelude.Top",+    --         [ "prelude_serial_grp"+    --         , "infinite_grp"+    --         , "noBench"+    --         ]+    --   )+    -- , ("Prelude.WSerial",+    --         [ "prelude_serial_grp"+    --         , "infinite_grp"+    --         , "serial_wserial_cmp"+    --         ]+    --   )+    -- , ("Prelude.Merge",+    --         [ "prelude_serial_grp"+    --         , "infinite_grp"+    --         , "noTest"+    --         ]+    --   )+    -- , ("Prelude.ZipSerial",+    --         [ "prelude_serial_grp"+    --         , "infinite_grp"+    --         ]+    --   )+    -- , ("Prelude.Async",+    --         [ "prelude_concurrent_grp"+    --         , "infinite_grp"+    --         , "concurrent_cmp"+    --         , "serial_async_cmp"+    --         ]+    --   )+    -- , ("Prelude.WAsync",+    --         [ "prelude_concurrent_grp"+    --         , "infinite_grp"+    --         , "concurrent_cmp"+    --         ]+    --   )+    -- , ("Prelude.Ahead",+    --         [ "prelude_concurrent_grp"+    --         , "infinite_grp"+    --         , "concurrent_cmp"+    --         ]+    --   )+    -- , ("Prelude.Parallel",+    --         [ "prelude_concurrent_grp"+    --         , "infinite_grp"+    --         , "concurrent_cmp"+    --         ]+    --   )+    -- , ("Prelude.ZipAsync",+    --         [ "prelude_concurrent_grp"+    --         , "infinite_grp"+    --         ]+    --   )+    -- , ("Prelude.Concurrent", [ "prelude_other_grp" ])+    -- , ("Prelude.Rate",+    --         [ "prelude_other_grp"+    --         , "infinite_grp"+    --         , "testDevOnly"+    --         ]+    --   )+    -- , ("Prelude.Adaptive",+    --         [ "prelude_other_grp"+    --         , "noTest"+    --         ]+    --   )+    ]
+ targets/streamly-targets.cabal view
@@ -0,0 +1,12 @@+cabal-version:      2.4+name:               streamly-targets+version:            0.1.0.0++library+    hs-source-dirs:   .+    exposed-modules: Targets+    ghc-options: -Wall+    build-depends:    base+                    , bench-report+                    , containers+    default-language: Haskell2010
test/README.md view
@@ -94,15 +94,12 @@  ## Writing doctests -* The test named `doctest` runs all the code snippets in a source module-  that are written using the `>>>` markup in haddock. See `doctest.hs`.+* We use `cabal-docspec` to run all the code snippets in a source module+  that are written using the `>>>` markup in haddock. * Make sure you do not enclose your snippets in the `@ .. @` markup otherwise   they will show up verbatim in the docs and not as ghci styled snippets.-* We use `--fast` mode of doctest, which means snippets are run as if you are-  typing those examples from top to bottom in that order in GHCi. Previous-  snippet's state is available to the next one. * A haddock section named `$setup` contains a snippet that is always run before-  any other. When `--fast` mode is not used it is run before every snippet.+  any other.  An example setup section: @@ -113,8 +110,8 @@ -- >>> import Data.Function ((&)) ``` -Some tests that may take long can be written as follows.  Just assigning-the code to a function makes it compile but not run.+Some tests that may take long can be written as follows.  Just defining+the snippet as a function makes it compile but not run.  ``` >>> :{@@ -128,31 +125,15 @@  ## Running doctests -Run tests for all modules:- ```-$ cabal run doctests --flag doctests-```--Use verbose mode to debug:--```-$ cabal run doctests --flag doctests -- --verbose-```--Run tests only for selected modules:--```-$ cabal run doctests --flag doctests -- --modules Streamly.Prelude+$ cabal build all+$ cabal-docspec --timeout 60 --check-properties --property-variables xs ``` -If it fails with a message that a particular modules is not loaded specify that-module as well on the command line.- ## Naming of test modules  Tests are organized by source modules. For example, for the source-module `Streamly.Data.Array` and `Streamly.Internal.Data.Array` we have-a test module `Data.Array`. For some modules tests for a source module+module `Streamly.Data.Array.Generic` and `Streamly.Internal.Data.Array.Generic` we have+a test module `Data.Array.Generic`. For some modules tests for a source module are broken into multiple modules. For example, for `Streamly.Prelude` we have `Streamly.Prelude.Serial`, `Streamly.Prelude.Async` etc.
test/Streamly/Test/Data/Array.hs view
@@ -1,6 +1,6 @@ -- | -- Module      : Streamly.Test.Data.Array--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2019 Composewell technologies -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental@@ -8,9 +8,24 @@  module Streamly.Test.Data.Array (main) where -#include "Streamly/Test/Data/Array/CommonImports.hs"+import Data.Char (isLower)+import Data.List (sort)+import Data.Proxy (Proxy(..))+import Data.Word(Word8, Word16)+import Foreign.Storable (peek)+import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr)+import GHC.Ptr (plusPtr, Ptr(..))+import Streamly.Internal.Data.MutByteArray (Unbox, sizeOf)+import Streamly.Internal.Data.MutArray (MutArray)+import Test.QuickCheck (chooseInt, listOf)+import System.Mem (performMajorGC)+import Streamly.Test.Common (performGCSweep)  import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.MutArray as MA++#include "Streamly/Test/Data/Array/CommonImports.hs"+ type Array = A.Array  moduleName :: String@@ -19,10 +34,11 @@ #include "Streamly/Test/Data/Array/Common.hs"  testFromStreamToStream :: Property-testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)+testFromStreamToStream = genericTestFromTo (const A.fromStream) A.read (==)  testFoldUnfold :: Property-testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)+testFoldUnfold =+    genericTestFromTo (const (S.fold A.create)) (S.unfold A.reader) (==)  testFromList :: Property testFromList =@@ -30,12 +46,232 @@             forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->                 monadicIO $ do                     let arr = A.fromList list-                    xs <- run $ S.toList $ (S.unfold A.read) arr+                    xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr                     assert (xs == list)  testLengthFromStream :: Property testLengthFromStream = genericTestFrom (const A.fromStream) +unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool+unsafeWriteIndex xs i x = do+    arr <- MA.fromList xs+    MA.unsafePutIndex i arr x+    x1 <- MA.unsafeGetIndex i arr+    return $ x1 == x++lastN :: Int -> [a] -> [a]+lastN n l = drop (length l - n) l++testLastN :: Property+testLastN =+    forAll (choose (0, maxArrLen)) $ \len ->+        forAll (choose (0, len)) $ \n ->+            forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->+                monadicIO $ do+                    xs <- run+                        $ fmap A.toList+                        $ S.fold (A.createOfLast n)+                        $ S.fromList list+                    assert (xs == lastN n list)++testLastN_LN :: Int -> Int -> IO Bool+testLastN_LN len n = do+    let list = [1..len]+    l1 <- fmap A.toList $ S.fold (A.createOfLast n) $ S.fromList list+    let l2 = lastN n list+    return $ l1 == l2++testStrip :: IO Bool+testStrip = do+    dt <- MA.fromList "abcDEFgeh"+    dt' <- MA.dropAround isLower dt+    x <- MA.toList dt'+    return $ x == "DEF"++testStripLeft :: IO Bool+testStripLeft = do+    dt <- MA.fromList "abcDEF"+    dt' <- MA.dropAround isLower dt+    x <- MA.toList dt'+    return $ x == "DEF"++testStripRight :: IO Bool+testStripRight = do+    dt <- MA.fromList "DEFgeh"+    dt' <- MA.dropAround isLower dt+    x <- MA.toList dt'+    return $ x == "DEF"++testStripZero :: IO Bool+testStripZero = do+    dt <- MA.fromList "DEF"+    dt' <- MA.dropAround isLower dt+    x <- MA.toList dt'+    return $ x == "DEF"++testStripEmpty :: IO Bool+testStripEmpty = do+    dt <- MA.fromList "abc"+    dt' <- MA.dropAround isLower dt+    x <- MA.toList dt'+    return $ x == ""++testStripNull :: IO Bool+testStripNull = do+    dt <- MA.fromList ""+    dt' <- MA.dropAround isLower dt+    x <- MA.toList dt'+    return $ x == ""++unsafeSlice :: Int -> Int -> [Int] -> Bool+unsafeSlice i n list =+    let lst = take n $ drop i list+        arr = A.toList $ A.unsafeSliceOffLen i n $ A.fromList list+     in arr == lst++testBubbleWith :: Bool -> Property+testBubbleWith asc =+   forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->+        monadicIO $ action ls0++        where++        action ls = do+            x <- S.fold (fldm ls) $ S.fromList ls+            lst <- MA.toList x+            if asc+            then assert (sort ls == lst)+            else assert (sort ls == reverse lst)++        fldm ls =+            Fold.foldlM'+                (\b a -> do+                    arr <- MA.snoc b a+                    if asc+                    then MA.bubble compare arr+                    else MA.bubble (flip compare) arr+                    return arr+                )+                (MA.emptyOf' $ length ls)++testBubbleAsc ::  Property+testBubbleAsc = testBubbleWith True++testBubbleDesc ::  Property+testBubbleDesc = testBubbleWith False++testByteLengthWithMA :: forall a. Unbox a => a -> IO ()+testByteLengthWithMA _ = do+     arrA <- MA.emptyOf' 100 :: IO (MutArray a)+     let arrW8 = MA.unsafeCast arrA :: MutArray Word8+     MA.byteLength arrA `shouldBe` MA.length arrW8++testBreakOn :: [Word8] -> Word8 -> [Word8] -> Maybe [Word8] -> IO ()+testBreakOn inp sep bef aft = do+    (bef_, aft_) <- A.breakEndByWord8_ sep (A.fromList inp)+    bef_ `shouldBe` A.fromList bef+    aft_ `shouldBe` fmap A.fromList aft++testWrite :: [Char] -> IO ()+testWrite inp = do+    arr <- S.fold A.create (S.fromList inp)+    A.toList arr `shouldBe` inp++testFromToList :: [Char] -> IO ()+testFromToList inp = A.toList (A.fromList inp) `shouldBe` inp++testUnsafeIndxedFromList :: [Char] -> IO ()+testUnsafeIndxedFromList inp =+    let arr = A.fromList inp+     in fmap (`A.unsafeGetIndex` arr) [0 .. (length inp - 1)] `shouldBe` inp++getIntList :: Ptr Int -> Int -> IO [Int]+getIntList ptr byteLen = do+    performMajorGC+    getList ptr (ptr `plusPtr` byteLen)++    where++    sizeOfInt = sizeOf (Proxy :: Proxy Int)++    -- We need to be careful here. We assume Unboxed and Storable are compatible+    -- with each other. For Int, they are compatible.+    getList p limitP+        | p >= limitP = return []+    getList p limitP = do+        val <- peek p+        rest <- getList (p `plusPtr` sizeOfInt) limitP+        return $ val : rest++testAsPtrUnsafeMA :: IO ()+testAsPtrUnsafeMA = do+    arr <- MA.fromList ([0 .. 99] :: [Int])+    arr1 <- MA.pin arr+    MA.unsafeAsPtr arr1 getIntList `shouldReturn` [0 .. 99]++testUnsafePinnedAsPtr :: IO ()+testUnsafePinnedAsPtr = do+    arr <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Int])+    let arr1 = A.unsafeFreeze arr+    A.unsafePinnedAsPtr arr1 getIntList `shouldReturn` [10 .. 59]++testUnsafeAsForeignPtr :: IO ()+testUnsafeAsForeignPtr = do+    arr <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Int])+    let arr1 = A.unsafeFreeze arr+    A.unsafeAsForeignPtr arr1 getIntList1 `shouldReturn` [10 .. 59]+    where+    getIntList1 fp blen = withForeignPtr fp $ \p -> getIntList p blen++testForeignPtrConversionId :: IO ()+testForeignPtrConversionId = do+    arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8])+    let arr = A.unsafeFreeze arr0+    A.unsafeAsForeignPtr arr $ \a b -> do+        res <- A.unsafeFromForeignPtr a b+        performGCSweep 4 100000+        res `shouldBe` arr+++testUnsafeFromForeignPtr :: IO ()+testUnsafeFromForeignPtr = do+    arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8])+    let arr = A.unsafeFreeze arr0+    A.unsafePinnedAsPtr arr $ \ptr len -> do+        fptr <- newForeignPtr_ ptr+        performMajorGC+        A.unsafeFromForeignPtr fptr len `shouldReturn` arr++testFromCString# :: IO ()+testFromCString# = do+    arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8])+    let arr = A.unsafeFreeze arr0+    A.unsafePinnedAsPtr (arr <> A.fromList [0]) $ \(Ptr addr#) _ -> do+        arr1 <- A.fromCString# addr#+        performGCSweep 4 100000+        arr1 `shouldBe` arr++testFromW16CString# :: IO ()+testFromW16CString# = do+    arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word16])+    let arr = A.unsafeFreeze arr0+    A.unsafePinnedAsPtr (arr <> A.fromList [0]) $ \(Ptr addr#) _ -> do+        arr1 <- A.fromW16CString# addr#+        performGCSweep 4 100000+        arr1 `shouldBe` arr++reallocMA :: Property+reallocMA =+    let len = 10000+        bSize = len * sizeOf (Proxy :: Proxy Char)+    in forAll (vectorOf len (arbitrary :: Gen Char)) $ \vec ->+           forAll (chooseInt (bSize - 2000, bSize + 2000)) $ \newBLen -> do+               arr <- MA.fromList vec+               arr1 <- MA.reallocBytes newBLen arr+               lst <- MA.toList arr+               lst1 <- MA.toList arr1+               lst `shouldBe` lst1+ main :: IO () main =     hspec $@@ -44,7 +280,64 @@       describe moduleName $ do         commonMain         describe "Construction" $ do+            -- XXX There is an issue https://github.com/composewell/streamly/issues/1577+            --prop "testAppend" testAppend+            prop "testBubbleAsc" testBubbleAsc+            prop "testBubbleDesc" testBubbleDesc             prop "length . fromStream === n" testLengthFromStream             prop "toStream . fromStream === id" testFromStreamToStream             prop "read . write === id" testFoldUnfold             prop "fromList" testFromList+            prop "foldMany with writeNUnsafe concats to original"+                (foldManyWith (\n -> Fold.take n (A.unsafeCreateOf n)))+        describe "AsPtr" $ do+            it "testUnsafePinnedAsPtr" testUnsafePinnedAsPtr+            it "testUnsafeAsForeignPtr" testUnsafeAsForeignPtr+            it "testForeignPtrConversionId" testForeignPtrConversionId+            it "testUnsafeFromForeignPtr" testUnsafeFromForeignPtr+            it "testFromCString#" testFromCString#+            it "testFromW16CString#" testFromW16CString#+        describe "unsafeSlice" $ do+            it "partial" $ unsafeSlice 2 4 [1..10]+            it "none" $ unsafeSlice 10 0 [1..10]+            it "full" $ unsafeSlice 0 10 [1..10]+        describe "Mut.unsafeWriteIndex" $ do+            it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True)+            it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)+            it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)+        describe "Fold" $ do+            prop "createOfLast : 0 <= n <= len" testLastN+            describe "createOfLast boundary conditions" $ do+                it "createOfLast -1" (testLastN_LN 10 (-1) `shouldReturn` True)+                it "createOfLast 0" (testLastN_LN 10 0 `shouldReturn` True)+                it "createOfLast length" (testLastN_LN 10 10 `shouldReturn` True)+                it "createOfLast (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)+        describe "Strip" $ do+            it "strip" (testStrip `shouldReturn` True)+            it "stripLeft" (testStripLeft `shouldReturn` True)+            it "stripRight" (testStripRight `shouldReturn` True)+            it "stripZero" (testStripZero `shouldReturn` True)+            it "stripEmpty" (testStripEmpty `shouldReturn` True)+            it "stripNull" (testStripNull `shouldReturn` True)+        describe "Mut" $ do+            it "testByteLengthWithMA Int"+                   (testByteLengthWithMA (undefined :: Int))+            it "testByteLengthWithMA Char"+                   (testByteLengthWithMA (undefined :: Char))+            it "testAsPtrUnsafeMA" testAsPtrUnsafeMA+            it "reallocMA" reallocMA+        describe "breakOn" $ do+            it "testBreakOn [1, 0, 2] 0"+                   (testBreakOn [1, 0, 2] 0 [1] (Just [2]))+            it "testBreakOn [1, 0] 0" (testBreakOn [1, 0] 0 [1] (Just []))+            it "testBreakOn [1] 0" (testBreakOn [1] 0 [1] Nothing)+        describe "toList . fromList" $ do+            it "testFromToList abc" (testFromToList "abc")+            it "testFromToList \\22407" (testFromToList "\22407")+        describe "unsafeGetIndex . fromList" $ do+            it "testUnsafeIndxedFromList abc" (testUnsafeIndxedFromList "abc")+            it "testUnsafeIndxedFromList \\22407"+                   (testUnsafeIndxedFromList "\22407")+        describe "write" $ do+            it "testWrite abc" (testWrite "abc")+            it "testWrite \\22407" (testWrite "\22407")
test/Streamly/Test/Data/Array/Common.hs view
@@ -1,4 +1,6 @@ +#include "MachDeps.h"+ -- Coverage build takes too long with default number of tests maxTestCount :: Int #ifdef DEVBUILD@@ -7,22 +9,11 @@ maxTestCount = 10 #endif -allocOverhead :: Int-allocOverhead = 2 * sizeOf (undefined :: Int)---- XXX this should be in sync with the defaultChunkSize in Array code, or we--- should expose that and use that. For fast testing we could reduce the--- defaultChunkSize under CPP conditionals.----defaultChunkSize :: Int-defaultChunkSize = 32 * k - allocOverhead-   where k = 1024- maxArrLen :: Int maxArrLen = defaultChunkSize * 8  genericTestFrom ::-       (Int -> SerialT IO Int -> IO (Array Int))+       (Int -> Stream IO Int -> IO (Array Int))     -> Property genericTestFrom arrFold =     forAll (choose (0, maxArrLen)) $ \len ->@@ -32,14 +23,14 @@                 assert (A.length arr == len)  testLength :: Property-testLength = genericTestFrom (S.fold . A.writeN)+testLength = genericTestFrom (S.fold . A.createOf)  testLengthFromStreamN :: Property testLengthFromStreamN = genericTestFrom A.fromStreamN  genericTestFromTo ::-       (Int -> SerialT IO Int -> IO (Array Int))-    -> (Array Int -> SerialT IO Int)+       (Int -> Stream IO Int -> IO (Array Int))+    -> (Array Int -> Stream IO Int)     -> ([Int] -> [Int] -> Bool)     -> Property genericTestFromTo arrFold arrUnfold listEq =@@ -47,30 +38,31 @@         forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->             monadicIO $ do                 arr <- run $ arrFold len $ S.fromList list-                xs <- run $ S.toList $ arrUnfold arr+                xs <- run $ S.fold Fold.toList $ arrUnfold arr                 assert (listEq xs list)   testFoldNUnfold :: Property testFoldNUnfold =-    genericTestFromTo (S.fold . A.writeN) (S.unfold A.read) (==)+    genericTestFromTo (S.fold . A.createOf) (S.unfold A.reader) (==)  testFoldNToStream :: Property testFoldNToStream =-    genericTestFromTo (S.fold . A.writeN) A.toStream (==)+    genericTestFromTo (S.fold . A.createOf) A.read (==)  testFoldNToStreamRev :: Property testFoldNToStreamRev =     genericTestFromTo-        (S.fold . A.writeN)-        A.toStreamRev+        (S.fold . A.createOf)+        A.readRev         (\xs list -> xs == reverse list)  testFromStreamNUnfold :: Property-testFromStreamNUnfold = genericTestFromTo A.fromStreamN (S.unfold A.read) (==)+testFromStreamNUnfold =+    genericTestFromTo A.fromStreamN (S.unfold A.reader) (==)  testFromStreamNToStream :: Property-testFromStreamNToStream = genericTestFromTo A.fromStreamN A.toStream (==)+testFromStreamNToStream = genericTestFromTo A.fromStreamN A.read (==)  testFromListN :: Property testFromListN =@@ -79,7 +71,7 @@             forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->                 monadicIO $ do                     let arr = A.fromListN n list-                    xs <- run $ S.toList $ S.unfold A.read arr+                    xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr                     listEquals (==) xs (take n list)  foldManyWith :: (Int -> Fold IO Int (Array Int)) -> Property@@ -88,8 +80,8 @@         forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->             monadicIO $ do                 xs <- run-                    $ S.toList-                    $ S.unfoldMany A.read+                    $ S.fold Fold.toList+                    $ S.unfoldEach A.reader                     $ S.foldMany (f 240)                     $ S.fromList list                 assert (xs == list)@@ -106,4 +98,4 @@         prop "toStream . fromStreamN === id" testFromStreamNToStream         prop "fromListN" testFromListN         prop "foldMany with writeN concats to original"-            (foldManyWith A.writeN)+            (foldManyWith A.createOf)
test/Streamly/Test/Data/Array/CommonImports.hs view
@@ -1,13 +1,13 @@ -import Foreign.Storable (Storable(..))- import Test.Hspec.QuickCheck import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, choose) import Test.QuickCheck.Monadic (monadicIO, assert, run) import Test.Hspec as H  import Streamly.Data.Fold (Fold)-import Streamly.Prelude (SerialT)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.System.IO (defaultChunkSize) import Streamly.Test.Common (listEquals) -import qualified Streamly.Prelude as S+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as S
− test/Streamly/Test/Data/Array/Foreign.hs 
@@ -1,120 +0,0 @@--- |--- Module      : Streamly.Test.Data.Array.Foreign--- Copyright   : (c) 2019 Composewell technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Test.Data.Array.Foreign (main) where--#include "Streamly/Test/Data/Array/CommonImports.hs"--import Data.Word(Word8)--import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Foreign.Type as A-import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS-type Array = A.Array--moduleName :: String-moduleName = "Data.Array.Foreign"--#include "Streamly/Test/Data/Array/Common.hs"--testFromStreamToStream :: Property-testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)--testFoldUnfold :: Property-testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)--testFromList :: Property-testFromList =-    forAll (choose (0, maxArrLen)) $ \len ->-            forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->-                monadicIO $ do-                    let arr = A.fromList list-                    xs <- run $ S.toList $ (S.unfold A.read) arr-                    assert (xs == list)--testLengthFromStream :: Property-testLengthFromStream = genericTestFrom (const A.fromStream)---unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool-unsafeWriteIndex xs i x = do-    arr <- MA.fromList xs-    MA.putIndexUnsafe i x arr-    x1 <- MA.getIndexUnsafe i arr-    return $ x1 == x--lastN :: Int -> [a] -> [a]-lastN n l = drop (length l - n) l--testLastN :: Property-testLastN =-    forAll (choose (0, maxArrLen)) $ \len ->-        forAll (choose (0, len)) $ \n ->-            forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->-                monadicIO $ do-                    xs <- run-                        $ fmap A.toList-                        $ S.fold (A.writeLastN n)-                        $ S.fromList list-                    assert (xs == lastN n list)--testLastN_LN :: Int -> Int -> IO Bool-testLastN_LN len n = do-    let list = [1..len]-    l1 <- fmap A.toList $ S.fold (A.writeLastN n) $ S.fromList list-    let l2 = lastN n list-    return $ l1 == l2---- Instead of hard coding 10000 here we can have maxStreamLength for operations--- that use stream of arrays.-concatArrayW8 :: Property-concatArrayW8 =-    forAll (vectorOf 10000 (arbitrary :: Gen Word8))-        $ \w8List -> do-              let w8ArrList = A.fromList . (: []) <$> w8List-              f2 <- S.toList $ AS.concat $ S.fromList w8ArrList-              w8List `shouldBe` f2--unsafeSlice :: Int -> Int -> [Int] -> Bool-unsafeSlice i n list =-    let lst = take n $ drop i $ list-        arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list-     in arr == lst--main :: IO ()-main =-    hspec $-    H.parallel $-    modifyMaxSuccess (const maxTestCount) $ do-      describe moduleName $ do-        commonMain-        describe "Construction" $ do-            prop "length . fromStream === n" testLengthFromStream-            prop "toStream . fromStream === id" testFromStreamToStream-            prop "read . write === id" testFoldUnfold-            prop "fromList" testFromList-            prop "foldMany with writeNUnsafe concats to original"-                (foldManyWith (\n -> Fold.take n (A.writeNUnsafe n)))-            prop "AS.concat . (A.fromList . (:[]) <$>) === id" $ concatArrayW8-        describe "unsafeSlice" $ do-            it "partial" $ unsafeSlice 2 4 [1..10]-            it "none" $ unsafeSlice 10 0 [1..10]-            it "full" $ unsafeSlice 0 10 [1..10]-        describe "Mut.unsafeWriteIndex" $ do-            it "first" (unsafeWriteIndex [1..10] 0 0 `shouldReturn` True)-            it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)-            it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)-        describe "Fold" $ do-            prop "writeLastN : 0 <= n <= len" $ testLastN-            describe "writeLastN boundary conditions" $ do-                it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)-                it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)-                it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)-                it "writeLastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)
+ test/Streamly/Test/Data/Array/Generic.hs view
@@ -0,0 +1,64 @@++-- |+-- Module      : Streamly.Test.Data.Array.Generic+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Array.Generic (main) where++#include "Streamly/Test/Data/Array/CommonImports.hs"++import qualified Streamly.Internal.Data.Array.Generic as A++type Array = A.Array++moduleName :: String+moduleName = "Data.Array"++#include "Streamly/Test/Data/Array/Common.hs"++testFromStreamToStream :: Property+testFromStreamToStream =+    genericTestFromTo (const A.fromStream) A.read (==)++testFoldUnfold :: Property+testFoldUnfold =+    genericTestFromTo (const (S.fold A.create)) (S.unfold A.reader) (==)++testFromList :: Property+testFromList =+    forAll (choose (0, maxArrLen)) $ \len ->+            forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->+                monadicIO $ do+                    let arr = A.fromList list+                    xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr+                    assert (xs == list)++testLengthFromStream :: Property+testLengthFromStream = genericTestFrom (const A.fromStream)++testReadShowInstance :: Property+testReadShowInstance =+    forAll (choose (0, maxArrLen)) $ \len ->+            forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->+                monadicIO $ do+                    let arr = A.fromList list+                    assert (A.toList (read (show arr)) == list)+++main :: IO ()+main =+    hspec $+    H.parallel $+    modifyMaxSuccess (const maxTestCount) $ do+      describe moduleName $ do+        commonMain+        describe "Construction" $ do+            prop "length . fromStream === n" testLengthFromStream+            prop "toStream . fromStream === id" testFromStreamToStream+            prop "read . write === id" testFoldUnfold+            prop "fromList" testFromList+            prop "testReadShowInstance" testReadShowInstance
− test/Streamly/Test/Data/Array/Prim.hs 
@@ -1,55 +0,0 @@--- |--- Module      : Streamly.Test.Data.Array.Prim--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Test.Data.Array.Prim (main) where--#include "Streamly/Test/Data/Array/CommonImports.hs"--import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Array.Prim as A-import qualified Streamly.Internal.Data.Array.Prim.Type as A-type Array = A.Array--moduleName :: String-moduleName = "Data.Array.Prim"--#include "Streamly/Test/Data/Array/Common.hs"--testFromStreamToStream :: Property-testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)--testFoldUnfold :: Property-testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)--testFromList :: Property-testFromList =-    forAll (choose (0, maxArrLen)) $ \len ->-            forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->-                monadicIO $ do-                    let arr = A.fromList list-                    xs <- run $ S.toList $ (S.unfold A.read) arr-                    assert (xs == list)--testLengthFromStream :: Property-testLengthFromStream = genericTestFrom (const A.fromStream)---main :: IO ()-main =-    hspec $-    H.parallel $-    modifyMaxSuccess (const maxTestCount) $ do-      describe moduleName $ do-        commonMain-        describe "Construction" $ do-            prop "length . fromStream === n" testLengthFromStream-            prop "toStream . fromStream === id" testFromStreamToStream-            prop "read . write === id" testFoldUnfold-            prop "fromList" testFromList-            prop "foldMany with writeNUnsafe concats to original"-                (foldManyWith (\n -> Fold.take n (A.writeNUnsafe n)))
− test/Streamly/Test/Data/Array/Prim/Pinned.hs 
@@ -1,55 +0,0 @@--- |--- Module      : Streamly.Test.Data.Array.Prim.Pinned--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Test.Data.Array.Prim.Pinned (main) where--#include "Streamly/Test/Data/Array/CommonImports.hs"--import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Array.Prim as A-import qualified Streamly.Internal.Data.Array.Prim.Type as A-type Array = A.Array--moduleName :: String-moduleName = "Data.Array.Prim.Pinned"--#include "Streamly/Test/Data/Array/Common.hs"--testFromStreamToStream :: Property-testFromStreamToStream = genericTestFromTo (const A.fromStream) A.toStream (==)--testFoldUnfold :: Property-testFoldUnfold = genericTestFromTo (const (S.fold A.write)) (S.unfold A.read) (==)--testFromList :: Property-testFromList =-    forAll (choose (0, maxArrLen)) $ \len ->-            forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->-                monadicIO $ do-                    let arr = A.fromList list-                    xs <- run $ S.toList $ (S.unfold A.read) arr-                    assert (xs == list)--testLengthFromStream :: Property-testLengthFromStream = genericTestFrom (const A.fromStream)---main :: IO ()-main =-    hspec $-    H.parallel $-    modifyMaxSuccess (const maxTestCount) $ do-      describe moduleName $ do-        commonMain-        describe "Construction" $ do-            prop "length . fromStream === n" testLengthFromStream-            prop "toStream . fromStream === id" testFromStreamToStream-            prop "read . write === id" testFoldUnfold-            prop "fromList" testFromList-            prop "foldMany with writeNUnsafe concats to original"-                (foldManyWith (\n -> Fold.take n (A.writeNUnsafe n)))
+ test/Streamly/Test/Data/Array/Stream.hs view
@@ -0,0 +1,111 @@++module Main (main) where++import Data.Word (Word8)+import Streamly.Test.Common (listEquals, chooseInt)+import Test.Hspec (hspec, describe, shouldBe)+import Test.Hspec.QuickCheck+import Test.QuickCheck (forAll, Property, vectorOf, Gen, Arbitrary (arbitrary))+import Test.QuickCheck.Monadic (assert, monadicIO, run)++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Parser as Parser+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Test.Hspec as Hspec++import Prelude hiding (sequence)++#if MIN_VERSION_QuickCheck(2,14,0)++import Test.QuickCheck (chooseAny)++#else++import System.Random (Random(random))+import Test.QuickCheck.Gen (Gen(MkGen))++-- | Generates a random element over the natural range of `a`.+chooseAny :: Random a => Gen a+chooseAny = MkGen (\r _ -> let (x,_) = random r in x)++#endif++maxTestCount :: Int+maxTestCount = 100++chunksOf :: Monad m+    => Int -> Fold.Fold m a b -> Stream.Stream m a -> Stream.Stream m b+chunksOf n f = Stream.foldMany (Fold.take n f)++parseBreak :: Property+parseBreak = do+    let len = 200+    -- ls = input list (stream)+    -- clen = chunk size+    -- tlen = parser take size+    forAll+        ((,,)+            <$> vectorOf len (chooseAny :: Gen Int)+            <*> chooseInt (1, len)+            <*> chooseInt (0, len))+        $ \(ls, clen, tlen) ->+            monadicIO $ do+                (ls1, str) <-+                    let input =+                            Stream.toStreamK+                                $ chunksOf+                                clen (Array.createOf clen) (Stream.fromList ls)+                        parser = Parser.fromFold (Fold.take tlen Fold.toList)+                     in run $ Array.parseBreak (Array.toParserK parser) input+                ls2 <- run $ Stream.fold Fold.toList (Array.concat $ Stream.fromStreamK str)+                case ls1 of+                    Right x -> listEquals (==) (x ++ ls2) ls+                    Left _ -> assert False++splitOnSuffix :: Word8 -> [Word8] -> [[Word8]] -> IO ()+splitOnSuffix sep inp out = do+    res <-+        Stream.fold Fold.toList+            $ Array.compactEndByByte_ sep+            $ chunksOf 2 (Array.createOf 2) $ Stream.fromList inp+    fmap Array.toList res `shouldBe` out++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Array.Stream"++-- Instead of hard coding 10000 here we can have maxStreamLength for operations+-- that use stream of arrays.++concatArrayW8 :: Property+concatArrayW8 =+    forAll (vectorOf 10000 (arbitrary :: Gen Word8))+        $ \w8List -> do+              let w8ArrList = Array.fromList . (: []) <$> w8List+              f2 <- Stream.fold Fold.toList $ Array.concat $ Stream.fromList w8ArrList+              w8List `shouldBe` f2+++main :: IO ()+main =+    hspec $+    Hspec.parallel $+    modifyMaxSuccess (const maxTestCount) $ do+        describe moduleName $ do+            describe "Stream parsing" $ do+                prop "parseBreak" parseBreak+                prop "concatArrayW8" concatArrayW8+            describe "splifOnSuffix" $ do+                Hspec.it "splitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6]"+                       $ splitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6]+                                         [[1, 2], [4], [5, 6]]+                Hspec.it "splitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6, 0]"+                       $ splitOnSuffix 0 [1, 2, 0, 4, 0, 5, 6, 0]+                                         [[1, 2], [4], [5, 6]]+                Hspec.it "splitOnSuffix 0 [0, 1, 2, 0, 4, 0, 5, 6]"+                       $ splitOnSuffix 0 [0, 1, 2, 0, 4, 0, 5, 6]+                                         [[], [1, 2], [4], [5, 6]]
− test/Streamly/Test/Data/Array/Stream/Foreign.hs 
@@ -1,72 +0,0 @@-module Main (main) where--import Streamly.Test.Common (listEquals, chooseInt)-import Test.Hspec (hspec, describe)-import Test.Hspec.QuickCheck-import Test.QuickCheck (forAll, Property, vectorOf, Gen)-import Test.QuickCheck.Monadic (monadicIO, run)--import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Array.Stream.Foreign as ArrayStream-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD-import qualified Streamly.Internal.Data.Stream.IsStream as Stream-import qualified Test.Hspec as Hspec--import Prelude hiding (sequence)--#if MIN_VERSION_QuickCheck(2,14,0)--import Test.QuickCheck (chooseAny)--#else--import System.Random (Random(random))-import Test.QuickCheck.Gen (Gen(MkGen))---- | Generates a random element over the natural range of `a`.-chooseAny :: Random a => Gen a-chooseAny = MkGen (\r _ -> let (x,_) = random r in x)--#endif--maxTestCount :: Int-maxTestCount = 100--parse :: Property-parse = do-    let len = 200-    -- ls = input list (stream)-    -- clen = chunk size-    -- tlen = parser take size-    forAll-        ((,,)-            <$> vectorOf len (chooseAny :: Gen Int)-            <*> chooseInt (1, len)-            <*> chooseInt (0, len))-        $ \(ls, clen, tlen) ->-            monadicIO $ do-                (ls1, str) <--                    let input =-                            Stream.chunksOf-                                clen (Array.writeN clen) (Stream.fromList ls)-                        parser = ParserD.fromFold (Fold.take tlen Fold.toList)-                     in run $ ArrayStream.parse parser input-                ls2 <- run $ Stream.toList $ ArrayStream.concat str-                listEquals (==) (ls1 ++ ls2) ls------------------------------------------------------------------------------------ Main----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Array.Stream.Foreign"--main :: IO ()-main =-    hspec $-    Hspec.parallel $-    modifyMaxSuccess (const maxTestCount) $ do-        describe moduleName $ do-            describe "Stream parsing" $ do-                prop "parse" parse
test/Streamly/Test/Data/Fold.hs view
@@ -1,5 +1,9 @@+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+ module Main (main) where +import Data.List (sort, sortBy)+import Data.Ord (comparing, Down(..)) import Data.Semigroup (Sum(..), getSum) import Streamly.Test.Common (checkListEqual, listEquals) import Test.QuickCheck@@ -13,15 +17,16 @@     , property     , vectorOf     , withMaxSuccess+    , generate     )+import Control.Monad.IO.Class (liftIO) import Test.QuickCheck.Monadic (monadicIO, assert, run)  import qualified Data.Map import qualified Prelude-import qualified Streamly.Internal.Data.Fold as F-import qualified Streamly.Prelude as S-import qualified Streamly.Internal.Data.Stream.IsStream as Stream-import qualified Streamly.Data.Fold as FL+import qualified Streamly.Internal.Data.MutArray as MArray+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream  import Prelude hiding     (maximum, minimum, elem, notElem, null, product, sum, head, last, take)@@ -56,26 +61,31 @@         forAll (choose (0, len)) $ \n ->             forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec ->                 monadicIO $ do-                a <- run $ S.fold F.rollingHash $ S.take n $ S.fromList vec-                b <- run $ S.fold (F.rollingHashFirstN n) $ S.fromList vec+                a <- run+                    $ Stream.fold Fold.rollingHash+                    $ Stream.take n+                    $ Stream.fromList  vec+                b <- run+                    $ Stream.fold (Fold.rollingHashFirstN n)+                    $ Stream.fromList  vec                 assert $ a == b  head :: [Int] -> Expectation-head ls = S.fold FL.head (S.fromList ls) `shouldReturn` headl ls+head ls = Stream.fold Fold.one (Stream.fromList  ls) `shouldReturn` headl ls  headl :: [a] -> Maybe a headl [] = Nothing headl (x:_) = Just x  length :: [Int] -> Expectation-length ls = S.fold FL.length (S.fromList ls) `shouldReturn` Prelude.length ls+length ls = Stream.fold Fold.length (Stream.fromList  ls) `shouldReturn` Prelude.length ls  sum :: [Int] -> Expectation-sum ls = S.fold FL.sum (S.fromList ls) `shouldReturn` Prelude.sum ls+sum ls = Stream.fold Fold.sum (Stream.fromList  ls) `shouldReturn` Prelude.sum ls  product :: [Int] -> Expectation product ls =-    S.fold FL.product (S.fromList ls) `shouldReturn` Prelude.product ls+    Stream.fold Fold.product (Stream.fromList  ls) `shouldReturn` Prelude.product ls  lesser :: (a -> a -> Ordering) -> a -> a -> a lesser f x y = if f x y == LT then x else y@@ -91,29 +101,29 @@  maximumBy :: (Ord a, Show a) => a -> (a -> a -> Ordering) -> [a] -> Expectation maximumBy genmin f ls =-    S.fold (FL.maximumBy f) (S.fromList ls)+    Stream.fold (Fold.maximumBy f) (Stream.fromList  ls)         `shouldReturn` foldMaybe (greater f) genmin ls  maximum :: (Show a, Ord a) => a -> [a] -> Expectation maximum genmin ls =-    S.fold FL.maximum (S.fromList ls)+    Stream.fold Fold.maximum (Stream.fromList  ls)         `shouldReturn` foldMaybe (greater compare) genmin ls  minimumBy :: (Ord a, Show a) => a -> (a -> a -> Ordering) -> [a] -> Expectation minimumBy genmax f ls =-    S.fold (FL.minimumBy f) (S.fromList ls)+    Stream.fold (Fold.minimumBy f) (Stream.fromList  ls)         `shouldReturn` foldMaybe (lesser f) genmax ls  minimum :: (Show a, Ord a) => a -> [a] -> Expectation minimum genmax ls =-    S.fold FL.minimum (S.fromList ls)+    Stream.fold Fold.minimum (Stream.fromList  ls)         `shouldReturn` foldMaybe (lesser compare) genmax ls  toList :: [Int] -> Expectation-toList ls = S.fold FL.toList (S.fromList ls) `shouldReturn` ls+toList ls = Stream.fold Fold.toList (Stream.fromList  ls) `shouldReturn` ls  toListRev :: [Int] -> Expectation-toListRev ls = S.fold FL.toListRev (S.fromList ls) `shouldReturn` reverse ls+toListRev ls = Stream.fold Fold.toListRev (Stream.fromList  ls) `shouldReturn` reverse ls  safeLast :: [a] -> Maybe a safeLast [] = Nothing@@ -121,7 +131,7 @@ safeLast (_:xs) = safeLast xs  last :: [String] -> Expectation-last ls = S.fold FL.last (S.fromList ls) `shouldReturn` safeLast ls+last ls = Stream.fold Fold.last (Stream.fromList  ls) `shouldReturn` safeLast ls  mapMaybe :: [Int] -> Expectation mapMaybe ls =@@ -129,8 +139,8 @@             if even x             then Just x             else Nothing-        f = FL.mapMaybe maybeEven FL.toList-    in S.fold f (S.fromList ls) `shouldReturn` filter even ls+        f = Fold.mapMaybe maybeEven Fold.toList+     in Stream.fold f (Stream.fromList  ls) `shouldReturn` filter even ls  nth :: Int -> [a] -> Maybe a nth idx (x : xs)@@ -141,18 +151,18 @@  index :: Int -> [String] -> Expectation index idx ls =-    let x = S.fold (FL.index idx) (S.fromList ls)+    let x = Stream.fold (Fold.index idx) (Stream.fromList  ls)     in x `shouldReturn` nth idx ls  find :: (Show a, Eq a) => (a -> Bool) -> [a] -> Expectation find f ls = do-    y <- S.fold (FL.findIndex f) (S.fromList ls)+    y <- Stream.fold (Fold.findIndex f) (Stream.fromList  ls)     case y of         Nothing ->-            let fld = S.fold (FL.find f) (S.fromList ls)+            let fld = Stream.fold (Fold.find f) (Stream.fromList  ls)             in fld `shouldReturn` Nothing         Just idx ->-            let fld = S.fold (FL.any f) (S.fromList $ Prelude.take idx ls)+            let fld = Stream.fold (Fold.any f) (Stream.fromList  $ Prelude.take idx ls)             in fld `shouldReturn` False  neg :: (a -> Bool) -> a -> Bool@@ -160,17 +170,17 @@  findIndex :: (a -> Bool) -> [a] -> Expectation findIndex f ls = do-    y <- S.fold (FL.findIndex f) (S.fromList ls)+    y <- Stream.fold (Fold.findIndex f) (Stream.fromList  ls)     case y of         Nothing  ->-            let fld = S.fold (FL.all $ neg f) (S.fromList ls)+            let fld = Stream.fold (Fold.all $ neg f) (Stream.fromList  ls)             in fld `shouldReturn` True         Just idx ->             if idx == 0             then-                S.fold (FL.all f) (S.fromList []) `shouldReturn` True+                Stream.fold (Fold.all f) (Stream.fromList  []) `shouldReturn` True             else-                S.fold (FL.all f) (S.fromList $ Prelude.take idx ls)+                Stream.fold (Fold.all f) (Stream.fromList  $ Prelude.take idx ls)                     `shouldReturn` False  predicate :: Int -> Bool@@ -178,19 +188,21 @@  elemIndex :: Int -> [Int] -> Expectation elemIndex elm ls = do-    y <- S.fold (FL.elemIndex elm) (S.fromList ls)+    y <- Stream.fold (Fold.elemIndex elm) (Stream.fromList  ls)     case y of         Nothing ->-            let fld = S.fold (FL.any (== elm)) (S.fromList ls)+            let fld = Stream.fold (Fold.any (== elm)) (Stream.fromList  ls)             in fld `shouldReturn` False         Just idx ->             let fld =-                    S.fold (FL.any (== elm)) (S.fromList $ Prelude.take idx ls)+                    Stream.fold+                        (Fold.any (== elm))+                        (Stream.fromList  $ Prelude.take idx ls)             in fld `shouldReturn` False  null :: [Int] -> Expectation null ls =-    S.fold FL.null (S.fromList ls)+    Stream.fold Fold.null (Stream.fromList  ls)         `shouldReturn`             case ls of                 [] -> True@@ -198,42 +210,42 @@  elem :: Int -> [Int] -> Expectation elem elm ls = do-    y <- S.fold (FL.elem elm) (S.fromList ls)-    let fld = S.fold (FL.any (== elm)) (S.fromList ls)+    y <- Stream.fold (Fold.elem elm) (Stream.fromList  ls)+    let fld = Stream.fold (Fold.any (== elm)) (Stream.fromList  ls)     fld `shouldReturn` y  notElem :: Int -> [Int] -> Expectation notElem elm ls = do-    y <- S.fold (FL.notElem elm) (S.fromList ls)-    let fld = S.fold (FL.any (== elm)) (S.fromList ls)+    y <- Stream.fold (Fold.notElem elm) (Stream.fromList  ls)+    let fld = Stream.fold (Fold.any (== elm)) (Stream.fromList  ls)     fld `shouldReturn` not y  all :: (a -> Bool) -> [a] -> Expectation all f ls =-    S.fold (FL.all f) (S.fromList ls) `shouldReturn` Prelude.all f ls+    Stream.fold (Fold.all f) (Stream.fromList  ls) `shouldReturn` Prelude.all f ls  any :: (a -> Bool) -> [a] -> Expectation-any f ls = S.fold (FL.any f) (S.fromList ls) `shouldReturn` Prelude.any f ls+any f ls = Stream.fold (Fold.any f) (Stream.fromList  ls) `shouldReturn` Prelude.any f ls  and :: [Bool] -> Expectation-and ls = S.fold FL.and (S.fromList ls) `shouldReturn` Prelude.and ls+and ls = Stream.fold Fold.and (Stream.fromList  ls) `shouldReturn` Prelude.and ls  or :: [Bool] -> Expectation-or ls = S.fold FL.or (S.fromList ls) `shouldReturn` Prelude.or ls+or ls = Stream.fold Fold.or (Stream.fromList  ls) `shouldReturn` Prelude.or ls  take :: [Int] -> Property take ls =     forAll (chooseInt (-1, Prelude.length ls + 2)) $ \n ->-            S.fold (FL.take n FL.toList) (S.fromList ls)+            Stream.fold (Fold.take n Fold.toList) (Stream.fromList  ls)                 `shouldReturn` Prelude.take n ls  takeEndBy_ :: Property takeEndBy_ =     forAll (listOf (chooseInt (0, 1))) $ \ls ->         let p = (== 1)-            f = FL.takeEndBy_ p FL.toList+            f = Fold.takeEndBy_ p Fold.toList             ys = Prelude.takeWhile (not . p) ls-         in case S.fold f (S.fromList ls) of+         in case Stream.fold f (Stream.fromList  ls) of             Right xs -> checkListEqual xs ys             Left _ -> property False @@ -242,9 +254,9 @@     forAll (chooseInt (min_value, max_value)) $ \n ->         forAll (listOf (chooseInt (0, 1))) $ \ls ->             let p = (== 1)-                f = FL.takeEndBy_ p (FL.take n FL.toList)+                f = Fold.takeEndBy_ p (Fold.take n Fold.toList)                 ys = Prelude.take n (Prelude.takeWhile (not . p) ls)-             in case S.fold f (S.fromList ls) of+             in case Stream.fold f (Stream.fromList  ls) of                     Right xs -> checkListEqual xs ys                     Left _ -> property False @@ -252,10 +264,10 @@ chooseFloat = choose  drain :: [Int] -> Expectation-drain ls = S.fold FL.drain (S.fromList ls) `shouldReturn` ()+drain ls = Stream.fold Fold.drain (Stream.fromList  ls) `shouldReturn` ()  drainBy :: [Int] -> Expectation-drainBy ls = S.fold (FL.drainBy return) (S.fromList ls) `shouldReturn` ()+drainBy ls = Stream.fold (Fold.drainBy return) (Stream.fromList  ls) `shouldReturn` ()  mean :: Property mean =@@ -265,7 +277,7 @@     where      action ls = do-        v1 <- run $ S.fold FL.mean (S.fromList ls)+        v1 <- run $ Stream.fold Fold.mean (Stream.fromList  ls)         let v2 = Prelude.sum ls / fromIntegral (Prelude.length ls)         assert (abs (v1 - v2) < 0.0001) @@ -277,7 +289,7 @@     where      action ls = do-        v1 <- run $ S.fold FL.stdDev (S.fromList ls)+        v1 <- run $ Stream.fold Fold.stdDev (Stream.fromList  ls)         let avg = Prelude.sum ls / fromIntegral (Prelude.length ls)             se = Prelude.sum (fmap (\x -> (x - avg) * (x - avg)) ls)             sd = sqrt $ se / fromIntegral (Prelude.length ls)@@ -291,7 +303,7 @@     where      action ls = do-        v1 <- run $ S.fold FL.variance (S.fromList ls)+        v1 <- run $ Stream.fold Fold.variance (Stream.fromList  ls)         let avg = Prelude.sum ls / fromIntegral (Prelude.length ls)             se = Prelude.sum (fmap (\x -> (x - avg) * (x - avg)) ls)             vr = se / fromIntegral (Prelude.length ls)@@ -305,7 +317,7 @@     where      action ls = do-        v1 <- run $ S.fold FL.mconcat (S.map Sum $ S.fromList ls)+        v1 <- run $ Stream.fold Fold.mconcat (fmap Sum $ Stream.fromList  ls)         let v2 = Prelude.sum ls         assert (getSum v1 == v2) @@ -317,7 +329,7 @@     where      action ls = do-        v1 <- run $ S.fold (FL.foldMap Sum) $ S.fromList ls+        v1 <- run $ Stream.fold (Fold.foldMap Sum) $ Stream.fromList  ls         let v2 = Prelude.sum ls         assert (getSum v1 == v2) @@ -329,7 +341,7 @@     where      action ls = do-        v1 <- run $ S.fold (FL.foldMapM (return . Sum)) $ S.fromList ls+        v1 <- run $ Stream.fold (Fold.foldMapM (return . Sum)) $ Stream.fromList  ls         let v2 = Prelude.sum ls         assert (getSum v1 == v2) @@ -346,7 +358,7 @@                  , (8, "fifth+third"), (9, "fifth+fourth")                  , (10, "fifth+fifth")                  ]-        v1 <- run $ S.fold (FL.lookup key) $ S.fromList ls+        v1 <- run $ Stream.fold (Fold.lookup key) $ Stream.fromList  ls         let v2 = Prelude.lookup key ls         assert (v1 == v2) @@ -359,9 +371,9 @@      action ls = do         let addLen x = return $ x + Prelude.length ls-            fld = FL.rmapM addLen FL.sum+            fld = Fold.rmapM addLen Fold.sum             v2 = foldl (+) (Prelude.length ls) ls-        v1 <- run $ S.fold fld $ S.fromList ls+        v1 <- run $ Stream.fold fld $ Stream.fromList  ls         assert (v1 == v2)  teeWithLength :: Property@@ -372,7 +384,7 @@     where      action ls = do-        v1 <- run $ S.fold (FL.tee FL.sum FL.length) $ S.fromList ls+        v1 <- run $ Stream.fold (Fold.tee Fold.sum Fold.length) $ Stream.fromList  ls         let v2 = Prelude.sum ls             v3 = Prelude.length ls         assert (v1 == (v2, v3))@@ -385,7 +397,10 @@     where      action ls = do-        v1 <- run $ S.fold (F.teeWithFst (,) (FL.take 5 FL.sum) FL.length) $ S.fromList ls+        v1 <-+            run+                $ Stream.fold (Fold.teeWithFst (,) (Fold.take 5 Fold.sum) Fold.length)+                $ Stream.fromList  ls         let v2 = Prelude.sum (Prelude.take 5 ls)             v3 = Prelude.length (Prelude.take 5 ls)         assert (v1 == (v2, v3))@@ -398,8 +413,11 @@     where      action ls = do-        let f = \x -> if odd x then return (Left x) else return (Right x)-        v1 <- run $ S.fold (F.partitionByM f FL.length FL.length) $ S.fromList ls+        let f x = if odd x then return (Left x) else return (Right x)+        v1 <-+            run+                $ Stream.fold (Fold.partitionByM f Fold.length Fold.length)+                $ Stream.fromList  ls         let v2 = foldl (\b a -> if odd a then b+1 else b) 0 ls             v3 = foldl (\b a -> if even a then b+1 else b) 0 ls         assert (v1 == (v2, v3))@@ -412,8 +430,12 @@     where      action _ = do-        let f = \x -> if odd x then return (Left x) else return (Right x)-        v1 <- run $ S.fold (F.partitionByFstM f (FL.take 25 FL.length) FL.length) (S.fromList ([1..100]:: [Int]))+        let f x = if odd x then return (Left x) else return (Right x)+        v1 <-+            run+                $ Stream.fold+                      (Fold.partitionByFstM f (Fold.take 25 Fold.length) Fold.length)+                      (Stream.fromList  ([1 .. 100] :: [Int]))         let v2 = foldl (\b a -> if odd a then b+1 else b) 0 ([1..49] :: [Int])             v3 = foldl (\b a -> if even a then b+1 else b) 0 ([1..49] :: [Int])         assert (v1 == (v2, v3))@@ -426,8 +448,12 @@     where      action _ = do-        let f = \x -> if odd x then return (Left x) else return (Right x)-        v1 <- run $ S.fold (F.partitionByMinM f  FL.length (FL.take 25 FL.length)) (S.fromList ([1..100]:: [Int]))+        let f x = if odd x then return (Left x) else return (Right x)+        v1 <-+            run+                $ Stream.fold+                      (Fold.partitionByMinM f Fold.length (Fold.take 25 Fold.length))+                      (Stream.fromList  ([1 .. 100] :: [Int]))         let v2 = foldl (\b a -> if odd a then b+1 else b) 0 ([1..50] :: [Int])             v3 = foldl (\b a -> if even a then b+1 else b) 0 ([1..50] :: [Int])         assert (v1 == (v2, v3))@@ -440,8 +466,12 @@     where      action _ = do-        let f = \x -> if odd x then return (Left x) else return (Right x)-        v1 <- run $ S.fold (F.partitionByMinM f (FL.take 25 FL.length) FL.length) (S.fromList ([1..100]:: [Int]))+        let f x = if odd x then return (Left x) else return (Right x)+        v1 <-+            run+                $ Stream.fold+                      (Fold.partitionByMinM f (Fold.take 25 Fold.length) Fold.length)+                      (Stream.fromList  ([1 .. 100] :: [Int]))         let v2 = foldl (\b a -> if odd a then b+1 else b) 0 ([1..49] :: [Int])             v3 = foldl (\b a -> if even a then b+1 else b) 0 ([1..49] :: [Int])         assert (v1 == (v2, v3))@@ -454,7 +484,10 @@     where      action ls = do-        v1 <- run $ S.fold (F.teeWithMin (,) (FL.take 5 FL.sum)  FL.length) $ S.fromList ls+        v1 <-+            run+                $ Stream.fold (Fold.teeWithMin (,) (Fold.take 5 Fold.sum) Fold.length)+                $ Stream.fromList  ls         let v2 = Prelude.sum (Prelude.take 5 ls)             v3 = Prelude.length (Prelude.take 5 ls)         assert (v1 == (v2, v3))@@ -468,10 +501,14 @@     where      action ls = do-        v1 <- run $ S.fold (F.teeWithMin (,) FL.sum  (FL.take 5 FL.length)) $ S.fromList ls+        v1 <-+            run+                $ Stream.fold (Fold.teeWithMin (,) Fold.sum (Fold.take 5 Fold.length))+                $ Stream.fromList  ls         let v2 = Prelude.sum (Prelude.take 5 ls)             v3 = Prelude.length (Prelude.take 5 ls)         assert (v1 == (v2, v3))+ teeWithMax :: Property teeWithMax =     forAll (listOf1 (chooseInt (intMin, intMax)))@@ -480,7 +517,7 @@     where      action ls = do-        v1 <- run $ S.fold (FL.tee FL.sum FL.maximum) $ S.fromList ls+        v1 <- run $ Stream.fold (Fold.tee Fold.sum Fold.maximum) $ Stream.fromList  ls         let v2 = Prelude.sum ls             v3 = foldMaybe (greater compare) intMin ls         assert (v1 == (v2, v3))@@ -493,7 +530,8 @@     where      action ls = do-        v1 <- run $ S.fold (FL.distribute [FL.sum, FL.length]) $ S.fromList ls+        v1 <-+            run $ Stream.fold (Fold.distribute [Fold.sum, Fold.length]) $ Stream.fromList  ls         let v2 = Prelude.sum ls             v3 = Prelude.length ls         assert (v1 == [v2, v3])@@ -503,8 +541,8 @@     monadicIO $ do         v1 :: (Int, [String]) <-             run-                $ S.fold (FL.partition FL.sum FL.toList)-                $ S.fromList+                $ Stream.fold (Fold.partition Fold.sum Fold.toList)+                $ Stream.fromList                     [Left 1, Right "abc", Left 3, Right "xy", Right "pp2"]         let v2 = (4,["abc","xy","pp2"])         assert (v1 == v2)@@ -514,29 +552,39 @@     monadicIO $ do     v1 :: (Int, [String]) <-         run-            $ S.fold (FL.unzip FL.sum FL.toList)-            $ S.fromList [(1, "aa"), (2, "bb"), (3, "cc")]+            $ Stream.fold (Fold.unzip Fold.sum Fold.toList)+            $ Stream.fromList  [(1, "aa"), (2, "bb"), (3, "cc")]     let v2 = (6, ["aa", "bb", "cc"])     assert (v1 == v2) +postscan :: Property+postscan = forAll (listOf (chooseInt (intMin, intMax))) $ \ls ->+    monadicIO $ do+    v1 :: [Int] <-+        run+            $ Stream.fold (Fold.postscan Fold.sum Fold.toList)+            $ Stream.fromList  ls+    let v2 = scanl1 (+) ls+    assert (v1 == v2)+ many :: Property many =     forAll (listOf (chooseInt (0, 100))) $ \lst ->     forAll (chooseInt (1, 100)) $ \i ->         monadicIO $ do-            let strm = S.fromList lst-            r1 <- S.fold (FL.many (split i) FL.toList) strm-            r2 <- S.toList $ Stream.foldMany (split i) strm+            let strm = Stream.fromList  lst+            r1 <- Stream.fold (Fold.many (split i) Fold.toList) strm+            r2 <- Stream.fold Fold.toList $ Stream.foldMany (split i) strm             assert $ r1 == r2      where -    split i = FL.take i FL.toList+    split i = Fold.take i Fold.toList -headAndRest :: [Int] -> Property-headAndRest ls = monadicIO $ do-    (mbh, rest) <- run $ Stream.fold_ FL.head (S.fromList ls)-    rests <- run $ S.toList rest+foldBreak :: [Int] -> Property+foldBreak ls = monadicIO $ do+    (mbh, rest) <- run $ Stream.foldBreak Fold.one (Stream.fromList  ls)+    rests <- run $ Stream.fold Fold.toList rest     assert (mbh == headl ls)     listEquals (==) rests (taill ls) @@ -548,94 +596,48 @@  demux :: Expectation demux =-    let table = Data.Map.fromList [("SUM", FL.sum), ("PRODUCT", FL.product)]-        input = Stream.fromList (+    let table "SUM" = return $ Just Fold.sum+        table "PRODUCT" = return $ Just Fold.product+        table _ = return $ Just Fold.length+        input = Stream.fromList  (                 [ ("SUM", 1)+                , ("abc", 1)                 , ("PRODUCT", 2)+                , ("abc", 2)                 , ("SUM",3)+                , ("xyz", 1)                 , ("PRODUCT", 4)+                , ("xyz", 2)+                , ("abc", 2)                 ] :: [(String, Int)])     in Stream.fold-        (F.demux table)+        (Fold.demuxKvToMap table)         input         `shouldReturn`-        Data.Map.fromList [("PRODUCT", 8),("SUM", 4)]+        Data.Map.fromList [("PRODUCT", 8),("SUM", 4),("abc",3),("xyz",2)]  -demuxWithSum :: Expectation-demuxWithSum =-    let f x = ("SUM", x::Int)-        table = Data.Map.fromList [("SUM", FL.sum)]-        input = Stream.fromList [1, 4]-    in Stream.fold-        (F.demuxWith f table)-        input-        `shouldReturn`-        Data.Map.fromList [("SUM", 5)]--demuxWithProduct :: Expectation-demuxWithProduct =-    let f x = ("PRODUCT", x::Int)-        table = Data.Map.fromList [("PRODUCT", FL.product)]-        input = Stream.fromList [2, 4]-    in Stream.fold-        (F.demuxWith f table)-        input-        `shouldReturn`-        Data.Map.fromList [("PRODUCT", 8)]--demuxDefaultWithSum :: Expectation-demuxDefaultWithSum =-    let f x = ("SUM", x::Int)-        table = Data.Map.fromList [("SUM", FL.sum)]-        input = Stream.fromList [2, 4]-    in Stream.fold-        (F.demuxDefaultWith f table (FL.lmap snd FL.sum))-        input-        `shouldReturn`-        (Data.Map.fromList [("SUM" , 6)] , 0)--demuxDefaultWithProduct :: Expectation-demuxDefaultWithProduct =-    let f x = ("PRODUCT", x::Int)-        table = Data.Map.fromList [("PRODUCT", FL.product)]-        input = Stream.fromList [2, 4]-    in Stream.fold-        (F.demuxDefaultWith f table (FL.lmap snd FL.product))-        input-        `shouldReturn`-        (Data.Map.fromList [("PRODUCT" , 8)] , 1)+demuxWith :: Expectation+demuxWith =+    let getKey x | even x = "SUM"+                 | otherwise = "PRODUCT" -demuxDefault :: Expectation-demuxDefault =-    let table =  Data.Map.fromList [("SUM", FL.sum), ("PRODUCT", FL.product)]-        input = Stream.fromList-            [ ("SUM", 1::Int)-            , ("PRODUCT", 2::Int)-            , ("SUM",3)-            , ("PRODUCT", 4::Int)-            ]-    in Stream.fold-        (F.demuxDefault table (FL.lmap snd FL.product))-        input-        `shouldReturn`-        (Data.Map.fromList [("PRODUCT", 8), ("SUM", 4)], 1)+        getFold "SUM" = return Fold.sum+        getFold "PRODUCT" = return Fold.product+        getFold _ = error "demuxWith: bug" -demuxDefaultEmpty :: Expectation-demuxDefaultEmpty =-    let table =  Data.Map.empty-        input = Stream.fromList []+        input = Stream.fromList  [1, 2, 3, 4 :: Int]     in Stream.fold-        (F.demuxDefault table (FL.lmap snd FL.product))+        (Fold.demuxToContainer getKey (getFold . getKey))         input         `shouldReturn`-        (Data.Map.fromList ([]::[(String, Int)]), 1)+        Data.Map.fromList  [("PRODUCT",3),("SUM",6)]  classifyWith :: Expectation classifyWith =-    let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]+    let input = Stream.fromList  [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]     in Stream.fold-        (F.classifyWith fst (FL.lmap snd FL.toList))+        (Fold.toContainer fst (Fold.lmap snd Fold.toList))         input         `shouldReturn`         Data.Map.fromList@@ -652,7 +654,7 @@             , ("TWO",(2, 2.2))             ]     in Stream.fold-        (F.classify (FL.lmap snd FL.toList))+        (Fold.kvToMap (Fold.lmap snd Fold.toList))         input         `shouldReturn`         Data.Map.fromList@@ -661,11 +663,53 @@ splitAt :: Expectation splitAt =     Stream.fold-    (F.splitAt 6 FL.toList FL.toList)-    (Stream.fromList "Hello World!")+    (Fold.splitAt 6 Fold.toList Fold.toList)+    (Stream.fromList  "Hello World!")     `shouldReturn`     ("Hello ","World!") +scan :: Property+scan = forAll (listOf (chooseInt (0, 100))) $ \lst ->+    monadicIO $ do+    v1 :: [Int] <-+        run+            $ Stream.fold (Fold.scan Fold.sum Fold.toList)+            $ Stream.fromList  lst+    let v2 = scanl (+) 0 lst+    assert (v1 == v2)++topBy :: Bool -> Property+topBy isTop = forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->+        monadicIO $ action ls0++        where++        action ls = do++            let n0 = Prelude.length ls+            n <- liftIO $ generate $ chooseInt (-2, n0 + 2)+            if isTop+            then do+                lst <- Stream.fold (Fold.top n) (Stream.fromList  ls) >>= MArray.toList+                assert ((Prelude.take n . sortBy (comparing Down)) ls ==  lst)+            else do+                lst <- Stream.fold (Fold.bottom n) (Stream.fromList  ls) >>= MArray.toList+                assert ((Prelude.take n . sort) ls ==  lst)++top :: Property+top = topBy True++bottom :: Property+bottom = topBy False++nub :: Property+nub = monadicIO $ do+    vals <- Stream.fold Fold.toList+            $ Stream.catMaybes+            $ Stream.postscan Fold.nub+            $ Stream.fromList  [1::Int, 1, 2, 3, 4, 4, 5, 1, 5, 7]+    assert (vals == [1, 2, 3, 4, 5, 7])+ moduleName :: String moduleName = "Data.Fold" @@ -696,12 +740,7 @@         prop "toList" toList         prop "toListRev" toListRev         prop "demux" demux-        prop "demuxWithSum" demuxWithSum-        prop "demuxWithProduct" demuxWithProduct-        prop "demuxDefaultWithSum" demuxDefaultWithSum-        prop "demuxDefaultWithProduct" demuxDefaultWithProduct-        prop "demuxDefault" demuxDefault-        prop "demuxDefaultEmpty" demuxDefaultEmpty+        prop "demuxWith" demuxWith         prop "classifyWith" classifyWith         prop "classify" classify @@ -719,10 +758,15 @@         prop "any" $ Main.any predicate         prop "and" Main.and         prop "or" Main.or+        prop "top" Main.top+        prop "bottom" Main.bottom+        prop "nub" Main.nub          -- Combinators          -- Transformation+        prop "scan" scan+        prop "postscan" Main.postscan         -- rsequence         -- Functor instance         prop "rmapM" Main.rmapM@@ -740,7 +784,7 @@         prop "takeEndByOrMax" takeEndByOrMax          -- Appending-        -- serialWith+        -- splitWith          -- Distributing         -- tee@@ -768,4 +812,4 @@         -- concatMap         -- chunksOf -        prop "head from fold_" headAndRest+        prop "foldBreak" foldBreak
+ test/Streamly/Test/Data/Fold/Window.hs view
@@ -0,0 +1,89 @@+module Streamly.Test.Data.Fold.Window (main) where++import Test.Hspec (hspec, describe, it, runIO)+import Streamly.Internal.Data.Scanl (Incr(..))+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.RingArray as RingArray+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Stream as S++import Prelude hiding (sum, maximum, minimum)++moduleName :: String+moduleName = "Window"++main :: IO ()+main = hspec $ do+    describe moduleName $ do+        let numElem = 80000+            winSize = 800+            testCaseChunk = [9007199254740992, 1, 1.0 :: Double,+                                9007199254740992, 1, 1, 1, 9007199254740992]+            testCase = take numElem $ cycle testCaseChunk+            deviationLimit = 1++            testFunc f = do+                let c = S.fromList testCase+                    f1 = Fold.fromScanl $ Scanl.incrScan winSize f+                    f2 = Fold.fromScanl f+                a <- runIO $ S.fold f1 c+                b <- runIO $ S.fold f2 $ S.drop (numElem - winSize)+                        $ fmap Insert c+                let c1 = a - b+                it ("should not deviate more than " ++ show deviationLimit)+                    $ c1 >= -1 * deviationLimit && c1 <= deviationLimit++        describe "Sum" $ testFunc Scanl.incrSum+        describe "mean" $ testFunc Scanl.incrMean++    describe "Correctness" $ do+        let winSize = 3+            testCase1 =+                [1.0, 4.0, 3.0, 2.1, -5.1, -2.0, 7.0, 3.0, -2.5] :: [Double]++            testCase2 = replicate 5 1.0 ++ [7.0]++            testFunc tc f sI sW = do+                let c = S.fromList tc+                a <- runIO $ S.fold Fold.toList $ S.postscanl f $ fmap Insert c+                b <- runIO $ S.fold Fold.toList $ S.postscanl+                        (Scanl.incrScan winSize f) c+                it "Infinite" $ a  == sI+                it ("Finite " ++ show winSize) $ b == sW++            testFunc2 tc expec f = do+                let c = S.fromList tc+                a <- runIO $ S.toList $ S.postscanl (f winSize) c+                runIO $ print a+                it (show tc) $ a == expec++        describe "toList" $ do+            testFunc2 testCase1+                [[1.0],[1.0,4.0],[1.0,4.0,3.0],[4.0,3.0,2.1],[3.0,2.1,-5.1]+                ,[2.1,-5.1,-2.0],[-5.1,-2.0,7.0],[-2.0,7.0,3.0],[7.0,3.0,-2.5]+                ]+                (RingArray.scanFoldRingsBy Fold.toList)+        describe "minimum" $ do+            testFunc2 testCase1+                [Just 1.0,Just 1.0,Just 1.0,Just 2.1,Just (-5.1),Just (-5.1)+                ,Just (-5.1),Just (-2.0),Just (-2.5)]+                (RingArray.scanFoldRingsBy Fold.minimum)+        describe "maximum" $ do+            testFunc2 testCase1+                [Just 1.0,Just 4.0,Just 4.0,Just 4.0,Just 3.0,Just 2.1+                ,Just 7.0,Just 7.0,Just 7.0]+                (RingArray.scanFoldRingsBy Fold.maximum)+        describe "range" $ do+            testFunc2 testCase1+                [Just (1.0,1.0),Just (1.0,4.0),Just (1.0,4.0),Just (2.1,4.0)+                ,Just (-5.1,3.0),Just (-5.1,2.1),Just (-5.1,7.0)+                ,Just (-2.0,7.0),Just (-2.5,7.0)]+                (RingArray.scanFoldRingsBy Fold.range)+        describe "sum" $ do+            let scanInf = [1, 2, 3, 4, 5, 12] :: [Double]+                scanWin = [1, 2, 3, 3, 3, 9] :: [Double]+            testFunc testCase2 Scanl.incrSum scanInf scanWin+        describe "mean" $ do+            let scanInf = [1, 1, 1, 1, 1, 2] :: [Double]+                scanWin = [1, 1, 1, 1, 1, 3] :: [Double]+            testFunc testCase2 Scanl.incrMean scanInf scanWin
test/Streamly/Test/Data/List.hs view
@@ -4,18 +4,15 @@  module Main (main) where -#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Test.Hspec import qualified GHC.Exts as GHC  #ifdef USE_STREAMLY_LIST import Data.Functor.Identity-import Streamly.Internal.Data.List (List(..), pattern Cons, pattern Nil, ZipList(..),-                     fromZipList, toZipList)-import Streamly.Prelude (SerialT)-import qualified Streamly.Prelude as S+import Streamly.Internal.Data.List+    (List(..), pattern Cons, pattern Nil, ZipList(..), fromZipList, toZipList)+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as S #else import Prelude -- to suppress compiler warning @@ -42,37 +39,37 @@ main = hspec $   describe moduleName $ do #ifdef USE_STREAMLY_LIST-    describe "OverloadedLists for 'SerialT Identity' type" $ do+    describe "OverloadedLists for 'Stream Identity' type" $ do         it "Overloaded lists" $ do-            ([1..3] :: SerialT Identity Int) `shouldBe` S.fromList [1..3]-            GHC.toList ([1..3] :: SerialT Identity Int) `shouldBe` [1..3]+            ([1..3] :: Stream Identity Int) `shouldBe` S.fromList [1..3]+            GHC.toList ([1..3] :: Stream Identity Int) `shouldBe` [1..3]          it "Show instance" $ do-            show (S.fromList [1..3] :: SerialT Identity Int)+            show (S.fromList [1..3] :: Stream Identity Int)                 `shouldBe` "fromList [1,2,3]"         it "Read instance" $ do-            (read "fromList [1,2,3]" :: SerialT Identity Int) `shouldBe` [1..3]+            (read "fromList [1,2,3]" :: Stream Identity Int) `shouldBe` [1..3]          it "Eq instance" $ do-            ([1,2,3] :: SerialT Identity Int) == [1,2,3] `shouldBe` True+            ([1,2,3] :: Stream Identity Int) == [1,2,3] `shouldBe` True          it "Ord instance" $ do-            ([1,2,3] :: SerialT Identity Int) > [1,2,1] `shouldBe` True+            ([1,2,3] :: Stream Identity Int) > [1,2,1] `shouldBe` True          it "Monad comprehension" $ do             [(x,y) | x <- [1..2], y <- [1..2]] `shouldBe`-                ([(1,1), (1,2), (2,1), (2,2)] :: SerialT Identity (Int, Int))+                ([(1,1), (1,2), (2,1), (2,2)] :: List (Int, Int)) -        it "Foldable (sum)" $ sum ([1..3] :: SerialT Identity Int)+        it "Foldable (sum)" $ sum ([1..3] :: Stream Identity Int)             `shouldBe` 6          it "Traversable (mapM)" $-            mapM return ([1..10] :: SerialT Identity Int)+            mapM return ([1..10] :: Stream Identity Int)                 `shouldReturn` [1..10] -    describe "OverloadedStrings for 'SerialT Identity' type" $ do+    describe "OverloadedStrings for 'Stream Identity' type" $ do         it "overloaded strings" $ do-            ("hello" :: SerialT Identity Char) `shouldBe` S.fromList "hello"+            ("hello" :: Stream Identity Char) `shouldBe` S.fromList "hello" #endif      describe "OverloadedLists for List type" $ do@@ -113,7 +110,7 @@         it "Show instance" $ do             show ([1..3] :: List Int) `shouldBe` #ifdef USE_STREAMLY_LIST-                "List {toSerial = fromList [1,2,3]}"+                "fromList [1,2,3]" #else                 "[1,2,3]" #endif@@ -121,7 +118,7 @@         it "Read instance" $ do             (read #ifdef USE_STREAMLY_LIST-                "List {toSerial = fromList [1,2,3]}"+                "fromList [1,2,3]" #else                 "[1,2,3]" #endif@@ -148,11 +145,7 @@             ("hello" :: List Char) `shouldBe` GHC.fromList "hello"          it "pattern matches" $ do-#if __GLASGOW_HASKELL__ >= 802             case "" of-#else-            case "" :: List Char of-#endif                 Nil -> return ()                 _ -> expectationFailure "not reached" @@ -203,10 +196,10 @@          it "Show instance" $ do             show ([1..3] :: ZipList Int) `shouldBe`-                "ZipList {toZipSerial = fromList [1,2,3]}"+                "ZipList {toZipStream = fromList [1,2,3]}"          it "Read instance" $ do-            (read "ZipList {toZipSerial = fromList [1,2,3]}" :: ZipList Int)+            (read "ZipList {toZipStream = fromList [1,2,3]}" :: ZipList Int)                 `shouldBe` [1..3]          it "Eq instance" $ do
+ test/Streamly/Test/Data/MutArray.hs view
@@ -0,0 +1,153 @@+module Streamly.Test.Data.MutArray (main) where++import Test.QuickCheck (listOf)++import Control.Monad (void)+import Data.Complex (Complex)+import Data.Functor.Const (Const)+import Data.Functor.Identity (Identity)+import Foreign.Ptr (IntPtr, WordPtr)+import GHC.Exts+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(..))+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Test.Common (chooseInt)+import Test.Hspec (hspec, describe, it)+import Test.Hspec.QuickCheck+import Test.QuickCheck (forAll, Property)+import Test.QuickCheck.Monadic (monadicIO, assert)+#if MIN_VERSION_base(4,15,0)+import GHC.IO.SubSystem (IoSubSystem (..))+#endif++import qualified Streamly.Internal.Data.MutArray as MArray+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Test.Hspec as Hspec++maxTestCount :: Int+maxTestCount = 100++moduleName :: String+moduleName = "Data.MutArray"++testAppend ::  Property+testAppend =+   forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->+        monadicIO $ action ls0++        where++        action ls = do+            arr0 <- MArray.emptyOf' 0+            x <- Stream.fold+                    (MArray.append2 arr0)+                    (Stream.fromList (ls::[Int]))+            lst <- MArray.toList x+            assert (ls == lst)++#define TEST_IE(_type) it "_type" $ testIE ([] :: [_type])++-- XXX This should be in test/Data.Unbox+-- C-ish foreign types are platfor specific. The platform needs to be taken into+-- consideration when making instances.+testUnboxInstanceExistance :: Hspec.SpecWith ()+testUnboxInstanceExistance = do+    describe "Unbox instances" $ do+        -- TEST_IE(CBool)+        -- TEST_IE(CChar)+        -- TEST_IE(CClock)+        -- TEST_IE(CDouble)+        -- TEST_IE(CFloat)+        -- TEST_IE(CInt)+        -- TEST_IE(CIntMax)+        -- TEST_IE(CIntPtr)+        -- TEST_IE(CLLong)+        -- TEST_IE(CLong)+        -- TEST_IE(CPtrdiff)+        -- TEST_IE(CSChar)+        -- TEST_IE(CSUSeconds)+        -- TEST_IE(CShort)+        -- TEST_IE(CSigAtomic)+        -- TEST_IE(CSize)+        -- TEST_IE(CTime)+        -- TEST_IE(CUChar)+        -- TEST_IE(CUInt)+        -- TEST_IE(CUIntMax)+        -- TEST_IE(CUIntPtr)+        -- TEST_IE(CULLong)+        -- TEST_IE(CULong)+        -- TEST_IE(CUSeconds)+        -- TEST_IE(CUShort)+        -- TEST_IE(CWchar)+        TEST_IE(IntPtr)+        TEST_IE(WordPtr)+        TEST_IE(Fingerprint)+        TEST_IE(Int16)+        TEST_IE(Int32)+        TEST_IE(Int64)+        TEST_IE(Int8)+#if MIN_VERSION_base(4,15,0)+        TEST_IE(IoSubSystem)+#endif+        TEST_IE(Word16)+        TEST_IE(Word32)+        TEST_IE(Word64)+        TEST_IE(Word8)+        -- TEST_IE(CBlkCnt)+        -- TEST_IE(CBlkSize)+        -- TEST_IE(CCc)+        -- TEST_IE(CClockId)+        -- TEST_IE(CDev)+        -- TEST_IE(CFsBlkCnt)+        -- TEST_IE(CFsFilCnt)+        -- TEST_IE(CGid)+        -- TEST_IE(CId)+        -- TEST_IE(CIno)+        -- TEST_IE(CKey)+        -- TEST_IE(CMode)+        -- TEST_IE(CNfds)+        -- TEST_IE(CNlink)+        -- TEST_IE(COff)+        -- TEST_IE(CPid)+        -- TEST_IE(CRLim)+        -- TEST_IE(CSocklen)+        -- TEST_IE(CSpeed)+        -- TEST_IE(CSsize)+        -- TEST_IE(CTcflag)+        -- TEST_IE(CTimer)+        -- TEST_IE(CUid)+        -- TEST_IE(Fd)+        TEST_IE(())+        TEST_IE(Bool)+        TEST_IE(Char)+        TEST_IE(Double)+        TEST_IE(Float)+        TEST_IE(Int)+        TEST_IE(Word)+        TEST_IE(Complex Int)+        TEST_IE(Identity Int)+#if MIN_VERSION_base(4,14,0)+        TEST_IE(Down Int)+#endif+        TEST_IE(FunPtr Int)+        TEST_IE(Ptr Int)+        TEST_IE(Ratio Int)+        TEST_IE(StablePtr Int)+        TEST_IE(Const Int Int)+    where++    testIE :: Unbox a => [a] -> IO ()+    testIE lst = void $ MArray.fromList lst++main :: IO ()+main =+    hspec $+    Hspec.parallel $+    modifyMaxSuccess (const maxTestCount) $ do+        describe moduleName $ do+            describe "Stream Append" $ do+                prop "testAppend" testAppend+            testUnboxInstanceExistance
test/Streamly/Test/Data/Parser.hs view
@@ -1,809 +1,470 @@-module Main (main) where--import Control.Exception (SomeException(..), displayException)-import Data.Word (Word8, Word32, Word64)-import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)-import Test.Hspec (Spec, hspec, describe)-import Test.Hspec.QuickCheck-import Test.QuickCheck-       (arbitrary, forAll, elements, Property, property, listOf,-        vectorOf, Gen)-import Test.QuickCheck.Monadic (monadicIO, assert, run)--import Prelude hiding (sequence)--import qualified Data.List as List-import qualified Prelude-import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser as P-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Test.Hspec as H--#if MIN_VERSION_QuickCheck(2,14,0)--import Test.QuickCheck (chooseAny)--#else--import System.Random (Random(random))-import Test.QuickCheck.Gen (Gen(MkGen))---- | Generates a random element over the natural range of `a`.-chooseAny :: Random a => Gen a-chooseAny = MkGen (\r _ -> let (x,_) = random r in x)--#endif---maxTestCount :: Int-maxTestCount = 100--min_value :: Int-min_value = 0--mid_value :: Int-mid_value = 5000--max_value :: Int-max_value = 10000--max_length :: Int-max_length = 1000---- Accumulator Tests--fromFold :: Property-fromFold =-    forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->-        case (==) <$> S.parse (P.fromFold FL.sum) (S.fromList ls)-                  <*> S.fold FL.sum (S.fromList ls) of-            Right is_equal -> is_equal-            Left _ -> False--fromPure :: Property-fromPure =-    forAll (chooseInt (min_value, max_value)) $ \x ->-        case S.parse (P.fromPure x) (S.fromList [1 :: Int]) of-            Right r -> r == x-            Left _ -> False--fromEffect :: Property-fromEffect =-    forAll (chooseInt (min_value, max_value)) $ \x ->-        case S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of-            Right r -> r == x-            Left _ -> False--die :: Property-die =-    property $-    case S.parse (P.die "die test") (S.fromList [0 :: Int]) of-        Right _ -> False-        Left _ -> True--dieM :: Property-dieM =-    property $-    case S.parse (P.dieM (Right "die test")) (S.fromList [0 :: Int]) of-        Right _ -> False-        Left _ -> True--parserFail :: Property-parserFail =-    property $-    case S.parse (fail err) (S.fromList [0 :: Int]) of-        Right _ -> False-        Left (SomeException e) -> err == displayException e-  where-    err = "Testing MonadFail.fail."---- Element Parser Tests--peekPass :: Property-peekPass =-    forAll (chooseInt (1, max_length)) $ \list_length ->-        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-            case S.parse P.peek (S.fromList ls) of-                Right head_value -> case ls of-                    head_ls : _ -> head_value == head_ls-                    _ -> False-                Left _ -> False--peekFail :: Property-peekFail =-    property (case S.parse P.peek (S.fromList []) of-        Right _ -> False-        Left _ -> True)--eofPass :: Property-eofPass =-    property (case S.parse P.eof (S.fromList []) of-        Right _ -> True-        Left _ -> False)--eofFail :: Property-eofFail =-    forAll (chooseInt (1, max_length)) $ \list_length ->-        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-            case S.parse P.eof (S.fromList ls) of-                Right _ -> False-                Left _ -> True--satisfyPass :: Property-satisfyPass =-    forAll (chooseInt (mid_value, max_value)) $ \first_element ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->-            let-                ls = first_element : ls_tail-                predicate = (>= mid_value)-            in-                case S.parse (P.satisfy predicate) (S.fromList ls) of-                    Right r -> r == first_element-                    Left _ -> False--satisfy :: Property-satisfy =-    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        case S.parse (P.satisfy predicate) (S.fromList ls) of-            Right r -> case ls of-                [] -> False-                (x : _) -> predicate x && (r == x)-            Left _ -> case ls of-                [] -> True-                (x : _) -> not $ predicate x-        where-            predicate = (>= mid_value)--nextPass :: Property-nextPass =-    forAll (chooseInt (1, max_value)) $ \int ->-        property (case S.parse P.next (S.fromList [int]) of-            Right (Just i) -> i  == int-            _ -> False)--next :: Property-next =-    property (case S.parse P.next (S.fromList []) of-        Right Nothing -> True-        _ -> False)---- Sequence Parsers Tests-takeBetweenPass :: Property-takeBetweenPass =-    forAll (chooseInt (min_value, max_value)) $ \m ->-        forAll (chooseInt (m, max_value)) $ \n ->-            forAll (chooseInt (m, max_value)) $ \list_length ->-                forAll (vectorOf list_length (chooseInt (min_value, max_value)))-                    $ \ls ->-                        case S.parse (P.takeBetween m n FL.toList)-                                (S.fromList ls) of-                            Right parsed_list ->-                                let lpl = Prelude.length parsed_list-                                in checkListEqual parsed_list-                                    $ Prelude.take lpl ls-                            Left _ -> property False--takeBetween :: Property-takeBetween =-    forAll (chooseInt (min_value, max_value)) $ \m ->-        forAll (chooseInt (min_value, max_value)) $ \n ->-            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-                go m n ls--    where--    go m n ls =-        let inputLen = Prelude.length ls-         in case S.parse (P.takeBetween m n FL.toList) (S.fromList ls) of-                Right xs ->-                    let parsedLen = Prelude.length xs-                     in if inputLen >= m && parsedLen >= m && parsedLen <= n-                        then checkListEqual xs $ Prelude.take parsedLen ls-                        else property False-                Left _ ->-                    property ((m >= 0 && n >= 0 && m > n) || inputLen < m)--takeEQPass :: Property-takeEQPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (chooseInt (n, max_value)) $ \list_length ->-            forAll (vectorOf list_length-                        (chooseInt (min_value, max_value))) $ \ls ->-                case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        checkListEqual parsed_list (Prelude.take n ls)-                    Left _ -> property False--takeEQ :: Property-takeEQ =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            let-                list_length = Prelude.length ls-            in-                case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        if n <= list_length-                        then checkListEqual parsed_list (Prelude.take n ls)-                        else property False-                    Left _ -> property (n > list_length)--takeGEPass :: Property-takeGEPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (chooseInt (n, max_value)) $ \list_length ->-            forAll (vectorOf list_length (chooseInt (min_value, max_value)))-                $ \ls ->-                    case S.parse (P.takeGE n FL.toList) (S.fromList ls) of-                        Right parsed_list -> checkListEqual parsed_list ls-                        Left _ -> property False--takeGE :: Property-takeGE =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            let-                list_length = Prelude.length ls-            in-                case S.parse (P.takeGE n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        if n <= list_length-                        then checkListEqual parsed_list ls-                        else property False-                    Left _ -> property (n > list_length)--nLessThanEqual0 ::-       (  Int-       -> FL.Fold (Either SomeException) Int [Int]-       -> P.Parser (Either SomeException) Int [Int]-       )-    -> (Int -> [Int] -> [Int])-    -> Property-nLessThanEqual0 tk ltk =-    forAll (elements [0, (-1)]) $ \n ->-        forAll (listOf arbitrary) $ \ls ->-            case S.parse (tk n FL.toList) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (ltk n ls)-                Left _ -> property False--takeProperties :: Spec-takeProperties =-    describe "take combinators when n <= 0/" $ do-        prop "takeEQ n FL.toList = []" $-            nLessThanEqual0 P.takeEQ (\_ -> const [])-        prop "takeGE n FL.toList xs = xs" $-            nLessThanEqual0 P.takeGE (\_ -> id)---- lookAheadPass :: Property--- lookAheadPass =---     forAll (chooseInt (min_value + 1, max_value)) $ \n ->---         let---             takeWithoutConsume = P.lookAhead $ P.take n FL.toList---             parseTwice = do---                 parsed_list_1 <- takeWithoutConsume---                 parsed_list_2 <- takeWithoutConsume---                 return (parsed_list_1, parsed_list_2)---         in---             forAll (chooseInt (n, max_value)) $ \list_length ->---                 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->---                     case S.parse parseTwice (S.fromList ls) of---                         Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)---                         Left _ -> property $ False---- lookAheadFail :: Property--- lookAheadFail =---     forAll (chooseInt (min_value + 1, max_value)) $ \n ->---         let---             takeWithoutConsume = P.lookAhead $ P.take n FL.toList---             parseTwice = do---                 parsed_list_1 <- takeWithoutConsume---                 parsed_list_2 <- takeWithoutConsume---                 return (parsed_list_1, parsed_list_2)---         in---             forAll (chooseInt (min_value, n - 1)) $ \list_length ->---                 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->---                     case S.parse parseTwice (S.fromList ls) of---                         Right _ -> False---                         Left _ -> True---- lookAhead :: Property--- lookAhead =---     forAll (chooseInt (min_value, max_value)) $ \n ->---         let---             takeWithoutConsume = P.lookAhead $ P.take n FL.toList---             parseTwice = do---                 parsed_list_1 <- takeWithoutConsume---                 parsed_list_2 <- takeWithoutConsume---                 return (parsed_list_1, parsed_list_2)---         in---             forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->---                 case S.parse parseTwice (S.fromList ls) of---                     Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)---                     Left _ -> property ((list_length < n) || (list_length == n && n == 0))---                         where---                             list_length = Prelude.length ls--sliceSepByP :: Property-sliceSepByP =-    forAll (listOf (chooseInt (min_value, max_value )))  $ \ls ->-        case S.parse (P.sliceSepByP predicate prsr) (S.fromList ls) of-            Right parsed_list ->-                checkListEqual parsed_list (tkwhl ls)-            Left _ -> property False-        where-            predicate = (>= 100)-            prsr = P.many (P.satisfy (const True)) FL.toList-            tkwhl ls = Prelude.takeWhile (not . predicate) ls--sliceBeginWith :: Property-sliceBeginWith =-    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        let ls1 = 1:ls-        in-            case S.parse parser (S.fromList ls1) of-                Right parsed_list ->-                  if not $ Prelude.null ls1-                  then-                    let tls = Prelude.takeWhile (not . predicate) (tail ls1)-                    in checkListEqual parsed_list $-                      if predicate (head ls1)-                      then head ls1 : tls-                      else Prelude.takeWhile (not . predicate) ls1-                  else property $ Prelude.null parsed_list-                Left _ -> property False-            where-                predicate = odd-                parser = P.sliceBeginWith predicate FL.toList--takeWhile :: Property-takeWhile =-    forAll (listOf (chooseInt (0, 1))) $ \ ls ->-        case S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of-            Right parsed_list ->-                checkListEqual parsed_list (Prelude.takeWhile predicate ls)-            Left _ -> property False-        where-            predicate = (== 0)--takeP :: Property-takeP =-    forAll-        ((,) <$> chooseInt (min_value, max_value)-             <*> listOf (chooseInt (0, 1)))-        $ \(takeNum, ls) ->-              case S.parse-                       (P.takeP takeNum (P.fromFold FL.toList))-                       (S.fromList ls) of-                  Right parsed_list ->-                      checkListEqual parsed_list (Prelude.take takeNum ls)-                  Left _ -> property False--takeWhile1 :: Property-takeWhile1 =-    forAll (listOf (chooseInt (0, 1))) $ \ ls ->-        case S.parse (P.takeWhile1 predicate  FL.toList) (S.fromList ls) of-            Right parsed_list -> case ls of-                [] -> property False-                (x : _) ->-                    if predicate x-                    then-                        checkListEqual parsed_list-                           $ Prelude.takeWhile predicate ls-                    else-                        property False-            Left _ -> case ls of-                [] -> property True-                (x : _) -> property (not $ predicate x)-        where-            predicate = (== 0)--choice :: Property-choice =-    forAll-        ((,,) <$> chooseInt (min_value, max_value)-             <*> chooseInt (min_value, max_value)-             <*> listOf (chooseInt (0, 1)))-        $ \(i, j, ls) ->-              case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of-                  Right parsed_list ->-                      checkListEqual parsed_list $ take (min i j) ls-                  Left _ -> property False--    where--    parser i = P.fromFold (FL.take i FL.toList)--groupBy :: Property-groupBy =-    forAll (listOf (chooseInt (0, 1)))-        $ \ls ->-              case S.parse parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (groupByLF ls)-                  Left _ -> property False--    where--    cmp = (==)-    parser = P.groupBy cmp FL.toList-    groupByLF lst-        | null lst = []-        | otherwise = head $ List.groupBy cmp lst--wordBy :: Property-wordBy =-    forAll (listOf (elements [' ', 's']))-        $ \ls ->-              case S.parse parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (words' ls)-                  Left _ -> property False--    where--    predicate = (== ' ')-    parser = P.many (P.wordBy predicate FL.toList) FL.toList-    words' lst =-        let wrds = words lst-         in if wrds == [] && length lst > 0 then [""] else wrds---- splitWithPass :: Property--- splitWithPass =---     forAll (listOf (chooseInt (0, 1))) $ \ls ->---         case S.parse (P.serialWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of---             Right (result_first, result_second) -> case ls of---                 0 : 1 : _ -> (result_first == 0) && (result_second == 1)---                 _ -> False---             Left _ -> case ls of---                 0 : 1 : _ -> False---                 _ -> True---- splitWithFailLeft :: Property--- splitWithFailLeft =---     property (case S.parse (P.serialWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)---- splitWithFailRight :: Property--- splitWithFailRight =---     property (case S.parse (P.serialWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)---- splitWithFailBoth :: Property--- splitWithFailBoth =---     property (case S.parse (P.serialWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)---- teeWithPass :: Property--- teeWithPass =---     forAll (chooseInt (0, 10000)) $ \n ->---         forAll (listOf (chooseInt (0, 1))) $ \ls ->---             let---                 prsr = P.take n FL.toList---             in---                 case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of---                     Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2---                     Left _ -> property False---- teeWithFailLeft :: Property--- teeWithFailLeft =---     property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)---- teeWithFailRight :: Property--- teeWithFailRight =---     property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)---- teeWithFailBoth :: Property--- teeWithFailBoth =---     property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)---- deintercalate :: Property--- deintercalate =---     forAll (listOf (chooseInt (0, 1))) $ \ls ->---         case S.parse (P.deintercalate concatFold prsr_1 concatFold prsr_2) (S.fromList ls) of---             Right parsed_list_tuple -> parsed_list_tuple == (partition (== 0) ls)---             Left _ -> False----         where---             prsr_1 = (P.takeWhile (== 0) FL.toList)---             prsr_2 = (P.takeWhile (== 1) FL.toList)---             concatFold = FL.Fold (\concatList curr_list -> return $ concatList ++ curr_list) (return []) return---- shortestPass :: Property--- shortestPass =---     forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->---         let---             prsr_1 = P.takeWhile (<= (mid_value `Prelude.div` 2)) FL.toList---             prsr_2 = P.takeWhile (<= mid_value) FL.toList---             prsr_shortest = P.shortest prsr_1 prsr_2---         in---             case S.parse prsr_shortest (S.fromList ls) of---                 Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)---                 Left _ -> property False---- shortestFailLeft :: Property--- shortestFailLeft =---     property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of---         Right r -> r == 1---         Left _ -> False)---- shortestFailRight :: Property--- shortestFailRight =---     property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of---         Right r -> r == 1---         Left _ -> False)---- shortestFailBoth :: Property--- shortestFailBoth =---     property (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)--many :: Property-many =-    forAll (listOf (chooseInt (0, 1))) $ \ls ->-        let fldstp conL currL = return $ FL.Partial $ conL ++ currL-            concatFold = FL.Fold fldstp (return (FL.Partial [])) return-            prsr =-                flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList-        in-            case S.parse prsr (S.fromList ls) of-                Right res_list -> checkListEqual res_list-                                    $ Prelude.filter (== 0) ls-                Left _ -> property False---- many_empty :: Property--- many_empty =---     property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of---         Right res_list -> checkListEqual res_list ([] :: [Int])---         Left _ -> property False)--some :: Property-some =-    forAll (listOf (chooseInt (0, 1))) $ \genLs ->-        let-            ls = 0 : genLs-            fldstp conL currL = return $ FL.Partial $ conL ++ currL-            concatFold = FL.Fold fldstp (return (FL.Partial [])) return-            prsr =-                flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList-        in-            case S.parse prsr (S.fromList ls) of-                Right res_list -> res_list == Prelude.filter (== 0) ls-                Left _ -> False---- someFail :: Property--- someFail =---     property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------applicative :: Property-applicative =-    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->-        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->-            let parser =-                    (,)-                        <$> P.fromFold (FL.take (length list1) FL.toList)-                        <*> P.fromFold (FL.take (length list2) FL.toList)-             in monadicIO $ do-                    (olist1, olist2) <--                        run $ S.parse parser (S.fromList $ list1 ++ list2)-                    listEquals (==) olist1 list1-                    listEquals (==) olist2 list2--sequence :: Property-sequence =-    forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->-        let p xs = P.fromFold (FL.take (length xs) FL.toList)-         in monadicIO $ do-                outs <- run $-                        S.parse-                            (Prelude.sequence $ fmap p ins)-                            (S.fromList $ concat ins)-                listEquals (==) outs ins--monad :: Property-monad =-    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->-        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->-            let parser = do-                    olist1 <- P.fromFold (FL.take (length list1) FL.toList)-                    olist2 <- P.fromFold (FL.take (length list2) FL.toList)-                    return (olist1, olist2)-             in monadicIO $ do-                    (olist1, olist2) <--                        run $ S.parse parser (S.fromList $ list1 ++ list2)-                    listEquals (==) olist1 list1-                    listEquals (==) olist2 list2------------------------------------------------------------------------------------ Stream parsing----------------------------------------------------------------------------------parseMany :: Property-parseMany =-    forAll (chooseInt (1,100)) $ \len ->-        forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->-            monadicIO $ do-                outs <- do-                    let p = P.fromFold $ FL.take len FL.toList-                    run-                        $ S.toList-                        $ S.parseMany p (S.fromList $ concat ins)-                listEquals (==) outs ins------------------------------------------------------------------------------------ Test for a particular case hit during fs events testing----------------------------------------------------------------------------------evId :: [Word8]-evId = [96,238,17,9,0,0,0,0]--evFlags :: [Word8]-evFlags = [0,4,1,0,0,0,0,0]--evPathLen :: [Word8]-evPathLen = [71,0,0,0,0,0,0,0]--evPath :: [Word8]-evPath =-    [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109-    ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112-    ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116-    ,114,101,97,109,108,121,47,116,109,112,47,122,122-    ]--event :: [Word8]-event = evId ++ evFlags ++ evPathLen ++ evPath--data Event = Event-   { eventId :: Word64-   , eventFlags :: Word32-   , eventAbsPath :: A.Array Word8-   } deriving (Show, Ord, Eq)--readOneEvent :: P.Parser IO Word8 Event-readOneEvent = do-    arr <- P.takeEQ 24 (A.writeN 24)-    let arr1 = A.unsafeCast arr :: A.Array Word64-        eid = A.unsafeIndex 0 arr1-        eflags = A.unsafeIndex 1 arr1-        pathLen = fromIntegral $ A.unsafeIndex 2 arr1-    -- XXX handle if pathLen is 0-    path <- P.takeEQ pathLen (A.writeN pathLen)-    return $ Event-        { eventId = eid-        , eventFlags = fromIntegral eflags-        , eventAbsPath = path-        }--parseMany2Events :: Property-parseMany2Events =-    monadicIO $ do-        xs <--            ( run-            $ S.toList-            $ S.parseMany readOneEvent-            $ S.fromList (concat (replicate 2 event))-            )-        assert (length xs == 2)-        -- XXX assuming little endian machine-        let ev = Event-                { eventId = 152170080-                , eventFlags = 66560-                , eventAbsPath = A.fromList evPath-                }-         in listEquals (==) xs (replicate 2 ev)--manyEqParseMany :: Property-manyEqParseMany =-    forAll (listOf (chooseInt (0, 100))) $ \lst ->-    forAll (chooseInt (1, 100)) $ \i ->-        monadicIO $ do-            let strm = S.fromList lst-            r1 <- run $ S.parse (P.many (split i) FL.toList) strm-            r2 <- run $ S.toList $ S.parseMany (split i) strm-            assert $ r1 == r2--    where--    split i = P.fromFold (FL.take i FL.toList)------------------------------------------------------------------------------------ Main----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Parser"--main :: IO ()-main =-  hspec $-  H.parallel $-  modifyMaxSuccess (const maxTestCount) $ do-  describe moduleName $ do--    describe "Instances" $ do-        prop "applicative" applicative-        prop "monad" monad-        prop "sequence" sequence--    describe "Stream parsing" $ do-        prop "parseMany" parseMany-        prop "parseMany2Events" parseMany2Events--    describe "test for accumulator" $ do-        prop "P.fromFold FL.sum = FL.sum" fromFold-        prop "fromPure value provided" fromPure-        prop "fromPure monadic value provided" fromEffect-        prop "fail err = Left (SomeException (ParseError err))" parserFail-        prop "always fail" die-        prop "always fail but monadic" dieM--    describe "test for element parser" $ do-        prop "peek = head with list length > 0" peekPass-        prop "peek fail on []" peekFail-        prop "eof pass on []" eofPass-        prop "eof fail on non-empty list" eofFail-        prop "first element exists and >= mid_value" satisfyPass-        prop "next pass on [Int]" nextPass-        prop "next fail on []" next-        prop "check first element exists and satisfies predicate" satisfy--    describe "test for sequence parser" $ do-        prop "P.takeBetween = Prelude.take when len >= m and len <= n"-            takeBetweenPass-        prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"-              ++ "otherwise fail") Main.takeBetween--        prop "P.takeEQ = Prelude.take when len >= n" takeEQPass-        prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"-            Main.takeEQ-        prop "P.takeGE n ls = ls when len >= n" takeGEPass-        prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE-        -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass-        -- prop "Fail when stream length exceeded" lookAheadFail-        -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead-        prop "P.sliceSepByP test" Main.sliceSepByP-        prop ("P.sliceBeginWith pred = head : Prelude.takeWhile (not . pred)"-                ++ " tail") sliceBeginWith-        prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile-        prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"-                ++ " else check why failed") takeWhile1-        prop ("P.takeP = Prelude.take") takeP-        prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy-        prop "many (P.wordBy ' ') = words'" wordBy-        prop "choice" choice-        -- prop "" splitWithPass-        -- prop "" splitWithFailLeft-        -- prop "" splitWithFailRight-        -- prop "" splitWithFailBoth-        -- prop "" teeWithPass-        -- prop "" teeWithFailLeft-        -- prop "" teeWithFailRight-        -- prop "" teeWithFailBoth-        -- prop "" deintercalate-        -- prop "" shortestPass-        -- prop "" shortestFailLeft-        -- prop "" shortestFailRight-        -- prop "" shortestFailBoth-        prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="-                ++ "Prelude.filter (== 0)") many-        -- prop "[] due to parser being die" many_empty-        prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="-                ++ "Prelude.filter (== 0)") some-        -- prop "fail due to parser being die" someFail-        prop "P.many == S.parseMany" manyEqParseMany-    takeProperties+{-# Language NoMonoLocalBinds #-}+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif+module Main (main) where++import Control.Applicative ((<|>))+import Control.Exception (displayException)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Char (isSpace)+import Data.Foldable (for_)+import Data.Word (Word8, Word32, Word64)+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.Parser (Parser(..), Step(..), Initial(..), Final(..))+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)+import Streamly.Internal.Data.Parser (ParseError(..))+import Test.QuickCheck (forAll, Property, property, listOf, vectorOf, Gen)+import Test.QuickCheck.Monadic (monadicIO, assert, run)++import Prelude hiding (sequence)++import qualified Streamly.Test.Data.Parser.Common as Common+import qualified Streamly.Data.Stream as S+import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Parser as P+import qualified Streamly.Internal.Data.ParserK as PK+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Stream as SI+import qualified Streamly.Internal.Data.StreamK as K+import qualified Test.Hspec as H++import Test.Hspec+import Test.Hspec.QuickCheck+import Streamly.Test.Parser.Common++#if MIN_VERSION_QuickCheck(2,14,0)++import Test.QuickCheck (chooseAny)++#else++import System.Random (Random(random))+import Test.QuickCheck.Gen (Gen(MkGen))++-- | Generates a random element over the natural range of `a`.+chooseAny :: Random a => Gen a+chooseAny = MkGen (\r _ -> let (x,_) = random r in x)++#endif++maxTestCount :: Int+maxTestCount = 100++-------------------------------------------------------------------------------+-- Stream parsing+-------------------------------------------------------------------------------++parseManyWordQuotedBy :: H.SpecWith ()+parseManyWordQuotedBy =+    describe "parseMany wordQuotedBy"+        $ for_ testCases+        $ \c@(kQ, isQ, input, expected) -> do+              let inpStrm = S.fromList input++                  esc = '\\'++                  spc ' ' = True+                  spc _ = False++                  tr _ _ = Nothing++                  parser = P.wordWithQuotes kQ tr esc isQ spc FL.toList+              result <- H.runIO $ S.fold FL.toList $ S.catRights $ S.parseMany parser inpStrm+              H.it (showCase c) $ result `H.shouldBe` expected++    where++    showCase (kQ, _, input, expected) =+        show kQ ++ ", " ++ input ++ " -> " ++ show expected++    testCases =+        [ ( True+          , \x -> if x == '\'' then Just '\'' else Nothing+          , "The quick brown fox"+          , ["The", "quick", "brown", "fox"])+        , ( True+          , \x -> if x == '\'' then Just '\'' else Nothing+          , "The' quick brown' fox"+          , ["The' quick brown'", "fox"])+        , ( False+          , \x -> if x == '\'' then Just '\'' else Nothing+          , "The' quick brown' fox"+          , ["The quick brown", "fox"])+        , ( True+          , \x -> if x == '[' then Just ']' else Nothing+          , "The[ quick brown] fox"+          , ["The[ quick brown]", "fox"])+        , ( True+          , \x -> if x == '[' then Just ']' else Nothing+          , "The[ qui[ck] brown] \\ f[  ox]"+          , ["The[ qui[ck] brown]", " f[  ox]"])+        , ( False+          , \x -> if x == '[' then Just ']' else Nothing+          , "The[ qui[ck] brown] fox"+          , ["The qui[ck] brown", "fox"])+        ]++parseMany :: Property+parseMany =+    forAll (chooseInt (1,100)) $ \len ->+        forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->+            monadicIO $ do+                outs <- do+                    let p = P.fromFold $ FL.take len FL.toList+                    run+                        $ S.fold FL.toList+                        $ S.catRights+                        $ S.parseMany p (S.fromList $ concat ins)+                listEquals (==) outs ins+++-- basic sanity test for parsing from arrays+parseUnfold :: Property+parseUnfold = do+    let len = 200+    -- ls = input list (stream)+    -- clen = chunk size+    -- tlen = parser take size+    forAll+        ((,,)+            <$> vectorOf len (chooseAny :: Gen Int)+            <*> chooseInt (1, len)+            <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->+        monadicIO $ do+            arrays <- S.toList $ A.chunksOf clen (S.fromList ls)+            let src = Producer.source (Just (Producer.OuterLoop arrays))+            let parser = P.fromFold (FL.take tlen FL.toList)+            let readSrc =+                    Producer.producer+                        $ Producer.concat Producer.fromList A.producer+            let streamParser =+                    Producer.simplify (Producer.parseManyD parser readSrc)+            xs <- run+                $ S.toList+                $ S.unfoldEach Unfold.fromList+                $ S.catRights+                $ S.unfold streamParser src++            listEquals (==) xs ls++parserSequence :: Property+parserSequence =+  forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->+    monadicIO $ do+    let parsers = S.fromList+            $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins+    let sequencedParser = P.sequence parsers FL.sum+    outs <-+        S.parse sequencedParser $ S.concatMap S.fromList (S.fromList ins)+    return $+        case outs of+            Right x -> x == sum (map sum ins)+            Left _ -> False++-------------------------------------------------------------------------------+-- Test for a particular case hit during fs events testing+-------------------------------------------------------------------------------++evId :: [Word8]+evId = [96,238,17,9,0,0,0,0]++evFlags :: [Word8]+evFlags = [0,4,1,0,0,0,0,0]++evPathLen :: [Word8]+evPathLen = [71,0,0,0,0,0,0,0]++evPath :: [Word8]+evPath =+    [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109+    ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112+    ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116+    ,114,101,97,109,108,121,47,116,109,112,47,122,122+    ]++event :: [Word8]+event = evId ++ evFlags ++ evPathLen ++ evPath++data Event = Event+   { eventId :: Word64+   , eventFlags :: Word32+   , eventAbsPath :: A.Array Word8+   } deriving (Show, Ord, Eq)++readOneEvent :: P.Parser Word8 IO Event+readOneEvent = do+    arr <- P.takeEQ 24 (A.createOf 24)+    let arr1 = A.unsafeCast arr :: A.Array Word64+        eid = A.unsafeGetIndex 0 arr1+        eflags = A.unsafeGetIndex 1 arr1+        pathLen = fromIntegral $ A.unsafeGetIndex 2 arr1+    -- XXX handle if pathLen is 0+    path <- P.takeEQ pathLen (A.createOf pathLen)+    return $ Event+        { eventId = eid+        , eventFlags = fromIntegral eflags+        , eventAbsPath = path+        }++parseMany2Events :: Property+parseMany2Events =+    monadicIO $ do+        xs <-+            ( run+            $ S.fold FL.toList+            $ S.catRights+            $ S.parseMany readOneEvent+            $ S.fromList (concat (replicate 2 event))+            )+        assert (length xs == 2)+        -- XXX assuming little endian machine+        let ev = Event+                { eventId = 152170080+                , eventFlags = 66560+                , eventAbsPath = A.fromList evPath+                }+         in listEquals (==) xs (replicate 2 ev)++--------------------------------------------------------------------------------+-- Parser sequence tests+--------------------------------------------------------------------------------++manyEqParseMany :: Property+manyEqParseMany =+    forAll (listOf (chooseInt (0, 100))) $ \lst ->+    forAll (chooseInt (1, 100)) $ \i ->+        monadicIO $ do+            let strm = S.fromList lst+            r1 <- run $ S.parse (P.many (split i) FL.toList) strm+            r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) strm+            return $+                case r1 of+                    Right o1 -> o1 == r2+                    Left _ -> False++    where++    split i = P.fromFold (FL.take i FL.toList)++splitWithSuffix+    :: Monad m+    => (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b+splitWithSuffix predicate f =  S.foldMany (FL.takeEndBy predicate f)++takeEndBy2 :: Property+takeEndBy2 =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        let+            strm = S.fromList ls++            predicate = (==0)++            eitherParsedList =+                S.fold FL.toList+                    $ S.catRights+                    $ S.parseMany (P.takeEndBy predicate prsr) strm++                    where++                    prsr = P.many (P.satisfy (const True)) FL.toList++            eitherSplitList =+                case ls of+                    [] -> return []+                    _ ->+                        if last ls == 0+                        then S.fold FL.toList $ S.append strm1 (S.fromList [])+                        else S.fold FL.toList strm1++                        where++                        strm1 = splitWithSuffix predicate FL.toList strm+        in+            case eitherParsedList of+                Left _ -> property False+                Right parsedList ->+                    case eitherSplitList of+                        Left _ -> property False+                        Right splitList -> checkListEqual parsedList splitList+++--------------------------------------------------------------------------------+-- Parser quoted word tests+--------------------------------------------------------------------------------++quotedWordTest :: String -> [String] -> IO ()+quotedWordTest inp expected = do+    res <-+        S.fold FL.toList+            $ catRightsErr+            $ S.parseMany quotedWord $ S.fromList inp+    res `shouldBe` expected+    where+    catRightsErr = fmap (either (error . displayException) id)+    quotedWord =+        let toRQuote x =+                case x of+                    '"' -> Just x+                    '\'' -> Just x+                    _ -> Nothing+            -- Inside ",+            -- * \\ is translated to \+            -- * \" is translated to "+            trEsc '"' x =+                case x of+                    '\\' -> Just '\\'+                    '"' -> Just '"'+                    _ -> Nothing+            trEsc _ _ = Nothing+         in P.wordWithQuotes False trEsc '\\' toRQuote isSpace FL.toList++--------------------------------------------------------------------------------+-- Parser sanity tests+--------------------------------------------------------------------------------++{-+TODO:+Add sanity tests for+- Producer.parse+- Producer.parseMany+-}++sanityParseBreak :: [Move] -> SpecWith ()+sanityParseBreak jumps = it (show jumps) $ do+    (val, rest) <- SI.parseBreakPos (jumpParser jumps) $ S.fromList tape+    lst <- S.toList rest+    (val, lst) `shouldBe` (expectedResult jumps tape)++sanityParseDBreak :: [Move] -> SpecWith ()+sanityParseDBreak jumps = it (show jumps) $ do+    (val, rest) <- K.parseBreakPos (PK.toParserK (jumpParser jumps)) $ K.fromList tape+    lst <- K.toList rest+    (val, lst) `shouldBe` (expectedResult jumps tape)++{-+sanityParseBreakChunksK :: [Move] -> SpecWith ()+sanityParseBreakChunksK jumps = it (show jumps) $ do+    (val, rest) <-+        A.parseBreakChunksK (jumpParser jumps)+            $ K.fromList $ Prelude.map A.fromList chunkedTape+    lst <- Prelude.map A.toList <$> K.toList rest+    (val, concat lst) `shouldBe` (expectedResult jumps tape)+-}++sanityParseMany :: [Move] -> SpecWith ()+sanityParseMany jumps = it (show jumps) $ do+    res <- S.toList $ SI.parseManyPos (jumpParser jumps) $ S.fromList tape+    res `shouldBe` (expectedResultMany jumps tape)++sanityParseIterate :: [Move] -> SpecWith ()+sanityParseIterate jumps = it (show jumps) $ do+    res <-+        S.toList+             $ SI.parseIteratePos (const (jumpParser jumps)) [] $ S.fromList tape+    res `shouldBe` (expectedResultMany jumps tape)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++{-# INLINE takeWhileFailD #-}+takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+takeWhileFailD predicate (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        res <- finitial+        return $ case res of+            FL.Partial s -> IPartial s+            FL.Done b -> IDone b++    step s a =+        if predicate a+        then do+            fres <- fstep s a+            return+                $ case fres of+                      FL.Partial s1 -> SContinue 1 s1+                      FL.Done b -> SDone 1 b+        else return $ SError "fail"++    extract s = fmap (FDone 0) (ffinal s)++{-# INLINE takeWhileFail #-}+takeWhileFail :: MonadIO m =>+    (a -> Bool) -> Fold m a b -> PK.ParserK a m b+takeWhileFail p f = PK.toParserK (takeWhileFailD p f)++{-# INLINE takeWhileK #-}+takeWhileK :: MonadIO m => (a -> Bool) -> PK.ParserK a m [a]+takeWhileK p = PK.toParserK $ P.takeWhile p FL.toList++{-# INLINE alt2 #-}+alt2 :: MonadIO m => K.StreamK m Int -> m (Either ParseError [Int])+alt2 =+    K.parse+        (   takeWhileFail (<= 5) FL.toList+        <|> takeWhileK (<= 7)+        )++{-# INLINE altD #-}+altD :: MonadIO m => S.Stream m Int -> m (Either P.ParseError [Int])+altD =+    S.parse+        (   takeWhileFailD (<= 5) FL.toList+        <|> P.takeWhile (<= 7) FL.toList+        )++altTests :: Spec+altTests =+    describe "alt" $ do+        it "alt2 [1..20]" $ alt2 (K.fromList [1..20]) `shouldReturn` Right [1..7]+        it "altD [1..20]" $ altD (S.fromList [1..20]) `shouldReturn` Right [1..7]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Parser"++main :: IO ()+main = do+  hspec $+      H.parallel $+      modifyMaxSuccess (const maxTestCount) $ do+      describe moduleName $ do+        parserSanityTests "Stream.parseBreak" sanityParseBreak+        parserSanityTests "StreamK.parseDBreak" sanityParseDBreak+        -- parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK+        parserSanityTests "Stream.parseMany" sanityParseMany+        parserSanityTests "Stream.parseIterate" sanityParseIterate+        describe "Stream parsing" $ do+            prop "parseMany" parseMany+            prop "parseMany2Events" parseMany2Events+            prop "parseUnfold" parseUnfold+            prop "parserSequence" parserSequence++        describe "test for sequence parser" $ do+            parseManyWordQuotedBy+            prop "P.many == S.parseMany" manyEqParseMany+            prop "takeEndBy2" takeEndBy2++        describe "quotedWordTest" $ do+            it "Single quote test" $ do+               quotedWordTest "'hello\\\\\"world'" ["hello\\\\\"world"]+               quotedWordTest "'hello\\'" ["hello\\"]+            it "Double quote test" $ do+               quotedWordTest+                   "\"hello\\\"\\\\w\\'orld\""+                   ["hello\"\\w\\'orld"]+++        altTests+        Common.main
+ test/Streamly/Test/Data/Parser/Common.hs view
@@ -0,0 +1,1241 @@+{-# Language NoMonoLocalBinds #-}+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif+module Streamly.Test.Data.Parser.Common (main) where++import Control.Applicative ((<|>))+import Control.Exception (displayException, try, evaluate, SomeException)+import Data.List (isSuffixOf)+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)+import Streamly.Internal.Data.Parser (ParseErrorPos(..))+import Test.QuickCheck+       (arbitrary, forAll, elements, Property, property, listOf,+        vectorOf, Gen, (.&&.), ioProperty)+import Test.QuickCheck.Monadic (monadicIO, assert, run, PropertyM)++import Prelude hiding (sequence)++import qualified Control.Monad.Fail as Fail+import qualified Data.List as List+import qualified Prelude+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Array.Generic as GA+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Parser as P+import qualified Streamly.Internal.Data.ParserK as PK+import qualified Streamly.Internal.Data.StreamK as K++import Test.Hspec+import Test.Hspec.QuickCheck++#if MIN_VERSION_QuickCheck(2,14,0)++import Test.QuickCheck (chooseAny)+import Control.Monad.Identity (Identity(runIdentity, Identity))++#else++import System.Random (Random(random))+import Test.QuickCheck.Gen (Gen(MkGen))++-- | Generates a random element over the natural range of `a`.+chooseAny :: Random a => Gen a+chooseAny = MkGen (\r _ -> let (x,_) = random r in x)++#endif++min_value :: Int+min_value = 0++mid_value :: Int+mid_value = 5000++max_value :: Int+max_value = 10000++max_length :: Int+max_length = 1000++-- Accumulator Tests++-- TODO: Replace ParserTestCase_Temp with ParserTestCase in all the test cases.++type ParserTestCase a m b c =+        (P.Parser a m b -> [a] -> m (Either ParseErrorPos b, [a])) -> c++type ParserTestCase_Temp a m b c =+        forall t. ([a] -> t)+        -> (P.Parser a m b -> t -> m (Either ParseErrorPos b))+        -> c++fromFold :: ParserTestCase Int IO Int Property+fromFold consumer =+    forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->+        ioProperty $ do+        (s1, rest) <- consumer (P.fromFold FL.sum) ls+        o2 <- S.fold FL.sum (S.fromList ls)+        pure $ rest == [] &&+            case s1 of+                Right o1 -> o1 == o2+                Left _ -> False++fromPure :: ParserTestCase Int Identity Int Property+fromPure consumer =+    forAll (chooseInt (min_value, max_value)) $ \x ->+        case runIdentity $ consumer (P.fromPure x) [1 :: Int] of+            (Right r, rest) -> r == x && rest == [1 :: Int]+            (Left _, _) -> False++fromEffect :: ParserTestCase Int Identity Int Property+fromEffect consumer =+    forAll (chooseInt (min_value, max_value)) $ \x ->+        case runIdentity $ consumer (P.fromEffect $ return x) [1 :: Int] of+            (Right r, rest) -> r == x && rest == [1 :: Int]+            (Left _, _) -> False++die :: ParserTestCase Int Identity Int Property+die consumer =+    property $+    case runIdentity $ consumer (P.die "die test") [0 :: Int] of+        (Right _, _) -> False+        (Left _, rest) -> rest == [0 :: Int]++dieM :: ParserTestCase Int Identity Int Property+dieM consumer =+    property $+    case runIdentity $ consumer (P.dieM (Identity "die test")) [0 :: Int] of+        (Right _, _) -> False+        (Left _, rest) -> rest == [0 :: Int]++parserFail :: ParserTestCase Int Identity Int Property+parserFail consumer =+    property $+        case runIdentity $ consumer (Fail.fail err) [0 :: Int] of+            (Right _, _) -> False+            (Left (ParseErrorPos _ e), rest) -> err == e && rest == [0 :: Int]+    where+    err = "Testing MonadFail.fail."++-- Element Parser Tests++peekPass :: ParserTestCase Int Identity Int Property+peekPass consumer =+    forAll (chooseInt (1, max_length)) $ \list_length ->+        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+            case runIdentity $ consumer P.peek ls of+                (Right head_value, rest) -> case ls of+                    head_ls : _ -> head_value == head_ls && rest == ls+                    _ -> False+                (Left _, _) -> False++peekFail :: ParserTestCase Int Identity Int Property+peekFail consumer =+    property (case runIdentity $ consumer P.peek [] of+        (Right _, _) -> False+        (Left _, rest) -> rest == [])++eofPass :: ParserTestCase_Temp Int Identity () Property+eofPass producer consumer =+    property (case runIdentity $ consumer P.eof (producer []) of+        Right _ -> True+        Left _ -> False)++eofFail :: ParserTestCase_Temp Int Identity () Property+eofFail producer consumer =+    forAll (chooseInt (1, max_length)) $ \list_length ->+        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+            case runIdentity $ consumer P.eof (producer ls) of+                Right _ -> False+                Left _ -> True++satisfyPass :: ParserTestCase_Temp Int Identity Int Property+satisfyPass producer consumer =+    forAll (chooseInt (mid_value, max_value)) $ \first_element ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->+            let+                ls = first_element : ls_tail+                predicate = (>= mid_value)+            in+                case runIdentity $ consumer (P.satisfy predicate) (producer ls) of+                    Right r -> r == first_element+                    Left _ -> False++satisfy :: ParserTestCase_Temp Int Identity Int Property+satisfy producer consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        case runIdentity $ consumer (P.satisfy predicate) (producer ls) of+            Right r -> case ls of+                [] -> False+                (x : _) -> predicate x && (r == x)+            Left _ -> case ls of+                [] -> True+                (x : _) -> not $ predicate x+        where+            predicate = (>= mid_value)++onePass :: ParserTestCase_Temp Int Identity Int Property+onePass producer consumer =+    forAll (chooseInt (1, max_value)) $ \int ->+        property (case runIdentity $ consumer P.one (producer [int]) of+            Right i -> i  == int+            Left _ -> False)++one :: ParserTestCase_Temp Int Identity Int Property+one producer consumer =+    property $+        case runIdentity $ consumer P.one (producer []) of+            Left _ -> True+            Right _ -> False++-- Sequence Parsers Tests+takeBetweenPass :: ParserTestCase_Temp Int Identity [Int] Property+takeBetweenPass producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \m ->+        forAll (chooseInt (m, max_value)) $ \n ->+            forAll (chooseInt (m, max_value)) $ \list_length ->+                forAll (vectorOf list_length (chooseInt (min_value, max_value)))+                    $ \ls ->+                        case runIdentity $ consumer (P.takeBetween m n FL.toList)+                                (producer ls) of+                            Right parsed_list ->+                                let lpl = Prelude.length parsed_list+                                in checkListEqual parsed_list+                                    $ Prelude.take lpl ls+                            Left _ -> property False++takeBetween :: ParserTestCase_Temp Int Identity [Int] Property+takeBetween producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \m ->+        forAll (chooseInt (min_value, max_value)) $ \n ->+            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+                ioProperty $ go m n ls++    where++    go m n ls = do+        let inputLen = Prelude.length ls+        let p = P.takeBetween m n FL.toList+        eres <- try $ evaluate $ runIdentity $ consumer p (producer ls)+        pure $ case eres of+            Left (_ :: SomeException) -> m >= 0 && n >= 0 && m > n+            Right (Right xs) ->+                let parsedLen = Prelude.length xs+                in (inputLen >= m && parsedLen >= m && parsedLen <= n)+                       && (xs == Prelude.take parsedLen ls)+            Right (Left _) -> inputLen < m+++take :: ParserTestCase_Temp Int Identity [Int] Property+take producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+            case runIdentity $ consumer (P.fromFold $ FL.take n FL.toList) (producer ls) of+                Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)+                Left _ -> property False++takeEQPass :: ParserTestCase_Temp Int Identity [Int] Property+takeEQPass producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (chooseInt (n, max_value)) $ \list_length ->+            forAll (vectorOf list_length+                        (chooseInt (min_value, max_value))) $ \ls ->+                case runIdentity $ consumer (P.takeEQ n FL.toList) (producer ls) of+                    Right parsed_list ->+                        checkListEqual parsed_list (Prelude.take n ls)+                    Left _ -> property False++takeEQ :: ParserTestCase_Temp Int Identity [Int] Property+takeEQ producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+            let+                list_length = Prelude.length ls+            in+                case runIdentity $ consumer (P.takeEQ n FL.toList) (producer ls) of+                    Right parsed_list ->+                        if n <= list_length+                        then checkListEqual parsed_list (Prelude.take n ls)+                        else property False+                    Left _ -> property (n > list_length)++takeGEPass :: ParserTestCase_Temp Int Identity [Int] Property+takeGEPass producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (chooseInt (n, max_value)) $ \list_length ->+            forAll (vectorOf list_length (chooseInt (min_value, max_value)))+                $ \ls ->+                    case runIdentity $ consumer (P.takeGE n FL.toList) (producer ls) of+                        Right parsed_list -> checkListEqual parsed_list ls+                        Left _ -> property False++takeGE :: ParserTestCase_Temp Int Identity [Int] Property+takeGE producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+            let+                list_length = Prelude.length ls+            in+                case runIdentity $ consumer (P.takeGE n FL.toList) (producer ls) of+                    Right parsed_list ->+                        if n <= list_length+                        then checkListEqual parsed_list ls+                        else property False+                    Left _ -> property (n > list_length)++nLessThanEqual0 ::+       (  Int+       -> FL.Fold Identity Int [Int]+       -> P.Parser Int Identity [Int]+       )+    -> (Int -> [Int] -> [Int])+    -> ParserTestCase_Temp Int Identity [Int] Property+nLessThanEqual0 tk ltk producer consumer =+    forAll (elements [0, (-1)]) $ \n ->+        forAll (listOf arbitrary) $ \ls ->+            case runIdentity $ consumer (tk n FL.toList) (producer ls) of+                Right parsed_list -> checkListEqual parsed_list (ltk n ls)+                Left _ -> property False++takeProperties :: ParserTestCase_Temp Int Identity [Int] Spec+takeProperties producer consumer =+    describe "take combinators when n <= 0/" $ do+        prop "takeEQ n FL.toList = []" $+            nLessThanEqual0 P.takeEQ (\_ -> const []) producer consumer+        prop "takeGE n FL.toList xs = xs" $+            nLessThanEqual0 P.takeGE (\_ -> id) producer consumer++-- XXX lookAhead can't deal with EOF which in this case means when+-- n==list_length, this test will fail. So excluding that case for now.+lookAheadPass :: ParserTestCase_Temp Int Identity ([Int], [Int]) Property+lookAheadPass producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        let+            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList+            parseTwice = do+                parsed_list_1 <- takeWithoutConsume+                parsed_list_2 <- takeWithoutConsume+                return (parsed_list_1, parsed_list_2)+        in+            forAll (chooseInt (n+1, max_value)) $ \list_length ->+                forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+                    case runIdentity $ consumer parseTwice (producer ls) of+                        Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)+                        Left _ -> property $ False++-- lookAheadFail :: ParserTestCase_Temp Int Identity Int Property+-- lookAheadFail producer consumer =+--     forAll (chooseInt (min_value + 1, max_value)) $ \n ->+--         let+--             takeWithoutConsume = P.lookAhead $ P.take n FL.toList+--             parseTwice = do+--                 parsed_list_1 <- takeWithoutConsume+--                 parsed_list_2 <- takeWithoutConsume+--                 return (parsed_list_1, parsed_list_2)+--         in+--             forAll (chooseInt (min_value, n - 1)) $ \list_length ->+--                 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+--                     case consumer parseTwice (producer ls) of+--                         Right _ -> False+--                         Left _ -> True++lookAhead :: ParserTestCase_Temp Int Identity ([Int], [Int]) Property+lookAhead producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        let+            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList+            parseTwice = do+                parsed_list_1 <- takeWithoutConsume+                parsed_list_2 <- takeWithoutConsume+                return (parsed_list_1, parsed_list_2)+        in+            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+                case runIdentity $ consumer parseTwice (producer ls) of+                    Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)+                    Left _ -> property ((list_length < n) || (list_length == n && n == 0))+                        where+                            list_length = Prelude.length ls++listTakeEndBy_ :: (a -> Bool) -> [a] -> ([a], [a])+listTakeEndBy_ predicate ls =+    case break predicate ls of+        (a, []) -> (a, [])+        (a, b) -> (a, tail b)++takeEndBy_ :: ParserTestCase Int Identity [Int] Property+takeEndBy_ consumer =+    forAll (listOf (chooseInt (min_value, max_value )))  $ \ls ->+        case runIdentity $ consumer (P.takeEndBy_ predicate prsr) ls of+            (Right parsed_list, rest) -> monadicIO $ do+                let (ls1, ls2) = listTakeEndBy_ predicate ls+                listEquals (==) parsed_list ls1+                listEquals (==) rest ls2+            _ -> property False+        where+            predicate = (>= 100)+            prsr = P.many (P.satisfy (const True)) FL.toList++takeEndByOrMax_ :: ParserTestCase Int Identity [Int] Property+takeEndByOrMax_ consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (0, 1))) $ \ls ->+            case runIdentity $ consumer (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) ls of+                (Right parsed_list, rest) -> monadicIO $ do+                    let (lsa, lsb) = listTakeEndBy_ predicate ls+                        (ls1, ls2) = Prelude.splitAt n ls+                    if length lsa < length ls1+                    then do+                        listEquals (==) parsed_list lsa+                        listEquals (==) rest lsb+                    else do+                        listEquals (==) parsed_list ls1+                        listEquals (==) rest ls2+                _ -> property False+            where+                predicate = (== 1)++takeStartBy :: ParserTestCase Int Identity [Int] Property+takeStartBy consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        let ls1 = 1:ls+        in+            case runIdentity $ consumer parser ls1 of+                (Right parsed_list, rest) ->+                  if not $ Prelude.null ls1+                  then+                    let (rls1, rls2) = Prelude.break predicate (tail ls1)+                    in monadicIO $ do+                           listEquals (==) parsed_list (head ls1 : rls1)+                           listEquals (==) rest rls2+                  else property $ Prelude.null parsed_list && Prelude.null rest+                _ -> property False+            where+                predicate = odd+                parser = P.takeBeginBy predicate FL.toList++takeWhile :: ParserTestCase Int Identity [Int] Property+takeWhile consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ ls ->+        case runIdentity $ consumer (P.takeWhile predicate FL.toList) ls of+            (Right parsed_list, rest) -> monadicIO $ do+                let (ls1, ls2) = Prelude.span predicate ls+                listEquals (==) parsed_list ls1+                listEquals (==) rest ls2+            _ -> property False+        where+            predicate = (== 0)++takeP :: ParserTestCase Int Identity [Int] Property+takeP consumer =+    forAll+        ((,) <$> chooseInt (min_value, max_value)+             <*> listOf (chooseInt (0, 1)))+        $ \(takeNum, ls) ->+              case runIdentity $ consumer+                       (P.takeP takeNum (P.fromFold FL.toList)) ls of+                  (Right parsed_list, rest) -> monadicIO $ do+                      let (ls1, ls2) = Prelude.splitAt takeNum ls+                      listEquals (==) parsed_list ls1+                      listEquals (==) rest ls2+                  _ -> property False++takeWhile1 :: ParserTestCase Int Identity [Int] Property+takeWhile1 consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ ls ->+        case runIdentity $ consumer (P.takeWhile1 predicate  FL.toList) ls of+            (Right parsed_list, rest) -> case ls of+                [] -> property False+                (x : _) ->+                    if predicate x+                    then monadicIO $ do+                        let (ls1, ls2) = span predicate ls+                        listEquals (==) parsed_list ls1+                        listEquals (==) rest ls2+                    else+                        property False+            (Left _, rest) -> monadicIO $ do+                listEquals (==) rest ls+                case ls of+                    [] -> assert True+                    (x : _) -> assert (not $ predicate x)+        where+            predicate = (== 0)++takeWhileP :: ParserTestCase Int Identity [Int] Property+takeWhileP consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        forAll (chooseInt (min_value, max_value)) $ \n ->+            let+                predicate = (== 1)++                prsr =+                    P.takeWhileP predicate+                        $ P.fromFold (FL.take n FL.toList)++                takeWhileTillLen maxLen prd list =+                    Prelude.take maxLen $ Prelude.takeWhile prd list+            in+                case runIdentity $ consumer prsr ls of+                    (Right parsed_list, rest) -> monadicIO $ do+                        let ls1 = takeWhileTillLen n predicate ls+                            ls2 = drop (length ls1) ls+                        listEquals (==) parsed_list ls1+                        listEquals (==) rest ls2+                    _ -> property False++{-+choice :: ParserTestCase_Temp Int Identity Int Property+choice producer consumer =+    forAll+        ((,,) <$> chooseInt (min_value, max_value)+             <*> chooseInt (min_value, max_value)+             <*> listOf (chooseInt (0, 1)))+        $ \(i, j, ls) ->+              case consumer (P.choice [parser i, parser j]) (producer ls) of+                  Right parsed_list ->+                      checkListEqual parsed_list $ take (min i j) ls+                  Left _ -> property False++    where++    parser i = P.fromFold (FL.take i FL.toList)+-}++groupBy :: ParserTestCase_Temp Int Identity [Int] Property+groupBy producer consumer =+    forAll (listOf (chooseInt (0, 1)))+        $ \ls ->+              case runIdentity $ consumer parser (producer ls) of+                  Right parsed -> checkListEqual parsed (groupByLF ls)+                  Left _ -> property False++    where++    cmp = (==)+    parser = P.groupBy cmp FL.toList+    groupByLF lst+        | null lst = []+        | otherwise = head $ List.groupBy cmp lst++groupByRolling :: ParserTestCase_Temp Int Identity [Int] Property+groupByRolling producer consumer =+    forAll (listOf (chooseInt (0, 1)))+        $ \ls ->+              case runIdentity $ consumer parser (producer ls) of+                  Right parsed -> checkListEqual parsed (groupByLF Nothing ls)+                  Left _ -> property False++    where++    cmp = (==)+    parser = P.groupBy cmp FL.toList+    groupByLF _ [] = []+    groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs+    groupByLF (Just y) (x:xs) =+        if cmp y x+        then x : groupByLF (Just x) xs+        else []++wordBy :: ParserTestCase_Temp Char Identity [String] Property+wordBy producer consumer =+    forAll (listOf (elements [' ', 's']))+        $ \ls ->+              case runIdentity $ consumer parser (producer ls) of+                  Right parsed -> checkListEqual parsed (words' ls)+                  Left _ -> property False++    where++    predicate = (== ' ')+    parser = P.many (P.wordBy predicate FL.toList) FL.toList+    words' lst =+        let wrds = words lst+         in if wrds == [] && length lst > 0 then [""] else wrds++splitWith :: ParserTestCase_Temp Int Identity (Int, Int) Property+splitWith producer consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        case runIdentity $ consumer (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (producer ls) of+            Right (result_first, result_second) -> case ls of+                0 : 1 : _ -> (result_first == 0) && (result_second == 1)+                _ -> False+            Left _ -> case ls of+                0 : 1 : _ -> False+                _ -> True++splitWithFailLeft :: ParserTestCase_Temp Int Identity (Int, Int) Property+splitWithFailLeft producer consumer =+    property (case runIdentity $ consumer (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of+        Right _ -> False+        Left _ -> True)++splitWithFailRight :: ParserTestCase_Temp Int Identity (Int, Int) Property+splitWithFailRight producer consumer =+    property (case runIdentity $ consumer (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of+        Right _ -> False+        Left _ -> True)++splitWithFailBoth :: ParserTestCase_Temp Int Identity (Int, Int) Property+splitWithFailBoth producer consumer =+    property (case runIdentity $ consumer (P.splitWith (,) (P.die "die") (P.die "die")) (producer [1 :: Int]) of+        Right _ -> False+        Left _ -> True)++-- teeWithPass :: ParserTestCase_Temp Int Identity Int Property+-- teeWithPass producer consumer =+--     forAll (chooseInt (min_value, max_value)) $ \n ->+--         forAll (listOf (chooseInt (0, 1))) $ \ls ->+--             let+--                 prsr = P.fromFold $ FL.take n FL.toList+--             in+--                 case consumer (P.teeWith (,) prsr prsr) (producer ls) of+--                     Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2+--                     Left _ -> property False++-- teeWithFailLeft :: ParserTestCase_Temp Int Identity Int Property+-- teeWithFailLeft producer consumer =+--     property (case consumer (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of+--         Right _ -> False+--         Left _ -> True)++-- teeWithFailRight :: ParserTestCase_Temp Int Identity Int Property+-- teeWithFailRight producer consumer =+--     property (case consumer (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of+--         Right _ -> False+--         Left _ -> True)++-- teeWithFailBoth :: ParserTestCase_Temp Int Identity Int Property+-- teeWithFailBoth producer consumer =+--     property (case consumer (P.teeWith (,) (P.die "die") (P.die "die")) (producer [1 :: Int]) of+--         Right _ -> False+--         Left _ -> True)++{-+deintercalate :: ParserTestCase_Temp Int Identity Int Property+deintercalate producer consumer =+    forAll (listOf (chooseAny :: Gen Int)) $ \ls ->+        case runIdentity $ consumer p (producer ls) of+            Right evenOdd -> evenOdd == List.partition even ls+            Left _ -> False++        where+            p1 = P.takeWhile even FL.toList+            p2 = P.takeWhile odd FL.toList+            partition =+                FL.tee (fmap concat $ FL.catLefts FL.toList)+                       (fmap concat $ FL.catRights FL.toList)+            p = P.deintercalate p1 p2 partition+-}++-- shortestPass :: ParserTestCase_Temp Int Identity Int Property+-- shortestPass producer consumer =+--     forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->+--         let+--             half_mid_value = mid_value `Prelude.div` 2+--             prsr_1 = P.takeWhile (<= half_mid_value) FL.toList+--             prsr_2 = P.takeWhile (<= mid_value) FL.toList+--             prsr_shortest = P.shortest prsr_1 prsr_2+--         in+--             case consumer prsr_shortest (producer ls) of+--                 Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)+--                 Left _ -> property False++-- shortestPassLeft :: ParserTestCase_Temp Int Identity Int Property+-- shortestPassLeft producer consumer =+--     property (case consumer (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of+--         Right r -> r == 1+--         Left _ -> False)+--+-- shortestPassRight :: ParserTestCase_Temp Int Identity Int Property+-- shortestPassRight producer consumer =+--     property (case consumer (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of+--         Right r -> r == 1+--         Left _ -> False)++-- shortestFailBoth :: ParserTestCase_Temp Int Identity Int Property+-- shortestFailBoth producer consumer =+--     property+--         (case consumer+--                   (P.shortest (P.die "die") (P.die "die"))+--                   (producer [1 :: Int]) of+--              Right _ -> False+--              Left _ -> True)+--+-- longestPass :: ParserTestCase_Temp Int Identity Int Property+-- longestPass producer consumer =+--     forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->+--         let+--             half_mid_value = mid_value `Prelude.div` 2+--             prsr_1 = P.takeWhile (<= half_mid_value) FL.toList+--             prsr_2 = P.takeWhile (<= mid_value) FL.toList+--             prsr_longest = P.longest prsr_1 prsr_2+--         in+--             case consumer prsr_longest (producer ls) of+--                 Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls+--                 Left _ -> False+--+-- longestPassLeft :: ParserTestCase_Temp Int Identity Int Property+-- longestPassLeft producer consumer =+--     property (case consumer (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of+--         Right r -> r == 1+--         Left _ -> False)+--+-- longestPassRight :: ParserTestCase_Temp Int Identity Int Property+-- longestPassRight producer consumer =+--     property (case consumer (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of+--         Right r -> r == 1+--         Left _ -> False)+--+-- longestFailBoth :: ParserTestCase_Temp Int Identity Int Property+-- longestFailBoth producer consumer =+--     property+--         (case consumer (P.shortest (P.die "die") (P.die "die")) (producer [1 :: Int]) of+--         Right _ -> False+--         Left _ -> True)++many :: ParserTestCase_Temp Int Identity [Int] Property+many producer consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        let fldstp conL currL = return $ FL.Partial (conL ++ currL)+            concatFold = FL.Fold fldstp (return (FL.Partial [])) return return+            prsr =+                flip P.many concatFold+                    $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList+         in case runIdentity $ consumer prsr (producer ls) of+                Right res_list ->+                    checkListEqual res_list (Prelude.filter (== 0) ls)+                Left _ -> property False++many_empty :: ParserTestCase_Temp Int Identity [Int] Property+many_empty producer consumer =+    property (case runIdentity $ consumer (flip P.many FL.toList (P.die "die")) (producer [1 :: Int]) of+        Right res_list -> checkListEqual res_list ([] :: [Int])+        Left _ -> property False)++some :: ParserTestCase_Temp Int Identity [Int] Property+some producer consumer =+    forAll (listOf (chooseInt (0, 1))) $ \genLs ->+        let+            ls = 0 : genLs+            fldstp conL currL = return $ FL.Partial $ conL ++ currL+            concatFold = FL.Fold fldstp (return (FL.Partial [])) return return+            prsr =+                flip P.some concatFold+                    $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList+         in case runIdentity $ consumer prsr (producer ls) of+                Right res_list -> res_list == Prelude.filter (== 0) ls+                Left _ -> False++someFail :: ParserTestCase_Temp Int Identity [Int] Property+someFail producer consumer =+    property (case runIdentity $ consumer (P.some (P.die "die") FL.toList) (producer [1 :: Int]) of+        Right _ -> False+        Left _ -> True)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++applicative :: ParserTestCase_Temp Int Identity ([Int], [Int]) Property+applicative producer consumer =+    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->+        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->+            let parser =+                    (,)+                        <$> P.fromFold (FL.take (length list1) FL.toList)+                        <*> P.fromFold (FL.take (length list2) FL.toList)+             in+                case runIdentity $ consumer parser (producer $ list1 ++ list2) of+                    Right (olist1, olist2) -> olist1 == list1 && olist2 == list2+                    Left _ -> False++sequence :: ParserTestCase_Temp Int IO [[Int]] Property+sequence producer consumer =+    forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->+        let p xs = P.fromFold (FL.take (length xs) FL.toList)+         in monadicIO $ do+                outs <- run $+                        consumer+                            (Prelude.sequence $ fmap p ins)+                            (producer $ concat ins)+                return $+                    case outs of+                        Right ls -> ls == ins+                        Left _ -> False++altEOF1 :: ParserTestCase_Temp Int (PropertyM IO) Int Property+altEOF1 producer consumer =+    monadicIO $ do+    s1 <- consumer+        (P.satisfy (> 0) <|> return 66)+        (producer ([]::[Int]))+    return $+        case s1 of+            Right x -> x == 66+            Left _ -> False++altEOF2 :: ParserTestCase_Temp Int (PropertyM IO) [Int] Property+altEOF2 producer consumer =+    monadicIO $ do+    s1 <- consumer+        ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))+        (producer ([51]::[Int]))+    return $+        case s1 of+            Right x -> x == [51]+            Left _ -> False++monad :: ParserTestCase_Temp Int (PropertyM IO) ([Int], [Int]) Property+monad producer consumer =+    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->+        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->+            let parser = do+                    olist1 <- P.fromFold (FL.take (length list1) FL.toList)+                    olist2 <- P.fromFold (FL.take (length list2) FL.toList)+                    return (olist1, olist2)+             in monadicIO $ do+                    s <- consumer parser (producer $ list1 ++ list2)+                    return $+                        case s of+                            Right (olist1, olist2) -> olist1 == list1 && olist2 == list2+                            Left _ -> False++takeEndBy1 :: ParserTestCase_Temp Int Identity [Int] Property+takeEndBy1 producer consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        case runIdentity $ consumer (P.takeEndBy predicate prsr) (producer ls) of+            Right parsed_list ->+                checkListEqual+                parsed_list+                (takeWhileAndFirstFail (not . predicate) ls)+            Left _ -> property False+        where+            prsr = P.many (P.satisfy (const True)) FL.toList++            predicate = (== 1)++            takeWhileAndFirstFail prd (x : xs) =+                if prd x+                then x : takeWhileAndFirstFail prd xs+                else [x]+            takeWhileAndFirstFail _ [] = []++takeEndByEsc :: ParserTestCase_Temp Int Identity [Int] Property+takeEndByEsc producer consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        let+            msg = "takeEndByEsc: trailing escape"++            isSep = even++            isEsc x = x `mod` 6 == 0++            prsr = P.takeEndByEsc isEsc isSep prsr0++                where++                prsr0 = P.many (P.satisfy (const True)) FL.toList++            escapeSep maybePrevEsc [] =+                case maybePrevEsc of+                    Nothing -> []+                    Just prevEsc -> [prevEsc]+            escapeSep maybePrevEsc (x : xs) =+                 case maybePrevEsc of+                    Nothing ->+                        if isEsc x+                        then escapeSep (Just x) xs+                        else+                            if isSep x+                            then [x]+                            else x : escapeSep Nothing xs+                    Just _ ->+                            x : escapeSep Nothing xs+        in+            case runIdentity $ consumer prsr (producer ls) of+                Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls+                Left err -> property (msg `isSuffixOf` displayException err)++takeFramedByEsc_ :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_ producer consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        let+            isBegin = (== 0)++            isEnd = (== 1)++            isEsc = (== 2)++            prsr = P.takeFramedByEsc_ isEsc isBegin isEnd  FL.toList++            checkPass (x : xs) maybePrevEsc openMinusClose =+                case maybePrevEsc of+                    Nothing ->+                        if isEsc x+                        then checkPass xs (Just x) openMinusClose+                        else+                            if isBegin x+                            then checkPass xs Nothing (openMinusClose + 1)+                            else+                                if isEnd x+                                then+                                    case openMinusClose of+                                        0 -> False+                                        1 -> True+                                        _ ->+                                            checkPass+                                            xs+                                            Nothing+                                            (openMinusClose - 1)+                                else+                                    checkPass xs Nothing openMinusClose+                    Just _ -> checkPass xs Nothing openMinusClose+            checkPass [] _ _ = False++            checkPassBeg [] = False+            checkPassBeg xxs@(x:_)+                | isBegin x = checkPass xxs Nothing (0 :: Int)+                | otherwise = False++            escapeFrame begin end escape l =+                let+                    helper (x : xs) maybePrevEsc openMinusClose =+                        case maybePrevEsc of+                            Nothing ->+                                if escape x+                                then helper xs (Just x) openMinusClose+                                else+                                    if begin x+                                    then helper xs Nothing (openMinusClose + 1)+                                    else+                                        if end x+                                        then+                                            if openMinusClose - 1 == 0+                                            then []+                                            else+                                                helper+                                                xs+                                                Nothing+                                                (openMinusClose - 1)+                                        else+                                            x : helper xs Nothing openMinusClose+                            Just prevEsc ->+                                if escape x || begin x || end x+                                then x : helper xs Nothing openMinusClose+                                else+                                    prevEsc : x : helper xs Nothing openMinusClose+                    helper [] _ _ = error "Cannot Reach Here"+                in+                    helper l Nothing (0 :: Int)+        in+            case runIdentity $ consumer prsr (producer ls) of+                Right parsed_list ->+                    if checkPassBeg ls+                    then checkListEqual parsed_list $+                        escapeFrame isBegin isEnd isEsc ls+                    else property False+                Left _ ->+                    if checkPassBeg ls+                    then property False+                    else property True++takeFramedByEsc_Pass :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_Pass producer consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \list ->+        let+            ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)++            isBegin = (== 0)++            isEnd = (== 1)++            isEsc = (== 2)++            prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList++            escapeFrame begin end escape l =+                let+                    helper (x : xs) maybePrevEsc openMinusClose =+                        case maybePrevEsc of+                            Nothing ->+                                if escape x+                                then helper xs (Just x) openMinusClose+                                else+                                    if begin x+                                    then+                                        if openMinusClose == 0+                                        then helper xs Nothing (openMinusClose + 1)+                                        else x : helper xs Nothing (openMinusClose + 1)+                                    else+                                        if end x+                                        then+                                            if openMinusClose - 1 == 0+                                            then []+                                            else+                                                x :+                                                helper+                                                xs+                                                Nothing+                                                (openMinusClose - 1)+                                        else+                                            x : helper xs Nothing openMinusClose+                            Just _ ->+                                x : helper xs Nothing openMinusClose+                    helper [] _ _ = error "Cannot Reach Here"+                in+                    helper l Nothing (0 :: Int)+        in+            case runIdentity $ consumer prsr (producer ls) of+                Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls+                _ -> property False++takeFramedByEsc_Fail1 :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_Fail1 producer consumer =+    let+        msg = "takeFramedByEsc_: missing frame end"++        isBegin = (== 0)++        isEnd = (== 0)++        isEsc = (== 2)++        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList++        ls = [0 :: Int]+    in+        case runIdentity $ consumer prsr (producer ls) of+            Right _ -> property False+            Left err -> property (msg `isSuffixOf` displayException err)++takeFramedByEsc_Fail2 :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_Fail2 producer consumer =+    let+        msg = "takeFramedByEsc_: missing frame start"++        isBegin = (== 0)++        isEnd = (== 1)++        isEsc = (== 1)++        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList++        ls = [1 :: Int]+    in+        case runIdentity $ consumer prsr (producer ls) of+            Right _ -> property False+            Left err -> property (msg `isSuffixOf` displayException err)++takeFramedByEsc_Fail3 :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_Fail3 producer consumer =+    let+        msg = "takeFramedByEsc_: missing frame end"++        isBegin = (== 2)++        isEnd = (== 1)++        isEsc = (== 2)++        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList++        ls = [2 :: Int]+    in+        case runIdentity $ consumer prsr (producer ls) of+            Right _ -> property False+            Left err -> property (msg `isSuffixOf` displayException err)++takeStartBy_ :: ParserTestCase_Temp Int Identity [Int] Property+takeStartBy_ producer consumer =+     forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        let ls1 = 1:ls+            msg = "takeFramedByGeneric: empty token"+        in+            case runIdentity $ consumer parser (producer ls1) of+                Right parsed_list ->+                  if not $ Prelude.null ls1+                  then+                    let tls = Prelude.takeWhile (not . predicate) (tail ls1)+                    in checkListEqual parsed_list $+                      if predicate (head ls1)+                      then tls+                      else Prelude.takeWhile (not . predicate) ls1+                  else property $ Prelude.null parsed_list+                Left err -> property (msg `isSuffixOf` displayException err)+            where+                predicate = odd+                parser = P.takeBeginBy_ predicate FL.toList++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++data TestMode+    = TMParserStream+    | TMParserKStreamK+    | TMParserKStreamKChunks+    | TMParserKStreamKChunksGeneric+    deriving (Show)++runParserTC :: (Unbox a, Monad m) => TestMode -> ParserTestCase a m b c -> c+runParserTC tm runner =+    case tm of+        TMParserStream ->+            runner $ \p -> mapMTup S.toList . S.parseBreakPos p . S.fromList+        TMParserKStreamK ->+            runner $ \p ->+                mapMTup K.toList . K.parseBreakPos (PK.toParserK p) . K.fromList+        TMParserKStreamKChunks ->+            runner $ \p ->+                mapMTup+                    (fmap (concatMap A.toList) . K.toList)+                        . A.parseBreakPos (A.toParserK p)+                        . producerChunks A.fromList+        TMParserKStreamKChunksGeneric ->+            runner $ \p ->+                mapMTup+                    (fmap (concatMap GA.toList) . K.toList)+                        . GA.parseBreakPos (GA.toParserK p)+                        . producerChunks GA.fromList++    where+    mapMTup f tupM = do+        (t, a) <- tupM+        (t,) <$> f a++    cSize = 50+    -- Not using A.createOf here because of the MonadIO constraint+    producerChunks fl =+        K.fromStream+             . S.groupsOf cSize (fl <$> FL.toList)+             . S.fromList++runParserTC_temp :: (Unbox a, Monad m) => TestMode -> ParserTestCase_Temp a m b c -> c+runParserTC_temp tm runner =+    case tm of+        TMParserStream -> runner S.fromList S.parsePos+        TMParserKStreamK -> runner K.fromList (K.parsePos . PK.toParserK)+        TMParserKStreamKChunks ->+            runner (producerChunks A.fromList) (A.parsePos . A.toParserK)+        TMParserKStreamKChunksGeneric ->+            runner+                (producerChunks GA.fromList)+                (GA.parsePos . GA.toParserK)++    where+    cSize = 50+    -- Not using A.createOf here because of the MonadIO constraint+    producerChunks fl =+        K.fromStream+             . S.groupsOf cSize (fl <$> FL.toList)+             . S.fromList++{-# NOINLINE mainCommon #-}+mainCommon :: TestMode -> Spec+mainCommon ptt = do+  describe (show ptt) $ do+    describe "Instances" $ do+        prop "applicative" $ runParserTC_temp ptt applicative+        prop "Alternative: end of input 1" $ runParserTC_temp ptt altEOF1+        prop "Alternative: end of input 2" $ runParserTC_temp ptt altEOF2+        prop "monad" $ runParserTC_temp ptt monad+        prop "sequence" $ runParserTC_temp ptt sequence++    describe "test for accumulator" $ do+        prop "P.fromFold FL.sum = FL.sum" $ runParserTC ptt fromFold+        prop "fromPure value provided" $ runParserTC ptt fromPure+        prop "fromPure monadic value provided" $ runParserTC ptt fromEffect+        prop "fail err = Left (SomeException (ParseError err))" $ runParserTC ptt parserFail+        prop "always fail" $ runParserTC ptt die+        prop "always fail but monadic" $ runParserTC ptt dieM++    describe "test for element parser" $ do+        prop "peek = head with list length > 0" $ runParserTC ptt peekPass+        prop "peek fail on []" $ runParserTC ptt peekFail+        prop "eof pass on []" $ runParserTC_temp ptt eofPass+        prop "eof fail on non-empty list" $ runParserTC_temp ptt eofFail+        prop "first element exists and >= mid_value" $ runParserTC_temp ptt satisfyPass+        prop "one pass on [Int]" $ runParserTC_temp ptt onePass+        prop "one fail on []" $ runParserTC_temp ptt one+        prop "check first element exists and satisfies predicate" $ runParserTC_temp ptt satisfy+    describe "test for sequence parser" $ do+        prop "P.takeBetween = Prelude.take when len >= m and len <= n"+            $ runParserTC_temp ptt takeBetweenPass+        prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"+              ++ "otherwise fail") $ runParserTC_temp ptt takeBetween+        prop "P.take = Prelude.take" $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.take+        prop "P.takeEQ = Prelude.take when len >= n" $ runParserTC_temp ptt takeEQPass+        prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"+            $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.takeEQ+        prop "P.takeGE n ls = ls when len >= n" $ runParserTC_temp ptt takeGEPass+        prop "P.takeGE n ls = ls when len >= n and fail otherwise" $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.takeGE+        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" $ runParserTC_temp ptt lookAheadPass+        -- prop "Fail when stream length exceeded" lookAheadFail+        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" $ runParserTC_temp ptt lookAhead+        prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"+                ++ " tail") $ runParserTC ptt takeStartBy+        prop "P.takeWhile = Prelude.takeWhile" $ runParserTC ptt Streamly.Test.Data.Parser.Common.takeWhile+        prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"+                ++ " else check why failed") $ runParserTC ptt takeWhile1+        prop "takeWhileP prd P.take = takeWhileMaxLen prd" $ runParserTC ptt takeWhileP+        prop ("P.takeP = Prelude.take") $ runParserTC ptt takeP+        prop "P.groupBy = Prelude.head . Prelude.groupBy" $ runParserTC_temp ptt groupBy+        prop "groupByRolling" $ runParserTC_temp ptt groupByRolling+        prop "many (P.wordBy ' ') = words'" $ runParserTC_temp ptt wordBy+        -- prop "choice" choice+        prop "parse 0, then 1, else fail" $ runParserTC_temp ptt splitWith+        prop "fail due to die as left parser" $ runParserTC_temp ptt splitWithFailLeft+        prop "fail due to die as right parser" $ runParserTC_temp ptt splitWithFailRight+        prop "fail due to die as both parsers" $ runParserTC_temp ptt splitWithFailBoth+        -- prop "" teeWithPass+        -- prop "" teeWithFailLeft+        -- prop "" teeWithFailRight+        -- prop "" teeWithFailBoth+        -- prop "deintercalate" deintercalate+        -- prop "" shortestPass+        -- prop "" shortestFailLeft+        -- prop "" shortestFailRight+        -- prop "" shortestFailBoth+        prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="+                ++ "Prelude.filter (== 0)") $ runParserTC_temp ptt many+        prop "[] due to parser being die" $ runParserTC_temp ptt many_empty+        prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="+                ++ "Prelude.filter (== 0)") $ runParserTC_temp ptt some+        prop "fail due to parser being die" $ runParserTC_temp ptt someFail+        prop "takeEndBy_" $ runParserTC ptt takeEndBy_+        prop "takeEndByOrMax_" $ runParserTC ptt takeEndByOrMax_+        prop "takeEndBy1" $ runParserTC_temp ptt takeEndBy1+        prop "takeEndByEsc" $ runParserTC_temp ptt takeEndByEsc+        prop "takeFramedByEsc_" $ runParserTC_temp ptt takeFramedByEsc_+        prop "takeFramedByEsc_Pass" $ runParserTC_temp ptt takeFramedByEsc_Pass+        prop "takeFramedByEsc_Fail1" $ runParserTC_temp ptt takeFramedByEsc_Fail1+        prop "takeFramedByEsc_Fail2" $ runParserTC_temp ptt takeFramedByEsc_Fail2+        prop "takeFramedByEsc_Fail3" $ runParserTC_temp ptt takeFramedByEsc_Fail3+        prop "takeStartBy_" $ runParserTC_temp ptt takeStartBy_++    runParserTC_temp ptt takeProperties++main :: Spec+main = do+        -- We keep Parser and ParserK tests in the same (Parser) executable for 2+        -- reasons:+        -- 1. We almost always write Parser tests hence we prioritize Parser over+        --    ParserK+        -- 2. This results in minimal compilation overhead compared to duplicating+        --    or keeping the common part in the library.+        --    2.1. Duplication will result in compilation of this code twice+        --    2.2. Keeping the common part in the library will compile the Parser+        --         code even when it's not necessary. For example, if we are running+        --         non-parser test suites.+        --+        -- One problem is that this module becomes very big for compilation. We can+        -- break this further and keep them as a part of "other-modules" in+        -- Test.Parser test-suite.+        mainCommon TMParserStream+        mainCommon TMParserKStreamKChunks+        mainCommon TMParserKStreamK+        mainCommon TMParserKStreamKChunksGeneric
− test/Streamly/Test/Data/Parser/ParserD.hs 
@@ -1,777 +0,0 @@-module Main (main) where--import Control.Exception (SomeException(..))-import Data.Word (Word8, Word32, Word64)-import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)-import Test.Hspec (Spec, hspec, describe)-import Test.Hspec.QuickCheck-import Test.QuickCheck-       (arbitrary, forAll, elements, Property,-        property, listOf, vectorOf, (.&&.), Gen)-import Test.QuickCheck.Monadic (monadicIO, assert, run)--import qualified Data.List as List-import qualified Prelude-import qualified Streamly.Internal.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser.ParserD as P-import qualified Streamly.Internal.Data.Producer.Source as Source-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Test.Hspec as H--import Prelude hiding (sequence)--#if MIN_VERSION_QuickCheck(2,14,0)--import Test.QuickCheck (chooseAny)--#else--import System.Random (Random(random))-import Test.QuickCheck.Gen (Gen(MkGen))---- | Generates a random element over the natural range of `a`.-chooseAny :: Random a => Gen a-chooseAny = MkGen (\r _ -> let (x,_) = random r in x)--#endif--maxTestCount :: Int-maxTestCount = 100--min_value :: Int-min_value = 0--mid_value :: Int-mid_value = 5000--max_value :: Int-max_value = 10000--max_length :: Int-max_length = 1000---- Accumulator Tests--fromFold :: Property-fromFold =-    forAll (listOf $ chooseInt (min_value, max_value))-      $ \ls ->-            case (==) <$> (S.parseD (P.fromFold FL.sum) (S.fromList ls))-                   <*> (S.fold FL.sum (S.fromList ls)) of-                Right is_equal -> is_equal-                Left _ -> False--fromPure :: Property-fromPure =-    forAll (chooseInt (min_value, max_value)) $ \x ->-        case S.parseD (P.fromPure x) (S.fromList [1 :: Int]) of-            Right r -> r == x-            Left _ -> False--fromEffect :: Property-fromEffect =-    forAll (chooseInt (min_value, max_value)) $ \x ->-        case S.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of-            Right r -> r == x-            Left _ -> False--die :: Property-die =-    property $-    case S.parseD (P.die "die test") (S.fromList [0 :: Int]) of-        Right _ -> False-        Left _ -> True--dieM :: Property-dieM =-    property $-    case S.parseD (P.dieM (Right "die test")) (S.fromList [0 :: Int]) of-        Right _ -> False-        Left _ -> True---- Element Parser Tests--peekPass :: Property-peekPass =-    forAll (chooseInt (1, max_length)) $ \list_length ->-        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-            case S.parseD P.peek (S.fromList ls) of-                Right head_value -> case ls of-                    head_ls : _ -> head_value == head_ls-                    _ -> False-                Left _ -> False--peekFail :: Property-peekFail =-    property (case S.parseD P.peek (S.fromList []) of-        Right _ -> False-        Left _ -> True)--eofPass :: Property-eofPass =-    property (case S.parseD P.eof (S.fromList []) of-        Right _ -> True-        Left _ -> False)--eofFail :: Property-eofFail =-    forAll (chooseInt (1, max_length)) $ \list_length ->-        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-            case S.parseD P.eof (S.fromList ls) of-                Right _ -> False-                Left _ -> True--satisfyPass :: Property-satisfyPass =-    forAll (chooseInt (mid_value, max_value)) $ \first_element ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->-            let-                ls = first_element : ls_tail-                predicate = (>= mid_value)-            in-                case S.parseD (P.satisfy predicate) (S.fromList ls) of-                    Right r -> r == first_element-                    Left _ -> False--satisfy :: Property-satisfy =-    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        case S.parseD (P.satisfy predicate) (S.fromList ls) of-            Right r -> case ls of-                [] -> False-                (x : _) -> predicate x && (r == x)-            Left _ -> case ls of-                [] -> True-                (x : _) -> not $ predicate x-        where-            predicate = (>= mid_value)---- Sequence Parsers Tests-takeBetweenPass :: Property-takeBetweenPass =-    forAll (chooseInt (min_value, max_value)) $ \m ->-        forAll (chooseInt (m, max_value)) $ \n ->-            forAll (chooseInt (m, max_value)) $ \list_length ->-                forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                    case S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of-                        Right parsed_list ->-                            let lpl = Prelude.length parsed_list-                            in checkListEqual parsed_list (Prelude.take lpl ls)-                        Left _ -> property False---takeBetween :: Property-takeBetween =-    forAll (chooseInt (min_value, max_value)) $ \m ->-        forAll (chooseInt (min_value, max_value)) $ \n ->-            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-                let-                    list_length = Prelude.length ls-                in-                    case S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of-                        Right parsed_list ->-                            if m <= list_length && n >= list_length-                            then-                                let lpl = Prelude.length parsed_list-                                in checkListEqual parsed_list (Prelude.take-                                    lpl ls)-                            else property False-                        Left _ -> property (m > n || list_length < m)--take :: Property-take =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            case S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)-                Left _ -> property False--takeEQPass :: Property-takeEQPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (chooseInt (n, max_value)) $ \list_length ->-            forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                case S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of-                    Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)-                    Left _ -> property False--takeEQ :: Property-takeEQ =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            let-                list_length = Prelude.length ls-            in-                case S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        if (n <= list_length) then-                            checkListEqual parsed_list (Prelude.take n ls)-                        else-                            property False-                    Left _ -> property (n > list_length)--takeGEPass :: Property-takeGEPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (chooseInt (n, max_value)) $ \list_length ->-            forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                case S.parseD (P.takeGE n FL.toList) (S.fromList ls) of-                    Right parsed_list -> checkListEqual parsed_list ls-                    Left _ -> property False--takeGE :: Property-takeGE =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            let-                list_length = Prelude.length ls-            in-                case S.parseD (P.takeGE n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        if (n <= list_length) then-                            checkListEqual parsed_list ls-                        else-                            property False-                    Left _ -> property (n > list_length)--nLessThanEqual0 ::-       (  Int-       -> FL.Fold (Either SomeException) Int [Int]-       -> P.Parser (Either SomeException) Int [Int]-       )-    -> (Int -> [Int] -> [Int])-    -> Property-nLessThanEqual0 tk ltk =-    forAll (elements [0, (-1)]) $ \n ->-        forAll (listOf arbitrary) $ \ls ->-            case S.parseD (tk n FL.toList) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (ltk n ls)-                Left _ -> property False--takeProperties :: Spec-takeProperties =-    describe "take combinators when n <= 0/" $ do-        prop "takeEQ n FL.toList = []" $-            nLessThanEqual0 P.takeEQ (\_ -> const [])-        prop "takeGE n FL.toList xs = xs" $-            nLessThanEqual0 P.takeGE (\_ -> id)----- XXX lookAhead can't deal with EOF which in this case means when--- n==list_length, this test will fail. So excluding that case for now.-lookAheadPass :: Property-lookAheadPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        let-            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList-            parseTwice = do-                parsed_list_1 <- takeWithoutConsume-                parsed_list_2 <- takeWithoutConsume-                return (parsed_list_1, parsed_list_2)-        in-            forAll (chooseInt (n+1, max_value)) $ \list_length ->-                forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                    case S.parseD parseTwice (S.fromList ls) of-                        Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)-                        Left _ -> property $ False--lookAhead :: Property-lookAhead =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        let-            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList-            parseTwice = do-                parsed_list_1 <- takeWithoutConsume-                parsed_list_2 <- takeWithoutConsume-                return (parsed_list_1, parsed_list_2)-        in-            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-                case S.parseD parseTwice (S.fromList ls) of-                    Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)-                    Left _ -> property ((list_length < n) || (list_length == n && n == 0))-                        where-                            list_length = Prelude.length ls--takeWhile :: Property-takeWhile =-    forAll (listOf (chooseInt (0, 1))) $ \ ls ->-        case S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of-            Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls)-            Left _ -> property False-        where-            predicate = (== 0)--takeWhile1 :: Property-takeWhile1 =-    forAll (listOf (chooseInt (0, 1))) $ \ ls ->-        case S.parseD (P.takeWhile1 predicate  FL.toList) (S.fromList ls) of-            Right parsed_list -> case ls of-                [] -> property False-                (x : _) ->-                    if predicate x then-                        checkListEqual parsed_list (Prelude.takeWhile predicate ls)-                    else-                        property False-            Left _ -> case ls of-                [] -> property True-                (x : _) -> property (not $ predicate x)-        where-            predicate = (== 0)--groupBy :: Property-groupBy =-    forAll (listOf (chooseInt (0, 1)))-        $ \ls ->-              case S.parseD parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (groupByLF ls)-                  Left _ -> property False--    where--    cmp = (==)-    parser = P.groupBy cmp FL.toList-    groupByLF lst-        | null lst = []-        | otherwise = head $ List.groupBy cmp lst--groupByRolling :: Property-groupByRolling =-    forAll (listOf (chooseInt (0, 1)))-        $ \ls ->-              case S.parseD parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (groupByLF Nothing ls)-                  Left _ -> property False--    where--    cmp = (==)-    parser = P.groupBy cmp FL.toList-    groupByLF _ [] = []-    groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs-    groupByLF (Just y) (x:xs) =-        if cmp y x-        then x : groupByLF (Just x) xs-        else []--takeEndByOrMax :: Property-takeEndByOrMax =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (0, 1))) $ \ls ->-            case S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))-                Left _ -> property False-            where-                predicate = (== 1)--wordBy :: Property-wordBy =-    forAll (listOf (elements [' ', 's']))-        $ \ls ->-              case S.parseD parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (words' ls)-                  Left _ -> property False--    where--    predicate = (== ' ')-    parser = P.many (P.wordBy predicate FL.toList) FL.toList-    words' lst =-        let wrds = words lst-         in if wrds == [] && length lst > 0 then [""] else wrds---serialWith :: Property-serialWith =-    forAll (listOf (chooseInt (0, 1))) $ \ls ->-        case S.parseD (P.serialWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of-            Right (result_first, result_second) -> case ls of-                0 : 1 : _ -> (result_first == 0) && (result_second == 1)-                _ -> False-            Left _ -> case ls of-                0 : 1 : _ -> False-                _ -> True--splitWithFailLeft :: Property-splitWithFailLeft =-    property (case S.parseD (P.serialWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--splitWithFailRight :: Property-splitWithFailRight =-    property (case S.parseD (P.serialWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--splitWithFailBoth :: Property-splitWithFailBoth =-    property (case S.parseD (P.serialWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--teeWithPass :: Property-teeWithPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (0, 1))) $ \ls ->-            let-                prsr = P.fromFold $ FL.take n FL.toList-            in-                case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of-                    Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2-                    Left _ -> property False--teeWithFailLeft :: Property-teeWithFailLeft =-    property (case S.parseD (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--teeWithFailRight :: Property-teeWithFailRight =-    property (case S.parseD (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--teeWithFailBoth :: Property-teeWithFailBoth =-    property (case S.parseD (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--shortestPass :: Property-shortestPass =-    forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->-        let-            half_mid_value = mid_value `Prelude.div` 2-            prsr_1 = P.takeWhile (<= half_mid_value) FL.toList-            prsr_2 = P.takeWhile (<= mid_value) FL.toList-            prsr_shortest = P.shortest prsr_1 prsr_2-        in-            case S.parseD prsr_shortest (S.fromList ls) of-                Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)-                Left _ -> property False--shortestPassLeft :: Property-shortestPassLeft =-    property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right r -> r == 1-        Left _ -> False)--shortestPassRight :: Property-shortestPassRight =-    property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right r -> r == 1-        Left _ -> False)--shortestFailBoth :: Property-shortestFailBoth =-    property-        (case S.parseD-                  (P.shortest (P.die "die") (P.die "die"))-                  (S.fromList [1 :: Int]) of-             Right _ -> False-             Left _ -> True)--longestPass :: Property-longestPass =-    forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->-        let-            half_mid_value = mid_value `Prelude.div` 2-            prsr_1 = P.takeWhile (<= half_mid_value) FL.toList-            prsr_2 = P.takeWhile (<= mid_value) FL.toList-            prsr_longest = P.longest prsr_1 prsr_2-        in-            case S.parseD prsr_longest (S.fromList ls) of-                Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls-                Left _ -> False--longestPassLeft :: Property-longestPassLeft =-    property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right r -> r == 1-        Left _ -> False)--longestPassRight :: Property-longestPassRight =-    property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right r -> r == 1-        Left _ -> False)--longestFailBoth :: Property-longestFailBoth =-    property-        (case S.parseD (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--many :: Property-many =-    forAll (listOf (chooseInt (0, 1)))-      $ \ls ->-            let fldstp conL currL = return $ FL.Partial (conL ++ currL)-                concatFold =-                    FL.Fold fldstp (return (FL.Partial [])) return-                prsr =-                    flip P.many concatFold-                        $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList-             in case S.parseD prsr (S.fromList ls) of-                    Right res_list ->-                        checkListEqual res_list (Prelude.filter (== 0) ls)-                    Left _ -> property False--many_empty :: Property-many_empty =-    property (case S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of-        Right res_list -> checkListEqual res_list ([] :: [Int])-        Left _ -> property False)--some :: Property-some =-    forAll (listOf (chooseInt (0, 1)))-      $ \ls ->-            let fldstp conL currL = return $ FL.Partial $ conL ++ currL-                concatFold = FL.Fold fldstp (return (FL.Partial [])) return-                prsr =-                    flip P.some concatFold-                        $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList-             in case S.parseD prsr (S.fromList ls) of-                    Right res_list -> res_list == Prelude.filter (== 0) ls-                    Left _ -> False--someFail :: Property-someFail =-    property (case S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------applicative :: Property-applicative =-    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->-        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->-            let parser =-                        (,)-                            <$> P.fromFold (FL.take (length list1) FL.toList)-                            <*> P.fromFold (FL.take (length list2) FL.toList)-             in monadicIO $ do-                    (olist1, olist2) <--                        run $ S.parseD parser (S.fromList $ list1 ++ list2)-                    listEquals (==) olist1 list1-                    listEquals (==) olist2 list2--sequence :: Property-sequence =-    forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->-        let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins-         in monadicIO $ do-                outs <- run $-                        S.parseD-                            (Prelude.sequence parsers)-                            (S.fromList $ concat ins)-                listEquals (==) outs ins--monad :: Property-monad =-    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->-        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->-            let parser = do-                            olist1 <- P.fromFold (FL.take (length list1) FL.toList)-                            olist2 <- P.fromFold (FL.take (length list2) FL.toList)-                            return (olist1, olist2)-             in monadicIO $ do-                    (olist1, olist2) <--                        run $ S.parseD parser (S.fromList $ list1 ++ list2)-                    listEquals (==) olist1 list1-                    listEquals (==) olist2 list2------------------------------------------------------------------------------------ Stream parsing----------------------------------------------------------------------------------parseMany :: Property-parseMany =-    forAll (chooseInt (1,100)) $ \len ->-        forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->-            monadicIO $ do-                outs <--                    ( run-                    $ S.toList-                    $ S.parseManyD-                        (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)-                    )-                listEquals (==) outs ins---- basic sanity test for parsing from arrays-parseUnfold :: Property-parseUnfold = do-    let len = 200-    -- ls = input list (stream)-    -- clen = chunk size-    -- tlen = parser take size-    forAll-        ((,,)-            <$> vectorOf len (chooseAny :: Gen Int)-            <*> chooseInt (1, len)-            <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->-        monadicIO $ do-            arrays <- S.toList $ S.arraysOf clen (S.fromList ls)-            let src = Source.source (Just (Producer.OuterLoop arrays))-            let parser = P.fromFold (FL.take tlen FL.toList)-            let readSrc =-                    Source.producer-                        $ Producer.concat Producer.fromList A.producer-            let streamParser =-                    Producer.simplify (Source.parseManyD parser readSrc)-            xs <- run-                $ S.toList-                $ S.unfoldMany Unfold.fromList-                $ S.unfold streamParser src--            listEquals (==) xs ls------------------------------------------------------------------------------------ Test for a particular case hit during fs events testing----------------------------------------------------------------------------------evId :: [Word8]-evId = [96,238,17,9,0,0,0,0]--evFlags :: [Word8]-evFlags = [0,4,1,0,0,0,0,0]--evPathLen :: [Word8]-evPathLen = [71,0,0,0,0,0,0,0]--evPath :: [Word8]-evPath =-    [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109-    ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112-    ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116-    ,114,101,97,109,108,121,47,116,109,112,47,122,122-    ]--event :: [Word8]-event = evId ++ evFlags ++ evPathLen ++ evPath--data Event = Event-   { eventId :: Word64-   , eventFlags :: Word32-   , eventAbsPath :: A.Array Word8-   } deriving (Show, Ord, Eq)--readOneEvent :: P.Parser IO Word8 Event-readOneEvent = do-    arr <- P.takeEQ 24 (A.writeN 24)-    let arr1 = A.unsafeCast arr :: A.Array Word64-        eid = A.unsafeIndex 0 arr1-        eflags = A.unsafeIndex 1 arr1-        pathLen = fromIntegral $ A.unsafeIndex 2 arr1-    path <- P.takeEQ pathLen (A.writeN pathLen)-    return $ Event-        { eventId = eid-        , eventFlags = fromIntegral eflags-        , eventAbsPath = path-        }--parseMany2Events :: Property-parseMany2Events =-    monadicIO $ do-        xs <--            ( run-            $ S.toList-            $ S.parseManyD readOneEvent-            $ S.fromList (concat (replicate 2 event))-            )-        assert (length xs == 2)-        -- XXX assuming little endian machine-        let ev = Event-                { eventId = 152170080-                , eventFlags = 66560-                , eventAbsPath = A.fromList evPath-                }-         in listEquals (==) xs (replicate 2 ev)------------------------------------------------------------------------------------ Main----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Parser.ParserD"--main :: IO ()-main =-  hspec $-  H.parallel $-  modifyMaxSuccess (const maxTestCount) $ do-  describe moduleName $ do--    describe "Instances" $ do-        prop "applicative" applicative-        prop "monad" monad-        prop "sequence" sequence--    describe "Stream parsing" $ do-        prop "parseMany" parseMany-        prop "parseMany2Events" parseMany2Events-        prop "parseUnfold" parseUnfold--    describe "test for accumulator" $ do-        prop "P.fromFold FL.sum = FL.sum" fromFold-        prop "fromPure value provided" fromPure-        prop "fromPure monadic value provided" fromEffect-        prop "always fail" die-        prop "always fail but monadic" dieM--    describe "test for element parser" $ do-        prop "peek = head with list length > 0" peekPass-        prop "peek fail on []" peekFail-        prop "eof pass on []" eofPass-        prop "eof fail on non-empty list" eofFail-        prop "first element exists and >= mid_value" satisfyPass-        prop "check first element exists and satisfies predicate" satisfy--    describe "test for sequence parser" $ do-        prop "P.takeBetween m n = Prelude.take when len >= m and len <= n"-                takeBetweenPass-        prop "P.takeBetween m n = Prelude.take when len >= m and len <= n and\-                \fail otherwise" takeBetween-        prop "P.take = Prelude.take" Main.take-        prop "P.takeEQ = Prelude.take when len >= n" takeEQPass-        prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ-        prop "P.takeGE n ls = ls when len >= n" takeGEPass-        prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE-        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass-        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead-        prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile-        prop "P.takeWhile1 = Prelude.takeWhile if taken something, else check why failed" takeWhile1-        prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy-        prop "groupByRolling" groupByRolling-        prop "P.takeEndByOrMax = Prelude.take n (Prelude.takeWhile (not . predicate)" takeEndByOrMax-        prop "many (P.wordBy ' ') = words'" wordBy-        prop "parse 0, then 1, else fail" serialWith-        prop "fail due to die as left parser" splitWithFailLeft-        prop "fail due to die as right parser" splitWithFailRight-        prop "fail due to die as both parsers" splitWithFailBoth-        prop "parsed two lists should be equal" teeWithPass-        prop "fail due to die as left parser" teeWithFailLeft-        prop "fail due to die as right parser" teeWithFailRight-        prop "fail due to die as both parsers" teeWithFailBoth-        prop "P.takeWhile (<= half_mid_value) = Prelude.takeWhile half_mid_value" shortestPass-        prop "pass even if die is left parser" shortestPassLeft-        prop "pass even if die is right parser" shortestPassRight-        prop "fail due to die as both parsers" shortestFailBoth-        prop "P.takeWhile (<= mid_value) = Prelude.takeWhile (<= mid_value)" longestPass-        prop "pass even if die is left parser" longestPassLeft-        prop "pass even if die is right parser" longestPassRight-        prop "fail due to die as both parsers" longestFailBoth-        prop "P.many concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" many-        prop "[] due to parser being die" many_empty-        prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some-        prop "fail due to parser being die" someFail-    takeProperties
+ test/Streamly/Test/Data/ParserK.hs view
@@ -0,0 +1,146 @@+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif++module Main (main) where++import Data.Either (fromRight)+import Test.Hspec (Spec, hspec, describe, it, expectationFailure, shouldBe)+import Test.Hspec.QuickCheck++import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Array.Generic as AG+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Parser as Parser+import qualified Streamly.Internal.Data.ParserK as ParserK+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Test.Hspec as H++import Streamly.Test.Parser.Common++import Prelude hiding (sequence)++maxTestCount :: Int+maxTestCount = 100++toParser :: Spec+toParser = do+    let p = ParserK.toParser (ParserK.toParserK Parser.one)+        runP xs = Stream.parsePos p (Stream.fromList xs)+    describe "toParser . toParserK" $ do+        it "empty stream" $ do+            r1 <- runP ([] :: [Int])+            case r1 of+                Left e -> print e+                Right x ->+                    expectationFailure $ "Expecting failure, got: " ++ show x+        it "exact stream" $ do+            r2 <- runP [0::Int]+            fromRight undefined r2 `shouldBe` 0+        it "longer stream" $ do+            r3 <- runP [0,1::Int]+            fromRight undefined r3 `shouldBe` 0++    let p1 = ParserK.toParserK $ ParserK.toParser (ParserK.toParserK Parser.one)+        runP1 xs = StreamK.parsePos p1 (StreamK.fromStream $ Stream.fromList xs)+    describe "toParserK . toParser . toParserK" $ do+        it "empty stream" $ do+            r1 <- runP1 ([] :: [Int])+            case r1 of+                Left e -> print e+                Right x ->+                    expectationFailure $ "Expecting failure, got: " ++ show x+        it "exact stream" $ do+            r2 <- runP1 [0::Int]+            fromRight undefined r2 `shouldBe` 0+        it "longer stream" $ do+            r3 <- runP1 [0,1::Int]+            fromRight undefined r3 `shouldBe` 0++    -- NOTE: Without fusionBreaker this test would pass even if toParser has+    -- incorrect implementation because of fusion rules.+    let p2 = Parser.takeWhile (<= 3) FL.toList+        runP2 xs = Stream.parseBreakPos p2 (Stream.fromList xs)++        p3 = ParserK.toParserK (Parser.takeWhile (<= 3) FL.toList)+        runP3 xs = StreamK.parseBreakPos p3 (StreamK.fromList xs)++        p4 =+            ParserK.toParser+                $ fusionBreaker+                $ ParserK.toParserK (Parser.takeWhile (<= 3) FL.toList)+        runP4 xs = Stream.parseBreakPos p4 (Stream.fromList xs)+    describe "toParser . toParserK" $ do+        it "(<= 3) for [1, 2, 3, 4, 5]" $ do+            (a, b) <- runP2 ([1, 2, 3, 4, 5] :: [Int])+            fromRight undefined a `shouldBe` [1, 2, 3]+            rest <- Stream.toList b+            rest `shouldBe` [4, 5]+        it "(<= 3) for [1, 2, 3, 4, 5]" $ do+            (a, b) <- runP3 ([1, 2, 3, 4, 5] :: [Int])+            fromRight undefined a `shouldBe` [1, 2, 3]+            rest <- StreamK.toList b+            rest `shouldBe` [4, 5]+        it "(<= 3) for [1, 2, 3, 4, 5]" $ do+            (a, b) <- runP4 ([1, 2, 3, 4, 5] :: [Int])+            fromRight undefined a `shouldBe` [1,2,3]+            rest <- Stream.toList b+            rest `shouldBe` [4, 5]+        it "(<= 3) for [1, 2, 3]" $ do+            (a, b) <- runP4 ([1, 2, 3] :: [Int])+            fromRight undefined a `shouldBe` [1, 2, 3]+            rest <- Stream.toList b+            rest `shouldBe` []++{-# NOINLINE fusionBreaker #-}+fusionBreaker :: a -> a+fusionBreaker = id++-------------------------------------------------------------------------------+-- Parser driver sanity tests+-------------------------------------------------------------------------------++sanityParseBreak :: [Move] -> H.SpecWith ()+sanityParseBreak jumps = it (show jumps) $ do+    (val, rest) <-+        StreamK.parseBreakPos (ParserK.toParserK (jumpParser jumps))+            $ StreamK.fromList tape+    lst <- StreamK.toList rest+    (val, lst) `shouldBe` (expectedResult jumps tape)++sanityParseBreakChunks :: [Move] -> H.SpecWith ()+sanityParseBreakChunks jumps = it (show jumps) $ do+    (val, rest) <-+        A.parseBreakPos (A.toParserK (jumpParser jumps))+            $ StreamK.fromList $ Prelude.map A.fromList chunkedTape+    lst <- Prelude.map A.toList <$> StreamK.toList rest+    (val, concat lst) `shouldBe` (expectedResult jumps tape)++sanityParseBreakChunksGeneric :: [Move] -> H.SpecWith ()+sanityParseBreakChunksGeneric jumps = it (show jumps) $ do+    (val, rest) <-+        AG.parseBreakPos (AG.toParserK (jumpParser jumps))+            $ StreamK.fromList $ Prelude.map AG.fromList chunkedTape+    lst <- Prelude.map AG.toList <$> StreamK.toList rest+    (val, concat lst) `shouldBe` (expectedResult jumps tape)++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.ParserK"++-- Many ParserK tests are tested in Test.Parser module+main :: IO ()+main =+  hspec $+  H.parallel $+  modifyMaxSuccess (const maxTestCount) $ do+  describe moduleName $ do+    parserSanityTests "StreamK.parseBreak" sanityParseBreak+    parserSanityTests "StreamK.parseBreakChunks" sanityParseBreakChunks+    parserSanityTests "StreamK.parseBreakChunksGeneric" sanityParseBreakChunksGeneric+    toParser
+ test/Streamly/Test/Data/RingArray.hs view
@@ -0,0 +1,56 @@+-- |+-- Module      : Streamly.Test.Data.RingArray+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.RingArray (main) where++import Streamly.Test.Common (performGCSweep)++import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.RingArray as RingArray++import Prelude as P+import Test.Hspec as H++eqArrayN :: [Int] -> [Int] -> Int -> Int -> Bool -> IO ()+eqArrayN lstArr lstRing startR nBytes expected = do+    let arr = Array.fromList lstArr+    marr <- MutArray.fromList lstRing+    let ring =+            maybe (error "cast failed") id $ RingArray.castMutArrayWith startR marr+    performGCSweep 4 100000+    res <- RingArray.eqArrayN ring arr nBytes+    res `shouldBe` expected++eqArray :: [Int] -> [Int] -> Int -> Bool -> IO ()+eqArray lstArr lstRing startR expected = do+    let arr = Array.fromList lstArr+    marr <- MutArray.fromList lstRing+    let ring =+            maybe (error "cast failed") id $ RingArray.castMutArrayWith startR marr+    performGCSweep 4 100000+    res <- RingArray.eqArray ring arr+    res `shouldBe` expected++moduleName :: String+moduleName = "Data.RingArray"++main :: IO ()+main = hspec $ do+    describe moduleName $ do+        describe "Eq" $ do+            let lstArr = [0..99]+                lstRing = [50..99] ++ [0..49]+            it "eqArrayN True (n < len)"+                   $ eqArrayN lstArr lstRing 50 75 True+            it "eqArrayN True (n > len)"+                   $ eqArrayN lstArr lstRing 50 200 True+            it "eqArrayN False"+                   $ eqArrayN lstArr lstRing 10 75 False+            it "eqArray True" $ eqArray lstArr lstRing 50 True+            it "eqArray False" $ eqArray lstArr lstRing 20 False
+ test/Streamly/Test/Data/Scanl/Concurrent.hs view
@@ -0,0 +1,154 @@+-- |+-- Module      : Streamly.Test.Data.Scanl.Concurrent+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Scanl.Concurrent (main) where++import Control.Concurrent (threadDelay)+import Control.Exception (ErrorCall(..), try)+import Data.Function ( (&) )+import Data.IORef (newIORef, atomicModifyIORef')+import Data.List (sort)+import Streamly.Data.Scanl (Scanl)+import Test.Hspec as H++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Scanl.Prelude as Scanl++moduleName :: String+moduleName = "Data.Scanl.Concurrent"++---------------------------------------------------------------------------+-- Main+---------------------------------------------------------------------------++evenScan :: Scanl IO Int (Maybe Int)+evenScan =+    Scanl.filtering even+        & Scanl.lmapM (\x -> threadDelay 100 >> pure x)++oddScan :: Scanl IO Int (Maybe Int)+oddScan =+    Scanl.filtering odd+        & Scanl.lmapM (\x -> threadDelay 100 >> pure x)++parDistributeScan_ScanEnd :: (Scanl.Config -> Scanl.Config) -> IO ()+parDistributeScan_ScanEnd concOpts = do+    let streamLen = 10000+        evenLen = 100+    ref <- newIORef [Scanl.take evenLen evenScan, oddScan]+    let gen = atomicModifyIORef' ref (\xs -> ([], xs))+        inpList = [1..streamLen]+        inpStream = Stream.fromList inpList+    res1 <-+        Scanl.parDistributeScanM concOpts gen inpStream+            & Stream.concatMap Stream.fromList+            & Stream.catMaybes+            & Stream.fold Fold.toList+    sort res1 `shouldBe` [1..evenLen] ++ filter odd [(evenLen+1)..streamLen]++parDemuxScan_ScanEnd :: (Scanl.Config -> Scanl.Config) -> IO ()+parDemuxScan_ScanEnd concOpts = do+    let streamLen = 10000+        evenLen = 100+        demuxer i = even (i :: Int)+    ref <- newIORef (Scanl.take evenLen $ Scanl.mkScanl1 (\_ x -> x))+    let gen True =+            atomicModifyIORef' ref (\xs -> (fmap (const Nothing) Scanl.drain, xs))+        gen False = pure $ Scanl.mkScanl1 (\_ x -> x)+        inpList = [1..streamLen]+        inpStream = Stream.fromList inpList+    res <-+        Scanl.parDemuxScanM concOpts demuxer gen inpStream+            & Stream.concatMap Stream.fromList+            & fmap (\x -> (fst x,) <$> snd x)+            & Stream.catMaybes+            & Stream.fold Fold.toList+    map snd (filter fst res) `shouldBe` take evenLen [2, 4 ..]+    map snd (filter (not . fst) res) `shouldBe` filter odd [1..streamLen]++parDistributeScan_StreamEnd :: (Scanl.Config -> Scanl.Config) -> IO ()+parDistributeScan_StreamEnd concOpts = do+    let streamLen = 10000+    ref <- newIORef [evenScan, oddScan]+    let gen = atomicModifyIORef' ref (\xs -> ([], xs))+        inpList = [1..streamLen]+        inpStream = Stream.fromList inpList+    res1 <-+        Scanl.parDistributeScanM concOpts gen inpStream+            & Stream.concatMap Stream.fromList+            & Stream.catMaybes+            & Stream.fold Fold.toList+    sort res1 `shouldBe` inpList++parDemuxScan_StreamEnd :: (Scanl.Config -> Scanl.Config) -> IO ()+parDemuxScan_StreamEnd concOpts = do+    let streamLen = 10000+        demuxer i = even (i :: Int)+        gen _ = pure $ Scanl.mkScanl1 (\_ x -> x)+        inpList = [1..streamLen]+        inpStream = Stream.fromList inpList+    res <-+        Scanl.parDemuxScanM concOpts demuxer gen inpStream+            & Stream.concatMap Stream.fromList+            & fmap (\x -> (fst x,) <$> snd x)+            & Stream.catMaybes+            & Stream.fold Fold.toList+    map snd (filter fst res) `shouldBe` filter even [1..streamLen]+    map snd (filter (not . fst) res) `shouldBe` filter odd [1..streamLen]++parDemuxScan_WorkerException :: (Scanl.Config -> Scanl.Config) -> IO ()+parDemuxScan_WorkerException concOpts = do+    let throwAfter = 3+        -- All items go to the same key so the driver stays in sendToWorker_+        -- for a single worker channel, maximizing the chance of blocking on a+        -- full buffer.+        demuxer _ = (0 :: Int)+        gen _ = pure+            $ Scanl.lmapM+                (\x -> do+                    -- Slow the worker down so the buffer fills up and the+                    -- driver blocks in sendToWorker_ waiting for space.+                    threadDelay 50000+                    if (x :: Int) > throwAfter+                    then error "worker exception"+                    else pure x)+            $ Scanl.mkScanl1 (\_ x -> x)+        -- Send enough items to fill the buffer (maxBuffer 1) and block+        inpList = [1..100]+        inpStream = Stream.fromList inpList+    res <- try+        $ Scanl.parDemuxScanM concOpts demuxer gen inpStream+            & Stream.concatMap Stream.fromList+            & fmap (\x -> (fst x,) <$> snd x)+            & Stream.catMaybes+            & Stream.fold Fold.toList+    case res of+        Left (ErrorCall msg) -> msg `shouldBe` "worker exception"+        Right _ -> expectationFailure+            "Expected ErrorCall exception but stream completed successfully"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+        it "parDistributeScanM (stream end) (maxBuffer 1)"+            $ parDistributeScan_StreamEnd (Scanl.maxBuffer 1)+        it "parDistributeScanM (scan end) (maxBuffer 1)"+            $ parDistributeScan_ScanEnd (Scanl.maxBuffer 1)+        it "parDemuxScanM (stream end) (maxBuffer 1)"+            $ parDemuxScan_StreamEnd (Scanl.maxBuffer 1)+        it "parDemuxScanM (scan end) (maxBuffer 1)"+            $ parDemuxScan_ScanEnd (Scanl.maxBuffer 1)+        it "parDemuxScanM (worker exception) (maxBuffer 1)"+            $ parDemuxScan_WorkerException (Scanl.maxBuffer 1)
+ test/Streamly/Test/Data/Serialize.hs view
@@ -0,0 +1,308 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++-- Required for Eq instance declaration of HigherOrderType+{-# LANGUAGE UndecidableInstances #-}++-- We are generating an orphan instance of Serialize for Identity.+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module      : Streamly.Test.Data.Serialize+-- Copyright   : (c) 2022 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Serialize (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Foldable (forM_)+import Data.Word (Word8)+import System.Random (randomRIO)+import Streamly.Internal.Data.MutByteArray (MutByteArray)+import GHC.Generics (Generic)+import Streamly.Data.MutByteArray (Serialize)+import Streamly.Test.Data.Serialize.TH (genDatatype)++import Data.Functor.Identity (Identity (..))++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.MutByteArray as Serialize++import qualified Streamly.Test.Data.Serialize.CompatV0 as CompatV0+import qualified Streamly.Test.Data.Serialize.CompatV1 as CompatV1++import Test.Hspec.QuickCheck+import Test.QuickCheck+import Test.Hspec as H++--------------------------------------------------------------------------------+-- Serialize configuration+--------------------------------------------------------------------------------++#ifdef ENABLE_constructorTagAsString+#define CONF_NAME "ENABLE_constructorTagAsString"+#define CONF (Serialize.encodeConstrNames True)+#else+#define CONF_NAME "DEFAULT"+#define CONF id+#endif++--------------------------------------------------------------------------------+-- Edge case types+--------------------------------------------------------------------------------++data Unit =+    Unit+    deriving (Eq, Show)+$(Serialize.deriveSerializeWith CONF [d|instance Serialize Unit|])++data The =+    The Unit Int Char+    deriving (Eq, Show)+$(Serialize.deriveSerializeWith CONF [d|instance Serialize The|])++--------------------------------------------------------------------------------+-- Generated types+--------------------------------------------------------------------------------++$(genDatatype "CustomDatatype" 15)+$(Serialize.deriveSerializeWith CONF [d|instance Serialize CustomDatatype|])++--------------------------------------------------------------------------------+-- Types with functional parameters+--------------------------------------------------------------------------------++data HigherOrderType f =+    HigherOrderType+        { field0 :: f Int+        , field1 :: f Char+        }++instance (Eq (f Int), Eq (f Char)) => Eq (HigherOrderType f) where+    (==) a b = (field0 a == field0 b) && (field1 a == field1 b)++instance (Show (f Int), Show (f Char)) => Show (HigherOrderType f) where+    show a = "HigherOrderType " ++ show (field0 a) ++ " " ++ show (field1 a)++$(Serialize.deriveSerializeWith CONF+      [d|instance Serialize a => Serialize (Identity a)|])+$(Serialize.deriveSerializeWith CONF+      [d|instance Serialize (HigherOrderType Identity)|])++--------------------------------------------------------------------------------+-- Recursive type+--------------------------------------------------------------------------------++-- Recursive ADT+data BinTree a+  = Tree (BinTree a) (BinTree a)+  | Leaf a+  deriving (Show, Read, Eq, Generic)++$(Serialize.deriveSerializeWith+      CONF+      [d|instance Serialize a => Serialize (BinTree a)|])++-- XXX This may not terminate, or could become really large.+instance Arbitrary a => Arbitrary (BinTree a) where+  arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]++-- Make a balanced tree of given level+mkBinTree :: (Arbitrary a) => Int -> IO (BinTree a)+mkBinTree = go (generate arbitrary)++    where++    go r 0 = Leaf <$> r+    go r n = Tree <$> go r (n - 1) <*> go r (n - 1)++--------------------------------------------------------------------------------+-- Record syntax type+--------------------------------------------------------------------------------++upgradeRec :: (a -> b) -> CompatV0.Rec a -> CompatV1.Rec b+upgradeRec f val =+    CompatV1.Rec+        { CompatV1.initialField = CompatV0.initialField val+        , CompatV1.otherField = f (CompatV0.otherField val)+        , CompatV1.theLastField = CompatV0.theLastField val+        , CompatV1.aNewField = Nothing+        }++upgradeRiver :: CompatV0.River -> CompatV1.River+upgradeRiver = read . show++downgradeRec  :: (a -> b) -> CompatV1.Rec a -> CompatV0.Rec b+downgradeRec f val =+    CompatV0.Rec+        { CompatV0.initialField = CompatV1.initialField val+        , CompatV0.otherField = f (CompatV1.otherField val)+        , CompatV0.theLastField = CompatV1.theLastField val+        }++downgradeRiver :: CompatV1.River -> CompatV0.River+downgradeRiver = read . show++testCompatibility ::+       CompatV0.Rec (CompatV0.Rec CompatV0.River)+    -> CompatV1.Rec (CompatV1.Rec CompatV1.River)+    -> IO ()+testCompatibility v0 v1 = do+    let upgradedV0 = upgradeRec (upgradeRec upgradeRiver) v0+        downgradedV1 = downgradeRec (downgradeRec downgradeRiver) v1++    res <- poke v0+    peekAndVerify res upgradedV0++    res1 <- poke v1+    peekAndVerify res1 downgradedV1++--------------------------------------------------------------------------------+-- Test helpers+--------------------------------------------------------------------------------++poke ::+       forall a. Serialize.Serialize a+    => a+    -> IO (MutByteArray, Int, Int)+poke val = do+    let sz = Serialize.addSizeTo 0 val++    let excessSize = 100+    randomOff <- randomRIO (10, excessSize)+    -- Use a proper slice to test instead of the array directly. This will catch+    -- any hardcoded 0 offsets+    let arrSize = sz + excessSize+        serStartOff = randomOff+        serEndOff = randomOff + sz+    arr <- Serialize.new arrSize+    arr2 <- Serialize.new arrSize+    -- Re-initialize the array with random value+    forM_ [0..(arrSize - 1)] $ \i -> Serialize.pokeAt i arr2 (8 :: Word8)++    off1 <- Serialize.serializeAt serStartOff arr val+    off2 <- Serialize.serializeAt 0 arr2 val++    let slice1 = Array.Array arr serStartOff off1 :: Array.Array Word8+        slice2 = Array.Array arr2 0 off2 :: Array.Array Word8+    -- The serialized representation should be the same+    slice1 `shouldBe` slice2++    off1 `shouldBe` serEndOff+    pure (arr, serStartOff, serEndOff)++peekAndVerify ::+       forall a. (Eq a, Show a, Serialize.Serialize a)+    => (MutByteArray, Int, Int)+    -> a+    -> IO ()+peekAndVerify (arr, serStartOff, serEndOff) val = do+    (off2, val2) <- Serialize.deserializeAt serStartOff arr serEndOff+    val2 `shouldBe` val+    off2 `shouldBe` serEndOff+    let slice = Array.Array arr serStartOff serEndOff+    val `shouldBe` fst (Array.deserialize slice)+    clonedSlice <-+        fmap Array.unsafeFreeze $ MutArray.clone $ Array.unsafeThaw slice+    val `shouldBe` fst (Array.deserialize clonedSlice)++roundtrip+    :: forall a. (Eq a, Show a, Serialize.Serialize a)+    => a+    -> IO ()+roundtrip val = do++    -- For debugging large size generated by arbitrary+    -- let sz = Serialize.addSizeTo 0 val+    -- putStrLn $ "Size is: " ++ show sz++    val `shouldBe` fst (Array.deserialize (Array.serialize' val))++    res <- poke val+    peekAndVerify res val++testSerializeList+    :: forall a. (Eq a, Show a, Serialize.Serialize a)+    => Int+    -> a+    -> IO ()+testSerializeList sizeOfA val = do++    let sz = Serialize.addSizeTo 0 val++    sz `shouldBe` sizeOfA++    roundtrip val++--------------------------------------------------------------------------------+-- Tests+--------------------------------------------------------------------------------++testCases :: Spec+testCases = do++    it "Serialize [Int]"+        $ testSerializeList (8 + 4 * 8) ([1, 2, 3, 4] :: [Int])+    it "Serialize [[Int]]"+        $ testSerializeList+              (8 + 3 * 8 + 6 * 8)+              ([[1], [1, 2], [1, 2, 3]] :: [[Int]])++    describe "Edge Cases" $ do+        it "Unit" $ roundtrip Unit+        it "The" $ roundtrip $ The Unit 1 'a'++    it "HigherOrderType"+        $ roundtrip $ HigherOrderType (Identity 5) (Identity 'e')++    prop "Integer"+        $ \(x :: Integer) -> roundtrip x++    prop "([Integer], [Int])"+        $ \(x :: ([Integer], [Int])) -> roundtrip x++    prop "Array Int"+        $ \(x :: [Int]) -> roundtrip (Array.fromList x)++    prop "Compatible Record"+        $ \(a :: CompatV1.Rec (CompatV0.Rec CompatV1.River)) -> roundtrip a++    prop "Compatibility"+        $ \a b -> testCompatibility a b++    limitQC+        $ prop "CustomDatatype"+        $ \(x :: CustomDatatype) -> roundtrip x++    limitQC+        $ prop "[CustomDatatype]"+        $ \(x :: [CustomDatatype]) -> roundtrip x++    limitQC+        $ prop "BinTree"+        $ forAll (elements [1..15])+            (\(x :: Int) -> do+                (r :: BinTree Int) <- mkBinTree x+                roundtrip r+            )++    where++    limitQC = modifyMaxSize (const 50)++--------------------------------------------------------------------------------+-- Main function+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Serialize." ++ CONF_NAME++main :: IO ()+main = hspec $ H.parallel $ describe moduleName testCases
+ test/Streamly/Test/Data/Serialize/CompatV0.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE TemplateHaskell #-}++module Streamly.Test.Data.Serialize.CompatV0+    ( Rec(..)+    , River(..)+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Test.QuickCheck (Arbitrary, arbitrary, elements)+import Streamly.Internal.Data.MutByteArray (Serialize)+import qualified Streamly.Internal.Data.MutByteArray as Serialize++--------------------------------------------------------------------------------+-- Types+--------------------------------------------------------------------------------++data Rec a =+    Rec+        { initialField :: Int+        , otherField :: a+        , theLastField :: Maybe String+        }+    deriving (Eq, Show)++instance Arbitrary a => Arbitrary (Rec a) where+    arbitrary = Rec <$> arbitrary <*> arbitrary <*> arbitrary++$(Serialize.deriveSerializeWith+      (Serialize.encodeRecordFields True)+      [d|instance Serialize a => Serialize (Rec a)|])++data River+    = Ganga+    | Yamuna+    | Godavari+    deriving (Eq, Show, Read)++instance Arbitrary River where+    arbitrary = elements [Ganga, Yamuna, Godavari]++$(Serialize.deriveSerializeWith+      (Serialize.encodeConstrNames True)+      [d|instance Serialize River|])
+ test/Streamly/Test/Data/Serialize/CompatV1.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE TemplateHaskell #-}++module Streamly.Test.Data.Serialize.CompatV1+    ( Rec(..)+    , River(..)+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Test.QuickCheck (Arbitrary, arbitrary, elements)+import Streamly.Internal.Data.MutByteArray (Serialize)+import qualified Streamly.Internal.Data.MutByteArray as Serialize++--------------------------------------------------------------------------------+-- Types+--------------------------------------------------------------------------------++data Rec a =+    Rec+        { initialField :: Int+        , otherField :: a+        , theLastField :: Maybe String+        , aNewField :: Maybe Char+        }+    deriving (Eq, Show)++instance Arbitrary a => Arbitrary (Rec a) where+    arbitrary = Rec <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++$(Serialize.deriveSerializeWith+      (Serialize.encodeRecordFields True)+      [d|instance Serialize a => Serialize (Rec a)|])++data River+    = Yamuna+    | Krishna+    | Godavari+    | Ganga+    deriving (Eq, Show, Read)++instance Arbitrary River where+    arbitrary = elements [Ganga, Yamuna, Godavari]++$(Serialize.deriveSerializeWith+      (Serialize.encodeConstrNames True)+      [d|instance Serialize River|])
+ test/Streamly/Test/Data/Serialize/TH.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Test.Data.Serialize.TH+-- Copyright   : (c) 2022 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Serialize.TH (genDatatype) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Language.Haskell.TH++import Test.QuickCheck.Arbitrary (Arbitrary(..))+import Test.QuickCheck.Gen (oneof)++--------------------------------------------------------------------------------+-- Generated types+--------------------------------------------------------------------------------++genDatatype :: String -> Int -> Q [Dec]+genDatatype tyName numCons =+    sequence+        [ dataD+               (pure [])+               (mkName tyName)+               []+               Nothing+               (mkCon <$> [0 .. (numCons - 1)])+               [derivClause Nothing [conT ''Eq, conT ''Show]]+         , instanceD+               (pure [])+               (appT (conT ''Arbitrary) (conT (mkName tyName)))+               [ funD+                     'arbitrary+                      [ clause+                           []+                           (normalB+                               (appE+                                    (varE 'oneof)+                                    (listE+                                        (mkArbitraryExp <$>+                                            [0 .. (numCons - 1)]))))+                           []+                      ]+               ]+         ]++    where++    fieldTypeChoices =+        [ conT ''Int+        , conT ''Char+        , conT ''String+        , appT listT (conT ''Int)+        , appT listT (conT ''String)+        , appT listT (appT listT (conT ''Int))+        , appT listT (appT listT (conT ''String))+        ]++    chooseCycle i xs = xs !! (i `mod` length xs)++    mkArbitraryExp i =+        foldl+            (\b a -> [|$(b) <*> $(a)|])+            [|pure $(conE (mkName ("Constructor" ++ show i)))|]+            (replicate i (varE 'arbitrary))++    mkCon i =+        normalC+            (mkName ("Constructor" ++ show i))+            (mkField <$> [0..(i - 1)])++    mkField i =+        bangType+            (bang noSourceUnpackedness noSourceStrictness)+            (chooseCycle i fieldTypeChoices)
test/Streamly/Test/Data/SmallArray.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Data.SmallArray -- Copyright   : (c) 2020 Composewell technologies
+ test/Streamly/Test/Data/Stream.hs view
@@ -0,0 +1,867 @@+-- XXX We are using head/tail at one place+{-# OPTIONS_GHC -Wno-missing-signatures #-}+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif++-- |+-- Module      : Streamly.Test.Data.Stream+-- Copyright   : (c) 2019 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Stream (main) where++import Control.Monad ( forM_ )+import Control.Monad.IO.Class (MonadIO)+import Data.List (sort, group, intercalate)+import Data.Semigroup (Sum(..), getSum)+import Data.Word (Word8)+import Streamly.Internal.Data.Array (Array)+import Streamly.Internal.Data.Fold (Fold)+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Internal.Data.Stream (Stream)+import Test.QuickCheck+    ( Gen+    , Property+    , Arbitrary(..)+    , choose+    , forAll+    , frequency+    , listOf+    , listOf1+    , suchThat+    , vectorOf+    , withMaxSuccess+    )+import Test.QuickCheck.Monadic (assert, monadicIO, pick, run)++import qualified Streamly.Internal.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.StreamK as StreamK+import qualified Streamly.Internal.Data.Parser as Parser++import Test.Hspec as H+import Test.Hspec.QuickCheck++import Streamly.Test.Common+-- import Streamly.Test.Prelude.Common++toList :: Monad m => Stream m a -> m [a]+toList = Stream.toList++-- XXX There are takeEndBy_ tests in Data.Fold module as well, need to+-- deduplicate.+-- XXX Where are the tests for "takeEndBy"?+splitOn :: Monad m =>+    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+splitOn predicate f = Stream.foldManyPost (Fold.takeEndBy_ predicate f)++splitOnSuffix :: Monad m =>+    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+splitOnSuffix predicate f = Stream.foldMany (Fold.takeEndBy_ predicate f)++-- XXX Where are the tests for "takeEndBySeq"?+splitOnSeqFold :: (MonadIO m, Unbox a, Enum a, Eq a) =>+   Array.Array a -> Fold m a b -> Stream m a -> Stream m b+splitOnSeqFold patt f = Stream.foldManyPost (Fold.takeEndBySeq_ patt f)++splitOnSeqStream :: (MonadIO m, Unbox a, Enum a, Eq a) =>+   Array.Array a -> Fold m a b -> Stream m a -> Stream m b+splitOnSeqStream = Stream.splitSepBySeq_++splitOnSuffixSeqFold :: (MonadIO m, Unbox a, Enum a, Eq a) =>+   Array.Array a -> Fold m a b -> Stream m a -> Stream m b+splitOnSuffixSeqFold patt f = Stream.foldMany (Fold.takeEndBySeq_ patt f)++-- XXX Where are the tests for Stream.splitOnSuffixSeq True ?+splitOnSuffixSeqStream :: (MonadIO m, Unbox a, Enum a, Eq a) =>+   Array.Array a -> Fold m a b -> Stream m a -> Stream m b+splitOnSuffixSeqStream = Stream.splitOnSuffixSeq False++groupsBy :: Monad m =>+    (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+groupsBy cmp f m = Stream.catRights $ Stream.parseMany (Parser.groupBy cmp f) m++groupsByRolling :: Monad m =>+    (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+groupsByRolling cmp f m =+   Stream.catRights $ Stream.parseMany (Parser.groupByRolling cmp f) m++{-+drainWhile :: Monad m => (a -> Bool) -> Stream m a -> m ()+drainWhile p m = Stream.fold Fold.drain $ Stream.takeWhile p m+-}++splitOnSeq ::+    (Array Char -> Fold IO a [a] -> Stream IO Char -> Stream IO String)+    -> Spec+splitOnSeq op = do+    describe "Tests for splitOnSeq" $ do+        -- Empty pattern case+        it "splitOnSeq_ \"\" \"\" = []"+          $ splitOnSeq_ "" "" `shouldReturn` []++        -- Single element pattern cases+        it "splitOnSeq_ \"x\" \"\" = []"+          $ splitOnSeq_ "x" "" `shouldReturn` []+        it "splitOnSeq_ \"x\" \"hello\" = [\"hello\"]"+          $ splitOnSeq_ "x" "hello" `shouldReturn` ["hello"]+        it "splitOnSeq_ \"h\" \"hello\" = [\"\", \"ello\"]"+          $ splitOnSeq_ "h" "hello" `shouldReturn` ["", "ello"]+        it "splitOnSeq_ \"e\" \"hello\" = [\"h\", \"llo\"]"+          $ splitOnSeq_ "e" "hello" `shouldReturn` ["h", "llo"]+        it "splitOnSeq_ \"l\" \"hello\" = [\"he\", \"\", \"o\"]"+          $ splitOnSeq_ "l" "hello" `shouldReturn` ["he", "", "o"]+        it "splitOnSeq_ \"o\" \"hello\" = [\"hell\", \"\"]"+          $ splitOnSeq_ "o" "hello" `shouldReturn` ["hell", ""]++        -- multi-element pattern fitting in a Word+        it "splitOnSeq_ \"he\" \"\" = []"+          $ splitOnSeq_ "he" "" `shouldReturn` []+        it "splitOnSeq_ \"he\" \"hello\" = [\"\", \"llo\"]"+          $ splitOnSeq_ "he" "hello" `shouldReturn` ["", "llo"]+        it "splitOnSeq_ \"ll\" \"hello\" = [\"he\", \"o\"]"+          $ splitOnSeq_ "ll" "hello" `shouldReturn` ["he", "o"]+        it "splitOnSeq_ \"lo\" \"hello\" = [\"hel\", \"\"]"+          $ splitOnSeq_ "lo" "hello" `shouldReturn` ["hel", ""]++        -- multi-element pattern - Rabin-Karp cases+        it "splitOnSeq_ \"hello\" \"\" = []"+          $ splitOnSeq_ "hello" "" `shouldReturn` []+        it "splitOnSeq_ \"hel\" \"hello\" = [\"\", \"lo\"]"+          $ splitOnSeq_ "hel" "hello" `shouldReturn` ["", "lo"]+        it "splitOnSeq_ \"ell\" \"hello\" = [\"h\", \"o\"]"+          $ splitOnSeq_ "ell" "hello" `shouldReturn` ["h", "o"]+        it "splitOnSeq_ \"llo\" \"hello\" = [\"he\", \"\"]"+          $ splitOnSeq_ "llo" "hello" `shouldReturn` ["he", ""]+        it "splitOnSeq_ \"hello\" \"hello\" = [\"\", \"\"]"+          $ splitOnSeq_ "hello" "hello" `shouldReturn` ["", ""]++    where++    splitOnSeq_ pat xs = toList $+        op (Array.fromList pat) Fold.toList (Stream.fromList xs)++splitOnSuffixSeq ::+    (Array Char -> Fold IO a [a] -> Stream IO Char -> Stream IO String)+    -> Spec+splitOnSuffixSeq op = do+    describe "Tests for splitOnSuffixSeq" $ do+        -- Empty pattern case++        -- Single element pattern cases+        it "splitSuffixOn_ \".\" \"\" []"+          $ splitSuffixOn_ "." "" `shouldReturn` []+        it "splitSuffixOn_ \".\" \".\" [\"\"]"+          $ splitSuffixOn_ "." "." `shouldReturn` [""]+        it "splitSuffixOn_ \".\" \"a\" [\"a\"]"+          $ splitSuffixOn_ "." "a" `shouldReturn` ["a"]+        it "splitSuffixOn_ \".\" \".a\" [\"\",\"a\"]"+          $ splitSuffixOn_ "." ".a" `shouldReturn` ["", "a"]+        it "splitSuffixOn_ \".\" \"a.\" [\"a\"]"+          $ splitSuffixOn_ "." "a." `shouldReturn` ["a"]+        it "splitSuffixOn_ \".\" \"a.b\" [\"a\",\"b\"]"+          $ splitSuffixOn_ "." "a.b" `shouldReturn` ["a", "b"]+        it "splitSuffixOn_ \".\" \"a.b.\" [\"a\",\"b\"]"+          $ splitSuffixOn_ "." "a.b." `shouldReturn` ["a", "b"]+        it "splitSuffixOn_ \".\" \"a..b..\" [\"a\",\"\",\"b\",\"\"]"+          $ splitSuffixOn_ "." "a..b.." `shouldReturn` ["a", "", "b", ""]++        -- multi-element pattern fitting in a Word+        it "splitSuffixOn_ \"he\" \"hello\" = [\"\", \"llo\"]"+          $ splitSuffixOn_ "he" "hello" `shouldReturn` ["", "llo"]+        it "splitSuffixOn_ \"el\" \"hello\" = [\"h\", \"lo\"]"+          $ splitSuffixOn_ "el" "hello" `shouldReturn` ["h", "lo"]+        it "splitSuffixOn_ \"lo\" \"hello\" = [\"hel\"]"+          $ splitSuffixOn_ "lo" "hello" `shouldReturn` ["hel"]++        -- multi-element pattern - Rabin-Karp cases+        it "splitSuffixOn_ \"hello\" \"\" = []"+          $ splitSuffixOn_ "hello" "" `shouldReturn` []+        it "splitSuffixOn_ \"hel\" \"hello\" = [\"\", \"lo\"]"+          $ splitSuffixOn_ "hel" "hello" `shouldReturn` ["", "lo"]+        it "splitSuffixOn_ \"ell\" \"hello\" = [\"h\", \"o\"]"+          $ splitSuffixOn_ "ell" "hello" `shouldReturn` ["h", "o"]+        it "splitSuffixOn_ \"llo\" \"hello\" = [\"he\"]"+          $ splitSuffixOn_ "llo" "hello" `shouldReturn` ["he"]+        it "splitSuffixOn_ \"hello\" \"hello\" = [\"\", \"\"]"+          $ splitSuffixOn_ "hello" "hello" `shouldReturn` [""]++    where++    splitSuffixOn_ pat xs = toList $+        op (Array.fromList pat) Fold.toList (Stream.fromList xs)++intercalateSuffix xs yss = intercalate xs yss ++ xs++nonSepElem :: (Arbitrary a, Eq a) => a -> Gen a+nonSepElem sep = suchThat arbitrary (/= sep)++listWithSep :: Arbitrary a => a -> Gen [a]+listWithSep sep = listOf $ frequency [(3, arbitrary), (1, return sep)]++listWithoutSep :: (Arbitrary a, Eq a) => a -> Gen [a]+listWithoutSep sep = vectorOf 4 (nonSepElem sep)++listsWithoutSep :: (Arbitrary a, Eq a) => a -> Gen [[a]]+listsWithoutSep sep = listOf (listWithoutSep sep)++listsWithoutSep1 :: (Arbitrary a, Eq a) => a -> Gen [[a]]+listsWithoutSep1 sep = listOf1 (listWithoutSep sep)++intercalateSplitEqId sep splitter lIntercalater sIntercalater i =+    let name =+            "intercalater . splitter == id ("+                <> show i <> " element separator)"+     in prop name+            $ forAll (listWithSep sep)+            $ \xs -> withMaxSuccess maxTestCount $ monadicIO $ testCase xs++    where++    testCase xs = do+        ys <- splitter xs (replicate i sep)+        szs <-+            toList+                $ sIntercalater (replicate i sep) Unfold.fromList+                $ Stream.fromList ys+        let lzs = lIntercalater (replicate i sep) ys+        listEquals (==) szs xs+        listEquals (==) lzs xs++intercalateSplitEqIdNoSepEnd sep splitter lIntercalater sIntercalater i =+    let name =+            "intercalater . splitter . (++ [x \\= sep]) == id ("+                <> show i <> " element separator)"+     in prop name+            $ forAll ((,) <$> listWithSep sep <*> nonSepElem sep)+            $ \(xs_, nonSep) -> do+                  let xs = xs_ ++ [nonSep]+                  withMaxSuccess maxTestCount $ monadicIO $ testCase xs++    where++    testCase xs = do+        ys <- splitter xs (replicate i sep)+        szs <-+            toList+                $ sIntercalater (replicate i sep) Unfold.fromList+                $ Stream.fromList ys+        let lzs = lIntercalater (replicate i sep) ys+        listEquals (==) szs xs+        listEquals (==) lzs xs++concatSplitIntercalateEqConcat sep splitter lIntercalater sIntercalater i =+    let name =+            "concat . splitter .Stream.intercalater == "+                <> "concat ("+                <> show i <> " element separator/possibly empty list)"+     in prop name+            $ forAll (listsWithoutSep sep)+            $ \xss -> withMaxSuccess maxTestCount $ monadicIO $ testCase xss++    where++    testCase xss = do+        let lxs = lIntercalater (replicate i sep) xss+        lys <- splitter lxs (replicate i sep)+        sxs <-+            toList+                $ sIntercalater (replicate i sep) Unfold.fromList+                $ Stream.fromList xss+        sys <- splitter sxs (replicate i sep)+        listEquals (==) (concat lys) (concat xss)+        listEquals (==) (concat sys) (concat xss)++splitIntercalateEqId sep splitter lIntercalater sIntercalater =+    let name =+            "splitter . intercalater == id"+                <> " (exclusive separator/non-empty list)"+     in prop name+            $ forAll (listsWithoutSep1 sep)+            $ \xss -> do+                  withMaxSuccess maxTestCount $ monadicIO $ testCase xss++    where++    testCase xss = do+        let lxs = lIntercalater [sep] xss+        lys <- splitter lxs [sep]+        sxs <- toList+                $ sIntercalater [sep] Unfold.fromList+                $ Stream.fromList xss+        sys <- splitter sxs [sep]+        listEquals (==) lys xss+        listEquals (==) sys xss++splitterProperties ::+       forall a. (Arbitrary a, Eq a, Show a)+    => a+    -> String+    -> Spec+splitterProperties sep desc = do+    describe (desc <> " splitOn")+        $ do++            intercalateSplitEqId+                sep splitOn_ intercalate Stream.unfoldEachSepBySeq 1++            concatSplitIntercalateEqConcat+                sep splitOn_ intercalate Stream.unfoldEachSepBySeq 1++            -- Exclusive case+            splitIntercalateEqId+                sep splitOn_ intercalate Stream.unfoldEachSepBySeq++    describe (desc <> " splitOnSuffix")+        $ do++            intercalateSplitEqIdNoSepEnd+                sep splitOnSuffix_ intercalate Stream.unfoldEachSepBySeq 1++            concatSplitIntercalateEqConcat+                sep splitOnSuffix_ intercalateSuffix Stream.unfoldEachEndBySeq 1++            -- Exclusive case+            splitIntercalateEqId+                sep splitOnSuffix_ intercalateSuffix Stream.unfoldEachEndBySeq++    where++    splitOn_ xs pat =+        toList $ splitOn (== head pat) Fold.toList (Stream.fromList xs)++    splitOnSuffix_ xs pat =+        toList $ splitOnSuffix (== head pat) Fold.toList (Stream.fromList xs)++seqSplitterProperties ::+       forall a. (Arbitrary a, Eq a, Show a, Unbox a, Enum a)+    => a+    -> String+    -> Spec+seqSplitterProperties sep desc = do+    describe (desc <> " splitOnSeq fold") (splitOnSeqWith splitOnSeq_)+    describe (desc <> " splitOnSeq stream") (splitOnSeqWith splitOnSeqStream_)+    describe (desc <> " splitOnSuffixSeq fold")+        (splitOnSuffixSeqWith splitOnSuffixSeq_)+    describe (desc <> " splitOnSuffixSeq stream")+        (splitOnSuffixSeqWith splitOnSuffixSeqStream_)++    where++    splitOnSeq_ xs pat =+        toList $ splitOnSeqFold (Array.fromList pat) Fold.toList (Stream.fromList xs)++    splitOnSeqStream_ xs pat =+        toList $ splitOnSeqStream (Array.fromList pat) Fold.toList (Stream.fromList xs)++    splitOnSuffixSeq_ xs pat =+        toList $ splitOnSuffixSeqFold (Array.fromList pat) Fold.toList (Stream.fromList xs)++    splitOnSuffixSeqStream_ xs pat =+        toList $ splitOnSuffixSeqStream (Array.fromList pat) Fold.toList (Stream.fromList xs)++    splitOnSeqWith op = do+        forM_ [0, 1, 2, 4]+            $ intercalateSplitEqId sep op intercalate Stream.unfoldEachSepBySeq++        forM_ [0, 1, 2, 4]+            $ concatSplitIntercalateEqConcat+                sep op intercalate Stream.unfoldEachSepBySeq++        -- Exclusive case+        splitIntercalateEqId sep op intercalate Stream.unfoldEachSepBySeq++    splitOnSuffixSeqWith op = do+        forM_ [0, 1, 2, 4]+            $ intercalateSplitEqIdNoSepEnd+                sep op intercalate Stream.unfoldEachSepBySeq++        forM_ [0, 1, 2, 4]+            $ concatSplitIntercalateEqConcat+                  sep op intercalateSuffix Stream.unfoldEachEndBySeq++        -- Exclusive case+        splitIntercalateEqId+            sep op intercalateSuffix Stream.unfoldEachEndBySeq++intercalateSplitOnId ::+       forall a. (Arbitrary a, Eq a, Show a, Num a) =>+       a -> String -> Spec+intercalateSplitOnId x desc =+    prop (desc <> " intercalate [x] . splitOn (== x) == id") $+        forAll listWithZeroes $ \xs -> do+            withMaxSuccess maxTestCount $+                monadicIO $ do+                    ys <- toList $ splitOn (== x) Fold.toList (Stream.fromList xs)+                    listEquals (==) (intercalate [x] ys) xs++    where++    listWithZeroes :: Gen [a]+    listWithZeroes = listOf $ frequency [(3, arbitrary), (1, return 0)]++groupSplitOps :: String -> Spec+groupSplitOps desc = do+    -- splitting++    -- The foldManyPost implementation on an empty stream produces a single+    -- value. The behaviour of foldManyPost implementation and the direct stream+    -- implementation is not different.+    -- splitOnSeq splitOnSeqFold++    splitOnSeq splitOnSeqStream+    splitOnSuffixSeq splitOnSuffixSeqFold++    -- XXX there are no tests for withSep = True option+    splitOnSuffixSeq splitOnSuffixSeqStream+    -- Some ad-hoc tests+    it "splitEndBySeq word hash cases" $ do+        let f sep input result =+                Stream.toList+                    ( Stream.splitEndBySeq (Array.fromList sep) Fold.toList+                    $ Stream.fromList input+                    ) `shouldReturn` result++        f "ab" "a" ["a"]+        f "ab" "ab" ["ab"]+        f "ab" "aba" ["ab","a"]+        f "ab" "abab" ["ab","ab"]+        f "ab" "abc" ["ab","c"]+        f "ab" "xab" ["xab"]+        f "" "" []+        f "." "" []+        f ".." "" []+        f "..." "" []+        f "" "a...b" ["a",".",".",".","b"]+        f "." "a...b" ["a.",".",".","b"]+        f ".." "a...b" ["a..",".b"]+        f "..." "a...b" ["a...","b"]+        f "." "abc" ["abc"]+        f ".." "abc" ["abc"]+        f "..." "abc" ["abc"]+        f "." "." ["."]+        f ".." ".." [".."]+        f "..." "..." ["..."]+        f "." ".a" [".","a"]+        f "." "a." ["a."]++    it "splitEndBySeq_ word hash cases" $ do+        let f sep input result =+                Stream.toList+                    ( Stream.splitEndBySeq_ (Array.fromList sep) Fold.toList+                    $ Stream.fromList input+                    ) `shouldReturn` result+        f "" "" []+        f "." "" []+        f ".." "" []+        f "..." "" []+        f "" "a...b" ["a",".",".",".","b"]+        f "." "a...b" ["a","","","b"]+        f ".." "a...b" ["a",".b"]+        f "..." "a...b" ["a","b"]+        f "." "abc" ["abc"]+        f ".." "abc" ["abc"]+        f "..." "abc" ["abc"]+        f "." "." [""]+        f ".." ".." [""]+        f "..." "..." [""]+        f "." ".a" ["","a"]+        f "." "a." ["a"]++    it "splitSepBySeq_ word hash cases" $ do+        let f sep input result =+                Stream.toList+                    ( Stream.splitSepBySeq_ (Array.fromList sep) Fold.toList+                    $ Stream.fromList input+                    ) `shouldReturn` result+        f "" "" []+        f "." "" []+        f ".." "" []+        f "..." "" []+        f "" "a...b" ["a",".",".",".","b"]+        f "." "a...b" ["a","","","b"]+        f ".." "a...b" ["a",".b"]+        f "..." "a...b" ["a","b"]+        f "." "abc" ["abc"]+        f ".." "abc" ["abc"]+        f "..." "abc" ["abc"]+        f "." "." ["",""]+        f ".." ".." ["",""]+        f "..." "..." ["",""]+        f "." ".a" ["","a"]+        f "." "a." ["a",""]++    let takeEndBySeq pat input result =+                Stream.toList+                    ( Stream.takeEndBySeq (Array.fromList pat)+                    $ Stream.fromList input+                    ) `shouldReturn` result+    it "takeEndBySeq empty pattern" $ do+        let f = takeEndBySeq ""+        f "" ""+        f "abcd" ""+    it "takeEndBySeq single element pattern" $ do+        let f = takeEndBySeq "a"+        f "" ""+        f "a" "a"+        f "ab" "a"+        f "xa" "xa"+        f "xab" "xa"+    it "takeEndBySeq word hash cases" $ do+        let f = takeEndBySeq "ab"+        f "" ""+        f "a" "a"+        f "ab" "ab"+        f "abc" "ab"+        f "aba" "ab"+        f "abab" "ab"+        f "x" "x"+        f "xa" "xa"+        f "xab" "xab"+        f "xabc" "xab"+    it "takeEndBySeq karp-rabin cases" $ do+        let f = takeEndBySeq "abc"+        f "" ""+        f "a" "a"+        f "ab" "ab"+        f "abc" "abc"+        f "abcd" "abc"+        f "abca" "abc"+        f "abcabc" "abc"+        f "x" "x"+        f "xa" "xa"+        f "xab" "xab"+        f "xabc" "xabc"+        f "xabcd" "xabc"++    -- splitting properties+    splitterProperties (0 :: Int) desc+    splitterProperties (0 :: Word8) desc++    seqSplitterProperties (0 :: Int) desc+    seqSplitterProperties (0 :: Word8) desc++    intercalateSplitOnId (0 :: Int) desc+    intercalateSplitOnId (0 :: Word8) desc++-- |+-- After grouping (and folding) Int stream using @<@ operation,+-- the first @Int@ of every @[Int]@ in the @[Int]@ stream should be the minimum.+testGroupsBy :: Property+testGroupsBy =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            r <- run $ Stream.fold (Fold.all (\ls ->+                case ls of+                    [] -> True+                    (x:_) -> x == minimum ls))+                $ groupsBy (<) Fold.toList+                $ Stream.fromList vec+            assert r++testGroups :: Property+testGroups =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            r <- toList $ groupsBy (==) Fold.toList $ Stream.fromList vec+            assert $ r == group vec++testGroupsByRolling :: Property+testGroupsByRolling =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            r <- toList $ groupsByRolling (==) Fold.toList $ Stream.fromList vec+            assert $ r == group vec++-- |+-- If the list is empty, returns Nothing,+-- else wraps the minimum value of the list in Just.+maybeMinimum :: [Int] -> Maybe Int+maybeMinimum [] = Nothing+maybeMinimum ls = Just $ minimum ls++-- |+-- Checks if the @[Int]@ is non-increasing.+decreasing :: [Maybe Int] -> Bool+decreasing [] = True+decreasing xs = and $ zipWith (<=) (tail xs) xs++-- |+-- To check if the minimum elements (after grouping on @<@)+-- are non-increasing (either decrease or remain the same).+-- Had an element been strictly greater, it would have been grouped+-- with that element only.+testGroupsBySep :: Property+testGroupsBySep =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            a <- toList+                    $ fmap maybeMinimum+                    $ groupsBy (<) Fold.toList+                    $ Stream.fromList vec+            assert $ decreasing a++testgroupsOf ::  Expectation+testgroupsOf =+    Stream.toList+        (Stream.groupsOf 2 Fold.sum (Stream.enumerateFromTo 1 10))+        `shouldReturn` [3::Int, 7, 11, 15, 19]++groupingOps :: Spec+groupingOps = do+    prop "groupsBy" testGroupsBy+    prop "Stream.groups = groups" testGroups+    prop "Stream.groupsByRolling = groups" testGroupsByRolling+    prop "testGroupsBySep" testGroupsBySep+    prop "testgroupsOf" testgroupsOf++{-+-- XXX to be fixed+associativityCheck+    :: String+    -> (Stream IO Int -> Stream IO Int)+    -> Spec+associativityCheck desc t = prop desc assocCheckProp+  where+    assocCheckProp :: [Int] -> [Int] -> [Int] -> Property+    assocCheckProp xs ys zs =+        monadicIO $ do+            let xStream = Stream.fromList xs+                yStream = Stream.fromList ys+                zStream = Stream.fromList zs+            infixAssocstream <-+                run $ Stream.toList $ t $ xStream `Stream.append` yStream `Stream.append` zStream+            assocStream <- run $ Stream.toList $ t $ xStream <> yStream <> zStream+            listEquals (==) infixAssocstream assocStream+-}++max_length :: Int+max_length = 1000++unfold :: Property+unfold = monadicIO $ do+    a <- pick $ choose (0, max_length `div` 2)+    b <- pick $ choose (0, max_length)+    let unf = Unfold.second b Unfold.enumerateFromToIntegral+    ls <- toList $ Stream.unfold unf a+    return $ ls == [a..b]++foldIterateM :: Property+foldIterateM =+    forAll (listOf (chooseInt (0, max_length))) $ \lst -> monadicIO $ do+        let s1 = Prelude.sum lst+            strm =Stream.fromList lst+        ms2 <-+           Stream.fold Fold.latest+                $ fmap getSum+                $ Stream.foldIterateM+                      (return . Fold.take 1 . Fold.sconcat)+                      (return (Sum 0))+                $ fmap Sum strm+        case ms2 of+            Nothing -> assert $ s1 == 0+            Just s2 -> assert $ s1 == s2++sortBy :: Property+sortBy =+    forAll (listOf (chooseInt (0, max_length)))+        $ \lst -> monadicIO $ do+            let s1 = sort lst+            s2 <- toList+                $ StreamK.toStream+                    ( StreamK.sortBy compare+                    $ StreamK.fromStream+                    $ Stream.fromList lst+                    )+            assert $ s1 == s2++------------------------------------------------------------------------------++maxStreamLen :: Int+maxStreamLen = 1000++-- Coverage build takes too long with default number of tests+maxTestCount :: Int+#ifdef DEVBUILD+maxTestCount = 100+#else+maxTestCount = 10+#endif++moduleName :: String+moduleName = "Data.Stream"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    describe "Runners" $ do+        -- XXX use an IORef to store and check the side effects+        it "simple serially" $+            Stream.fold Fold.drain+            (Stream.fromPure (0 :: Int)) `shouldReturn` ()+        it "simple serially with IO" $+            Stream.fold Fold.drain+            (Stream.fromEffect $ putStrLn "hello") `shouldReturn` ()++    describe "Construction" $ do+    {-+        -- XXX To be fixed. Copied from old stream Prelude tests.+        -- Add all the construction tests for all stream types.+        serialOps   $ prop "serially repeat" . constructWithRepeat+        serialOps   $ prop "serially repeatM" . constructWithRepeatM+        serialOps   $ prop "serially replicate" . constructWithReplicate+        serialOps   $ prop "serially replicateM" . constructWithReplicateM+        serialOps   $ prop "serially intFromThenTo" .+                            constructWithIntFromThenTo+        serialOps   $ prop "serially DoubleFromThenTo" .+                            constructWithDoubleFromThenTo+        serialOps   $ prop "serially iterate" . constructWithIterate+        -- XXX test for all types of streams+        serialOps   $ prop "serially iterateM" . constructWithIterateM+        serialOps $ prop "serially enumerate" . constructWithEnumerate id+        serialOps $ prop "serially enumerateTo" . constructWithEnumerateTo id+        serialOps $ prop "serially fromIndices" . constructWithFromIndices+        serialOps $ prop "serially fromIndicesM" . constructWithFromIndicesM+        serialOps $ prop "serially fromList" . constructWithFromList id+        serialOps $ prop "serially fromListM" . constructWithFromListM id+        serialOps $ prop "serially unfoldr" . constructWithUnfoldr id+        serialOps $ prop "serially fromPure" . constructWithFromPure id+        serialOps $ prop "serially fromEffect" . constructWithFromEffect id+        serialOps $ prop "serially cons" . constructWithCons Stream.cons+        serialOps $ prop "serially consM" . constructWithConsM Stream.consM id+        -}++        describe "From Generators" $ do+            prop "unfold" unfold++    {-+    describe "Simple Operations" $ serialOps simpleOps++    describe "Functor operations" $ do+        serialOps    $ functorOps (Stream.fromFoldable) "serially" (==)+        serialOps    $ functorOps folded "serially folded" (==)++    describe "Monoid operations" $ do+        serialOps $ monoidOps "serially" mempty (==)++    describe "Serial loops" $ loops fromSerial id reverse++    describe "Bind and Monoidal composition combinations" $ do+        -- XXX Taking a long time when serialOps is used.+        bindAndComposeSimpleOps "Serial" sortEq fromSerial+        bindAndComposeHierarchyOps "Serial" fromSerial+        serialOps $ nestTwoStreams "Serial" id id+        serialOps $ nestTwoStreamsApp "Serial" id id+        composeAndComposeSimpleSerially "Serial <> " (repeat [1..9]) fromSerial+        composeAndComposeSimpleAheadly "Serial <> " (repeat [1 .. 9]) fromSerial+        composeAndComposeSimpleWSerially+            "Serial <> "+            [[1..9], [1..9], [1,3,2,4,6,5,7,9,8], [1,3,2,4,6,5,7,9,8]]+            fromSerial++    describe "Semigroup operations" $ do+        serialOps $ semigroupOps "serially" (==)+        serialOps $ associativityCheck "serial == <>"++    describe "Applicative operations" $ do+        -- The tests using sorted equality are weaker tests+        -- We need to have stronger unit tests for all those+        -- XXX applicative with three arguments+        serialOps $ applicativeOps (Stream.fromFoldable) "serially" (==)+        serialOps $ applicativeOps folded "serially folded" (==)+        serialOps $ applicativeOps1 (Stream.fromFoldable) "serially" (==)+        serialOps $ applicativeOps1 (Stream.fromFoldable) "serially folded" (==)++    -- XXX add tests for indexed/indexedR+    describe "Zip operations" $ do+        -- We test only the serial zip with serial streams and the parallel+        -- stream, because the rate setting in these streams can slow down+        -- zipAsync.+        serialOps   $ prop "zip monadic serially" . zipMonadic (Stream.fromFoldable) (==)+        serialOps   $ prop "zip monadic serially folded" . zipMonadic folded (==)++    -- XXX add merge tests like zip tests+    -- for mergeBy, we can split a list randomly into two lists and+    -- then merge them, it should result in original list+    -- describe "Merge operations" $ do++    describe "Monad operations" $ do+        serialOps   $ prop "serially monad then" . monadThen (Stream.fromFoldable) (==)+        serialOps   $ prop "serially monad then folded" . monadThen folded (==)+        serialOps   $ prop "serially monad bind" . monadBind (Stream.fromFoldable) (==)+        serialOps   $ prop "serially monad bind folded"  . monadBind folded (==)++    describe "Stream transform and combine operations" $ do+        serialOps    $ transformCombineOpsCommon (Stream.fromFoldable) "serially" (==)+        serialOps    $ transformCombineOpsCommon folded "serially" (==)+        serialOps    $ transformCombineOpsOrdered (Stream.fromFoldable) "serially" (==)+        serialOps    $ transformCombineOpsOrdered folded "serially" (==)+    -}++    -- Just some basic sanity tests for now+    let input = [[1,1] :: [Int],[2,2],[3,3],[4,4],[5,5],[6,6],[7,7],[8,8]]+        mustBe g inp out =+            Stream.toList (StreamK.toStream (StreamK.mergeMapWith g StreamK.fromList (StreamK.fromList inp)))+                `shouldReturn` out+     in do+        it "concatPairsWith serial"+            $ mustBe StreamK.append input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+        it "concatPairsWith wSerial"+            $ mustBe StreamK.interleave input [1,5,3,7,2,6,4,8,1,5,3,7,2,6,4,8]+        it "concatPairsWith mergeBy sorted"+            $ mustBe+                (StreamK.mergeBy compare) input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+        it "concatPairsWith mergeBy reversed"+            $ mustBe+                (StreamK.mergeBy compare)+                (reverse input)+                [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+        prop "sortBy" sortBy++    describe "Stream group and split operations" $ do+        groupSplitOps "serially"++    {-+    describe "Stream elimination operations" $ do+        serialOps    $ eliminationOps (Stream.fromFoldable) "serially"+        serialOps    $ eliminationOps folded "serially folded"+        serialOps    $ eliminationOpsWord8 (Stream.fromFoldable) "serially"+        serialOps    $ eliminationOpsWord8 folded "serially folded"+        serialOps $ \t ->+            prop "drainWhile (> 0)" $ \n ->+                withMaxSuccess maxTestCount $+                monadicIO $ do+                    let xs = [1..n]+                    ioRef <- run $ newIORef ([] :: [Int])+                    run $+                        drainWhile (> 0) . t $+                            Stream.mapM (\a -> modifyIORef' ioRef (a :) >> return a) $+                                Stream.fromList xs+                    strm <- run $ readIORef ioRef+                    listEquals (==) (reverse strm) (takeWhile (> 0) xs)++    -- XXX Add a test where we chain all transformation APIs and make sure that+    -- the state is being passed through all of them.+    describe "Stream serial elimination operations" $ do+        serialOps    $ eliminationOpsOrdered (Stream.fromFoldable) "serially"+        serialOps    $ eliminationOpsOrdered folded "serially folded"+    -}++    describe "Tests for Stream.groupsBy" groupingOps++    -- describe "Tests for exceptions" $ serialOps $ exceptionOps "serially"++    -- describe "Composed MonadThrow serially" $ composeWithMonadThrow fromSerial++    describe "Nesting" $ do+        prop "foldIterateM" foldIterateM
+ test/Streamly/Test/Data/Stream/Concurrent.hs view
@@ -0,0 +1,396 @@+-- |+-- Module      : Streamly.Test.Data.Stream.Concurrent+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Stream.Concurrent (main) where++import Control.Concurrent (threadDelay)+import Control.Exception (Exception, try)+import Control.Monad (replicateM)+import Control.Monad.Catch (throwM)+import Data.Function ( (&) )+import Data.IORef ( newIORef, readIORef, writeIORef)+import Data.List (sort)+import Data.Maybe ( isJust, fromJust )+import Data.Word (Word8)+import Streamly.Data.Stream (Stream)+import Test.Hspec.QuickCheck+import Test.QuickCheck (Testable, Property, choose, forAll, withMaxSuccess)+import Test.QuickCheck.Monadic (monadicIO, run)+import Test.Hspec as H++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Async++import Streamly.Test.Common (listEquals)++moduleName :: String+moduleName = "Data.Stream.Concurrent"++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++sortEq :: Ord a => [a] -> [a] -> Bool+sortEq a b = sort a == sort b++cmp :: (Show a, Ord a) => ([a] -> [a] -> Bool) -> [a] -> Stream IO a -> Property+cmp eq list s =+    monadicIO $ do+        stream <- run $ sort <$> Stream.fold Fold.toList  s+        listEquals eq stream list++prop1 :: Testable prop => String -> prop -> SpecWith ()+prop1 x y = modifyMaxSuccess (const 1) $ prop x y++-- Coverage build takes too long with default number of tests+maxTestCount :: Int+#ifdef DEVBUILD+maxTestCount = 100+#else+maxTestCount = 10+#endif++transformCombineFromList ::+       ([Int] -> Stream IO Int)+    -> ([Int] -> [Int] -> Bool)+    -> ([Int] -> [Int])+    -> (Stream IO Int -> Stream IO Int)+    -> [Int]+    -> [Int]+    -> [Int]+    -> Property+transformCombineFromList constr eq listOp op a b c =+    withMaxSuccess maxTestCount $+        monadicIO $ do+            let s1 = op (Async.parList id [constr b, constr c])+            let s2 = Async.parList id [constr a, s1]+            stream <- run (Stream.fold Fold.toList s2)+            let list = a <> listOp (b <> c)+            listEquals eq stream list++commonOpConfigs :: [(String, Async.Config -> Async.Config)]+commonOpConfigs =+    [ ("default", id)+#ifndef COVERAGE_BUILD+    , ("rate AvgRate 10000", Async.avgRate 10000)+    , ("rate Nothing", Async.rate Nothing)+    , ("maxBuffer 0", Async.maxBuffer 0)+    , ("maxThreads 0", Async.maxThreads 0)+    , ("maxThreads 1", Async.maxThreads 1)+    , ("eager", Async.eager True)+    -- XXX Need to use an unsorted eq operation for ahead+    , ("ordered", Async.ordered True)+#ifdef USE_LARGE_MEMORY+    , ("maxThreads -1", Async.maxThreads (-1))+#endif+#endif+    ]++opConfigs :: [(String, Async.Config -> Async.Config)]+opConfigs = commonOpConfigs+    ++ [+#ifndef COVERAGE_BUILD+              ("maxBuffer 1", Async.maxBuffer 1)+#endif+    ]++makeSpec :: [(String, a)] -> (a -> Spec) -> Spec+makeSpec cfg spec = mapM_ (\(desc, arg) -> describe desc $ spec arg) cfg++asyncSpec :: ((Async.Config -> Async.Config) -> Spec) -> Spec+asyncSpec =+    makeSpec $ opConfigs+#ifndef COVERAGE_BUILD+        <> [("maxBuffer (-1)", Async.maxBuffer (-1))]+#endif++-------------------------------------------------------------------------------+-- Compose with MonadThrow+-------------------------------------------------------------------------------++newtype ExampleException = ExampleException String deriving (Eq, Show, Ord)++instance Exception ExampleException++exceptionPropagation ::+    (Stream IO Int -> Stream IO Int -> Stream IO Int) -> Spec+exceptionPropagation f = do+    it "append throwM, nil" $+        try (tl (Stream.fromEffect (throwM (ExampleException "E")) `f` Stream.nil))+        `shouldReturn`+            (Left (ExampleException "E") :: Either ExampleException [Int])+    it "append nil, throwM" $+        try (tl (Stream.nil `f` Stream.fromEffect (throwM (ExampleException "E"))))+        `shouldReturn`+            (Left (ExampleException "E") :: Either ExampleException [Int])+    it "append nested throwM" $ do+        let nested =+                (Stream.fromList [1..10])+                    `f` Stream.fromEffect (throwM (ExampleException "E"))+                    `f` (Stream.fromList [1..10])+        try (tl (Stream.nil `f` nested `f` (Stream.fromList [1..10])))+            `shouldReturn`+                (Left (ExampleException "E")+                    :: Either ExampleException [Int])+    it "sequence throwM" $+        let stream = Stream.fromList [throwM (ExampleException "E")]+         in try (tl (Stream.nil `f` Async.parSequence id stream))+            `shouldReturn`+                (Left (ExampleException "E") :: Either ExampleException [Int])++    it "concatMap throwM" $ do+        let s1 = Async.parList id $ fmap Stream.fromPure [1..4]+            s2 = Async.parList id $ fmap Stream.fromPure [5..8]+        try $ tl (+            let bind = flip (Async.parConcatMap id)+             in bind s1 $ \x ->+                bind s2 $ \y ->+                    if x + y > 10+                    then Stream.fromEffect (throwM (ExampleException "E"))+                    else Stream.fromPure (x + y)+            )+        `shouldReturn`+            (Left (ExampleException "E") :: Either ExampleException [Int])++    where++    tl = Stream.fold Fold.toList++---------------------------------------------------------------------------+-- Time ordering+---------------------------------------------------------------------------++#ifdef DEVBUILD+timeOrdering :: ([Stream IO Int] -> Stream IO Int) -> Spec+timeOrdering f = do+    it "Parallel event ordering check" $+        Stream.fold Fold.toList (f [event 4, event 3, event 2, event 1])+            `shouldReturn` [1..4]++    where event n = Stream.fromEffect (threadDelay (n * 200000) >> return n)+#endif++-------------------------------------------------------------------------------+-- Some ad-hoc tests that failed at times+-------------------------------------------------------------------------------++takeCombined :: Int -> IO ()+takeCombined n = do+    let constr = Stream.fromList+    let s = Async.parList id [constr ([] :: [Int]), constr ([] :: [Int])]+    r <- Stream.fold Fold.toList $ Stream.take n s+    r `shouldBe` []++---------------------------------------------------------------------------+-- Main+---------------------------------------------------------------------------++constructWithLenM+    :: (Int -> Stream IO Int)+    -> (Int -> IO [Int])+    -> Word8+    -> Property+constructWithLenM mkStream mkList len =+    withMaxSuccess maxTestCount+        $ monadicIO $ do+            stream <-+                run+                    $ Stream.fold Fold.toList+                    $ mkStream (fromIntegral len)+            list <- run $ mkList (fromIntegral len)+            listEquals (==) stream list++sequenceReplicate+    :: (Async.Config -> Async.Config)+    -> Word8+    -> Property+sequenceReplicate cfg = constructWithLenM stream list++    where++    list = flip replicateM (return 1 :: IO Int)+    stream = Async.parSequence cfg . flip Stream.replicate (return 1 :: IO Int)++drainMapM :: Monad m => (a -> m b) -> Stream m a -> m ()+drainMapM f = Stream.fold (Fold.drainMapM f)++testFromCallback :: IO Int+testFromCallback = do+    ref <- newIORef Nothing+    let stream =+           Stream.parList (Stream.eager True)+                [ fmap Just (Stream.fromCallback (setCallback ref))+                , runCallback ref+                ]+    Stream.fold Fold.sum $ fmap fromJust $ Stream.takeWhile isJust stream++    where++    setCallback ref cb = do+        writeIORef ref (Just cb)++    runCallback ref = Stream.fromEffect $ do+        cb <-+             Stream.repeatM (readIORef ref)+                & Stream.delayPost 0.1+                & Stream.mapMaybe id+                & Stream.fold Fold.one++        Stream.fromList [1..100]+            & Stream.delayPost 0.001+            & drainMapM (fromJust cb)+        threadDelay 100000+        return Nothing++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+        let transform = transformCombineFromList Stream.fromList sortEq++        prop "parBuffered" $+            transform+                (fmap (+2))+                (fmap (+1) . Async.parBuffered id . fmap (+1))++        asyncSpec $ prop "parSequence" . sequenceReplicate++        asyncSpec $+            prop "parMapM (+1)"+                . transform (fmap (+1))+                . (`Async.parMapM` (\x -> return (x + 1)))++        -- XXX Need to use eq instead of sortEq for ahead oeprations+        -- Binary append+        asyncSpec $+            let appWith cfg = Async.parList cfg [Stream.nil, Stream.nil]+            in prop1 "parList [] []" . cmp sortEq ([] :: [Int]) . appWith++        asyncSpec $+            let appWith cfg = Async.parList cfg [Stream.nil, Stream.fromPure 1]+            in prop1 "parList [] [1]" . cmp sortEq [1 :: Int] . appWith++        asyncSpec $+            let appWith cfg = Async.parList cfg [Stream.fromPure 1, Stream.nil]+            in prop1 "parList [1] []" . cmp sortEq [1 :: Int] . appWith++        asyncSpec $+            let appWith cfg =+                    Async.parList cfg [Stream.fromPure 0, Stream.fromPure 1]+            in prop1 "parList [0] [1]" . cmp sortEq [0, 1 :: Int] . appWith++        asyncSpec $+            let appWith cfg =+                    Async.parList+                        cfg [Stream.fromPure 0, Stream.nil, Stream.fromPure 1]+            in prop1 "parList [0] [] [1]" . cmp sortEq [0, 1 :: Int] . appWith++        asyncSpec $+            let appWith cfg =+                    Async.parTwo cfg+                        (Async.parTwo cfg+                            (Async.parTwo cfg+                                (Stream.fromPure 0) (Stream.fromPure 1))+                            (Stream.fromPure 2))+                        (Stream.fromPure 3)+            in prop1 "parTwo left associated"+                    . cmp sortEq [0, 1, 2, 3 :: Int] . appWith++        asyncSpec $+            let appWith cfg =+                    Async.parTwo cfg+                        (Stream.fromPure 0)+                        (Async.parTwo cfg+                            (Stream.fromPure 1)+                            (Async.parTwo cfg+                                (Stream.fromPure 2) (Stream.fromPure 3))+                        )+            in prop1 "parTwo right associated"+                    . cmp sortEq [0, 1, 2, 3 :: Int] . appWith++        asyncSpec $+            let leaf x y cfg =+                    Async.parTwo cfg (Stream.fromPure x)+                        (Stream.fromPure y)+                leaf11 cfg =+                    Async.parTwo cfg (leaf 0 1 cfg) $ leaf 2 (3 :: Int) cfg+                leaf12 cfg =+                    Async.parTwo cfg (leaf 4 5 cfg) $ leaf 6 7 cfg+                appWith cfg =+                    Async.parTwo cfg (leaf11 cfg) (leaf12 cfg)+            in prop1 "parTwo balanced"+                    . cmp sortEq [0, 1, 2, 3, 4, 5, 6,7] . appWith++        asyncSpec $+            let appWith cfg =+                    Async.parTwo cfg+                        (Stream.fromList [1,2,3,4,5 :: Int])+                        (Stream.fromList [6,7,8,9,10])+            in prop1 "parTwo" . cmp (==) [1,2,3,4,5,6,7,8,9,10] . appWith++        asyncSpec $+            let par2 cfg =+                    Async.parTwo+                        cfg+                        (Stream.fromPure 1)+                        (Stream.fromPure 2)+                s1 cfg =+                    Async.parCrossApply+                        cfg+                        (Stream.fromPure (,))+                        (par2 cfg)+                s2 cfg =+                    Async.parCrossApply+                        cfg+                        (s1 cfg)+                        (Stream.fromPure 3) :: Stream IO (Int, Int)+            in prop1+                "parCrossApply (async arg1)" . cmp (==) ( [(1, 3), (2, 3)]) . s2++        asyncSpec $+            let par2 cfg =+                    Async.parTwo+                        cfg+                        (Stream.fromPure (2 :: Int))+                        (Stream.fromPure 3)+                s1 = Stream.fromPure (1 :: Int,)+                s2 cfg = Async.parCrossApply cfg s1 (par2 cfg)+            in prop1 "apply (async arg2)" . cmp (==) ([(1, 2), (1, 3)]) . s2++        -- concat+        asyncSpec $+            let stream cfg =+                    Async.parConcat cfg+                        $ fmap Stream.fromPure+                        $ Stream.fromList [1..100 :: Int]+            in prop1 "parConcat" . cmp sortEq [1..100] . stream++        asyncSpec $+            let f cfg =+                    forAll (choose (0, 100)) $ \n ->+                        transform+                            (concatMap (const [1..n]))+                            (Async.parConcatMap+                                cfg (const (Stream.fromList [1..n]))+                            )+             in prop "parConcatMap" . f++#ifdef DEVBUILD+        describe "Time ordering" $ timeOrdering (Async.parList id)+#endif+        let async = Async.parTwo id+        describe "Exception propagation" $ exceptionPropagation async+        -- Ad-hoc tests+        it "takes n from stream of streams" $ takeCombined 2+        it "fromCallback" $ testFromCallback `shouldReturn` (50*101)
+ test/Streamly/Test/Data/Stream/Exception.hs view
@@ -0,0 +1,204 @@+module Streamly.Test.Data.Stream.Exception (main)++where++import Control.Concurrent (threadDelay)+import Control.Exception (SomeException, throw, catch, finally, bracket_)+import Control.Monad (when)+import Data.Foldable (sequenceA_)+import Data.Function ((&))+import Data.IORef (IORef, newIORef, atomicModifyIORef', readIORef)+import Streamly.Internal.Control.Exception (AcquireIO, acquire)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Stream.Prelude (Config)+import System.Mem (performMajorGC)++import qualified Streamly.Internal.Control.Exception as Exception+import qualified Streamly.Internal.Data.Stream.Prelude as Stream+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++-- IMPORTANT: do not use a blocking operation inside it, otherwise the tests+-- might fail because the operation will become interruptible..+incr :: Num a => IORef a -> IO ()+incr ref = do+    -- tid <- myThreadId+    -- putStrLn $ "Incrementing the counter: " ++ show tid+    atomicModifyIORef' ref (\x -> (x + 1, ()))++-- IMPORTANT: do not use a blocking operation inside it, otherwise the tests+-- might fail because the operation will become interruptible..+decr :: Num a => IORef a -> IO ()+decr ref = do+    atomicModifyIORef' ref (\x -> (x - 1, ()))+    -- tid <- myThreadId+    -- putStrLn $ "Decremented the counter: " ++ show tid++handler :: SomeException -> IO b+handler (e :: SomeException) = do+    -- tid <- myThreadId+    -- putStrLn $ "Child: " ++ show tid ++ " " ++ show e+    -- Rethrowing the exception is important, otherwise the thread will not+    -- exit.+    throw e++run :: Num a => IORef a -> IO c -> IO c+run ref x = bracket_ (incr ref) (decr ref) (x `catch` handler)++timeout :: Int+timeout = 1000000++takeCount :: Int+takeCount = 1++stream :: IORef Int -> (Config -> Config) -> Stream.Stream IO ()+stream ref modifier =+      Stream.enumerateFrom (1 :: Int)+        & Stream.parMapM modifier+            ( \x ->+              -- somehow if all of them have same timeout then the chances of+              -- failure are more.+              run ref $ threadDelay (if x == 1 then 1000000 else timeout)+            )+        & Stream.take takeCount++streamRelease ::+    AcquireIO -> IORef Int -> IORef Int -> (Config -> Config) -> Stream IO ()+streamRelease aref ref1 ref2 modifier =+      Stream.enumerateFrom (1 :: Int)+        & Stream.parMapM modifier+            ( \x -> do+              if x <= 10+              then do+                -- IMPORTANT: do not put interruptile operations in the+                -- release function, otherwise the tests might fail,+                -- because the operation will become interruptible.+                  ((), release) <-+                        acquire aref (incr ref1) (\() -> decr ref1)+                  -- 1000 makes a particular bug surface, not less, not more+                  threadDelay 1000+                  -- putStrLn $ "release: " ++ show x+                  release+              else do+                  run ref2 $ threadDelay timeout+            )+        & Stream.take 10++finalAction :: Bool -> IORef Int -> Int -> IO ()+finalAction gc ref t = do+    -- When cleanup happens via GC, ghc creates a thread for the finalizer to+    -- run, actual cleanup time depends on when that thread is scheduled. The+    -- thread may outlive one or more GCs. So we have to give it some time to+    -- finish. But it cannot be deterministic.+    -- threadDelay 1000000+    when gc $ do+        performMajorGC+        threadDelay t+        performMajorGC+        threadDelay t+    r <- readIORef ref+    putStrLn $ "Pending computations: " ++ show r+    -- Delay for letting any gc based cleanup threads drain and print output+    -- for debugging+    -- when gc $ threadDelay 1000000+    when (r /= 0) $ error "Failed"++testStream :: Int -> (Config -> Config) -> IO ()+testStream t cfg = do+    ref <- newIORef (0 :: Int)+    (Stream.withAcquireIO (\aref -> stream ref (cfg . Stream.useAcquire aref))+        -- XXX enable this when stream finalization is implemented+        -- & Stream.take 1+        & Stream.fold Fold.drain) `finally` finalAction False ref t++testStreamRelease :: Int -> (Config -> Config) -> IO ()+testStreamRelease count cfg = do+    ref1 <- newIORef (0 :: Int)+    ref2 <- newIORef (0 :: Int)+    (Stream.withAcquireIO (\aref -> do+            let cfg1 = cfg . Stream.useAcquire aref+            streamRelease aref ref1 ref2 cfg1)+        -- XXX enable this when stream finalization is implemented+        -- & Stream.take 1+        & Stream.fold Fold.drain+       )+       `finally` do+            putStrLn "Checking MANUALLY released resources..."+            finalAction False ref1 count+            putStrLn "Checking AUTO released resources..."+            finalAction False ref2 count++testEffect :: Int -> (Config -> Config) -> IO ()+testEffect t cfg = do+    ref <- newIORef (0 :: Int)+    Exception.withAcquireIO (\aref ->+        stream ref (cfg . Stream.useAcquire aref)+        & Stream.take 1+        & Stream.fold Fold.drain+      ) `finally` finalAction False ref t++testEffectRelease :: Int -> (Config -> Config) -> IO ()+testEffectRelease count cfg = do+    ref1 <- newIORef (0 :: Int)+    ref2 <- newIORef (0 :: Int)+    Exception.withAcquireIO (\aref -> do+            let cfg1 = cfg . Stream.useAcquire aref+            streamRelease aref ref1 ref2 cfg1+                & Stream.take 1+                & Stream.fold Fold.drain+      ) `finally` do+            putStrLn "Checking MANUALLY released resources..."+            finalAction False ref1 count+            putStrLn "Checking AUTO released resources..."+            finalAction False ref2 count++finallyGC :: Int -> (Stream.Config -> Stream.Config) -> IO ()+finallyGC t cfg = do+    ref <- newIORef (0 :: Int)+    Stream.finallyIO (finalAction True ref t) (stream ref cfg)+        & Stream.fold Fold.drain++-- XXX Include rate as well+limits :: [(String, Stream.Config -> Stream.Config)]+limits =+    [ ("default", id)+    , ("maxBuffer 10", Stream.maxBuffer 10)+    , ("maxThreads 10", Stream.maxThreads 10)+    ]++sched :: [(String, Stream.Config -> Stream.Config)]+sched =+    [ ("default", id)+    , ("eager", Stream.eager True)+    , ("ordered", Stream.ordered True)+    , ("interleaved", Stream.interleaved True)+    ]++funcs :: [(String, Int -> (Stream.Config -> Stream.Config) -> IO ())]+funcs =+    [ ("Stream.withAcquireIO", testStream)+    , ("Exception.withAcquireIO", testEffect)+    , ("Stream.withAcquireIO release", testStreamRelease)+    , ("Exception.withAcquireIO release", testEffectRelease)+    , ("finallyGC", finallyGC)+    ]++main :: IO ()+main = do+    let cfg = id -- Stream.inspect True++    -- TODO: Interrupt test+    -- Run the main test in a separate thread. Keep the thread-id in a global+    -- variable which will be used to interrupt the thread. Once one thread is+    -- over then the next test will keep it's threadId in the global var.+    -- Run another thread which sleeps for random intervals and sends+    -- UserInterrupt exception to the current test thread-id stored in the+    -- glbal variable in a loop.+    -- TODO: test for non-concurrent use cases as well+    sequenceA_+        [ putStrLn ("Running: " ++ fst f ++ " " ++ fst x1 ++ " " ++ fst x2)+            >> snd f+                (if fst x1 == "default" then 500000 else 100000)+                (snd x1 . snd x2 . cfg)+        | f <- funcs, x1 <- limits, x2 <- sched+        ]
+ test/Streamly/Test/Data/Stream/Rate.hs view
@@ -0,0 +1,287 @@+-- |+-- Module      : Streamly.Test.Data.Stream.Rate+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Stream.Rate (main) where++import Data.Int (Int64)+import Streamly.Data.Stream.Prelude (Config)+import Streamly.Internal.Data.Time.Clock (getTime, Clock(..))+import Streamly.Internal.Data.Time.Units+    (NanoSecond64, diffAbsTime64, fromRelTime64)+import System.Mem (performMajorGC)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream++import Control.Concurrent+import Control.Monad+import System.Random+import Test.Hspec++durationShouldBe :: (Double, Double) -> IO () -> Expectation+durationShouldBe d@(tMin, tMax) action = do+        t0 <- getTime Monotonic+        action+        t1 <- getTime Monotonic+        let diff = fromRelTime64 (diffAbsTime64 t1 t0) :: NanoSecond64+        let t = fromIntegral diff / 1e9+        putStrLn $ "Expected: " <> show d <> " Took: " <> show t+        (t <= tMax && t >= tMin) `shouldBe` True++toMicroSecs :: Num a => a -> a+toMicroSecs x = x * 10^(6 :: Int)++measureRate' ::+       String+    -> (Config -> Config)+    -> Int -- buffers+    -> Int -- threads+    -> Either Double Int  -- either rate or count of actions+    -> Int+    -> (Double, Double)+    -> (Double, Double)+    -> Spec+measureRate'+    desc modifier buffers threads rval consumerDelay producerDelay expectedRange = do+    it (desc <> rateDesc+             <> " buffers: " <> show buffers+             <> " threads: " <> show threads+             <> ", consumer latency: " <> show consumerDelay+             <> ", producer latency: " <> show producerDelay)+        runTest++    where++    -- Keep a minimum of 2 for the very low rate cases, otherwise the+    -- timing would be 0 because we will finish as soon as the first result+    -- arrives.+    yieldCount :: Int+    yieldCount = case rval of+        Left r -> max 2 (round (10 * r))+        Right n -> max 2 n++    rateDesc = (case rval of+        Left r ->  ", rate: " <> show r <> ", count: " <> show yieldCount+        Right n -> ", count: " <> show n) <> ","++    cfg (_n :: Maybe Int64) =+          modifier+        . Stream.maxBuffer buffers+        -- . Stream.inspect True+        . Stream.maxThreads threads+        . case rval of+            Left r -> Stream.avgRate r+            Right _ -> Stream.rate Nothing+        -- XXX it comes out less than expected for ordered streams at high+        -- rates, need to fix.+        -- . Stream.maxYields (Just (fromIntegral yieldCount))++    threadAction f =+        case rval of+            Left _ ->+                  Stream.take yieldCount+                $ Stream.parMapM (cfg (Just (fromIntegral yieldCount))) f+                $ Stream.enumerateFrom (1 :: Int)+            Right _ ->+                Stream.parReplicateM+                    (cfg (Just (fromIntegral yieldCount))) yieldCount (f 1)++    runTest = do+        durationShouldBe expectedRange $ do+            res <- Stream.fold Fold.length+                $ (if consumerDelay > 0+                  then Stream.mapM $ \x ->+                            threadDelay (toMicroSecs consumerDelay) >> return x+                  else id)+                $ threadAction $ \_idx -> do+                    let (t1, t2) = producerDelay+                    r <- if t1 == t2+                         then return $ round $ toMicroSecs t1+                         else randomRIO ( round $ toMicroSecs t1+                                        , round $ toMicroSecs t2)+                    when (r > 0) $ -- do+                        -- t1 <- getTime Monotonic+                        threadDelay r+                        -- t2 <- getTime Monotonic+                        -- let delta = fromIntegral (toNanoSecs (t2 - t1)) / 1000000000+                        -- putStrLn $ "delay took: " <> show delta+                        -- when (delta > 2) $ do+                        --     putStrLn $ "delay took high: " <> show delta+                    -- putStrLn $ "Done: " ++ show idx+                    return (1 :: Int)+            when (res /= yieldCount) $+                error $ "expected yield count: " ++ show yieldCount+                    ++ " actual: " ++ show res++        -- To ensure that when we use "inspect" option on the channel, GC+        -- occurs and cleans up the channel to print the debug info.+        performMajorGC++measureRateVariable ::+       String+    -> (Config -> Config)+    -> Double+    -> Int+    -> (Double, Double)+    -> (Double, Double)+    -> Spec+measureRateVariable desc modifier rval =+    measureRate' desc modifier (-1) (-1) (Left rval)++measureRate ::+       String+    -> (Config -> Config)+    -> Double+    -> Int+    -> Int+    -> (Double, Double)+    -> Spec+measureRate desc modifier rval consumerDelay producerDelay dur =+    let d = fromIntegral producerDelay+    in measureRateVariable desc modifier rval consumerDelay (d, d) dur++measureThreads ::+       String+    -> (Config -> Config)+    -> Int -- threads+    -> Int -- count of actions+    -> Spec+measureThreads desc modifier threads count = do+    let expectedTime =+            if threads < 0+            then 1.0+            else fromIntegral count / fromIntegral threads+        duration = (expectedTime * 0.9, expectedTime * 1.1)+    measureRate' desc modifier (-1) threads (Right count) 0 (1,1) duration++measureBuffers ::+       String+    -> (Config -> Config)+    -> Int -- buffers+    -> Int -- count of actions+    -> Spec+measureBuffers desc modifier buffers count = do+    let expectedTime =+            if buffers < 0+            then 1.0+            else fromIntegral count / fromIntegral buffers+        duration = (expectedTime * 0.9, expectedTime * 1.1)+    measureRate' desc modifier buffers (-1) (Right count) 0 (1,1) duration++moduleName :: String+moduleName = "Data.Stream.Rate"++main :: IO ()+main = hspec $ do+  describe moduleName $ do++    describe "maxBuffers" $ do+        measureBuffers "async" id (-1) 5+        -- XXX this test fails due to a known issue+        -- measureBuffers "maxBuffers" id 1 5+        measureBuffers "async" id 5 5++    describe "maxThreads" $ do+        measureThreads "async" id (-1) 5+        measureThreads "async" id 1 5+        measureThreads "async" id 5 5++        measureThreads "ordered" (Stream.ordered True) (-1) 5+        measureThreads "ordered" (Stream.ordered True) 1 5+        measureThreads "ordered" (Stream.ordered True) 5 5++        measureThreads "interleaved" (Stream.interleaved True) (-1) 5+        measureThreads "interleaved" (Stream.interleaved True) 1 5+        measureThreads "interleaved" (Stream.interleaved True) 5 5++    describe "max rate possible (count / time)" $ do+        measureRate "async" (Stream.rate Nothing) 1000000 0 0 (0, 1e9)++    let range = (8,12)++    -- Note that because after the last yield we don't wait, the last period+    -- will be effectively shorter. This becomes significant when the rates are+    -- lower (1 or lower). For rate 1 we lose 1 second in the end and for rate+    -- 10 0.1 second.+    let rates = [0.1, 1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "async no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "async" id r 0 0 range)++    -- XXX try staggering the dispatches to achieve higher rates+    -- Producer delay causes a lot of threads to be created, consuming large+    -- amounts of memory at higher rates.+    let rates = [0.1, 1, 10, 100+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                1000, 10000, 25000+#endif+                ]+     in describe "async no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "async" id r 0 1 range)++    -- At lower rates (1/10) this is likely to vary quite a bit depending on+    -- the spread of random producer latencies generated.+    let rates = [1, 10, 100+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                , 1000, 10000, 25000+#endif+                ]+     in describe "async, no consumer delay and variable producer delay" $+            forM_ rates $ \r ->+                measureRateVariable "async" id r 0 (0.1, 3) range++    let rates = [0.1, 1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "interleaved, no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "interleaved" (Stream.interleaved True) r 0 0 range)++    let rates = [0.1, 1, 10, 100, 1000+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                , 10000, 25000+#endif+                ]+     in describe "interleaved, no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "interleaved" (Stream.interleaved True) r 0 1 range)++    let rates = [0.1, 1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "ordered, no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "ordered" (Stream.ordered True) r 0 0 range)++    -- XXX after the change to stop workers when the heap is clearing+    -- thi does not work well at a 25000 ops per second, need to fix.+    let rates = [0.1, 1, 10, 100, 1000+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                , 10000, 12500+#endif+                ]+     in describe "ordered, no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "ordered" (Stream.ordered True) r 0 1 range)++    describe "async, some consumer delay and 1 sec producer delay" $ do+        -- ideally it should take 10 x 1 + 1 seconds+        forM_ [1] (\r -> measureRate "async" id r 1 1 (11, 16))+        -- ideally it should take 10 x 2 + 1 seconds+        forM_ [1] (\r -> measureRate "async" id r 2 1 (21, 23))+        -- ideally it should take 10 x 3 + 1 seconds+        forM_ [1] (\r -> measureRate "async" id r 3 1 (31, 33))++    describe "ordered, some consumer delay and 1 sec producer delay" $ do+        forM_ [1] (\r -> measureRate "ordered" (Stream.ordered True) r 1 1 (11, 16))+        forM_ [1] (\r -> measureRate "ordered" (Stream.ordered True) r 2 1 (21, 23))+        forM_ [1] (\r -> measureRate "ordered" (Stream.ordered True) r 3 1 (31, 33))
+ test/Streamly/Test/Data/Stream/Time.hs view
@@ -0,0 +1,95 @@+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif++-- |+-- Module      : Streamly.Test.Data.Stream+-- Copyright   : (c) 2019 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Stream.Time (main) where++#ifdef DEVBUILD+import Control.Concurrent ( threadDelay )+import Control.Monad ( when)+import Data.Int (Int64)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units+       (AbsTime, NanoSecond64(..), toRelTime64, diffAbsTime64)++import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream++#endif++import Test.Hspec as H++#ifdef DEVBUILD+tenPow8 :: Int64+tenPow8 = 10^(8 :: Int)++tenPow7 :: Int64+tenPow7 = 10^(7 :: Int)++takeDropTime :: NanoSecond64+takeDropTime = NanoSecond64 $ 5 * tenPow8++checkTakeDropTime :: (Maybe AbsTime, Maybe AbsTime) -> IO Bool+checkTakeDropTime (mt0, mt1) = do+    let graceTime = NanoSecond64 $ 8 * tenPow7+    case mt0 of+        Nothing -> return True+        Just t0 ->+            case mt1 of+                Nothing -> return True+                Just t1 -> do+                    let tMax = toRelTime64 (takeDropTime + graceTime)+                    let tMin = toRelTime64 (takeDropTime - graceTime)+                    let t = diffAbsTime64 t1 t0+                    let r = t >= tMin && t <= tMax+                    when (not r) $ putStrLn $+                        "t = " ++ show t +++                        " tMin = " ++ show tMin +++                        " tMax = " ++ show tMax+                    return r++testTakeInterval :: IO Bool+testTakeInterval = do+    r <-+         Stream.fold (Fold.tee Fold.one Fold.latest)+        $ Stream.takeInterval (fromIntegral takeDropTime * 10**(-9))+        $ Stream.repeatM (threadDelay 1000 >> getTime Monotonic)+    checkTakeDropTime r++testDropInterval :: IO Bool+testDropInterval = do+    t0 <- getTime Monotonic+    mt1 <-+         Stream.fold Fold.one+        $ Stream.dropInterval (fromIntegral takeDropTime * 10**(-9))+        $ Stream.repeatM (threadDelay 1000 >> getTime Monotonic)+    checkTakeDropTime (Just t0, mt1)+#endif++moduleName :: String+moduleName = "Data.Stream.Time"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+#ifdef DEVBUILD+        describe "Filtering" $ do+            it "takeInterval" (testTakeInterval `shouldReturn` True)+            it "dropInterval" (testDropInterval `shouldReturn` True)+#endif+        it "dummy" (return () `shouldReturn` ())+
+ test/Streamly/Test/Data/Unbox.hs view
@@ -0,0 +1,351 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE TemplateHaskell #-}++-- This module has a lot of orphan instances as we are deriving it here. We can+-- ignore this warning.+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module      : Streamly.Test.Data.Unbox+-- Copyright   : (c) 2022 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Unbox (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++#ifdef USE_SERIALIZE+import Data.Foldable (forM_)+import Data.Word (Word8)+import qualified Streamly.Internal.Data.Array as Array+#endif++import GHC.Fingerprint (Fingerprint(..))++import Data.Complex (Complex ((:+)))+import Data.Functor.Const (Const (..))+import Data.Functor.Identity (Identity (..))+import Data.Proxy (Proxy(..))+import GHC.Generics (Generic, Rep)+import GHC.Real (Ratio(..))++import Streamly.Internal.Data.MutByteArray+import qualified Streamly.Internal.Data.MutByteArray as MBA++import Test.Hspec as H++--------------------------------------------------------------------------------+-- Types+--------------------------------------------------------------------------------++#ifdef USE_SERIALIZE++#define MODULE_NAME "Data.Serialize.Deriving.TH"+#define DERIVE_UNBOX(typ) $(deriveSerialize [d|instance Serialize typ|])+#define PEEK(i, arr, sz) (deserializeAt i arr sz)+#define POKE(i, arr, val) (serializeAt i arr val)+#define TYPE_CLASS Serialize++#else++#define PEEK(i, arr, sz) peekAtWithNextOff i arr+#define POKE(i, arr, val) pokeAtWithNextOff i arr val+#define TYPE_CLASS Unbox++#ifdef USE_TH++#define MODULE_NAME "Data.Unbox.Deriving.TH"+#define DERIVE_UNBOX(typ) $(deriveUnbox [d|instance Unbox typ|])++#else++#define MODULE_NAME "Data.Unbox.Deriving.Generic"+#define DERIVE_UNBOX(typ) deriving instance Unbox (typ)++#endif++#endif++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++#ifndef USE_SERIALIZE++peekAtWithNextOff ::+       forall a. Unbox a+    => Int+    -> MutByteArray+    -> IO (Int, a)+peekAtWithNextOff i arr = do+    val <- peekAt i arr+    pure (i + sizeOf (Proxy :: Proxy a), val)++pokeAtWithNextOff ::+       forall a. Unbox a+    => Int+    -> MutByteArray+    -> a+    -> IO Int+pokeAtWithNextOff i arr val = do+    pokeAt i arr val+    pure $ i + sizeOf (Proxy :: Proxy a)++#endif++--------------------------------------------------------------------------------+-- Types+--------------------------------------------------------------------------------++-- Unit instance uses a hack, so test all cases+data Unit =+    Unit+    deriving (Show, Generic, Eq)+DERIVE_UNBOX(Unit)++data UnarySum+    = Sum1+    | Sum2+    deriving (Show, Generic, Eq)+DERIVE_UNBOX(UnarySum)++data UnarySum2+    = UnitSum1 Unit+    | UnitSum2 Unit+    deriving (Generic, Eq, Show)+DERIVE_UNBOX(UnarySum2)++data Unit1 =+    Unit1 Unit+    deriving (Generic, Eq, Show)+DERIVE_UNBOX(Unit1)++data Unit2 =+    Unit2 Unit Unit+    deriving (Generic, Eq, Show)+DERIVE_UNBOX(Unit2)++data Unit3 =+    Unit3 Int Unit Int+    deriving (Generic, Eq, Show)+DERIVE_UNBOX(Unit3)++data Unit4 =+    Unit4 Int Unit1 Int+    deriving (Generic,  Eq, Show)+DERIVE_UNBOX(Unit4)++{-# ANN Single "HLint: ignore" #-}+data Single =+    Single Int+    deriving (Show, Generic, Eq)+DERIVE_UNBOX(Single)++data Product2 =+    Product2 Int Char+    deriving (Show, Generic, Eq)+DERIVE_UNBOX(Product2)++data SumOfProducts+    = SOP0+    | SOP1 Int+    | SOP2 Int Char+    | SOP3 Int Int Int+    deriving (Show, Generic, Eq)+DERIVE_UNBOX(SumOfProducts)++data NestedSOP+    = NSOP0 SumOfProducts+    | NSOP1 SumOfProducts+    deriving (Show, Generic, Eq)+DERIVE_UNBOX(NestedSOP)++--------------------------------------------------------------------------------+-- Standalone derivations+--------------------------------------------------------------------------------++-- The following types don't have a Generic instance by default+deriving instance Generic (Ratio Int)+#if !MIN_VERSION_base(4,15,0)+deriving instance Generic (Fingerprint)+#endif++#if defined(USE_SERIALIZE)+$(deriveSerialize+    [d|instance Serialize a => Serialize (Complex a)|])+$(deriveSerialize+    [d|instance Serialize a => Serialize (Ratio a)|])+$(deriveSerialize+    [d|instance Serialize a => Serialize (Const a b)|])+$(deriveSerialize+    [d|instance Serialize a => Serialize (Identity a)|])+#endif++--------------------------------------------------------------------------------+-- Test helpers+--------------------------------------------------------------------------------++#ifdef USE_SERIALIZE+variableSizeOf ::+       forall a. Serialize a+    => a+    -> Int+variableSizeOf = addSizeTo 0+#endif++testSerialization ::+       forall a. (Eq a, Show a, TYPE_CLASS a)+    => a+    -> IO ()+testSerialization val = do+    let len =+#ifdef USE_SERIALIZE+               (variableSizeOf val)+#else+               (sizeOf (Proxy :: Proxy a))+#endif+    arr <- MBA.new len+    nextOff <- POKE(0, arr, val)+#ifdef USE_SERIALIZE+    arr2 <- MBA.new len+    -- Re-initialize the array with random value+    forM_ [0..(len - 1)] $ \i -> POKE(i, arr2, (8 :: Word8))+    _ <- POKE(0, arr2, val)+    let slice1 = Array.Array arr 0 len :: Array.Array Word8+        slice2 = Array.Array arr2 0 len :: Array.Array Word8+    -- The serialized representation should be the same+    slice1 `shouldBe` slice2+    -- The serialized representation is not the same for "Unbox" as the Array+    -- might not be fully utilized in case of "Unbox". This is because different+    -- constructors might have different lengths.+#endif+    (nextOff1, val1) <- PEEK(0, arr, len)+    val1 `shouldBe` val+    nextOff1 `shouldBe` len+    nextOff `shouldBe` len++testGenericConsistency ::+       forall a.+       ( Eq a+       , Show a+#ifdef USE_SERIALIZE+       , Serialize a+#endif+       , Unbox a+       , Generic a+       , SizeOfRep (Rep a)+       , PeekRep (Rep a)+       , PokeRep (Rep a)+       )+    => a+    -> IO ()+testGenericConsistency val = do++    -- Test the generic sizeOf+    let len =+#ifdef USE_SERIALIZE+            variableSizeOf val+#else+            sizeOf (Proxy :: Proxy a)+#endif+    len  `shouldBe` genericSizeOf (Proxy :: Proxy a)++    -- Test the serialization and deserialization+    arr <- MBA.new (sizeOf (Proxy :: Proxy a))++    nextOff <- POKE(0, arr, val)+    genericPeekByteIndex arr 0 `shouldReturn` val++    genericPokeByteIndex arr 0 val+    (nextOff1, val1) <- PEEK(0, arr, len)+    val1 `shouldBe` val++    nextOff1 `shouldBe` len+    nextOff `shouldBe` len+++#ifndef USE_SERIALIZE+-- Size is also implicitly tested while serializing and deserializing.+checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> IO ()+checkSizeOf _ sz = sizeOf (Proxy :: Proxy a) `shouldBe` sz++#endif++--------------------------------------------------------------------------------+-- CPP helpers+--------------------------------------------------------------------------------++#define CHECK_SIZE(type, expectation) \+ it "checkSizeOf type" $ checkSizeOf (Proxy :: Proxy type) expectation++--------------------------------------------------------------------------------+-- Tests+--------------------------------------------------------------------------------++testCases :: Spec+testCases = do+    it "Unit" $ testSerialization Unit+    it "Unit1" $ testSerialization (Unit1 Unit)+    it "Unit2" $ testSerialization (Unit2 Unit Unit)+    it "Unit3" $ testSerialization (Unit3 1234 Unit 4567)+    it "Unit4" $ testSerialization (Unit4 1234 (Unit1 Unit) 4567)+    it "UnarySum Sum1" $ testSerialization Sum1+    it "UnarySum Sum2" $ testSerialization Sum2+    it "UnarySum2 UnitSum1" $ testSerialization (UnitSum1 Unit)+    it "UnarySum2 UnitSum2" $ testSerialization (UnitSum2 Unit)+    it "Single" $ testSerialization (Single 2)+    it "Product2" $ testSerialization (Product2 2 'b')+    it "SumOfProducts SOP0" $ testSerialization SOP0+    it "SumOfProducts SOP1" $ testSerialization (SOP1 1)+    it "SumOfProducts SOP2" $ testSerialization (SOP2 1 'a')+    it "SumOfProducts SOP3" $ testSerialization (SOP3 1 2 3)++#ifndef USE_SERIALIZE+    CHECK_SIZE(Unit, 1)+    CHECK_SIZE(Unit1, 1)+    CHECK_SIZE(Unit2, 2)+    CHECK_SIZE(Unit3, 17)+    CHECK_SIZE(Unit4, 17)+    CHECK_SIZE(UnarySum, 1)+    CHECK_SIZE(UnarySum2, 2)+    CHECK_SIZE(Single, 8)+    CHECK_SIZE(Product2, 12)+    CHECK_SIZE(SumOfProducts, 25)+    CHECK_SIZE(NestedSOP, 26)+#endif++    it "Bool" $ testSerialization True+    it "Complex Int" $ testSerialization (5 :+ 3 :: Complex Int)+    it "Ratio Int" $ testSerialization (5 :% 3 :: Ratio Int)+    it "Const Float Int" $ testSerialization (Const 333.5678 :: Const Float Int)+    it "Identity Int" $ testSerialization (Identity 56760 :: Identity Int)++    it "GenericConsistency Bool" $ testGenericConsistency True+    it "GenericConsistency (Complex Int)"+        $ testGenericConsistency (5 :+ 3 :: Complex Int)+    it "GenericConsistency (Ratio Int)"+        $ testGenericConsistency (5 :% 3 :: Ratio Int)+    it "GenericConsistency (Const Float Int)"+        $ testGenericConsistency (Const 333.5678 :: Const Float Int)+    it "GenericConsistency (Identity Int)"+        $ testGenericConsistency (Identity 56760 :: Identity Int)++    it "Fingerprint" $ testSerialization (Fingerprint 123456 876588)+    it "GenericConsistency Fingerprint"+        $ testGenericConsistency (Fingerprint 123456 876588)++--------------------------------------------------------------------------------+-- Main function+--------------------------------------------------------------------------------++moduleName :: String+moduleName = MODULE_NAME++main :: IO ()+main = hspec $ H.parallel $ describe moduleName testCases
+ test/Streamly/Test/Data/Unbox/TH.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Test.Data.Unbox.TH+-- Copyright   : (c) 2022 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Unbox.TH (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Proxy (Proxy(..))+import Streamly.Internal.Data.MutByteArray+import qualified Streamly.Internal.Data.MutByteArray as MBA++import Test.Hspec as H++--------------------------------------------------------------------------------+-- Test helpers+--------------------------------------------------------------------------------++testSerialization ::+       forall a. (Eq a, Show a, Unbox a)+    => a+    -> IO ()+testSerialization val = do+    arr <- MBA.new (sizeOf (Proxy :: Proxy a))+    pokeAt 0 arr val+    peekAt 0 arr `shouldReturn` val++-- Size is also implicitly tested while serializing and deserializing.+checkSizeOf :: forall a. Unbox a => Proxy a -> Int -> IO ()+checkSizeOf _ sz = sizeOf (Proxy :: Proxy a) `shouldBe` sz++checkSizeOfNew :: forall a. Unbox a => String -> Proxy a -> Int -> Spec+checkSizeOfNew tag proxy expectation =+    it ("checkSizeOf " ++ tag) $ checkSizeOf proxy expectation++data CustomDataType1 =+    CustomDataType1+    deriving (Show, Eq)++data CustomDataType2+    = CDT2Constructor1+    | CDT2Constructor2+    | CDT2Constructor3+    deriving (Show, Eq)++data CustomDataType3 a b c+    = CDT3Constructor1 a+    | CDT3Constructor2 a b+    | CDT3Constructor3 a b c+    deriving (Show, Eq)++data CustomDataType4 a b+    = CDT4Constructor1+    | CDT4Constructor2 Bool+    | CDT4Constructor3 Bool b+    deriving (Show, Eq)++$(deriveUnbox [d|instance Unbox CustomDataType1|])+$(deriveUnbox [d|instance Unbox CustomDataType2|])+$(deriveUnbox+    [d|instance (Unbox a, Unbox b, Unbox c) => Unbox (CustomDataType3 a b c)|])+$(deriveUnbox [d|instance Unbox b => Unbox (CustomDataType4 a b)|])++--------------------------------------------------------------------------------+-- CPP helpers+--------------------------------------------------------------------------------++#define CHECK_SIZE(type, expectation) \+ it "checkSizeOf type" $ checkSizeOf (Proxy :: Proxy type) expectation++--------------------------------------------------------------------------------+-- Tests+--------------------------------------------------------------------------------++testCustomDatatype1TH :: Spec+testCustomDatatype1TH = do+    it "CustomDataType1" $ testSerialization CustomDataType1++    CHECK_SIZE(CustomDataType1, 1)++testCustomDatatype2TH :: Spec+testCustomDatatype2TH = do+    it "CustomDataType2 1" $ testSerialization CDT2Constructor1+    it "CustomDataType2 2" $ testSerialization CDT2Constructor2+    it "CustomDataType2 3" $ testSerialization CDT2Constructor3++    CHECK_SIZE(CustomDataType2, 1)++testCustomDatatype3TH :: Spec+testCustomDatatype3TH = do+    it "CustomDataType3 1"+           $ testSerialization+                 (CDT3Constructor1 3 :: CustomDataType3 Int Bool Double)+    it "CustomDataType3 2"+           $ testSerialization+                 (CDT3Constructor2 3 False :: CustomDataType3 Int Bool Double)+    it "CustomDataType3 3"+           $ testSerialization (CDT3Constructor3 (3 :: Int) False (5 :: Double))++    checkSizeOfNew+        "CustomDataType3"+        (Proxy :: Proxy (CustomDataType3 Int Bool Double))+        (1 + sizeOf (Proxy :: Proxy Int)+           + sizeOf (Proxy :: Proxy Bool)+           + sizeOf (Proxy :: Proxy Double))++testCustomDatatype4TH :: Spec+testCustomDatatype4TH = do+    it "CustomDataType4 1"+           $ testSerialization (CDT4Constructor1 :: CustomDataType4 a Int)+    it "CustomDataType4 2"+           $ testSerialization+                 (CDT4Constructor2 True :: CustomDataType4 a Int)+    it "CustomDataType4 3"+           $ testSerialization (CDT4Constructor3 False (5 :: Int))++    checkSizeOfNew+        "CustomDataType4"+        (Proxy :: Proxy (CustomDataType4 a Int))+        (1 + sizeOf (Proxy :: Proxy Bool) + sizeOf (Proxy :: Proxy Int))++testCases :: Spec+testCases = do++    testCustomDatatype1TH+    testCustomDatatype2TH+    testCustomDatatype3TH+    testCustomDatatype4TH++--------------------------------------------------------------------------------+-- Main function+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Unboxed.TH"++main :: IO ()+main = hspec $ H.parallel $ describe moduleName testCases
test/Streamly/Test/Data/Unfold.hs view
@@ -13,15 +13,15 @@  import qualified Data.List as List import qualified Prelude+import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Unfold as UF-import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K  import Control.Monad.Trans.State.Strict import Data.Functor.Identity import Prelude hiding (const, take, drop, concat, mapM)-import Streamly.Prelude (SerialT) import Test.Hspec as H import Test.Hspec.QuickCheck import Test.QuickCheck@@ -41,7 +41,7 @@     where      action = do-        x <- S.toList $ S.unfold unf seed+        x <- S.fold Fold.toList $ S.unfold unf seed         y <- get         return $ x == lst && y == sf @@ -55,7 +55,7 @@     where      action = do-        x <- S.toList $ S.unfold unf seed+        x <- S.fold Fold.toList $ S.unfold unf seed         return $ x == lst  testUnfoldD :: Unfold Identity a Int -> a -> [Int] -> Bool@@ -70,19 +70,19 @@     let unf = UF.lmapM (\x -> modify (+ 1) >> return x) (UF.function id)      in testUnfoldMD unf 1 0 1 [1] -supply :: Bool-supply =+both :: Bool+both =     let unf = UF.supply 1 (UF.function id)-     in testUnfold unf undefined ([1] :: [Int])+     in testUnfold unf () ([1] :: [Int]) -supplyFirst :: Bool-supplyFirst =-    let unf = UF.supplyFirst 1 (UF.function id)+first :: Bool+first =+    let unf = UF.first 1 (UF.function id)      in testUnfold unf 2 ([(1, 2)] :: [(Int, Int)]) -supplySecond :: Bool-supplySecond =-    let unf = UF.supplySecond 1 (UF.function id)+second :: Bool+second =+    let unf = UF.second 1 (UF.function id)      in testUnfold unf 2 ([(2, 1)] :: [(Int, Int)])  discardFirst :: Bool@@ -110,7 +110,7 @@         $ \list ->               testUnfoldD                   UF.fromStream-                  (S.fromList list :: SerialT Identity Int)+                  (S.fromList list :: S.Stream Identity Int)                   list  fromStreamD :: Property@@ -168,8 +168,8 @@     property         $ \i ->               let ns = max 0 i-                  seed = modify (+ 1) >> get-               in testUnfoldMD (UF.replicateM i) seed 0 ns [1 .. i]+                  seed = (i, modify (+ 1) >> get)+               in testUnfoldMD UF.replicateM seed 0 ns [1 .. i]  repeatM :: Bool repeatM =@@ -410,8 +410,6 @@                 in testUnfold unf (f :: (), th, to) $                     Prelude.take 1 $ Prelude.enumFromThenTo f th to --#if MIN_VERSION_base(4,12,0) enumerateFromFractional :: Property enumerateFromFractional =     property@@ -443,12 +441,18 @@                 let unf = UF.enumerateFromToFractional                 in testUnfold unf (f :: Double, t) [f..(t :: Double)] -#endif- ------------------------------------------------------------------------------- -- Stream transformation ------------------------------------------------------------------------------- +postscan :: Property+postscan =+    property+        $ \(ls :: [Int]) ->+              let unf = UF.postscan Fold.sum UF.fromList+                  mList = scanl1 (+) ls+              in testUnfold unf ls mList+ mapM :: Property mapM =     property@@ -459,13 +463,13 @@                   mList = Prelude.map fA list                in testUnfoldMD unf list 0 (length list) mList -mapMWithInput :: Property-mapMWithInput =+mapM2 :: Property+mapM2 =     property         $ \f list ->               let fA = applyFun2 f :: [Int] -> Int -> Int-                  fM x y = modify (+ 1) >> return (fA x y)-                  unf = UF.mapMWithInput fM UF.fromList+                  fM (x, y) = modify (+ 1) >> return (fA x y)+                  unf = UF.mapM fM (UF.carry UF.fromList)                   mList = Prelude.map (fA list) list                in testUnfoldMD unf list 0 (length list) mList @@ -543,9 +547,9 @@  concat :: Bool concat =-    let unfIn = UF.replicateM 10-        unfOut = UF.map return UF.enumerateFromToIntegral-        unf = UF.many unfOut unfIn+    let unfIn = UF.replicateM+        unfOut = UF.map ((10,) . return) UF.enumerateFromToIntegral+        unf = UF.unfoldEach unfIn unfOut         lst = Prelude.concat $ Prelude.map (Prelude.replicate 10) [1 .. 10]      in testUnfoldD unf (1, 10) lst @@ -564,7 +568,7 @@ concatMapM :: Bool concatMapM =     let inner b =-          let u = UF.lmap (\_ -> modify (+ 1) >> return b) (UF.replicateM 10)+          let u = UF.lmap (\_ -> (10, modify (+ 1) >> return b)) UF.replicateM            in modify (+ 1) >> return u         unf = UF.concatMapM inner UF.enumerateFromToIntegral         list = List.concatMap (replicate 10) [1 .. 10]@@ -580,9 +584,9 @@         $ do             -- prop "lmap" lmap             prop "lmapM" lmapM-            prop "supply" supply-            prop "supplyFirst" supplyFirst-            prop "supplySecond" supplySecond+            prop "both" both+            prop "first" first+            prop "second" second             prop "discardFirst" discardFirst             prop "discardSecond" discardSecond             prop "swap" swap@@ -643,20 +647,19 @@             prop "enumerateFromToSmallBool" enumerateFromToSmallBool             prop "enumerateFromThenToSmallBool" enumerateFromThenToSmallBool -#if MIN_VERSION_base(4,12,0)             prop "enumerateFromFractional" enumerateFromFractional             prop "enumerateFromThenFractional" enumerateFromThenFractional             prop "enumerateFromToFractional" enumerateFromToFractional             prop "enumerateFromThenToFractional" enumerateFromThenToFractional-#endif  testTransformation :: Spec testTransformation =     describe "Transformation"         $ do             -- prop "map" map+            prop "postscan" postscan             prop "mapM" mapM-            prop "mapMWithInput" mapMWithInput+            prop "mapM2" mapM2             prop "takeWhileM" takeWhileM             -- prop "takeWhile" takeWhile             prop "take" take
+ test/Streamly/Test/FileSystem/DirIO.hs view
@@ -0,0 +1,202 @@+-- |+-- Module      : Streamly.Test.FileSystem.DirIO+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE CPP #-}++{-# OPTIONS_GHC -Wno-unrecognised-warning-flags #-}+{-# OPTIONS_GHC -Wno-x-partial #-}++module Main (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Word (Word8)+import GHC.IO.Encoding (setLocaleEncoding, utf8)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Streamly.Data.Array (Array)+#endif+import System.Directory (createDirectoryLink)++import qualified Streamly.Unicode.Stream as Unicode+import qualified Streamly.Internal.Unicode.Stream as Unicode (lines)+import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.StreamK as StreamK+import qualified Streamly.Internal.FileSystem.DirIO as Dir++import Prelude hiding (last, length)+import BenchTestLib.DirIO++import Test.Hspec as H++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "FileSystem.DirIO"++testCorrectness+    :: [FilePath] -> Stream.Stream IO Word8 -> Expectation+testCorrectness expectation lister = do+    reality <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream+            $ Unicode.lines Fold.toList+            $ Unicode.decodeUtf8 lister+    reality `shouldBe` expectation++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+testCorrectnessByteChunked+    :: [FilePath] -> Stream.Stream IO (Array Word8) -> Expectation+testCorrectnessByteChunked expectation lister = do+    reality <-+         Stream.fold Fold.toList+             $ StreamK.toStream+             $ StreamK.sortBy compare+             $ StreamK.fromStream+             $ Unicode.lines Fold.toList+             $ Unicode.decodeUtf8Chunks lister+    reality `shouldBe` expectation+#endif++testSymLinkFollow :: Spec+testSymLinkFollow = do+    let fp = "benchmark-tmp/dir-structure-small-sym"+    -- We create and use a different directory tree here for these tests because+    -- of convinence.+    pathsUnsorted <- runIO $ createDirStucture fp 2 3+    paths <-+        runIO+            $ Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList pathsUnsorted+    runIO $ do+        createDirectoryLink "./dir_1" (fp ++ "/sym-link-1")+        createDirectoryLink "./dir_1/dir_2" (fp ++ "/sym-link-2")+        createDirectoryLink "./broken_link" (fp ++ "/sym-link-3")+    let answerFollowSym =+            (fp ++ "/sym-link-1")+                : (fp ++ "/sym-link-1/dir_1")+                : (fp ++ "/sym-link-1/dir_2")+                : (fp ++ "/sym-link-1/dir_3")+                : (fp ++ "/sym-link-2")+                : paths+        answerNoFollowSym =+            (fp ++ "/sym-link-1")+                : (fp ++ "/sym-link-2")+                : (fp ++ "/sym-link-3")+                : paths+    sortedAnswerFollowSym <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList answerFollowSym+    sortedAnswerNoFollowSym <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList answerNoFollowSym+    describe "Symlink" $ do+        it "followSymlinks True" $+            testCorrectness+                sortedAnswerFollowSym+                (listDirUnfoldDfs+                     ( Dir.followSymlinks True+                     . Dir.ignoreMissing True+                     . Dir.ignoreInaccessible False+                     . Dir.ignoreSymlinkLoops False+                     )+                     fp)+        it "followSymlinks False" $+            testCorrectness+                sortedAnswerNoFollowSym+                (listDirUnfoldDfs+                     ( Dir.followSymlinks False+                     . Dir.ignoreMissing True+                     . Dir.ignoreInaccessible False+                     . Dir.ignoreSymlinkLoops False+                     )+                     fp)++-- | List the current directory recursively+main :: IO ()+main = do+    setLocaleEncoding utf8++    let smallTree = "benchmark-tmp/dir-structure-small"+        bigTree = "benchmark-tmp/dir-structure-big"+    pathsSmallUnsorted <- createDirStucture smallTree 2 3+    pathsBigUnsorted <- createDirStucture bigTree 5 5++    pathsSmall <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList pathsSmallUnsorted+    pathsBig <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList pathsBigUnsorted++    hspec $+      describe moduleName $ do+        describe "Sanity" $ do+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+            it "listDirByteChunked" $+                testCorrectnessByteChunked+                    (tail pathsBig) (listDirByteChunked bigTree)+#endif+            -- NOTE: The BFS traversal fails with:+            -- openDirStream: resource exhausted (Too many open files)+            -- if a bigger directory tree is used+            it "listDirUnfoldDfs" $+               testCorrectness pathsBig (listDirUnfoldDfs id bigTree)+            it "listDirUnfoldBfs" $+               testCorrectness pathsSmall (listDirUnfoldBfs id smallTree)+            it "listDirUnfoldBfsRev" $+               testCorrectness pathsSmall (listDirUnfoldBfsRev id smallTree)+            it "listDirConcatDfs" $+               testCorrectness pathsBig (listDirConcatDfs id bigTree)+            it "listDirConcatBfs" $+               testCorrectness pathsSmall (listDirConcatBfs id smallTree)+            it "listDirConcatBfsRev" $+               testCorrectness pathsSmall (listDirConcatBfsRev id smallTree)+            it "listDirAppend" $+               testCorrectness pathsBig (listDirAppend id bigTree)+            it "listDirInterleave" $+               testCorrectness pathsBig (listDirInterleave id bigTree)+            it "listDirPar" $+               testCorrectness pathsBig (listDirPar id bigTree)+            it "listDirParInterleaved" $+               testCorrectness pathsBig (listDirParInterleaved id bigTree)+            it "listDirParOrdered" $+               testCorrectness pathsBig (listDirParOrdered id bigTree)+            it "listDirChunkDfs" $+               testCorrectness pathsBig (listDirChunkDfs id bigTree)+            it "listDirChunkBfs" $+               testCorrectness pathsSmall (listDirChunkBfs id smallTree)+            it "listDirChunkBfsRev" $+               testCorrectness pathsSmall (listDirChunkBfsRev id smallTree)+            it "listDirChunkAppend" $+               testCorrectness pathsBig (listDirChunkAppend id bigTree)+            it "listDirChunkInterleave" $+               testCorrectness pathsBig (listDirChunkInterleave id bigTree)+            it "listDirChunkPar" $+               testCorrectness pathsBig (listDirChunkPar id bigTree)+            it "listDirChunkParInterleaved" $+               testCorrectness pathsBig (listDirChunkParInterleaved id bigTree)+            it "listDirChunkParOrdered" $+               testCorrectness pathsBig (listDirChunkParOrdered id bigTree)+        testSymLinkFollow
test/Streamly/Test/FileSystem/Event.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.FileSystem.Event -- Copyright   : (c) 2021 Composewell Technologies
test/Streamly/Test/FileSystem/Event/Common.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.FileSystem.Event.Common -- Copyright   : (c) 2020 Composewell Technologies@@ -46,11 +48,13 @@ import Data.Functor.Identity (runIdentity) import Data.List.NonEmpty (NonEmpty) import Data.Word (Word8)-import Streamly.Data.Array.Foreign (Array)+import Streamly.Data.Array (Array) import System.Directory     ( createDirectory     , createDirectoryIfMissing     , createDirectoryLink+    , doesDirectoryExist+    , doesFileExist     , removeFile     , removePathForcibly     , renameDirectory@@ -63,8 +67,9 @@ import System.IO.Temp (withSystemTempDirectory)  import qualified Data.List.NonEmpty as NonEmpty-import qualified Streamly.Internal.Data.Array.Foreign as Array-import qualified Streamly.Internal.Data.Stream.IsStream as Stream+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream import qualified Streamly.Unicode.Stream as Unicode  #if defined(FILESYSTEM_EVENT_LINUX)@@ -93,7 +98,7 @@     -> MVar ()   -- mvar to sync file system ops and the watch     -> [(String, Event -> Bool)] -- expected events     -> IO ()-type EventWatcher = NonEmpty (Array Word8) -> Stream.SerialT IO Event.Event+type EventWatcher = NonEmpty (Array Word8) -> Stream.Stream IO Event.Event  eventMatches :: Event -> (String, Event -> Bool) -> Bool eventMatches ev (expectedPath, f) =@@ -104,7 +109,7 @@      utf8ToString :: Array Word8 -> String     utf8ToString =-        runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.toStream+        runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.read      evPath = utf8ToString (Event.getAbsPath ev) @@ -170,11 +175,13 @@                             openFile root WriteMode >>= hClose                             return root                         SymLinkResolvedPath -> do+                            -- root -> target                             let tgt = fp </> "watch-root-real"                             createDirectory tgt                             createDirectoryLink tgt root                             return tgt                         SymLinkOrigPath -> do+                            -- root -> target                             let tgt = fp </> "watch-root-real"                             createDirectory tgt                             createDirectoryLink tgt root@@ -186,21 +193,28 @@                 startWatchAndCheck root target sync      startWatchAndCheck root target sync = do+            putStrLn ("Before pre op: root [" <> root+                    <> "] target [" <> target <> "]")             pre root+            putStrLn ("After pre op: root [" <> root+                    <> "] target [" <> target <> "]")             -- XXX On macOS the events from pre ops also seem to be bundled             -- with the events occurred after the watch is started.             let check = checker root target sync expected                 fsOps = Stream.fromEffect $ runFSOps root sync-            Stream.drain $ Stream.fromEffect check `Stream.parallelFst` fsOps+            Stream.drain+                $ Stream.parListEagerFst [Stream.fromEffect check, fsOps]      runFSOps fp sync = do         -- We put the MVar before the event watcher starts to run but that does         -- not ensure that the event watcher has actually started. So we need a         -- delay as well. Do we?         takeMVar sync >> threadDelay 200000+        putStrLn ("Before fs ops: root [" <> fp)         ops fp+        putStrLn ("After fs ops: root [" <> fp)         threadDelay 10000000-        error "Time out occurred before event watcher could terminate"+        error $ fp <> ": Time out occurred before event watcher could terminate"  ------------------------------------------------------------------------------- -- Test descriptions@@ -229,7 +243,7 @@  createParent :: FilePath -> FilePath -> IO () createParent file parent = do-    createDirectoryIfMissing True (parent </> takeDirectory file)+    createDirectoryIfMissing True (takeDirectory (parent </> file))  createDirWithParent :: FilePath -> FilePath -> IO () createDirWithParent dir parent =@@ -297,9 +311,25 @@  createFileWithParent :: FilePath -> FilePath -> IO () createFileWithParent file parent = do-    when (not (null file)) $-        createDirectoryIfMissing True (parent </> takeDirectory file)-    openFile (parent </> file) WriteMode >>= hClose+    let filepath = parent </> file+    let dir = takeDirectory filepath+    putStrLn $ "createFileWithParent: file ["+        ++ file ++ "] dir [" ++ dir ++ "]"+    putStrLn $ "Ensuring dir: " ++ dir+    createDirectoryIfMissing True dir+    r <- doesDirectoryExist dir+    if r+    then do+        putStrLn $ "Ensured dir: " ++ dir+        when (not (null file)) $ do+            exists <- doesFileExist filepath+            if not exists+            then do+                putStrLn $ "Creating file: " ++ (parent </> file)+                openFile (parent </> file) WriteMode >>= hClose+                putStrLn $ "Created file: " ++ (parent </> file)+            else error $ "File exists: " ++ filepath+    else error $ "Could not create dir: " ++ dir  createFile :: FilePath -> FilePath -> IO () createFile file parent =
test/Streamly/Test/FileSystem/Event/Darwin.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.FileSystem.Event.Darwin -- Copyright   : (c) 2020 Composewell Technologies@@ -78,7 +80,7 @@             , fileModify "" (const [])             ] -    let w = Event.watchWith (Event.setAllEvents Event.On)+    let w = Event.watchWith (Event.setAllEvents True)         run = runTests moduleName "recursive" w      run DirType regularRootTests
test/Streamly/Test/FileSystem/Event/Linux.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.FileSystem.Event.Linux -- Copyright   : (c) 2020 Composewell Technologies@@ -9,10 +11,16 @@ module Streamly.Test.FileSystem.Event.Linux (main) where  import Streamly.Internal.FileSystem.Event.Linux (Event)+-- #if __GLASGOW_HASKELL__ == 902+#if 0+import qualified Data.List as List+#endif import qualified Streamly.Internal.FileSystem.Event.Linux as Event  import Streamly.Test.FileSystem.Event.Common +#define DEVBUILD+ moduleName :: String moduleName = "FileSystem.Event.Linux" @@ -44,6 +52,7 @@     , (dst, dirEvent Event.isMovedTo)     ] +#ifdef DEVBUILD -- In recursive mode all subdirectories are roots therefore they will generate -- isRootMoved. rootDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]@@ -53,6 +62,7 @@  recDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)] recDirMoveEvents src dst = dirMoveEvents src dst ++ rootDirMoveEvents src dst+#endif  fileTouchEvents :: String -> [([Char], Event -> Bool)] fileTouchEvents file =@@ -90,18 +100,39 @@             : regSymTests      let symTests =-             -- when root is a symlinked dir, it does not recv touch, isDeleted-             -- or rootDeleted, rootUnwatched events.+#if 0+             -- No events occur when a symlink root is moved. when root is a+             -- symlinked dir, it does not recv touch, isDeleted or+             -- rootDeleted, rootUnwatched events. We are not seeing+             -- isAttrModified event as well, so disabling this altogether.               dirDelete "" (\dir -> [(dir, dirEvent Event.isAttrsModified)])-            -- No events occur when a symlink root is moved-            : regSymTests+            :+#endif+            regSymTests -    let w = Event.watchWith (Event.setAllEvents Event.On)+    let w = Event.watchWith (Event.setAllEvents True)         run = runTests moduleName "non-recursive" w -    run DirType regTests-    run SymLinkOrigPath symTests+#if 0+    let failingTests =+            [ "File deleted (file1)"+            , "File modified (file1)"+            , "File moved (file1 file2)"+            ]+#endif +    run DirType+#if 0+        $ filter (\(desc, _, _, _) -> desc `List.notElem` failingTests)+#endif+        regTests++    run SymLinkOrigPath+#if 0+        $ filter (\(desc, _, _, _) -> desc `List.notElem` failingTests)+#endif+        symTests+     let fileRootTests =             [ fileDelete "" (\path ->                 [ (path, Event.isAttrsModified)@@ -114,6 +145,11 @@      run FileType fileRootTests +    let recw = Event.watchWith+                (Event.setAllEvents True . Event.setRecursiveMode True)+        runRec = runTests moduleName "recursive" recw++#ifdef DEVBUILD     -- In recursive mode all subdirectories are roots therefore they will     -- generate isRootDeleted/isRootUnwatched. Also, for subdirectories     -- multiple events are generated, once in the parent watch and once in the@@ -141,10 +177,34 @@         recRegTests = regTests ++ regSymRecTests         recSymTests = symTests ++ regSymRecTests -    let recw = Event.watchWith-                (Event.setAllEvents Event.On . Event.setRecursiveMode Event.On)-        runRec = runTests moduleName "recursive" recw+    -- XXX these tests fails intermittently for recursive case+    -- FileSystem.Event.Linux.recursive, Root type SymLinkOrigPath, File deleted (subdir/file1)+    -- FileSystem.Event.Linux.recursive, Root type SymLinkOrigPath, File modified (subdir/file1)+    -- FileSystem.Event.Linux.recursive, Root type SymLinkOrigPath, File moved (subdir/file1 subdir/file2)+    -- FileSystem.Event.Linux.recursive, Root type DirType, File moved (file1 file2)+    -- FileSystem.Event.Linux.recursive, Root type DirType, File created (file)+    --      uncaught exception: IOException of type ResourceBusy+    --      /tmp/fsevent_dir-a5bd0df64c44ab27/watch-root/file: openFile: resource busy (file is locked) -    runRec DirType recRegTests-    runRec SymLinkOrigPath recSymTests+#if 0+    let failingRecTests = failingTests +++            [ "File created (subdir/file)"+            , "File deleted (subdir/file1)"+            , "File modified (subdir/file1)"+            , "File moved (subdir/file1 subdir/file2)"+            ]+#endif++    runRec DirType+#if 0+        $ filter (\(desc, _, _, _) -> desc `List.notElem` failingRecTests)+#endif+        recRegTests++    runRec SymLinkOrigPath+#if 0+        $ filter (\(desc, _, _, _) -> desc `List.notElem` failingRecTests)+#endif+        recSymTests+#endif     runRec FileType fileRootTests
test/Streamly/Test/FileSystem/Event/Windows.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}
+
 -- |
 -- Module      : Streamly.Test.FileSystem.Event.Windows
 -- Copyright   : (c) 2020 Composewell Technologies
@@ -30,7 +32,7 @@         --
         -- ++ dirDelete "" (\dir -> [(dir, Event.isDeleted)])
 
-    let w = Event.watchWith (Event.setAllEvents Event.On)
+    let w = Event.watchWith (Event.setAllEvents True)
         run = runTests moduleName "non-recursive" w
 
     run DirType regularRootTests
@@ -44,7 +46,7 @@             ] ++ commonRecTests
 
     let recw = Event.watchWith
-                (Event.setAllEvents Event.On . Event.setRecursiveMode Event.On)
+                (Event.setAllEvents True . Event.setRecursiveMode True)
         runRec = runTests moduleName "recursive" recw
 
     runRec DirType (regularRootTests ++ recTests)
test/Streamly/Test/FileSystem/Handle.hs view
@@ -10,8 +10,8 @@  import Data.Functor.Identity (runIdentity) import Data.Word (Word8)-import Foreign.Storable (Storable(..))-import Streamly.Internal.Data.Stream.IsStream (IsStream, SerialT)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.System.IO (defaultChunkSize) import System.FilePath ((</>)) import System.IO     ( Handle@@ -20,27 +20,31 @@     , hClose     , hFlush     , hSeek-    , openFile+    , hPutStr     ) import System.IO.Temp (withSystemTempDirectory)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Streamly.Internal.FileSystem.Posix.File (openFile, withFile)+#else+import Streamly.Internal.FileSystem.Windows.File (openFile, withFile)+#endif import Test.QuickCheck (Property, forAll, Gen, vectorOf, choose) import Test.QuickCheck.Monadic (monadicIO, assert, run)+import Streamly.Internal.FileSystem.Path (Path)  import qualified Streamly.Data.Fold as Fold import qualified Streamly.Internal.FileSystem.Handle as Handle-import qualified Streamly.Internal.Data.Stream.IsStream as Stream-import qualified Streamly.Internal.Data.Array.Foreign as Array+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Unicode.Stream as Unicode+import qualified Streamly.Internal.FileSystem.Path as Path +import Prelude hiding (writeFile) import Test.Hspec as H import Test.Hspec.QuickCheck -allocOverhead :: Int-allocOverhead = 2 * sizeOf (undefined :: Int)--defaultChunkSize :: Int-defaultChunkSize = 32 * k - allocOverhead-   where k = 1024+writeFile :: Path -> String -> IO ()+writeFile fpath val = withFile fpath WriteMode (`hPutStr` val)  maxArrLen :: Int maxArrLen = defaultChunkSize * 8@@ -51,9 +55,12 @@ chooseWord8 :: (Word8, Word8) -> Gen Word8 chooseWord8 = choose +toList :: Monad m => Stream m a -> m [a]+toList = Stream.fold Fold.toList+ utf8ToString :: Array.Array Word8 -> String utf8ToString =-    runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.toStream+    runIdentity . toList . Unicode.decodeUtf8' . Array.read  testData :: String testData = "This is the test data for FileSystem.Handle ??`!@#$%^&*~~))`]"@@ -64,43 +71,43 @@ testBinData :: String testBinData = "01234567890123456789012345678901234567890123456789" -executor :: (Handle -> SerialT IO Char) -> IO (SerialT IO Char)+executor :: (Handle -> Stream IO Char) -> IO (Stream IO Char) executor f =     withSystemTempDirectory "fs_handle" $ \fp -> do-        let fpath = fp </> "tmp_read.txt"+        fpath <- Path.fromString $ fp </> "tmp_read.txt"         writeFile fpath testDataLarge         h <- openFile fpath ReadMode         return $ f h -readFromHandle :: IO (SerialT IO Char)+readFromHandle :: IO (Stream IO Char) readFromHandle =-    let f = Unicode.decodeUtf8 . Stream.unfold Handle.read+    let f = Unicode.decodeUtf8 . Stream.unfold Handle.reader     in executor f -readWithBufferFromHandle :: IO (SerialT IO Char)+readWithBufferFromHandle :: IO (Stream IO Char) readWithBufferFromHandle =-    let f1 = (\h -> (1024, h))-        f2 = Unicode.decodeUtf8 . Stream.unfold Handle.readWithBufferOf . f1+    let f1 h = (1024, h)+        f2 = Unicode.decodeUtf8 . Stream.unfold Handle.readerWith . f1     in executor f2 -readChunksFromHandle :: IO (SerialT IO Char)+readChunksFromHandle :: IO (Stream IO Char) readChunksFromHandle =     let f =   Unicode.decodeUtf8-            . Stream.concatMap Array.toStream-            . Stream.unfold Handle.readChunks+            . Stream.concatMap Array.read+            . Stream.unfold Handle.chunkReader     in executor f -readChunksWithBuffer :: IO (SerialT IO Char)+readChunksWithBuffer :: IO (Stream IO Char) readChunksWithBuffer =-    let f1 = (\h -> (1024, h))+    let f1 h = (1024, h)         f2 =               Unicode.decodeUtf8-            . Stream.concatMap Array.toStream-            . Stream.unfold Handle.readChunksWithBufferOf+            . Stream.concatMap Array.read+            . Stream.unfold Handle.chunkReaderWith             . f1     in executor f2 -testRead :: (IsStream t) => IO (t IO Char) -> Property+testRead :: IO (Stream IO Char) -> Property testRead fn = monadicIO $ do     let v2 = Stream.fromList testDataLarge     v1 <- run fn@@ -119,14 +126,14 @@                  go list =                     withSystemTempDirectory "fs_handle" $ \fp -> do-                        let fpathWrite = fp </> "tmp_write.txt"+                        fpathWrite <- Path.fromString $ fp </> "tmp_write.txt"                         writeFile fpathWrite ""                         h <- openFile fpathWrite ReadWriteMode                         hSeek h AbsoluteSeek 0                         _ <- Stream.fold (hfold h) $ Stream.fromList list                         hFlush h                         hSeek h AbsoluteSeek 0-                        ls <- Stream.toList $ Stream.unfold Handle.read h+                        ls <- toList $ Stream.unfold Handle.reader h                         hClose h                         return (ls == list) @@ -140,18 +147,18 @@          go =             withSystemTempDirectory "fs_handle" $ \fp -> do-                let fpathRead = fp </> "tmp_read.txt"-                    fpathWrite = fp </> "tmp_write.txt"+                fpathRead <- Path.fromString $ fp </> "tmp_read.txt"+                fpathWrite <- Path.fromString $ fp </> "tmp_write.txt"                 writeFile fpathRead testDataLarge                 writeFile fpathWrite ""                 hr <- openFile fpathRead ReadMode                 hw <- openFile fpathWrite ReadWriteMode                 hSeek hw AbsoluteSeek 0                 _ <- Stream.fold (Handle.writeChunks hw)-                    $ Stream.unfold Handle.readChunksWithBufferOf (1024, hr)+                    $ Stream.unfold Handle.chunkReaderWith (1024, hr)                 hFlush hw                 hSeek hw AbsoluteSeek 0-                ls <- Stream.toList $ Stream.unfold Handle.read hw+                ls <- toList $ Stream.unfold Handle.reader hw                 let arr = Array.fromList ls                 return (testDataLarge == utf8ToString arr) @@ -162,13 +169,13 @@      go =         withSystemTempDirectory "fs_handle" $ \fp -> do-            let fpathRead = fp </> "tmp_read.txt"+            fpathRead <- Path.fromString $ fp </> "tmp_read.txt"             writeFile fpathRead testBinData             h <- openFile fpathRead ReadMode             ls <--                Stream.toList+                toList                     $ Stream.unfold-                        Handle.readChunksFromToWith (from, to, buffSize, h)+                        Handle.chunkReaderFromToWith (from, to, buffSize, h)             return (res `shouldBe` fmap Array.toList ls)  -- Test for first byte@@ -209,9 +216,9 @@       describe moduleName $ do         describe "Read From Handle" $ do             prop "read" $ testRead readFromHandle-            prop "readWithBufferOf" $ testRead readWithBufferFromHandle+            prop "readWith" $ testRead readWithBufferFromHandle             prop "readChunks" $ testRead readChunksFromHandle-            prop "readChunksWithBufferOf" $ testRead readChunksWithBuffer+            prop "readChunksWith" $ testRead readChunksWithBuffer             prop "readChunksFromToWith (0,0,n)"                 testReadChunksFromToWithFirstByte             prop "readChunksFromToWith (1,1,n)"@@ -226,7 +233,7 @@                 testReadChunksFromToWithRangeInvalid         describe "Write To Handle" $ do             prop "write" $ testWrite Handle.write-            prop "writeWithBufferOf"-                $ testWrite $ Handle.writeWithBufferOf 1024+            prop "writeWith"+                $ testWrite $ Handle.writeWith 1024             -- XXX This test needs a lot of stack when built with -O0             prop "writeChunks" testWriteWithChunk
test/Streamly/Test/Network/Inet/TCP.hs view
@@ -1,3 +1,4 @@+ -- | -- Module      : Streamly.Test.Network.Socket -- Copyright   : (c) 2020 Composewell technologies@@ -16,15 +17,16 @@ import Network.Socket (Socket, PortNumber) import Streamly.Internal.Control.Monad (discard) import Streamly.Internal.System.IO (defaultChunkSize)-import Streamly.Prelude (SerialT)+import Streamly.Internal.Data.Stream (Stream) import Test.QuickCheck (Property) import Test.QuickCheck.Monadic (monadicIO, assert, run) +import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream.Prelude as Stream import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.Network.Inet.TCP as TCP import qualified Streamly.Internal.Network.Socket as Socket import qualified Streamly.Internal.Unicode.Stream as Unicode-import qualified Streamly.Prelude as Stream  import Test.Hspec import Test.Hspec.QuickCheck@@ -43,7 +45,7 @@ ------------------------------------------------------------------------------ handlerRW :: Socket -> IO () handlerRW sk =-          Stream.unfold Socket.read sk+          Stream.unfold Socket.reader sk         & Stream.fold (Socket.write sk)         & discard @@ -71,29 +73,33 @@     -> IO () server listener port sem handler = do     putMVar sem ()-    Stream.fromSerial (Stream.unfold listener port)-        & (Stream.fromAsync . Stream.mapM (Socket.forSocketM handler))-        & Stream.drain+    Stream.unfold listener port+        & Stream.mapM (Socket.forSocketM handler)+        & Stream.fold Fold.drain  remoteAddr :: (Word8,Word8,Word8,Word8) remoteAddr = (127, 0, 0, 1) -sender :: PortNumber -> MVar () -> SerialT IO Char-sender port sem = do-    _ <- liftIO $ takeMVar sem-    liftIO $ threadDelay 1000000                       -- wait for server-    Stream.replicate 1000 testData                     -- SerialT IO String-        & Stream.concatMap Stream.fromList             -- SerialT IO Char-        & Unicode.encodeLatin1                         -- SerialT IO Word8-        & TCP.processBytes remoteAddr port             -- SerialT IO Word8-        & Unicode.decodeLatin1                         -- SerialT IO Char+sender :: PortNumber -> MVar () -> Stream IO Char+sender port sem = Stream.before action stream +    where++    action = liftIO (takeMVar sem >> threadDelay 1000000)  -- wait for server++    stream =+        Stream.replicate 1000 testData                     -- Stream IO String+            & Stream.concatMap Stream.fromList             -- Stream IO Char+            & Unicode.encodeLatin1                         -- Stream IO Word8+            & TCP.pipeBytes remoteAddr port                -- Stream IO Word8+            & Unicode.decodeLatin1                         -- Stream IO Char+ execute     :: Unfold.Unfold IO PortNumber Socket     -> PortNumber     -> Int     -> (Socket -> IO ())-    -> IO (SerialT IO Char)+    -> IO (Stream IO Char) execute listener port size handler = do     sem <- newEmptyMVar     tid <- forkIO $ server listener port sem handler@@ -106,7 +112,7 @@ validateOnPort = monadicIO $ do     res <- run $ do         ls2 <--            execute TCP.acceptOnPort basePort defaultChunkSize handlerRW+            execute TCP.acceptor basePort defaultChunkSize handlerRW         let dataChunk = take defaultChunkSize testDataSource         Stream.eqBy (==) (Stream.fromList dataChunk) ls2     assert res@@ -116,7 +122,7 @@     res <- run $ do         ls2 <-             execute-                TCP.acceptOnPortLocal+                TCP.acceptorLocal                 (basePort + 1)                 defaultChunkSize                 handlerRW
test/Streamly/Test/Network/Socket.hs view
@@ -1,3 +1,4 @@+ -- | -- Module      : Streamly.Test.Network.Socket -- Copyright   : (c) 2020 Composewell technologies@@ -16,14 +17,15 @@ import Network.Socket (Socket, PortNumber) import Streamly.Internal.Control.Monad (discard) import Streamly.Internal.System.IO (defaultChunkSize)-import Streamly.Prelude (SerialT)+import Streamly.Internal.Data.Stream (Stream) import Test.QuickCheck (Property) import Test.QuickCheck.Monadic (monadicIO, assert, run) +import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream.Prelude as Stream import qualified Streamly.Internal.Network.Inet.TCP as TCP import qualified Streamly.Internal.Network.Socket as Socket import qualified Streamly.Internal.Unicode.Stream as Unicode-import qualified Streamly.Prelude as Stream  import Test.Hspec import Test.Hspec.QuickCheck@@ -40,29 +42,31 @@ ------------------------------------------------------------------------------ -- Parse and handle commands on a socket ------------------------------------------------------------------------------+ handlerChunksWithBuffer :: Socket -> IO () handlerChunksWithBuffer sk =-          Stream.unfold Socket.readChunksWithBufferOf (100, sk)+          Stream.unfold Socket.chunkReaderWith (100, sk)         & Stream.fold (Socket.writeChunks sk)         & discard  handlerChunks :: Socket -> IO () handlerChunks sk =-          Stream.unfold Socket.readChunks sk+          Stream.unfold Socket.chunkReader sk         & Stream.fold (Socket.writeChunks sk)         & discard  handlerwithbuffer :: Socket -> IO () handlerwithbuffer sk =-          Stream.unfold Socket.readWithBufferOf (100, sk)-        & Stream.fold (Socket.writeWithBufferOf 100 sk)+          Stream.unfold Socket.readerWith (100, sk)+        & Stream.fold (Socket.writeWith 100 sk)         & discard  handlerRW :: Socket -> IO () handlerRW sk =-          Stream.unfold Socket.read sk+          Stream.unfold Socket.reader sk         & Stream.fold (Socket.write sk)         & discard+ ------------------------------------------------------------------------------ -- Accept connections and handle connected sockets ------------------------------------------------------------------------------@@ -82,24 +86,28 @@ server :: PortNumber -> MVar () -> (Socket -> IO ()) -> IO () server port sem handler = do     putMVar sem ()-    Stream.fromSerial (Stream.unfold TCP.acceptOnPort port)-        & Stream.fromAsync . Stream.mapM (Socket.forSocketM handler)-        & Stream.drain+    Stream.unfold TCP.acceptor port+        & Stream.mapM (Socket.forSocketM handler)+        & Stream.fold Fold.drain  remoteAddr :: (Word8,Word8,Word8,Word8) remoteAddr = (127, 0, 0, 1) -sender :: PortNumber -> MVar () -> SerialT IO Char-sender port sem = do-    _ <- liftIO $ takeMVar sem-    liftIO $ threadDelay 1000000                       -- wait for server-    Stream.replicate 1000 testData                     -- SerialT IO String-        & Stream.concatMap Stream.fromList             -- SerialT IO Char-        & Unicode.encodeLatin1                         -- SerialT IO Word8-        & TCP.processBytes remoteAddr port             -- SerialT IO Word8-        & Unicode.decodeLatin1                         -- SerialT IO Char+sender :: PortNumber -> MVar () -> Stream IO Char+sender port sem = Stream.before action stream -execute :: PortNumber -> Int -> (Socket -> IO ()) -> IO (SerialT IO Char)+    where++    action = liftIO (takeMVar sem >> threadDelay 1000000) -- wait for server++    stream =+        Stream.replicate 1000 testData                     -- Stream IO String+            & Stream.concatMap Stream.fromList             -- Stream IO Char+            & Unicode.encodeLatin1                         -- Stream IO Word8+            & TCP.pipeBytes remoteAddr port                -- Stream IO Word8+            & Unicode.decodeLatin1                         -- Stream IO Char++execute :: PortNumber -> Int -> (Socket -> IO ()) -> IO (Stream IO Char) execute port size handler = do     sem <- newEmptyMVar     tid <- forkIO $ server port sem handler@@ -108,8 +116,8 @@                 & Stream.finally (killThread tid)     return lst -validateWithBufferOf :: Property-validateWithBufferOf = monadicIO $ do+validateWith :: Property+validateWith = monadicIO $ do     res <- run $ do         ls2 <- execute basePort 45000 handlerwithbuffer         Stream.eqBy (==) (Stream.fromList testDataSource) ls2@@ -130,8 +138,8 @@         Stream.eqBy (==) (Stream.fromList testDataSource) ls2     assert res -validateChunksWithBufferOf :: Property-validateChunksWithBufferOf = monadicIO $ do+validateChunksWith :: Property+validateChunksWith = monadicIO $ do     res <- run $ do         ls2 <- execute (basePort + 3) 45000 handlerChunksWithBuffer         Stream.eqBy (==) (Stream.fromList testDataSource) ls2@@ -146,6 +154,6 @@       describe moduleName $ do         describe "Read/Write" $ do             prop "read/write" validateRW-            prop "readWithBufferOf/writeWithBufferOf" validateWithBufferOf+            prop "readWith/writeWith" validateWith             prop "readChunks/writeChunks" validateChunks-            prop "readChunksWithBufferOf" validateChunksWithBufferOf+            prop "readChunksWith" validateChunksWith
test/Streamly/Test/Prelude.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude -- Copyright   : (c) 2020 Composewell Technologies@@ -15,9 +17,6 @@ import Control.Monad.Error.Class (throwError, MonadError) import Control.Monad.Trans.Except (runExceptT, ExceptT) import Data.List (sort)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup(..))-#endif import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering)) import System.Random (randomIO) import Test.Hspec as H
test/Streamly/Test/Prelude/Ahead.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.Ahead -- Copyright   : (c) 2020 Composewell Technologies@@ -9,9 +11,6 @@  module Streamly.Test.Prelude.Ahead (main) where -#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup ((<>))-#endif import Test.QuickCheck (Property) import Test.Hspec.QuickCheck import Test.QuickCheck.Monadic (monadicIO, run)
test/Streamly/Test/Prelude/Async.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.Async -- Copyright   : (c) 2020 Composewell Technologies@@ -11,9 +13,6 @@  import Control.Concurrent (threadDelay) import Data.List (sort)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup ((<>))-#endif import Test.Hspec.QuickCheck import Test.QuickCheck (Property, withMaxSuccess) import Test.QuickCheck.Monadic (monadicIO, run)
test/Streamly/Test/Prelude/Concurrent.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.Concurrent -- Copyright   : (c) 2020 Composewell Technologies@@ -21,9 +23,6 @@                            , StateT(..), evalStateT) import Data.Foldable (fold) import Data.IORef (readIORef, modifyIORef, newIORef)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup, (<>))-#endif import GHC.Word (Word8) import Test.Hspec.QuickCheck import Test.Hspec as H@@ -491,10 +490,13 @@                    replicate 2000 $ S.fromEffect $ threadDelay 1000000)         `shouldReturn` () +-- Hanging on macOS CI+#ifdef DEVBUILD     it "aheadly crosses thread limit (4000 threads)" $         S.drain (fromAhead $ fold $                    replicate 4000 $ S.fromEffect $ threadDelay 1000000)         `shouldReturn` ()+#endif  #ifdef DEVBUILD     describe "restricts concurrency and cleans up extra tasks" $ do
test/Streamly/Test/Prelude/Fold.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.Fold -- Copyright   : (c) 2020 Composewell Technologies
test/Streamly/Test/Prelude/Parallel.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.Parallel -- Copyright   : (c) 2020 Composewell Technologies@@ -10,9 +12,6 @@ module Streamly.Test.Prelude.Parallel (main) where  import Data.List (sort)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Test.Hspec.QuickCheck import Test.Hspec as H
test/Streamly/Test/Prelude/Rate.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.MaxRate -- Copyright   : (c) 2018 Composewell Technologies
test/Streamly/Test/Prelude/Serial.hs view
@@ -1,3 +1,10 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# Language TypeApplications #-}+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif+ -- | -- Module      : Streamly.Test.Prelude.Serial -- Copyright   : (c) 2020 Composewell Technologies@@ -16,11 +23,9 @@ import Data.Int (Int64) import Data.List (sort, group, intercalate) import Data.Maybe ( isJust, fromJust )-import Foreign.Storable (Storable)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup ((<>))-#endif+import Data.Word (Word8) import Data.Semigroup (Sum(..), getSum)+import Streamly.Internal.Data.MutByteArray (Unbox) import Test.Hspec.QuickCheck import Test.QuickCheck     ( Gen@@ -43,11 +48,14 @@ #ifndef COVERAGE_BUILD import Streamly.Prelude (avgRate, maxBuffer) #endif-import qualified Streamly.Prelude as S+import qualified Streamly.Data.Stream.Prelude as S import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Unfold as UF-import qualified Streamly.Internal.Data.Stream.IsStream as IS-import qualified Streamly.Data.Array.Foreign as A+import qualified Streamly.Internal.Data.Stream as IS+import qualified Streamly.Internal.Data.StreamK as K+import qualified Streamly.Data.Array as A+import qualified Streamly.Internal.Data.Parser as Parser+import qualified Streamly.Prelude as SP  import Streamly.Internal.Data.Time.Units        (AbsTime, NanoSecond64(..), toRelTime64, diffAbsTime64)@@ -58,31 +66,66 @@  import Streamly.Test.Common import Streamly.Test.Prelude.Common+import Control.Monad.IO.Class (MonadIO) +toList :: Monad m => S.Stream m a -> m [a]+toList = S.fold FL.toList++splitOn :: Monad m =>+    (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b+splitOn predicate f = IS.foldManyPost (FL.takeEndBy_ predicate f)++splitOnSuffix :: Monad m =>+    (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b+splitOnSuffix predicate f = S.foldMany (FL.takeEndBy_ predicate f)++splitOnSeq' :: (MonadIO m, Unbox a, Enum a, Eq a) =>+    A.Array a -> FL.Fold m a b -> S.Stream m a -> S.Stream m b+splitOnSeq' patt f m = IS.foldManyPost (FL.takeEndBySeq_ patt f) m++splitOnSuffixSeq' :: (MonadIO m, Unbox a, Enum a, Eq a) =>+    A.Array a -> FL.Fold m a b -> S.Stream m a -> S.Stream m b+splitOnSuffixSeq' patt f m = S.foldMany (FL.takeEndBySeq_ patt f) m++groupsBy :: Monad m =>+    (a -> a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b+groupsBy cmp f m = S.catRights $ S.parseMany (Parser.groupBy cmp f) m++groupsByRolling :: Monad m =>+    (a -> a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b+groupsByRolling cmp f m =+    S.catRights $ S.parseMany (Parser.groupByRolling cmp f) m++drainWhile :: Monad m => (a -> Bool) -> SerialT m a -> m ()+drainWhile p m = SP.fold FL.drain $ SP.takeWhile p m++drainMapM :: Monad m => (a -> m b) -> S.Stream m a -> m ()+drainMapM f = S.fold (FL.drainMapM f)+ splitOnSeq :: Spec splitOnSeq = do     describe "Tests for splitOnSeq" $ do-        it "splitOnSeq' \"hello\" \"\" = [\"\"]"-          $ splitOnSeq' "hello" "" `shouldReturn` [""]-        it "splitOnSeq' \"hello\" \"hello\" = [\"\", \"\"]"-          $ splitOnSeq' "hello" "hello" `shouldReturn` ["", ""]-        it "splitOnSeq' \"x\" \"hello\" = [\"hello\"]"-          $ splitOnSeq' "x" "hello" `shouldReturn` ["hello"]-        it "splitOnSeq' \"h\" \"hello\" = [\"\", \"ello\"]"-          $ splitOnSeq' "h" "hello" `shouldReturn` ["", "ello"]-        it "splitOnSeq' \"o\" \"hello\" = [\"hell\", \"\"]"-          $ splitOnSeq' "o" "hello" `shouldReturn` ["hell", ""]-        it "splitOnSeq' \"e\" \"hello\" = [\"h\", \"llo\"]"-          $ splitOnSeq' "e" "hello" `shouldReturn` ["h", "llo"]-        it "splitOnSeq' \"l\" \"hello\" = [\"he\", \"\", \"o\"]"-          $ splitOnSeq' "l" "hello" `shouldReturn` ["he", "", "o"]-        it "splitOnSeq' \"ll\" \"hello\" = [\"he\", \"o\"]"-          $ splitOnSeq' "ll" "hello" `shouldReturn` ["he", "o"]+        it "splitOnSeq_ \"hello\" \"\" = [\"\"]"+          $ splitOnSeq_ "hello" "" `shouldReturn` [""]+        it "splitOnSeq_ \"hello\" \"hello\" = [\"\", \"\"]"+          $ splitOnSeq_ "hello" "hello" `shouldReturn` ["", ""]+        it "splitOnSeq_ \"x\" \"hello\" = [\"hello\"]"+          $ splitOnSeq_ "x" "hello" `shouldReturn` ["hello"]+        it "splitOnSeq_ \"h\" \"hello\" = [\"\", \"ello\"]"+          $ splitOnSeq_ "h" "hello" `shouldReturn` ["", "ello"]+        it "splitOnSeq_ \"o\" \"hello\" = [\"hell\", \"\"]"+          $ splitOnSeq_ "o" "hello" `shouldReturn` ["hell", ""]+        it "splitOnSeq_ \"e\" \"hello\" = [\"h\", \"llo\"]"+          $ splitOnSeq_ "e" "hello" `shouldReturn` ["h", "llo"]+        it "splitOnSeq_ \"l\" \"hello\" = [\"he\", \"\", \"o\"]"+          $ splitOnSeq_ "l" "hello" `shouldReturn` ["he", "", "o"]+        it "splitOnSeq_ \"ll\" \"hello\" = [\"he\", \"o\"]"+          $ splitOnSeq_ "ll" "hello" `shouldReturn` ["he", "o"]      where -    splitOnSeq' pat xs =-        S.toList $ IS.splitOnSeq (A.fromList pat) FL.toList (S.fromList xs)+    splitOnSeq_ pat xs = toList $+        splitOnSeq' (A.fromList pat) FL.toList (S.fromList xs)  splitOnSuffixSeq :: Spec splitOnSuffixSeq = do@@ -106,12 +149,11 @@      where -    splitSuffixOn_ pat xs =-        S.toList-             $ IS.splitOnSuffixSeq (A.fromList pat) FL.toList (S.fromList xs)+    splitSuffixOn_ pat xs = toList $+        splitOnSuffixSeq' (A.fromList pat) FL.toList (S.fromList xs)  splitterProperties ::-       forall a. (Arbitrary a, Eq a, Show a, Storable a, Enum a)+       forall a. (Arbitrary a, Eq a, Show a, Unbox a, Enum a)     => a     -> String     -> Spec@@ -178,17 +220,17 @@      where -    splitOnSeq_ xs ys =-        S.toList $ IS.splitOnSeq (A.fromList ys) FL.toList (S.fromList xs)+    splitOnSeq_ xs pat =+        toList $ splitOnSeq' (A.fromList pat) FL.toList (S.fromList xs) -    splitOnSuffixSeq_ xs ys =-        S.toList $ IS.splitOnSuffixSeq (A.fromList ys) FL.toList (S.fromList xs)+    splitOnSuffixSeq_ xs pat =+        toList $ splitOnSuffixSeq' (A.fromList pat) FL.toList (S.fromList xs) -    splitOn_ xs ys =-        S.toList $ IS.splitOn (== (head ys)) FL.toList (S.fromList xs)+    splitOn_ xs pat =+        toList $ splitOn (== (head pat)) FL.toList (S.fromList xs) -    splitOnSuffix_ xs ys =-        S.toList $ IS.splitOnSuffix (== (head ys)) FL.toList (S.fromList xs)+    splitOnSuffix_ xs pat =+        toList $ splitOnSuffix (== (head pat)) FL.toList (S.fromList xs)      intercalateSuffix xs yss = intercalate xs yss ++ xs @@ -220,7 +262,7 @@         testCase xs = do             ys <- splitter xs (replicate i sep)             szs <--                IS.toList+                toList                     $ sIntercalater UF.fromList (replicate i sep)                     $ IS.fromList ys             let lzs = lIntercalater (replicate i sep) ys@@ -242,7 +284,7 @@         testCase xs = do             ys <- splitter xs (replicate i sep)             szs <--                IS.toList+                toList                     $ sIntercalater UF.fromList (replicate i sep)                     $ IS.fromList ys             let lzs = lIntercalater (replicate i sep) ys@@ -264,7 +306,7 @@             let lxs = lIntercalater (replicate i sep) xss             lys <- splitter lxs (replicate i sep)             sxs <--                S.toList+                toList                     $ sIntercalater UF.fromList (replicate i sep)                     $ S.fromList xss             sys <- splitter sxs (replicate i sep)@@ -285,12 +327,27 @@         testCase xss = do             let lxs = lIntercalater [sep] xss             lys <- splitter lxs [sep]-            sxs <- S.toList $ sIntercalater UF.fromList [sep] $ S.fromList xss+            sxs <- toList $ sIntercalater UF.fromList [sep] $ S.fromList xss             sys <- splitter sxs [sep]             listEquals (==) lys xss             listEquals (==) sys xss +intercalateSplitOnId ::+       forall a. (Arbitrary a, Eq a, Show a, Num a) =>+       a -> String -> Spec+intercalateSplitOnId x desc =+    prop (desc <> " intercalate [x] . splitOn (== x) == id") $+        forAll listWithZeroes $ \xs -> do+            withMaxSuccess maxTestCount $+                monadicIO $ do+                    ys <- toList $ splitOn (== x) toListFL (S.fromList xs)+                    listEquals (==) (intercalate [x] ys) xs +    where++    listWithZeroes :: Gen [a]+    listWithZeroes = listOf $ frequency [(3, arbitrary), (1, elements [0])]+ groupSplitOps :: String -> Spec groupSplitOps desc = do     -- splitting@@ -299,33 +356,22 @@      -- splitting properties     splitterProperties (0 :: Int) desc-    -- XXX This will fail-    -- splitterProperties (0 :: Word8) desc--    prop (desc <> " intercalate [x] . splitOn (== x) == id") $-        forAll listWithZeroes $ \xs -> do-            withMaxSuccess maxTestCount $-                monadicIO $ do-                    ys <- S.toList $ S.splitOn (== 0) toListFL (S.fromList xs)-                    listEquals (==) (intercalate [0] ys) xs--    where--    listWithZeroes :: Gen [Int]-    listWithZeroes = listOf $ frequency [(3, arbitrary), (1, elements [0])]+    splitterProperties (0 :: Word8) desc+    intercalateSplitOnId (0 :: Int) desc+    intercalateSplitOnId (0 :: Word8) desc  -- |--- After grouping (and folding) Int stream using @>@ operation,+-- After grouping (and folding) Int stream using @<@ operation, -- the first @Int@ of every @[Int]@ in the @[Int]@ stream should be the minimum. testGroupsBy :: Property testGroupsBy =     forAll (choose (0, maxStreamLen)) $ \len ->         forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do-            r <- run $ S.all (\ls ->+            r <- run $ S.fold (FL.all (\ls ->                 case ls of                     [] -> True-                    (x:_) -> x == minimum ls)-                $ S.groupsBy (>) FL.toList+                    (x:_) -> x == minimum ls))+                $ groupsBy (<) FL.toList                 $ S.fromList vec             assert r @@ -333,14 +379,14 @@ testGroups =     forAll (choose (0, maxStreamLen)) $ \len ->         forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do-            r <- run $ S.toList $ S.groups FL.toList $ S.fromList vec+            r <- toList $ groupsBy (==) FL.toList $ S.fromList vec             assert $ r == group vec  testGroupsByRolling :: Property testGroupsByRolling =     forAll (choose (0, maxStreamLen)) $ \len ->         forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do-            r <- run $ S.toList $ S.groupsByRolling (==) FL.toList $ S.fromList vec+            r <- toList $ groupsByRolling (==) FL.toList $ S.fromList vec             assert $ r == group vec  -- |@@ -357,7 +403,7 @@ decreasing xs = all (== True) $ zipWith (<=) (tail xs) xs  -- |--- To check if the minimum elements (after grouping on @>@)+-- To check if the minimum elements (after grouping on @<@) -- are non-increasing (either decrease or remain the same). -- Had an element been strictly greater, it would have been grouped -- with that element only.@@ -365,10 +411,10 @@ testGroupsBySep =     forAll (choose (0, maxStreamLen)) $ \len ->         forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do-            a <- run $ S.toList-                $ S.map maybeMinimum-                $ S.groupsBy (>) FL.toList-                $ S.fromList vec+            a <- toList+                    $ fmap maybeMinimum+                    $ groupsBy (<) FL.toList+                    $ S.fromList vec             assert $ decreasing a  groupingOps :: Spec@@ -387,12 +433,12 @@     assocCheckProp :: [Int] -> [Int] -> [Int] -> Property     assocCheckProp xs ys zs =         monadicIO $ do-            let xStream = S.fromList xs-                yStream = S.fromList ys-                zStream = S.fromList zs+            let xStream = SP.fromList xs+                yStream = SP.fromList ys+                zStream = SP.fromList zs             infixAssocstream <--                run $ S.toList $ t $ xStream `serial` yStream `serial` zStream-            assocStream <- run $ S.toList $ t $ xStream <> yStream <> zStream+                run $ SP.toList $ t $ xStream `serial` yStream `serial` zStream+            assocStream <- run $ SP.toList $ t $ xStream <> yStream <> zStream             listEquals (==) infixAssocstream assocStream  max_length :: Int@@ -431,7 +477,7 @@ testTakeInterval = do     r <-           S.fold (FL.tee FL.head FL.last)-        $ IS.takeInterval takeDropTime+        $ S.takeInterval (fromIntegral takeDropTime * 10**(-9))         $ S.repeatM (threadDelay 1000 >> getTime Monotonic)     checkTakeDropTime r @@ -439,8 +485,8 @@ testDropInterval = do     t0 <- getTime Monotonic     mt1 <--          S.head-        $ IS.dropInterval takeDropTime+          S.fold FL.head+        $ S.dropInterval (fromIntegral takeDropTime * 10**(-9))         $ S.repeatM (threadDelay 1000 >> getTime Monotonic)     checkTakeDropTime (Just t0, mt1) #endif@@ -449,24 +495,19 @@ unfold = monadicIO $ do     a <- pick $ choose (0, max_length `div` 2)     b <- pick $ choose (0, max_length)-    let unf = UF.supplySecond b UF.enumerateFromToIntegral-    ls <- S.toList $ S.unfold unf a-    return $ ls == [a..b]--unfold0 :: Property-unfold0 = monadicIO $ do-    a <- pick $ choose (0, max_length `div` 2)-    b <- pick $ choose (0, max_length)-    let unf = UF.supply a (UF.supplySecond b UF.enumerateFromToIntegral)-    ls <- S.toList $ IS.unfold0 unf+    let unf = UF.second b UF.enumerateFromToIntegral+    ls <- toList $ S.unfold unf a     return $ ls == [a..b]  testFromCallback :: IO Int testFromCallback = do     ref <- newIORef Nothing-    let stream = S.map Just (IS.fromCallback (setCallback ref))-                    `S.parallel` runCallback ref-    S.sum $ S.map fromJust $ S.takeWhile isJust stream+    let stream =+            S.parList (S.eager True)+                [ fmap Just (S.fromCallback (setCallback ref))+                , runCallback ref+                ]+    S.fold FL.sum $ fmap fromJust $ S.takeWhile isJust stream      where @@ -478,11 +519,11 @@               S.repeatM (readIORef ref)                 & IS.delayPost 0.1                 & S.mapMaybe id-                & S.head+                & S.fold FL.head          S.fromList [1..100]             & IS.delayPost 0.001-            & S.mapM_ (fromJust cb)+            & drainMapM (fromJust cb)         threadDelay 100000         return Nothing @@ -492,12 +533,12 @@         let s1 = Prelude.sum lst             strm = S.fromList lst         ms2 <--            S.last-                $ S.map getSum+            S.fold FL.last+                $ fmap getSum                 $ IS.foldIterateM                       (return . FL.take 1 . FL.sconcat)                       (return (Sum 0))-                $ S.map Sum strm+                $ fmap Sum strm         case ms2 of             Nothing -> assert $ s1 == 0             Just s2 -> assert $ s1 == s2@@ -505,7 +546,7 @@ sortBy :: Property sortBy = forAll (listOf (chooseInt (0, max_length))) $ \lst -> monadicIO $ do         let s1 = sort lst-        s2 <- run $ S.toList $ IS.sortBy compare $ S.fromList lst+        s2 <- toList $ K.toStream (K.sortBy compare $ K.fromStream $ S.fromList lst)         assert $ s1 == s2  moduleName :: String@@ -525,14 +566,16 @@             <> [("maxBuffer -1", fromSerial . maxBuffer (-1))] #endif     let toListSerial :: SerialT IO a -> IO [a]-        toListSerial = S.toList . fromSerial+        toListSerial = SP.toList      describe "Runners" $ do         -- XXX use an IORef to store and check the side effects         it "simple serially" $-            (S.drain . fromSerial) (return (0 :: Int)) `shouldReturn` ()+            (SP.fold FL.drain . fromSerial)+            (return (0 :: Int)) `shouldReturn` ()         it "simple serially with IO" $-            (S.drain . fromSerial) (S.fromEffect $ putStrLn "hello") `shouldReturn` ()+            (S.fold FL.drain)+            (S.fromEffect $ putStrLn "hello") `shouldReturn` ()      describe "Empty" $         it "Monoid - mempty" $@@ -550,10 +593,8 @@         serialOps   $ prop "serially replicateM" . constructWithReplicateM         serialOps   $ prop "serially intFromThenTo" .                             constructWithIntFromThenTo-#if __GLASGOW_HASKELL__ >= 806         serialOps   $ prop "serially DoubleFromThenTo" .                             constructWithDoubleFromThenTo-#endif         serialOps   $ prop "serially iterate" . constructWithIterate         -- XXX test for all types of streams         serialOps   $ prop "serially iterateM" . constructWithIterateM@@ -566,19 +607,16 @@         serialOps $ prop "serially unfoldr" . constructWithUnfoldr id         serialOps $ prop "serially fromPure" . constructWithFromPure id         serialOps $ prop "serially fromEffect" . constructWithFromEffect id-        serialOps $ prop "serially cons" . constructWithCons S.cons-        serialOps $ prop "serially consM" . constructWithConsM S.consM id-        serialOps $ prop "serially (.:)" . constructWithCons (S..:)-        serialOps $ prop "serially (|:)" . constructWithConsM (S.|:) id+        serialOps $ prop "serially cons" . constructWithCons SP.cons+        serialOps $ prop "serially consM" . constructWithConsM SP.consM id          describe "From Generators" $ do             prop "unfold" unfold-            prop "unfold0" unfold0      describe "Simple Operations" $ serialOps simpleOps      describe "Functor operations" $ do-        serialOps    $ functorOps S.fromFoldable "serially" (==)+        serialOps    $ functorOps (SP.fromFoldable) "serially" (==)         serialOps    $ functorOps folded "serially folded" (==)      describe "Monoid operations" $ do@@ -607,17 +645,17 @@         -- The tests using sorted equality are weaker tests         -- We need to have stronger unit tests for all those         -- XXX applicative with three arguments-        serialOps $ applicativeOps S.fromFoldable "serially" (==)+        serialOps $ applicativeOps (SP.fromFoldable) "serially" (==)         serialOps $ applicativeOps folded "serially folded" (==)-        serialOps $ applicativeOps1 S.fromFoldable "serially" (==)-        serialOps $ applicativeOps1 S.fromFoldable "serially folded" (==)+        serialOps $ applicativeOps1 (SP.fromFoldable) "serially" (==)+        serialOps $ applicativeOps1 (SP.fromFoldable) "serially folded" (==)      -- XXX add tests for indexed/indexedR     describe "Zip operations" $ do         -- We test only the serial zip with serial streams and the parallel         -- stream, because the rate setting in these streams can slow down         -- zipAsync.-        serialOps   $ prop "zip monadic serially" . zipMonadic S.fromFoldable (==)+        serialOps   $ prop "zip monadic serially" . zipMonadic (SP.fromFoldable) (==)         serialOps   $ prop "zip monadic serially folded" . zipMonadic folded (==)      -- XXX add merge tests like zip tests@@ -626,15 +664,15 @@     -- describe "Merge operations" $ do      describe "Monad operations" $ do-        serialOps   $ prop "serially monad then" . monadThen S.fromFoldable (==)+        serialOps   $ prop "serially monad then" . monadThen (SP.fromFoldable) (==)         serialOps   $ prop "serially monad then folded" . monadThen folded (==)-        serialOps   $ prop "serially monad bind" . monadBind S.fromFoldable (==)+        serialOps   $ prop "serially monad bind" . monadBind (SP.fromFoldable) (==)         serialOps   $ prop "serially monad bind folded"  . monadBind folded (==)      describe "Stream transform and combine operations" $ do-        serialOps    $ transformCombineOpsCommon S.fromFoldable "serially" (==)+        serialOps    $ transformCombineOpsCommon (SP.fromFoldable) "serially" (==)         serialOps    $ transformCombineOpsCommon folded "serially" (==)-        serialOps    $ transformCombineOpsOrdered S.fromFoldable "serially" (==)+        serialOps    $ transformCombineOpsOrdered (SP.fromFoldable) "serially" (==)         serialOps    $ transformCombineOpsOrdered folded "serially" (==)  #ifdef DEVBUILD@@ -646,19 +684,19 @@     -- Just some basic sanity tests for now     let input = [[1,1] :: [Int],[2,2],[3,3],[4,4],[5,5],[6,6],[7,7],[8,8]]         mustBe g inp out =-            S.toList (IS.concatPairsWith g S.fromList (S.fromList inp))+            toList (K.toStream (K.mergeMapWith g K.fromList (K.fromList inp)))                 `shouldReturn` out      in do         it "concatPairsWith serial"-            $ mustBe S.serial input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+            $ mustBe K.append input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]         it "concatPairsWith wSerial"-            $ mustBe S.wSerial input [1,5,3,7,2,6,4,8,1,5,3,7,2,6,4,8]+            $ mustBe K.interleave input [1,5,3,7,2,6,4,8,1,5,3,7,2,6,4,8]         it "concatPairsWith mergeBy sorted"             $ mustBe-                (S.mergeBy compare) input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+                (K.mergeBy compare) input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]         it "concatPairsWith mergeBy reversed"             $ mustBe-                (S.mergeBy compare)+                (K.mergeBy compare)                 (reverse input)                 [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]         prop "sortBy" sortBy@@ -667,9 +705,9 @@         groupSplitOps "serially"      describe "Stream elimination operations" $ do-        serialOps    $ eliminationOps S.fromFoldable "serially"+        serialOps    $ eliminationOps (SP.fromFoldable) "serially"         serialOps    $ eliminationOps folded "serially folded"-        serialOps    $ eliminationOpsWord8 S.fromFoldable "serially"+        serialOps    $ eliminationOpsWord8 (SP.fromFoldable) "serially"         serialOps    $ eliminationOpsWord8 folded "serially folded"         serialOps $ \t ->             prop "drainWhile (> 0)" $ \n ->@@ -678,16 +716,16 @@                     let xs = [1..n]                     ioRef <- run $ newIORef ([] :: [Int])                     run $-                        S.drainWhile (> 0) . t $-                        S.mapM (\a -> modifyIORef' ioRef (a :) >> return a) $-                        S.fromList xs+                        drainWhile (> 0) . t $+                            SP.mapM (\a -> modifyIORef' ioRef (a :) >> return a) $+                                SP.fromList xs                     strm <- run $ readIORef ioRef                     listEquals (==) (reverse strm) (takeWhile (> 0) xs)      -- XXX Add a test where we chain all transformation APIs and make sure that     -- the state is being passed through all of them.     describe "Stream serial elimination operations" $ do-        serialOps    $ eliminationOpsOrdered S.fromFoldable "serially"+        serialOps    $ eliminationOpsOrdered (SP.fromFoldable) "serially"         serialOps    $ eliminationOpsOrdered folded "serially folded"      describe "Tests for S.groupsBy" groupingOps
test/Streamly/Test/Prelude/Top.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ module Main (main) where  import Data.List (elem, intersect, nub, sort)@@ -12,7 +14,7 @@     ) import Test.QuickCheck.Monadic (monadicIO, assert, run) import qualified Streamly.Prelude as S-import qualified Streamly.Internal.Data.Stream.IsStream.Top as Top+import qualified Streamly.Internal.Data.Stream.IsStream as Top  import Prelude hiding     (maximum, minimum, elem, notElem, null, product, sum, head, last, take)@@ -85,7 +87,6 @@         v4 = filter (\(_, a2, _) -> isNothing a2)  v3     in v2 ++ v4 --- XXX A bug need to be fixed in joinOuter function {- joinOuter :: Property joinOuter =@@ -105,6 +106,7 @@                 assert (sort v1 == sort v3) -} + joinOuterMap :: Property joinOuterMap =     forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->@@ -133,6 +135,7 @@             else return (fst i, fst i, Nothing)     in v +{- joinLeft :: Property joinLeft =     forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->@@ -150,6 +153,7 @@                 let v2 = joinLeftList (map (\a -> (a,a)) ls0) (map (\a -> (a,a)) ls1)                     v3 = map (\ (_, x1, x2) -> (x1, x2)) v2                 assert (v1 == v3)+-}  joinLeftMap :: Property joinLeftMap =@@ -178,10 +182,10 @@        )     -> (Int -> Int -> a)     -> Property-intersectBy _srt intersectFunc cmp =+intersectBy srt intersectFunc cmp =     forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->         forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 ->-            monadicIO $ action (sort ls0) (sort ls1)+            monadicIO $ action (srt ls0) (srt ls1)              where @@ -194,7 +198,7 @@                         (S.fromList ls0)                         (S.fromList ls1)                 let v2 = ls0 `intersect` ls1-                assert (v1 == sort v2)+                assert (sort v1 == sort v2)  ------------------------------------------------------------------------------- -- Main@@ -209,13 +213,12 @@         -- Joins         prop "joinInner" Main.joinInner         prop "joinInnerMap" Main.joinInnerMap-        -- XXX currently API is broken https://github.com/composewell/streamly/issues/1032-        --prop "joinOuter" Main.joinOuter+        -- prop "joinOuter" Main.joinOuter         prop "joinOuterMap" Main.joinOuterMap-        prop "joinLeft" Main.joinLeft+        -- prop "joinLeft" Main.joinLeft         prop "joinLeftMap" Main.joinLeftMap         -- intersect-        -- XXX currently API is broken https://github.com/composewell/streamly/issues/1471-        --prop "intersectBy" (intersectBy id Top.intersectBy (==))+        prop "intersectBy"+            (intersectBy id Top.intersectBy (==))         prop "intersectBySorted"             (intersectBy sort Top.intersectBySorted compare)
test/Streamly/Test/Prelude/WAsync.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.WAsync -- Copyright   : (c) 2020 Composewell Technologies@@ -13,9 +15,6 @@ import Control.Concurrent ( threadDelay ) #endif import Data.List (sort)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup ((<>))-#endif import Test.Hspec.QuickCheck import Test.QuickCheck (Property, withMaxSuccess) import Test.QuickCheck.Monadic (monadicIO, run)@@ -146,7 +145,7 @@      describe "Stream transform and combine operations" $ do         wAsyncOps $ transformCombineOpsCommon S.fromFoldable "wAsyncly" sortEq-        wAsyncOps $ transformCombineOpsCommon folded "wAsyncly" sortEq+        wAsyncOps $ transformCombineOpsCommon folded "wAsyncly folded" sortEq      describe "Stream elimination operations" $ do         wAsyncOps $ eliminationOps S.fromFoldable "wAsyncly"
test/Streamly/Test/Prelude/WSerial.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.WSerial -- Copyright   : (c) 2020 Composewell Technologies@@ -10,9 +12,6 @@ module Streamly.Test.Prelude.WSerial (main) where  import Data.List (sort)-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup ((<>))-#endif import Test.QuickCheck (Property, forAll) import Test.Hspec.QuickCheck import Test.QuickCheck.Monadic (monadicIO, run)
test/Streamly/Test/Prelude/ZipAsync.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.ZipAsync -- Copyright   : (c) 2020 Composewell Technologies
test/Streamly/Test/Prelude/ZipSerial.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.Prelude.ZipSerial -- Copyright   : (c) 2020 Composewell Technologies@@ -9,9 +11,6 @@  module Streamly.Test.Prelude.ZipSerial (main) where -#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup ((<>))-#endif import Test.Hspec.QuickCheck import Test.Hspec as H
+ test/Streamly/Test/Serialize/Serializable.hs view
@@ -0,0 +1,237 @@+module Main (main) where++import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Int (Int8, Int16, Int32, Int64)+import Test.QuickCheck+    ( Gen+    , Property+    , choose+    , forAll+    )+import Test.QuickCheck.Monadic (monadicIO)++import qualified Streamly.Internal.Data.Binary.Parser as Decoder+import qualified Streamly.Internal.Data.Binary.Stream as Encoder+import qualified Streamly.Data.Stream as Stream+import Streamly.Internal.Data.Parser (Parser)++import Prelude hiding+    (maximum, minimum, elem, notElem, null, product, sum, head, last, take)+import Test.Hspec as H+import Test.Hspec.QuickCheck+import GHC.Base (unsafeChr)++word16Max :: Word16+word16Max = maxBound++word32Max :: Word32+word32Max = maxBound++word64Max :: Word64+word64Max = maxBound++chooseWord8 :: (Word8, Word8) -> Gen Word8+chooseWord8 = choose++chooseWord16 :: (Word16, Word16) -> Gen Word16+chooseWord16 = choose++chooseWord32 :: (Word32, Word32) -> Gen Word32+chooseWord32 = choose++chooseWord64 :: (Word64, Word64) -> Gen Word64+chooseWord64 = choose++chooseInt8 :: (Int8, Int8) -> Gen Int8+chooseInt8 = choose++chooseInt16 :: (Int16, Int16) -> Gen Int16+chooseInt16 = choose++chooseInt32 :: (Int32, Int32) -> Gen Int32+chooseInt32 = choose++chooseInt64 :: (Int64, Int64) -> Gen Int64+chooseInt64 = choose++chooseFloat :: (Float, Float) -> Gen Float+chooseFloat = choose++chooseDouble :: (Double, Double) -> Gen Double+chooseDouble = choose++chooseChar :: (Char, Char) -> Gen Char+chooseChar = choose++action :: (Monad m, Eq a) =>+       a+    -> (a -> Stream.Stream m Word8)+    -> Parser Word8 m a+    -> m Bool+action x enc dec = do+    let str = enc x+    v1 <- Stream.parse dec str+    return $+        case v1 of+            Right v -> x == v+            Left _ -> False++unit :: Property+unit = monadicIO $+    do+    let str = Encoder.unit+    v1 <- Stream.parse Decoder.unit str+    return $+        case v1 of+            Right v -> v == ()+            Left _ -> False++bool :: Property+bool =+    forAll (chooseWord8 (0, 1)) $ \case+        0 -> monadicIO $ action False Encoder.bool Decoder.bool+        _ -> monadicIO $ action True Encoder.bool Decoder.bool++ordering :: Property+ordering =+    forAll (chooseWord8 (0, 2)) $ \case+        0 -> monadicIO $ action LT Encoder.ordering Decoder.ordering+        1 -> monadicIO $ action EQ Encoder.ordering Decoder.ordering+        _ -> monadicIO $ action GT Encoder.ordering Decoder.ordering++word8 :: Property+word8 =+    forAll (chooseWord8 (0, 255)) $ \x ->+        monadicIO $ action x Encoder.word8  Decoder.word8++word16be :: Property+word16be =+    forAll (chooseWord16 (0, word16Max)) $ \x ->+        monadicIO $ action x Encoder.word16be Decoder.word16be++word32be :: Property+word32be =+    forAll (chooseWord32 (0, word32Max)) $ \x ->+        monadicIO $ action x Encoder.word32be Decoder.word32be++word64be :: Property+word64be =+    forAll (chooseWord64 (0, word64Max)) $ \x ->+        monadicIO $ action x  Encoder.word64be Decoder.word64be++word16le :: Property+word16le =+    forAll (chooseWord16 (0, word16Max)) $ \x ->+        monadicIO $ action x Encoder.word16le Decoder.word16le++word32le :: Property+word32le =+    forAll (chooseWord32 (0, word32Max)) $ \x ->+        monadicIO $ action x Encoder.word32le Decoder.word32le++word64le :: Property+word64le =+    forAll (chooseWord64 (0, word64Max)) $ \x ->+        monadicIO $ action x  Encoder.word64le Decoder.word64le++int8 :: Property+int8 =+    forAll (chooseInt8 (-128, 127)) $ \x ->+        monadicIO $ action x Encoder.int8  Decoder.int8++int16be :: Property+int16be =+    forAll (chooseInt16 (-32768, 32767)) $ \x ->+        monadicIO $ action x Encoder.int16be Decoder.int16be++int32be :: Property+int32be =+    forAll (chooseInt32 (-2147483648, 2147483647)) $ \x ->+        monadicIO $ action x Encoder.int32be Decoder.int32be++int64be :: Property+int64be =+    forAll (chooseInt64 (-9223372036854775808, 9223372036854775807)) $ \x ->+        monadicIO $ action x  Encoder.int64be Decoder.int64be++int16le :: Property+int16le =+    forAll (chooseInt16 (-32768, 32767)) $ \x ->+        monadicIO $ action x Encoder.int16le Decoder.int16le++int32le :: Property+int32le =+    forAll (chooseInt32 (-2147483648, 2147483647)) $ \x ->+        monadicIO $ action x Encoder.int32le Decoder.int32le++int64le :: Property+int64le =+    forAll (chooseInt64 (-9223372036854775808, 9223372036854775807)) $ \x ->+        monadicIO $ action x  Encoder.int64le Decoder.int64le++float32be :: Property+float32be =+    forAll (chooseFloat (-3.40282e+38, 3.40282e+38)) $ \x ->+        monadicIO $ action x Encoder.float32be  Decoder.float32be++float32le :: Property+float32le =+    forAll (chooseFloat (-3.40282e+38, 3.40282e+38)) $ \x ->+        monadicIO $ action x Encoder.float32le  Decoder.float32le++double64be :: Property+double64be =+    forAll (chooseDouble (-1.79769e+308, 1.79769e+308)) $ \x ->+        monadicIO $ action x Encoder.double64be  Decoder.double64be++double64le :: Property+double64le =+    forAll (chooseDouble (-1.79769e+308, 1.79769e+308)) $ \x ->+        monadicIO $ action x Encoder.double64le  Decoder.double64le++charLatin1 :: Property+charLatin1 = forAll (chooseChar (unsafeChr 0, unsafeChr 255)) $ \x ->+        monadicIO $ action x Encoder.charLatin1  Decoder.charLatin1++moduleName :: String+moduleName = "Serialize.Serializable"++main :: IO ()+main =+    hspec $ do+    describe moduleName $ do+        -- Unit+        prop "unit" Main.unit++        -- Bool+        prop "bool" Main.bool++        -- Ordering+        prop "ordering" Main.ordering++        -- Words+        prop "word8" Main.word8+        prop "word16be" Main.word16be+        prop "word32be" Main.word32be+        prop "word64be" Main.word64be+        prop "word16le" Main.word16le+        prop "word32le" Main.word32le+        prop "word64le" Main.word64le++        -- Integral+        prop "int8" Main.int8+        prop "int16be" Main.int16be+        prop "int32be" Main.int32be+        prop "int64be" Main.int64be+        prop "int16le" Main.int16le+        prop "int32le" Main.int32le+        prop "int64le" Main.int64le++        -- Fractional+        prop "float32be" Main.float32be+        prop "float32le" Main.float32le+        prop "double64be" Main.double64be+        prop "double64le" Main.double64le++        -- Char+        prop "charLatin1" Main.charLatin1
test/Streamly/Test/Unicode/Char.hs view
@@ -16,39 +16,34 @@ import Control.Monad (when) import Data.Char (chr, isSpace, ord, toUpper) import Data.List (intercalate, isPrefixOf)-#if MIN_VERSION_base(4,8,0) import Data.Function ((&))-#endif import Streamly.Internal.Unicode.Char     ( NormalizationMode(NFC, NFD, NFKC, NFKD)     , normalize     )-import Streamly.Internal.Data.Stream.IsStream (SerialT)+import Streamly.Internal.Data.Stream (Stream) import Text.Printf (printf) import System.FilePath.Posix ((</>)) -import qualified Streamly.Internal.Data.Stream.IsStream as S+import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Fold as FL import qualified System.Directory as Dir -#if !MIN_VERSION_base(4,8,0)-(&) :: a -> (a -> b) -> b-x & f = f x-#endif- chrToHex :: Char -> [Char] chrToHex = map toUpper . printf "%.4x" . ord  strToHex :: [Char] -> String strToHex = unwords . map chrToHex -type Text = SerialT IO Char+type Text = Stream IO Char +toList = S.fold FL.toList+ checkEqual :: String -> (Text -> Text) -> (Text, Text) -> IO Bool checkEqual opName op (mc1, mc2) = do-    c1 <- S.toList mc1-    c2 <- S.toList mc2-    opc2 <- S.toList $ op mc2+    c1 <- toList mc1+    c2 <- toList mc2+    opc2 <- toList $ op mc2     if c1 /= opc2 then do         putStrLn $ opName ++ " "            ++ strToHex c2                           ++ " = "          ++ strToHex opc2@@ -59,7 +54,7 @@ checkOp :: String -> NormalizationMode -> [(Text, Text)] -> IO Bool checkOp name op pairs = do     res <- mapM (checkEqual name (normalize op)) pairs-    return $ all (== True) res+    return $ and res  checkNFC :: (Text, Text, Text, Text, Text) -> IO Bool checkNFC (c1, c2, c3, c4, c5) =@@ -77,9 +72,11 @@ checkNFKD (c1, c2, c3, c4, c5) =     checkOp "toNFKD" NFKD $ map (c5,) [c1, c2, c3, c4, c5] +splitOn predicate f = S.foldMany1 (FL.takeEndBy_ predicate f)+ checkAllTestCases :: Int -> String -> IO () checkAllTestCases lineno line = do-    cs <- S.toList $ S.splitOn (== ';') FL.toList $ S.fromList line+    cs <- toList $ splitOn (== ';') FL.toList $ S.fromList line     case cs of         c1 : c2 : c3 : c4 : c5 : _ -> do             let cps = map cpToText [c1, c2, c3, c4, c5]@@ -92,7 +89,7 @@         checkOneTestCase cps f = do             res <- f (tuplify cps)             when (not res) $ do-                strs <- mapM S.toList cps+                strs <- mapM toList cps                 let codes = intercalate ";" $ map strToHex strs                     txt = intercalate "; " strs                 putStrLn ("Failed at line: " ++ show lineno)
+ test/Streamly/Test/Unicode/Parser.hs view
@@ -0,0 +1,231 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++module Streamly.Test.Unicode.Parser+    (main)+where++import Control.Monad.Identity (Identity(runIdentity))+import Debug.Trace (trace)+import Streamly.Internal.Data.Parser (ParseError (..), Parser)+import Streamly.Test.Common (chooseDouble)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck+       (forAll, Property, property)+import Test.QuickCheck.Monadic (monadicIO, assert, run)++import qualified Data.Scientific as Scientific+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Unicode.Parser as Unicode+import qualified Streamly.Internal.Unicode.Parser as Parser+import qualified Test.Hspec as H++-- Scientific notation+scientificExpFP :: Property+scientificExpFP =+    forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls ->+        case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of+                Right val -> val `H.shouldBe` read (show ls)+                Left _ -> error "Parsing failed."++        where++        toScientific (c, m) = Scientific.scientific c m+        parser = toScientific <$> Parser.number++-- Standard decimal notation.+scientificFixFP :: Property+scientificFixFP =+    forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->+        case runIdentity $ Stream.parse parser (Stream.fromList (show ls)) of+                Right val -> val `H.shouldBe` read (show ls)+                Left _ -> error "Parsing failed."++        where++        toScientific (c, m) = Scientific.scientific c m+        parser = toScientific <$> Parser.number++doubleExpFP :: Property+doubleExpFP =+    forAll (chooseDouble (-99.99e-12, 1234.4567e+234)) $ \ls -> do+        let sls = show ls+        case runIdentity $ Stream.parse Parser.double (Stream.fromList sls) of+                Right val -> if val == ls+                             then property (val == ls)+                             else trace+                                    ("Read = "++ show (read sls :: Double) ++ " Expected = " ++ sls ++ " Got = " ++ show val)+                                    property (val == ls)+                Left _ -> property False++-- Standard decimal notation.+doubleFixFP :: Property+doubleFixFP =+    forAll (chooseDouble (-0.00099, 123445.67998)) $ \ls ->+        case runIdentity $ Stream.parse Parser.double (Stream.fromList (show ls)) of+                Right val -> if val == ls+                            then property (val == ls)+                            else trace+                                    ("Expected = " ++ show ls ++ " Got = " ++ show val)+                                    property (val == ls)+                Left _ -> property False++doubleParser :: String -> IO (Either ParseError Double)+doubleParser = Stream.parse Unicode.double . Stream.fromList++double :: String -> Double -> Property+double s d = monadicIO $ do+    x <- run $ doubleParser s+    case x of+        Right val -> if val == d+                     then assert (val == d)+                     else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d))+        Left (ParseError _) -> assert False++numberP :: Monad m => Parser Char m Double+numberP = uncurry Parser.mkDouble <$> Parser.number++numberParser :: String -> IO (Either ParseError Double)+numberParser = Stream.parse numberP . Stream.fromList++number :: String -> Double -> Property+number s d = monadicIO $ do+    x <- run $ numberParser s+    case x of+        Right val -> if val == d+                     then assert (val == d)+                     else trace ("Expected = " ++ show d ++ " Got = "++ show val) (assert (val == d))+        Left (ParseError _) -> assert False++doubleErr :: (String -> IO (Either ParseError Double)) -> String -> String -> Property+doubleErr f s msg = monadicIO $ do+    x <- run $ f s+    case x of+        Right _ -> assert False+        Left (ParseError err) ->+            if err == msg+            then assert (err == msg)+            else trace err (assert (err == msg))++remainingStreamDouble :: String -> [String]+remainingStreamDouble x =+    let f = Stream.parseBreak Unicode.double . Stream.fromList+        in concatMap (Stream.toList . snd) (f x)++remainingStreamNumber :: String -> [String]+remainingStreamNumber x =+    let f = Stream.parseBreak numberP . Stream.fromList+        in concatMap (Stream.toList . snd) (f x)++afterParse :: (String -> [String]) -> String -> String -> Property+afterParse f si so = monadicIO $ do+    let x = f si+        in assert (x == [so])++testParser :: String -> (String -> Double -> Property) -> H.SpecWith ()+testParser desc f = do+   -- XXX We can combine the parser tests and remaining stream tests in the+   -- same test.+    H.describe ("Unicode Parser " ++ desc) $ do+        prop "double \"00.00\"" $ f "00.00" 0.0+        prop "double \"00.00e00\"" $ f "00.00e00" 0.0+        prop "double \"4\" 4.0" $ f "4" 4.0+        prop "double \"00.3\" 0.3" $ f "00.3" 0.3+        prop "double \"0.003\" 3.0e-3" $ f "0.003" 3.0e-3+        prop "double \"44.56.67\" 44.56" $ f "44.56.67" 44.56+        prop "double \"0.0.00\" 0.0" $ f "0.0.00" 0.0+        prop "double \"44.56-78\" 44.56" $ f "44.56-78" 44.56+        prop "double \"44-\" 44.0" $ f "44-" 44.0+        prop "double \"44-56\" 44.0" $ f "44-56" 44.0+        prop "double \"44+\" 44.0" $ f "44+" 44.0+        prop "double \"44+56\" 44.0" $ f "44+56" 44.0+        prop "double \"44u\" 44.0" $ f "44u" 44.0+        prop "double \"+123.345\" 123.345" $ f "+123.345" 123.345+        prop "double \"-123.345\" (-123.345)" $ f "-123.345" (-123.345)+        prop "double \"1e\"" $ f "1e" 1.0+        prop "double \"1e+\"" $ f "1e+" 1.0+        prop "double \"1ex\"" $ f "1ex" 1.0+        prop "double \"1e+x\"" $ f "1e+x" 1.0+        prop "double \"1e+0\"" $ f "1e+0" 1.0+        prop "double \"1e-0\"" $ f "1e-0" 1.0+        prop "double \"1.0e-1\"" $ f "1.0e-1" 0.1+        prop "double \"1.0e+1\"" $ f "1.0e+1" 10.0+        prop "double \"1.0e1\"" $ f "1.0e1" 10.0+        prop "double \"1.0e+309\"" $ f "1.0e+309" 1.0e309+        prop "double \"1.0e-309\"" $ f "1.0e-309" 1.0e-309+        prop "double \"1.0e1.\"" $ f "1.0e1." 10.0+        prop "double \"1.0e1+\"" $ f "1.0e1+" 10.0+        prop "double \"1.0e1-\"" $ f "1.0e1-" 10.0+        prop "double \"1.0e1e\"" $ f "1.0e1e" 10.0+        prop "double \"1.0E+1\"" $ f "1.0E+1" 10.0+        prop "double \"9223372036854775806\"" $ f "9223372036854775806" 9.223372036854776e18+        -- maxBound :: Int+        prop "double \"9223372036854775807\"" $ f "9223372036854775807" 9.223372036854776e18+        prop "double \"9223372036854775808\"" $ f "9223372036854775808" 9.223372036854776e18++testParseErr :: String -> (String -> IO (Either ParseError Double)) -> H.SpecWith ()+testParseErr desc f = do+    H.describe ("Unicode Parser Error " ++ desc) $ do+        prop "double \"\" Error"+            $ doubleErr f "" "number: expecting sign or decimal digit, got end of input"+        prop "double \"a\" Error"+            $ doubleErr f "a" "number: expecting sign or decimal digit, got 'a'"+        prop "double \".4\" Error"+            $ doubleErr f ".4" "number: expecting sign or decimal digit, got '.'"+        prop "double \".\" Error"+            $ doubleErr f "." "number: expecting sign or decimal digit, got '.'"+        prop "double \"..\" Error"+            $ doubleErr f ".." "number: expecting sign or decimal digit, got '.'"+        prop "double \"-\" Error"+            $ doubleErr f "-" "number: expecting decimal digit, got end of input"+        prop "double \"+\" Error"+            $ doubleErr f "+" "number: expecting decimal digit, got end of input"+        prop "double \"++\" Error"+            $ doubleErr f "++" "number: expecting decimal digit, got '+'"++testLeftOver :: String -> (String -> [String]) -> H.SpecWith ()+testLeftOver desc f = do+    H.describe ("Unicode Parser leftover " ++ desc) $ do+        prop "afterParse \"4.\" \".\"" $ afterParse f "4." "."+        prop "afterParse \"4..\" \"..\"" $ afterParse f "4.." ".."+        prop "afterParse \"4-\" \"-\"" $ afterParse f "4-" "-"+        prop "afterParse \"4--\" \"--\"" $ afterParse f "4--" "--"+        prop "afterParse \"4.9abc\" \"abc\"" $ afterParse f "4.9abc" "abc"+        prop "afterParse \"4.9ex\"" $ afterParse f "4.9ex" "ex"+        prop "afterParse \"4.9e+x\"" $ afterParse f "4.9e+x" "e+x"+        prop "afterParse \"4.9\" \"\"" $ afterParse f "4.9" ""+        prop "afterParse \"+4.9\" \"\"" $ afterParse f "+4.9" ""+        prop "afterParse \"-4.9\" \"\"" $ afterParse f "-4.9" ""+        prop "afterParse \"4.9.\" \".\"" $ afterParse f "4.9." "."+        prop "afterParse \"4.9..\" \"..\"" $ afterParse f "4.9.." ".."+        prop "afterParse \"4.9...\" \"...\"" $ afterParse f "4.9..." "..."+        prop "afterParse \"4.9+\" \"+\"" $ afterParse f "4.9+" "+"+        prop "afterParse \"4.9++\" \"++\"" $ afterParse f "4.9++" "++"+        prop "afterParse \"4.9+++\" \"+++\"" $ afterParse f "4.9+++" "+++"+        prop "afterParse \"4.9-\" \"-\"" $ afterParse f "4.9-" "-"+        prop "afterParse \"4.9--\" \"--\"" $ afterParse f "4.9--" "--"+        prop "afterParse \"4.9---\" \"---\"" $ afterParse f "4.9---" "---"+        prop "afterParse \"\" \"\"" $ afterParse f "" ""+        prop "afterParse \".\" \".\"" $ afterParse f "." "."+        prop "afterParse \"..\" \"..\"" $ afterParse f ".." ".."+        prop "afterParse \"+\" \"+\"" $ afterParse f "+" "+"+        prop "afterParse \"++\" \"++\"" $ afterParse f "++" "++"++moduleName :: String+moduleName = "Unicode.Parser"++main :: IO ()+main = do+    H.hspec+  $ H.describe moduleName $ do+    testParser "double" double+    testParser "number" number+    testParseErr "double" doubleParser+    testParseErr "number" numberParser+    testLeftOver "double" remainingStreamDouble+    testLeftOver "number" remainingStreamNumber+    H.describe "Scientific parser property test" $ do+        prop "Exponent format" scientificExpFP+        prop "Decimal format" scientificFixFP+    H.describe "double parser property test" $ do+        prop "Exponent format" doubleExpFP+        prop "Decimal format" doubleFixFP
test/Streamly/Test/Unicode/Stream.hs view
@@ -1,7 +1,10 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ module Streamly.Test.Unicode.Stream (main) where +import Control.Monad (when) import Data.Char (ord, chr)-import Data.Word (Word8)+import Data.Word (Word8, Word16) import Test.QuickCheck     ( Property     , forAll@@ -14,14 +17,17 @@     , vectorOf     , choose     )-import Test.QuickCheck.Monadic (run, monadicIO, assert)+import Test.QuickCheck.Monadic (run, monadicIO, assert, PropertyM)+import Streamly.Data.Stream (Stream) -import qualified Streamly.Data.Array.Foreign as A-import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS-import qualified Streamly.Prelude as S+import qualified Streamly.Data.Array as A+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Array.Stream as AS+import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Unicode.Stream as SS import qualified Streamly.Internal.Unicode.Stream as IUS-import qualified Streamly.Internal.Unicode.Array.Char as IUA+import qualified Streamly.Internal.Unicode.Array as IUA import qualified Test.Hspec as H  import Test.Hspec.QuickCheck@@ -36,38 +42,74 @@ #endif -} +assertEq :: (Eq a, Show a) => a -> a -> PropertyM IO ()+assertEq a b = do+    when (a /= b) $ run $ do+        putStrLn $ "A: " ++ show a+        putStrLn $ "B: " ++ show b+    assert (a == b)+ -- Use quickcheck-unicode instead? genUnicode :: Gen String genUnicode = listOf arbitraryUnicodeChar -genWord8 :: Gen [Word8]-genWord8 = listOf arbitrary+genWord8List :: Gen [Word8]+genWord8List = listOf arbitrary +genListOfW8List :: Gen [[Word8]]+genListOfW8List = listOf (listOf arbitrary)+ propDecodeEncodeId' :: Property propDecodeEncodeId' =     forAll genUnicode $ \list ->         monadicIO $ do-            let wrds = SS.encodeUtf8' $ S.fromList list-            chrs <- S.toList $ SS.decodeUtf8' wrds+            let wrds = SS.encodeUtf8' $ Stream.fromList list+            chrs <- run $ Stream.toList $ SS.decodeUtf8' wrds             assert (chrs == list) +propDecodeEncodeUtf16Id+    :: (Stream IO Char -> Stream IO Word16)+    -> (Stream IO Word16 -> Stream IO Char)+    -> Property+propDecodeEncodeUtf16Id encoder decoder =+    forAll genUnicode $ \list ->+        monadicIO $ do+            let wrds = encoder $ Stream.fromList list+            chrs <- run $ Stream.toList $ decoder wrds+            assertEq chrs list++propMkEvenW8Chunks :: Property+propMkEvenW8Chunks =+    forAll genListOfW8List $ \list ->+        monadicIO $ do+            list1 <-+                run $ Stream.toList+                    $ fmap A.toList+                    $ IUS.mkEvenW8Chunks+                    $ fmap A.fromList $ Stream.fromList list+            let concatedList = concat list+                concatedList1 = concat list1+            assert (and (map (even . length) list1))+            if (odd (length concatedList))+            then assertEq concatedList1 (init concatedList)+            else assertEq concatedList1 concatedList+ -- XXX need to use invalid characters propDecodeEncodeId :: Property propDecodeEncodeId =     forAll genUnicode $ \list ->         monadicIO $ do-            let wrds = SS.encodeUtf8 $ S.fromList list-            chrs <- S.toList $ SS.decodeUtf8 wrds-            assert (chrs == list)+            let wrds = SS.encodeUtf8 $ Stream.fromList list+            chrs <- Stream.toList $ SS.decodeUtf8 wrds+            assertEq chrs list  propDecodeEncodeIdArrays :: Property propDecodeEncodeIdArrays =     forAll genUnicode $ \list ->         monadicIO $ do-            let wrds = SS.encodeUtf8' $ S.fromList list-            chrs <- S.toList $ IUS.decodeUtf8Arrays-                                    (S.fold A.write wrds)-            assert (chrs == list)+            let wrds = Array.chunksOf 8 $ SS.encodeUtf8' $ Stream.fromList list+            chrs <- Stream.toList $ IUS.decodeUtf8Chunks wrds+            assertEq chrs list  unicodeTestData :: [Char] unicodeTestData = "z\72150\83468;L$Wz| ?_i/J ."@@ -80,9 +122,11 @@     forAll (choose (1, 1000)) $ \len ->         forAll (vectorOf len arbitraryASCIIChar) $ \list ->             monadicIO $ do-                let wrds = SS.decodeLatin1 $ SS.encodeLatin1 $ S.fromList list-                lst <- run $  S.toList wrds-                assert (list == lst)+                let wrds = SS.decodeLatin1+                            $ SS.encodeLatin1+                            $ Stream.fromList list+                lst <- run $  Stream.toList wrds+                assertEq list lst  propUnicodeToLatin1 :: Property propUnicodeToLatin1 =@@ -90,9 +134,9 @@         let wrds =                 SS.decodeLatin1                     $ SS.encodeLatin1-                    $ S.fromList unicodeTestData-        lst <- run $  S.toList wrds-        assert (latin1TestData == lst)+                    $ Stream.fromList unicodeTestData+        lst <- run $ Stream.toList wrds+        assertEq latin1TestData lst  propUnicodeToLatin1' :: Property propUnicodeToLatin1' =@@ -100,61 +144,61 @@         let wrds =                 SS.decodeLatin1                     $ SS.encodeLatin1'-                    $ S.fromList unicodeTestData-        lst <- run $  S.toList wrds-        assert (latin1TestData == lst)+                    $ Stream.fromList unicodeTestData+        lst <- run $ Stream.toList wrds+        assertEq latin1TestData lst  testLines :: Property testLines =     forAll genUnicode $ \list ->         monadicIO $ do-            xs <- S.toList-                $ S.map A.toList+            xs <- Stream.toList+                $ fmap A.toList                 $ IUA.lines-                $ S.fromList list-            assert (xs == lines list)+                $ Stream.fromList list+            assertEq xs (lines list)  testLinesArray :: Property testLinesArray =-    forAll genWord8 $ \list ->+    forAll genWord8List $ \list ->         monadicIO $ do-            xs <- S.toList-                    $ S.map A.toList+            xs <- Stream.toList+                    $ fmap A.toList                     $ AS.splitOnSuffix 10-                    $ S.fromPure (A.fromList list)-            assert (xs == map (map (fromIntegral . ord))+                    $ Stream.fromPure (A.fromList list)+            assertEq xs (map (map (fromIntegral . ord))                               (lines (map (chr .  fromIntegral) list)))  testWords :: Property testWords =     forAll genUnicode $ \list ->         monadicIO $ do-            xs <- S.toList-                $ S.map A.toList+            xs <- Stream.toList+                $ Stream.map A.toList                 $ IUA.words-                $ S.fromList list-            assert (xs == words list)+                $ Stream.fromList list+            assertEq xs (words list)  testUnlines :: Property testUnlines =   forAll genUnicode $ \list ->       monadicIO $ do-          xs <- S.toList+          xs <- Stream.toList               $ IUA.unlines               $ IUA.lines-              $ S.fromList list-          assert (xs == unlines (lines list))+              $ Stream.fromList list+          assertEq xs (unlines (lines list))  testUnwords :: Property testUnwords =   forAll genUnicode $ \list ->       monadicIO $ do           xs <- run-              $ S.toList+              $ Stream.toList               $ IUA.unwords               $ IUA.words-              $ S.fromList list-          assert (xs == unwords (words list))+              $ Stream.fromList list+          assertEq xs (unwords (words list))  moduleName :: String moduleName = "Unicode.Stream"@@ -179,6 +223,13 @@         prop             "Streamly.Data.String.unwords . Streamly.Data.String.words == unwords . words"             testUnwords++    H.describe "UTF16 - Encoding / Decoding" $ do+        prop "decodeUtf16le' . encodeUtf16le' == id"+             (propDecodeEncodeUtf16Id IUS.encodeUtf16le' IUS.decodeUtf16le')+        prop "decodeUtf16le . encodeUtf16le == id"+             (propDecodeEncodeUtf16Id IUS.encodeUtf16le' IUS.decodeUtf16le)+        prop "mkEvenW8Chunks" propMkEvenW8Chunks      H.describe "Latin1 - Encoding / Decoding" $ do         prop "ASCII to Latin1" propASCIIToLatin1
test/lib/Streamly/Test/Common.hs view
@@ -12,17 +12,19 @@     , listEquals     , checkListEqual     , chooseInt+    , chooseDouble+    , performGCSweep     ) where -import Control.Monad (when)+import Control.Monad (when, void, replicateM_) import Control.Monad.IO.Class (MonadIO(..)) import Data.List ((\\))-#if __GLASGOW_HASKELL__ < 808-import Data.Semigroup ((<>))-#endif+import System.Mem (performMajorGC) import Test.QuickCheck (Property, Gen, choose, counterexample) import Test.QuickCheck.Monadic (PropertyM, assert, monitor, monadicIO) +import qualified Streamly.Internal.Data.MutArray as MA+ equals     :: (Show a, Monad m)     => (a -> a -> Bool) -> a -> a -> PropertyM m ()@@ -63,3 +65,13 @@  chooseInt :: (Int, Int) -> Gen Int chooseInt = choose++chooseDouble :: (Double, Double) -> Gen Double+chooseDouble = choose++-- XXX Move this to Streamly.Test.Array.Common?+performGCSweep :: Int -> Int -> IO ()+performGCSweep i j = do+  replicateM_ i $ do+      performMajorGC+      void $ MA.fromList ([0 .. j] :: [Int])
+ test/lib/Streamly/Test/Parser/Common.hs view
@@ -0,0 +1,178 @@+module Streamly.Test.Parser.Common+    ( Move(..)+    , jumpParser+    , chunkedTape+    , tape+    , tapeLen+    , expectedResult+    , expectedResultMany+    , parserSanityTests+    )+where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Streamly.Internal.Data.Parser (ParseErrorPos(..))+import qualified Streamly.Internal.Data.Parser as P+import Test.Hspec++--------------------------------------------------------------------------------+-- Parser driver tests+--------------------------------------------------------------------------------++data Move+    = Consume Int+    | Custom (P.Step () ())+    deriving (Show)++jumpParser :: Monad m => [Move] -> P.Parser Int m [Int]+jumpParser jumps = P.Parser step initial done+    where+    initial = pure $ P.IPartial (jumps, [])++    step ([], buf) _ = pure $ P.SDone 0 (reverse buf)+    step (action:xs, buf) a =+        case action of+            Consume n+                | n == 1 -> pure $ P.SContinue 1 (xs, a:buf)+                | n > 0 -> pure $ P.SContinue 1 (Consume (n - 1) : xs, a:buf)+                | otherwise -> error "Cannot consume <= 0"+            Custom (P.SPartial i ()) -> pure $ P.SPartial i (xs, buf)+            Custom (P.SContinue i ()) -> pure $ P.SContinue i (xs, buf)+            Custom (P.SDone i ()) -> pure $ P.SDone i (reverse buf)+            Custom (P.SError err) -> pure $ P.SError err++    done ([], buf) = pure $ P.FDone 0 (reverse buf)+    done (action:xs, buf) =+        case action of+            Consume _ -> pure $ P.FError "INCOMPLETE"+            Custom (P.SPartial i ()) -> pure $ P.FContinue i (xs, buf)+            Custom (P.SContinue i ()) -> pure $ P.FContinue i (xs, buf)+            Custom (P.SDone i ()) -> pure $ P.FDone i (reverse buf)+            Custom (P.SError err) -> pure $ P.FError err++chunkedTape :: [[Int]]+chunkedTape = Prelude.map (\x -> [x..(x+9)]) [1, 11 .. 91]++tape :: [Int]+tape = concat chunkedTape++tapeLen :: Int+tapeLen = length tape++expectedResult :: [Move] -> [Int] -> (Either ParseErrorPos [Int], [Int])+expectedResult moves inp = go 0 0 [] moves+    where+    inpLen = length inp++    slice off len = Prelude.take len . Prelude.drop off+    slice_ = Prelude.drop++    -- i = Index of inp head+    -- j = Minimum index of inp head+    go i j ys [] = (Right ys, slice_ (max i j) inp)+    go i j ys ((Consume n):xs)+        | i + n > inpLen = (Left (ParseErrorPos inpLen "INCOMPLETE"), drop j inp)+        | otherwise =+            go (i + n) j (ys ++ slice i n inp) xs+    go i j ys ((Custom step):xs)+        | i > inpLen = error "i > inpLen"+        | otherwise =+              case step of+                  P.SPartial n () -> go (i + n) (max j (i + n)) ys xs+                  P.SContinue n () -> go (i + n) j ys xs+                  P.SDone n () -> (Right ys, slice_ (max (i + n) j) inp)+                  P.SError err -> (Left (ParseErrorPos (i + 1) err), slice_ j inp)++expectedResultMany :: [Move] -> [Int] -> [Either ParseErrorPos [Int]]+expectedResultMany = go 0+    where+    go _ _ [] = []+    go off moves inp =+        let (res, rest) = expectedResult moves inp+            consumed = length inp - length rest+         in+           case res of+               Left (ParseErrorPos relOff err) ->+                   [Left (ParseErrorPos (off + relOff) err)]+               Right val -> Right val : go (off + consumed) moves rest++createPaths :: [a] -> [[a]]+createPaths xs =+    Prelude.map (`Prelude.take` xs) [1..length xs]++parserSanityTests :: String -> ([Move] -> SpecWith ()) -> SpecWith ()+parserSanityTests desc testRunner =+    describe desc $ do+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume (tapeLen + 1)+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Custom (P.SError "Message0")+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 10+                , Custom (P.SPartial 1 ())+                , Consume 10+                , Custom (P.SPartial 0 ())+                , Consume 10+                , Custom (P.SPartial (-10) ())+                , Consume 10+                , Custom (P.SContinue 1 ())+                , Consume 10+                , Custom (P.SContinue 0 ())+                , Consume 10+                , Custom (P.SContinue (-10) ())+                , Custom (P.SError "Message1")+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 10+                , Custom (P.SContinue 1 ())+                , Consume 10+                , Custom (P.SContinue 0 ())+                , Consume 10+                , Custom (P.SContinue (-10) ())+                , Consume 10+                , Custom (P.SDone 1 ())+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 20+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-10) ())+                , Custom (P.SDone 0 ())+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 20+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-10) ())+                , Custom (P.SError "Message2")+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 20+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-10) ())+                , Custom (P.SDone (-4) ())+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume (tapeLen - 1)+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-9) ())+                , Custom (P.SDone (-4) ())+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume (tapeLen - 1)+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-9) ())+                , Custom (P.SError "Message3")+                ]
test/lib/Streamly/Test/Prelude/Common.hs view
@@ -1,3 +1,10 @@+{-# Language NoMonoLocalBinds #-}+{-# OPTIONS_GHC -Wno-deprecations #-}+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif+ -- | -- Module      : Streamly.Test.Prelude.Common -- Copyright   : (c) 2020 Composewell Technologies@@ -15,9 +22,7 @@     , constructWithReplicate     , constructWithReplicateM     , constructWithIntFromThenTo-#if __GLASGOW_HASKELL__ >= 806     , constructWithDoubleFromThenTo-#endif     , constructWithIterate     , constructWithIterateM     , constructWithEnumerate@@ -85,7 +90,10 @@     , sortEq     ) where -import Control.Applicative (ZipList(..), liftA2)+#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Applicative (ZipList(..)) import Control.Exception (Exception, try) import Control.Concurrent (threadDelay) import Control.Monad (replicateM)@@ -95,6 +103,8 @@ import Control.Monad.Catch (throwM, MonadThrow) import Data.IORef ( IORef, atomicModifyIORef', modifyIORef', newIORef                   , readIORef, writeIORef)+import Data.Foldable+    (elem, foldl, foldMap, foldr, length, maximum, minimum, null, product, sum) import Data.List     ( delete     , deleteBy@@ -117,9 +127,6 @@     , unfoldr     ) import Data.Maybe (mapMaybe)-#if !(MIN_VERSION_base(4,11,0))-import Data.Semigroup (Semigroup, (<>))-#endif import GHC.Word (Word8) import System.Mem (performMajorGC) import Test.Hspec.QuickCheck@@ -134,12 +141,13 @@ import qualified Streamly.Prelude as S import qualified Streamly.Data.Fold as FL import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.IsStream.Common as IS+import qualified Streamly.Internal.Data.Stream.IsStream as IS import qualified Streamly.Internal.Data.Unfold as UF  import qualified Data.Map.Strict as Map  import Streamly.Test.Common+import Prelude hiding (Foldable(..))  maxStreamLen :: Int maxStreamLen = 1000@@ -224,7 +232,6 @@     stream n = S.take n $ S.repeatM (return 1)     list n = return $ replicate n 1 -#if __GLASGOW_HASKELL__ >= 806 -- XXX try very small steps close to 0 constructWithDoubleFromThenTo     :: IsStream t@@ -238,7 +245,6 @@         let list len = take len [from,next..to]             stream len = S.take len $ S.enumerateFromThenTo from next to         in constructWithLen stream list op l-#endif  constructWithIterate ::        IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property@@ -399,11 +405,7 @@         else Just (seed, seed + 1)  constructWithFromPure ::-       (IsStream t-#if __GLASGOW_HASKELL__ < 806-       , Monoid (t IO Int)-#endif-       )+       (IsStream t, Monoid (t IO Int))     => ([Int] -> [Int])     -> (t IO Int -> SerialT IO Int)     -> Word8@@ -419,11 +421,7 @@         listEquals (==) (listT strm) list  constructWithFromEffect ::-       (IsStream t-#if __GLASGOW_HASKELL__ < 806-       , Monoid (t IO Int)-#endif-       )+       (IsStream t, Monoid (t IO Int))     => ([Int] -> [Int])     -> (t IO Int -> SerialT IO Int)     -> Word8@@ -972,9 +970,6 @@ composeAndComposeSimple     :: ( IsStream t1, Semigroup (t1 IO Int)        , IsStream t2, Monoid (t2 IO Int), Monad (t2 IO)-#if !(MIN_VERSION_base(4,11,0))-       , Semigroup (t2 IO Int)-#endif        )     => (t1 IO Int -> SerialT IO Int)     -> (t2 IO Int -> t2 IO Int)@@ -1039,11 +1034,7 @@  -- XXX concatenate streams of multiple elements rather than single elements semigroupOps-    :: (IsStream t-#if __GLASGOW_HASKELL__ < 804-       , Semigroup (t IO Int)-#endif-       , Monoid (t IO Int))+    :: (IsStream t, Monoid (t IO Int))     => String     -> ([Int] -> [Int] -> Bool)     -> (t IO Int -> SerialT IO Int)@@ -1214,7 +1205,7 @@         forAll (choose (0, 100)) $ \n ->             transform (concatMap (const [1..n]))                 t (S.unfoldMany (UF.lmap (const undefined)-                                   $ UF.supply [1..n] UF.fromList))+                                   $ UF.both [1..n] UF.fromList))  toListFL :: Monad m => FL.Fold m a [a] toListFL = FL.toList@@ -1475,11 +1466,7 @@ #endif  bracketExceptionProp ::-       (IsStream t, MonadThrow (t IO)-#if __GLASGOW_HASKELL__ < 806-       , Semigroup (t IO Int)-#endif-       )+       (IsStream t, MonadThrow (t IO), Semigroup (t IO Int))     => (t IO Int -> SerialT IO Int)     -> Property bracketExceptionProp t =@@ -1566,11 +1553,7 @@ #endif  finallyExceptionProp ::-       (IsStream t, MonadThrow (t IO)-#if __GLASGOW_HASKELL__ < 806-       , Semigroup (t IO Int)-#endif-       )+       (IsStream t, MonadThrow (t IO), Semigroup (t IO Int))     => (t IO Int -> SerialT IO Int)     -> Property finallyExceptionProp t =@@ -1588,11 +1571,7 @@         assert $ refValue == 1  onExceptionProp ::-       (IsStream t, MonadThrow (t IO)-#if __GLASGOW_HASKELL__ < 806-       , Semigroup (t IO Int)-#endif-       )+       (IsStream t, MonadThrow (t IO), Semigroup (t IO Int))     => (t IO Int -> SerialT IO Int)     -> Property onExceptionProp t =@@ -1626,11 +1605,7 @@         assert $ res == vec ++ [0] ++ vec  exceptionOps ::-       (IsStream t, MonadThrow (t IO)-#if __GLASGOW_HASKELL__ < 806-       , Semigroup (t IO Int)-#endif-       )+       (IsStream t, MonadThrow (t IO), Semigroup (t IO Int))     => String     -> (t IO Int -> SerialT IO Int)     -> Spec
test/streamly-tests.cabal view
@@ -40,13 +40,16 @@   manual: True   default: True +flag use-streamly-core+  description: Test only core package+  manual: True+  default: False+ ------------------------------------------------------------------------------- -- Common stanzas -------------------------------------------------------------------------------  common compile-options-    default-language: Haskell2010-     if os(darwin)       cpp-options:    -DCABAL_OS_DARWIN @@ -87,10 +90,23 @@       cpp-options: -DINCLUDE_FLAKY_TESTS  common default-extensions+    default-language: Haskell2010++    -- GHC2024 may include more extensions than we are actually using, see the+    -- full list below. We enable this to ensure that we are able to compile+    -- with this i.e. there is no interference by other extensions.+    if impl(ghc >= 9.10)+      default-language: GHC2024++    if impl(ghc >= 9.2) && impl(ghc < 9.10)+      default-language: GHC2021++    if impl(ghc >= 8.10)+      default-extensions: StandaloneKindSignatures++    -- In GHC 2024     default-extensions:         BangPatterns-        CApiFFI-        CPP         ConstraintKinds         DeriveDataTypeable         DeriveGeneric@@ -102,24 +118,18 @@         InstanceSigs         KindSignatures         LambdaCase-        MagicHash         MultiParamTypeClasses-        PatternSynonyms         RankNTypes-        RecordWildCards         ScopedTypeVariables         TupleSections-        TypeFamilies-        ViewPatterns -        -- MonoLocalBinds, enabled by TypeFamilies, causes performance-        -- regressions. Disable it. This must come after TypeFamilies,-        -- otherwise TypeFamilies will enable it again.+        -- Not in GHC2024+        CPP+        MagicHash+        PatternSynonyms+        RecordWildCards         NoMonoLocalBinds -        -- UndecidableInstances -- Does not show any perf impact-        -- UnboxedTuples        -- interferes with (#.)- common threading-options   ghc-options:  -threaded                 -with-rtsopts=-N@@ -139,21 +149,26 @@  common test-dependencies   build-depends:-      streamly-    , base              >= 4.9   && < 4.17-    , containers        >= 0.5   && < 0.7-    , exceptions        >= 0.8   && < 0.11-    , ghc-    , hspec             >= 2.0   && < 2.10-    , mtl               >= 2.2   && < 2.3-    , random            >= 1.0.0 && < 1.3-    , transformers      >= 0.4   && < 0.7-    , QuickCheck        >= 2.13  && < 2.15-    , directory         >= 1.2.2 && < 1.4-    , filepath          >= 1.4.1 && < 1.5-    , temporary         >= 1.3   && < 1.4-    , network           >= 3.1   && < 3.2+        streamly-core+      , base              >= 4.9   && < 4.23+      , containers        >= 0.5   && < 0.9+      , exceptions        >= 0.8   && < 0.11+      , ghc+      , hspec             >= 2.0   && < 2.12+      , mtl               >= 2.2   && < 2.4+      , random            >= 1.0.0 && < 1.4+      , transformers      >= 0.4   && < 0.7+      , QuickCheck        >= 2.13  && < 2.19+      , directory         >= 1.2.2 && < 1.5+      , filepath          >= 1.4.1 && < 1.6+      , temporary         >= 1.3   && < 1.4+      , network           >= 3.1   && < 3.3+      , scientific        >= 0.0   && < 0.4+      , template-haskell  >= 2.12  && < 2.25 +  if !flag(use-streamly-core)+    build-depends: streamly+   if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)      build-depends:          fusion-plugin     >= 0.2   && < 0.3@@ -171,8 +186,11 @@ library     import: lib-options, test-dependencies     hs-source-dirs: lib-    exposed-modules: Streamly.Test.Common-                   , Streamly.Test.Prelude.Common+    exposed-modules:+        Streamly.Test.Common+        Streamly.Test.Parser.Common+    if !flag(use-streamly-core)+      exposed-modules: Streamly.Test.Prelude.Common     if flag(limit-build-mem)       ghc-options: +RTS -M1500M -RTS @@ -183,7 +201,10 @@ common test-options   import: lib-options         , threading-options-  ghc-options: -rtsopts -fno-ignore-asserts+  ghc-options:+    -rtsopts+    -with-rtsopts "-t"+    -fno-ignore-asserts   include-dirs: .   build-depends: streamly-tests @@ -197,79 +218,205 @@                -fmax-worker-args=16                -fspec-constr-recursive=16                -rtsopts+               -with-rtsopts "-t"                -fno-ignore-asserts   if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)     ghc-options: -fplugin Fusion.Plugin  ---------------------------------------------------------------------------------- Test suites in sorted order+-- Test suites in alphabetical order ------------------------------------------------------------------------------- -test-suite Data.List+test-suite Data.Array   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/List.hs-  cpp-options:  -DUSE_STREAMLY_LIST+  main-is: Streamly/Test/Data/Array.hs+  ghc-options: -main-is Streamly.Test.Data.Array.main -test-suite Data.List.Base+test-suite Data.Array.Generic   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/List.hs+  main-is: Streamly/Test/Data/Array/Generic.hs+  ghc-options: -main-is Streamly.Test.Data.Array.Generic.main+  if flag(use-streamly-core)+    buildable: False -test-suite Data.Array+test-suite Data.Array.Stream   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Array.hs-  ghc-options: -main-is Streamly.Test.Data.Array.main+  main-is: Streamly/Test/Data/Array/Stream.hs+  if flag(use-streamly-core)+    buildable: False -test-suite Data.Array.Prim+test-suite Data.Binary   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Array/Prim.hs-  ghc-options: -main-is Streamly.Test.Data.Array.Prim.main+  main-is: Streamly/Test/Serialize/Serializable.hs -test-suite Data.Array.Prim.Pinned+test-suite Data.Fold   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Array/Prim/Pinned.hs-  ghc-options: -main-is Streamly.Test.Data.Array.Prim.Pinned.main+  main-is: Streamly/Test/Data/Fold.hs -test-suite Data.Array.Foreign+test-suite Data.Fold.Window   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Array/Foreign.hs-  ghc-options: -main-is Streamly.Test.Data.Array.Foreign.main+  main-is: Streamly/Test/Data/Fold/Window.hs+  ghc-options: -main-is Streamly.Test.Data.Fold.Window.main -test-suite Data.Array.Stream.Foreign+-- The Streamly.Data.List needs to be fixed to enable this+-- test-suite Data.List+--   import: test-options+--   type: exitcode-stdio-1.0+--   main-is: Streamly/Test/Data/List.hs+--   cpp-options:  -DUSE_STREAMLY_LIST+--   if !flag(dev)+--     buildable: False++test-suite Data.List.Base   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Array/Stream/Foreign.hs+  main-is: Streamly/Test/Data/List.hs -test-suite Data.Fold+test-suite Data.MutArray   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Fold.hs+  main-is: Streamly/Test/Data/MutArray.hs+  ghc-options: -main-is Streamly.Test.Data.MutArray.main  test-suite Data.Parser   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Data/Parser.hs+  hs-source-dirs: .+  other-modules: Streamly.Test.Data.Parser.Common   if flag(limit-build-mem)-    ghc-options: +RTS -M1000M -RTS+    ghc-options: +RTS -M2000M -RTS -test-suite Data.Parser.ParserD+test-suite Data.ParserK   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Parser/ParserD.hs+  main-is: Streamly/Test/Data/ParserK.hs   if flag(limit-build-mem)-    ghc-options: +RTS -M1000M -RTS+    ghc-options: +RTS -M1500M -RTS +test-suite Data.RingArray+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/RingArray.hs+  ghc-options: -main-is Streamly.Test.Data.RingArray.main++test-suite Data.Scanl.Concurrent+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Scanl/Concurrent.hs+  ghc-options: -main-is Streamly.Test.Data.Scanl.Concurrent.main+  if flag(use-streamly-core)+    buildable: False++-- XXX Rename to MutByteArray+test-suite Data.Serialize+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Serialize.hs+  other-modules:+      Streamly.Test.Data.Serialize.TH+      Streamly.Test.Data.Serialize.CompatV0+      Streamly.Test.Data.Serialize.CompatV1+  ghc-options: -main-is Streamly.Test.Data.Serialize.main+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS++test-suite Data.Serialize.Derive.TH+  import: test-options+  type: exitcode-stdio-1.0+  cpp-options: -DUSE_SERIALIZE+  main-is: Streamly/Test/Data/Unbox.hs+  ghc-options: -main-is Streamly.Test.Data.Unbox.main++test-suite Data.Serialize.ENABLE_constructorTagAsString+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Serialize.hs+  other-modules:+      Streamly.Test.Data.Serialize.TH+      Streamly.Test.Data.Serialize.CompatV0+      Streamly.Test.Data.Serialize.CompatV1+  cpp-options: -DENABLE_constructorTagAsString+  ghc-options: -main-is Streamly.Test.Data.Serialize.main+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS+ test-suite Data.SmallArray   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Data/SmallArray.hs   ghc-options: -main-is Streamly.Test.Data.SmallArray.main+  if !flag(dev) || flag(use-streamly-core)+    buildable: False +test-suite Data.Stream+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Stream.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.main+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS++test-suite Data.Stream.Concurrent+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Stream/Concurrent.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.Concurrent.main+  if flag(use-streamly-core)+    buildable: False++test-suite Data.Stream.Exception+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Stream/Exception.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.Exception.main++test-suite Data.Stream.Time+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Stream/Time.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.Time.main+  if flag(use-streamly-core)+    buildable: False++test-suite Data.Stream.Rate+  import:always-optimized+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Stream/Rate.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.Rate.main+  if flag(dev)+    buildable: True+  else+    buildable: False+  if flag(use-streamly-core)+    buildable: False++-- XXX Rename to MutByteArray.Unbox+test-suite Data.Unbox.Derive.Generic+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Unbox.hs+  ghc-options: -main-is Streamly.Test.Data.Unbox.main++test-suite Data.Unbox.Derive.TH+  import: test-options+  type: exitcode-stdio-1.0+  cpp-options: -DUSE_TH+  main-is: Streamly/Test/Data/Unbox.hs+  ghc-options: -main-is Streamly.Test.Data.Unbox.main++test-suite Data.Unbox.TH+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Unbox/TH.hs+  ghc-options: -main-is Streamly.Test.Data.Unbox.TH.main+ test-suite Data.Unfold   import: test-options   type: exitcode-stdio-1.0@@ -281,6 +428,8 @@   ghc-options: -main-is Streamly.Test.FileSystem.Event   main-is: Streamly/Test/FileSystem/Event.hs   other-modules: Streamly.Test.FileSystem.Event.Common+  if !((os(linux) && impl(ghc >= 9.4)) || os(darwin) || os(windows)) || flag(use-streamly-core)+    buildable: False  test-suite FileSystem.Event.Darwin   import: test-options@@ -289,7 +438,7 @@   other-modules: Streamly.Test.FileSystem.Event.Common   cpp-options: -DFILESYSTEM_EVENT_DARWIN   ghc-options: -main-is Streamly.Test.FileSystem.Event.Darwin-  if !os(darwin)+  if !os(darwin) || flag(use-streamly-core)     buildable: False  test-suite FileSystem.Event.Linux@@ -299,7 +448,7 @@   other-modules: Streamly.Test.FileSystem.Event.Common   cpp-options: -DFILESYSTEM_EVENT_LINUX   ghc-options: -main-is Streamly.Test.FileSystem.Event.Linux-  if !os(linux)+  if impl(ghc < 9.4) || !os(linux) || flag(use-streamly-core)     buildable: False  test-suite FileSystem.Event.Windows@@ -309,7 +458,7 @@   other-modules: Streamly.Test.FileSystem.Event.Common   cpp-options: -DFILESYSTEM_EVENT_WINDOWS   ghc-options: -main-is Streamly.Test.FileSystem.Event.Windows-  if !os(windows)+  if !os(windows) || flag(use-streamly-core)     buildable: False  test-suite FileSystem.Handle@@ -317,34 +466,103 @@   type: exitcode-stdio-1.0   main-is: Streamly/Test/FileSystem/Handle.hs   ghc-options: -main-is Streamly.Test.FileSystem.Handle.main+  if flag(use-streamly-core)+    buildable: False -test-suite Network.Inet.TCP+test-suite FileSystem.DirIO   import: test-options   type: exitcode-stdio-1.0+  main-is: Streamly/Test/FileSystem/DirIO.hs+  if flag(use-streamly-core)+    buildable: False+  build-depends:+      bench-test-lib+  -- Fix this test-suite for Windows+  if os(windows)+    buildable: False++test-suite Network.Inet.TCP+  import: lib-options+  type: exitcode-stdio-1.0   main-is: Streamly/Test/Network/Inet/TCP.hs+  ghc-options: -rtsopts -fno-ignore-asserts+  include-dirs: .+  build-depends: streamly-tests+  -- Cannot killThread in listen/accept on Windows threaded runtime+  if !os(windows)+    ghc-options: -threaded -with-rtsopts=-N+  if flag(use-streamly-core)+    buildable: False  test-suite Network.Socket-  import: test-options+  import: lib-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Network/Socket.hs+  ghc-options: -rtsopts -fno-ignore-asserts+  include-dirs: .+  build-depends: streamly-tests+  -- Cannot killThread in listen/accept on Windows threaded runtime+  if !os(windows)+    ghc-options: -threaded -with-rtsopts=-N+  if flag(use-streamly-core)+    buildable: False +test-suite Unicode.Char+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Unicode/Char.hs+  ghc-options: -main-is Streamly.Test.Unicode.Char.main+  if flag(use-streamly-core) || !flag(dev)+    buildable: False++test-suite Unicode.Parser+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Unicode/Parser.hs+  ghc-options: -main-is Streamly.Test.Unicode.Parser.main+  if flag(use-streamly-core)+    buildable: False++test-suite Unicode.Stream+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Unicode/Stream.hs+  ghc-options: -main-is Streamly.Test.Unicode.Stream.main+  if flag(use-streamly-core)+    buildable: False++test-suite version-bounds+  import: test-options+  type: exitcode-stdio-1.0+  main-is: version-bounds.hs++-------------------------------------------------------------------------------+-- Deprecated+-------------------------------------------------------------------------------+ test-suite Prelude   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude.hs   ghc-options: -main-is Streamly.Test.Prelude.main+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.Ahead   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude/Ahead.hs   ghc-options: -main-is Streamly.Test.Prelude.Ahead.main+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.Async   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude/Async.hs   ghc-options: -main-is Streamly.Test.Prelude.Async.main+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.Concurrent   import: test-options@@ -353,18 +571,24 @@   ghc-options: -main-is Streamly.Test.Prelude.Concurrent.main   if flag(limit-build-mem)     ghc-options: +RTS -M2000M -RTS+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.Fold   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude/Fold.hs   ghc-options: -main-is Streamly.Test.Prelude.Fold.main+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.Parallel   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude/Parallel.hs   ghc-options: -main-is Streamly.Test.Prelude.Parallel.main+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.Rate   import:always-optimized@@ -375,6 +599,8 @@     buildable: True   else     buildable: False+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.Serial   import: test-options@@ -383,23 +609,31 @@   ghc-options: -main-is Streamly.Test.Prelude.Serial.main   if flag(limit-build-mem)     ghc-options: +RTS -M1500M -RTS+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.Top   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude/Top.hs+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.WAsync   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude/WAsync.hs   ghc-options: -main-is Streamly.Test.Prelude.WAsync.main+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.WSerial   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude/WSerial.hs   ghc-options: -main-is Streamly.Test.Prelude.WSerial.main+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.ZipAsync   import: test-options@@ -408,30 +642,13 @@   ghc-options: -main-is Streamly.Test.Prelude.ZipAsync.main   if flag(limit-build-mem)     ghc-options: +RTS -M750M -RTS+  if flag(use-streamly-core)+    buildable: False  test-suite Prelude.ZipSerial   import: test-options   type: exitcode-stdio-1.0   main-is: Streamly/Test/Prelude/ZipSerial.hs   ghc-options: -main-is Streamly.Test.Prelude.ZipSerial.main--test-suite Unicode.Stream-  import: test-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Test/Unicode/Stream.hs-  ghc-options: -main-is Streamly.Test.Unicode.Stream.main--test-suite Unicode.Char-  import: test-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Test/Unicode/Char.hs-  ghc-options: -main-is Streamly.Test.Unicode.Char.main-  if flag(dev)-    buildable: True-  else+  if flag(use-streamly-core)     buildable: False--test-suite version-bounds-  import: test-options-  type: exitcode-stdio-1.0-  main-is: version-bounds.hs
+ test/test-runner/Main.hs view
@@ -0,0 +1,38 @@+module Main where++import TestRunner (mainWith)+import BuildLib (Quickness(..))+import Control.Applicative ((<|>))+import Data.List (isInfixOf, isPrefixOf, isSuffixOf)+import Data.Map (Map)++import qualified Data.Map as Map+import Targets (targets)++rtsOpts :: Bool -> String -> String -> String+rtsOpts relaxMem exeName target = mkOpts <> " -t"+++    where++    mkOpts =+        if relaxMem+        then "-K16M -M1024M"+        else "-K8M -M64M " <> targetSpecific++    targetSpecific =+        case target of+            -- XXX Data.Array.* heap requirement increased for GHC-8.10+            "Data.Array" -> "-M128M"+            "Data.Array.Generic" -> "-M128M"+            "Data.Stream.Rate" -> "-M512M"+            "Data.Serialize" -> "-M128M"+            "Data.Serialize.ENABLE_constructorTagAsString" -> "-M128M"+            "Prelude.Rate" -> "-M512M"+            -- For -O0 case writeChunks test fails, maybe we should have a+            -- separate flag for O0 case?+            "FileSystem.Handle" -> "-K16M -M128M"+            _ -> ""++main :: IO ()+main = mainWith targets rtsOpts
+ test/test-runner/test-runner.cabal view
@@ -0,0 +1,41 @@+cabal-version:      2.4+name:               test-runner+version:            0.1.0.0++-- A short (one-line) description of the package.+-- synopsis:++-- A longer description of the package.+-- description:++-- A URL where users can report bugs.+-- bug-reports:++-- The license under which the package is released.+-- license:++-- The package author(s).+-- author:++-- An email address to which users can send suggestions, bug reports, and patches.+-- maintainer:++-- A copyright notice.+-- copyright:+-- category:+-- extra-source-files: CHANGELOG.md++executable test-runner+    main-is:          Main.hs++    -- Modules included in this executable, other than Main.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:+    build-depends:    base+                    , bench-report+                    , containers+                    , streamly-targets+    hs-source-dirs:   .+    default-language: Haskell2010