packages feed

streamly 0.5.2 → 0.11.1

raw patch · 356 files changed

Files

+ 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
+ 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.
− Changelog.md 
@@ -1,215 +0,0 @@-## 0.5.2--### 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--* Performance improvements, especially space consumption, for concurrent-  streams--## 0.5.0--### 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--### Bug Fixes--* foldxM was not fully strict, fixed.--## 0.4.0--### 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--### 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--### 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--### 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--### Enhancements-* Add `iterate`, `iterateM` stream operations--### Bug Fixes-* Fixed a bug that casued unexpected behavior when `pure` was used to inject-  values in Applicative composition of `ZipStream` and `ZipAsync` types.--## 0.1.1--### 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--* Initial release
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2017, Harendra Kumar+Copyright (c) 2017, Composewell Technologies All rights reserved.  Redistribution and use in source and binary forms, with or without@@ -24,4 +24,72 @@ 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++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 Mark Dittmer 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.++-------------------------------------------------------------------------------+hfsevents-0.1.6 (http://hackage.haskell.org/package/hfsevents-0.1.6)+-------------------------------------------------------------------------------+Copyright (c) 2012, Luite Stegeman++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 Luite Stegeman 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.
README.md view
@@ -1,460 +1,139 @@-# Streamly--## 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 framwework.  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 generalizes lists to monadic streams, and the `IO` monad to-non-deterministic and concurrent stream composition. The `IO` monad is a-special case of streamly; if we use single element streams the behavior of-streamly becomes identical to the IO monad.  The IO monad code can be replaced-with streamly by just prefixing the IO actions with `liftIO`, without any other-changes, and without any loss of performance.  Pure lists too are a special-case of streamly; if we use `Identity` as the underlying monad, streamly-streams turn into pure lists.  Non-concurrent programs are just a special case-of concurrent ones, simply adding a combinator turns a non-concurrent program-into a concurrent one.--In other words, streamly combines the functionality of lists and IO, with-builtin concurrency.  If you want to write a program that involves IO,-concurrent or not, then you can just use streamly as the base monad, in fact,-you could even use streamly for pure computations, as streamly performs at par-with pure lists or `vector`.--## 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?--## Show me an example--Here is an IO monad code to list a directory recursively:--```haskell-import Control.Monad.IO.Class (liftIO)-import Path.IO (listDir, getCurrentDir) -- from path-io package--listDirRecursive = getCurrentDir >>= readdir-  where-    readdir dir = do-      (dirs, files) <- listDir dir-      liftIO $ mapM_ putStrLn-             $ map show dirs ++ map show files-      foldMap readdir dirs-```--This is your usual IO monad code, with no streamly specific code whatsoever.-This is how you can run this:--``` haskell-main :: IO ()-main = listDirRecursive-```--And, this is how you can run exactly the same code using streamly with-lookahead style concurrency, the only difference is that this time multiple-directories are read concurrently:--``` haskell-import Streamly (runStream, aheadly)--main :: IO ()-main = runStream $ aheadly $ listDirRecursive-```--Isn't that magical? What's going on here? Streamly does not introduce any new-abstractions, it just uses standard abstractions like `Semigroup` or-`Monoid` to combine monadic streams concurrently, the way lists combine a-sequence of pure values non-concurrently. The `foldMap` in the code-above turns into a concurrent monoidal composition of a stream of `readdir`-computations.--## How does it perform?--Providing monadic streaming and high level declarative concurrency does not-mean that `streamly` compromises with performance in any way. The-non-concurrent performance of `streamly` competes with lists and the `vector`-library. The concurrent performance is as good as it gets, see [concurrency-benchmarks](https://github.com/composewell/concurrency-benchmarks) for detailed-performance results and a comparison with the `async` package.--The following chart shows a summary of the cost of key streaming operations-processing a million elements. The timings for `streamly` and `vector` are in-the 600-700 microseconds range and therefore can barely be seen in the graph.-For more details, see [streaming-benchmarks](https://github.com/composewell/streaming-benchmarks).--![Streaming Operations at a Glance](charts-0/KeyOperations-time.svg)--## 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 Streamly-import qualified Streamly.Prelude as S-import Data.Function ((&))--main = runStream $-       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.  Combinators are provided in-`Streamly.Prelude` to transform or fold streams.--## Concurrent Stream Generation--Monadic construction and generation functions e.g. `consM`, `unfoldrM`,-`replicateM`, `repeatM`, `iterateM` and `fromFoldableM` etc. work concurrently-when used with appropriate stream type combinator (e.g. `asyncly`, `aheadly` or-`parallely`).--The following code finishes in 3 seconds (6 seconds when serial):--``` haskell-> let p n = threadDelay (n * 1000000) >> return n-> S.toList $ aheadly $ p 3 |: p 2 |: p 1 |: S.nil-[3,2,1]--> S.toList $ parallely $ p 3 |: p 2 |: p 1 |: S.nil-[1,2,3]-```--The following finishes in 10 seconds (100 seconds when serial):--``` haskell-runStream $ asyncly $ 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 = runStream $-      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-> runStream $ aheadly $ S.mapM (\x -> p 1 >> print x) (serially $ 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 Streamly-import qualified Streamly.Prelude as S-import Control.Concurrent (threadDelay)--main = S.toList $ parallely $ foldMap delay [1..10]- where delay n = S.yieldM $ 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 Streamly-import qualified Streamly.Prelude as S-import Control.Concurrent--delay n = S.yieldM $ do-    threadDelay (n * 1000000)-    tid <- myThreadId-    putStrLn (show tid ++ ": Delay " ++ show n)-```-### Serial--``` haskell-main = runStream $ delay 3 <> delay 2 <> delay 1-```-```-ThreadId 36: Delay 3-ThreadId 36: Delay 2-ThreadId 36: Delay 1-```--### Parallel--``` haskell-main = runStream . parallely $ 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 Streamly-import qualified Streamly.Prelude as S--loops = do-    x <- S.fromFoldable [1,2]-    y <- S.fromFoldable [3,4]-    S.yieldM $ putStrLn $ show (x, y)--main = runStream loops-```-```-(1,3)-(1,4)-(2,3)-(2,4)-```--## Concurrent Nested Loops--To run the above code with, lookahead style concurrency i.e. each iteration in-the loop can run run concurrently by but the results are presented in the same-order as serial execution:--``` haskell-main = runStream $ aheadly $ loops-```--To run it with depth first concurrency yielding results asynchronously in the-same order as they become available (deep async composition):--``` haskell-main = runStream $ asyncly $ loops-```--To run it with breadth first concurrency and yeilding results asynchronously-(wide async composition):+# [Streamly][]: Idiomatic Haskell with C-Like Performance -``` haskell-main = runStream $ wAsyncly $ loops-```+[![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) -The above streams provide lazy/demand-driven concurrency which is automatically-scaled as per demand and is controlled/bounded so that it can be used on-infinite streams. The following combinator provides strict, unbounded-concurrency irrespective of demand:+## Upgrading to 0.9.0+ -``` haskell-main = runStream $ parallely $ loops-```+Please read the [Streamly 0.9.0 Upgrade Guide](/docs/User/Project/Upgrading-0.8-to-0.9.md). -To run it serially but interleaving the outer and inner loop iterations-(breadth first serial):+## Overview -``` haskell-main = runStream $ wSerially $ loops-```+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: -## Magical Concurrency+* 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. -Streams can perform semigroup (<>) and monadic bind (>>=) operations-concurrently using combinators like `asyncly`, `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:+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]. -``` haskell-import Streamly-import qualified Streamly.Prelude as S+## Blazing Fast -main = do-    s <- S.sum $ asyncly $ 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-```+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. -The concurrency facilities provided by streamly can be compared with-[OpenMP](https://en.wikipedia.org/wiki/OpenMP) and-[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative-expression.+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. -## Rate Limiting+## Declarative Concurrency -For bounded concurrent streams, stream yield rate can be specified. For-example, to print hello once every second you can simply write this:+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. -``` haskell-import Streamly-import Streamly.Prelude as S+## Unified API -main = runStream $ asyncly $ avgRate 1 $ S.repeatM $ putStrLn "hello"-```+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. -For some practical uses of rate control, see-[AcidRain.hs](https://github.com/composewell/streamly/tree/master/examples/AcidRain.hs)-and-[CirclingSquare.hs](https://github.com/composewell/streamly/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.+Check out [Streamly's documentation][Streamly] for more information+about Streamly's features. -## Exceptions+## Batteries Included -From a library user point of view, there is nothing much to learn or talk about-exceptions.  Synchronous exceptions work just the way they are supposed to work-in any standard 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. Exceptions can be thrown-using the `MonadThrow` instance.+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. -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!+## 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. -## Reactive Programming (FRP)+## Credits -Streamly is a foundation for first class reactive programming as well by virtue-of integrating concurrency and streaming. See-[AcidRain.hs](https://github.com/composewell/streamly/tree/master/examples/AcidRain.hs)-for a console based FRP game example and-[CirclingSquare.hs](https://github.com/composewell/streamly/tree/master/examples/CirclingSquare.hs)-for an SDL based animation example.+The following authors/libraries have influenced or inspired this library in a+significant way: -## Conclusion+  * 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)) -Streamly, short for streaming concurrently, provides monadic streams, with a-simple API, almost identical to standard lists, and an 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.  The programmer does not have to be-aware of threads, locking or synchronization to write scalable concurrent-programs.+Please see the [`credits`](/docs/User/Project/Credits.md) directory for a full+list of contributors, credits and licenses. -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 in favor of streamly are:+## Licensing -  * _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 the-    same way 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 best possible performance. Serial peformance 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.+Streamly is an [open source](https://github.com/composewell/streamly)+project available under a liberal [BSD-3-Clause license][LICENSE] -The basic streaming functionality of streamly is equivalent to that provided by-streaming libraries like-[vector](https://hackage.haskell.org/package/vector),-[streaming](https://hackage.haskell.org/package/streaming),-[pipes](https://hackage.haskell.org/package/pipes), and-[conduit](https://hackage.haskell.org/package/conduit).-In addition to providing streaming functionality, streamly subsumes-the functionality of list transformer libraries like `pipes` or-[list-t](https://hackage.haskell.org/package/list-t), and also the logic-programming library [logict](https://hackage.haskell.org/package/logict). On-the concurrency side, it subsumes the functionality of the-[async](https://hackage.haskell.org/package/async) package, and provides even-higher level concurrent composition. Because it supports-streaming with concurrency we can write FRP applications similar in concept to-[Yampa](https://hackage.haskell.org/package/Yampa) or-[reflex](https://hackage.haskell.org/package/reflex).+## Contributing to Streamly -See the `Comparison with existing packages` section at the end of the-[tutorial](https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html).+As an open project we welcome contributions: -## Further Reading+* [Streamly Contributor's Guide][CONTRIBUTING.md]+* [Contact the streamly development team](mailto:streamly@composewell.com) -For more information, see:+## Getting Support -  * [Detailed tutorial](https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html)-  * [Reference documentation](https://hackage.haskell.org/package/streamly)-  * [Examples](https://github.com/composewell/streamly/tree/master/examples)-  * [Guides](https://github.com/composewell/streamly/blob/master/docs)-  * [Streaming benchmarks](https://github.com/composewell/streaming-benchmarks)-  * [Concurrency benchmarks](https://github.com/composewell/concurrency-benchmarks)+Professional support is available for [Streamly][]: please contact+[support@composewell.com](mailto:support@composewell.com). -## Support+You can also join our [community chat+channel](https://gitter.im/composewell/streamly) on Gitter. -If you require professional support, consulting, training or timely-enhancements to the library please contact-[support@composewell.com](mailto:support@composewell.com).+<!--+Link References.+--> -## Contributing+[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 -The code is available under BSD-3 license-[on github](https://github.com/composewell/streamly). Join the-[gitter chat](https://gitter.im/composewell/streamly) channel for discussions.-You can find some of the-[todo items on the github wiki](https://github.com/composewell/streamly/wiki/Things-To-Do).-Please ask on the gitter channel or [contact the maintainer directly](mailto:harendra.kumar@gmail.com)-for more details on each item. All contributions are welcome!+<!--+Keep all the unstable links here so that they can be updated to stable+links (for online docs) before we release.+--> -This library was originally inspired by the `transient` package authored by-Alberto G. Corona.+<!-- local files -->+[LICENSE]: /LICENSE+[CONTRIBUTING.md]: /docs/Developer/Contributing.md+[docs]: docs/
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMainWithHooks autoconfUserHooks
+ 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))
− bench.sh 
@@ -1,287 +0,0 @@-#!/bin/bash--print_help () {-  echo "Usage: $0 "-  echo "       [--compare] [--base commit] [--candidate commit]"-  echo "       [--benchmarks <all|linear|linear-async|linear-rate|nested|base>]"-  echo "       [--graphs]"-  echo "       [--slow]"-  echo "       [--no-measure]"-  echo "       [--append] "-  echo "       -- <gauge options>"-  echo-  echo "Multiple benchmarks can be specified as a space separate list"-  echo " e.g. --benchmarks \"linear nested\""-  echo-  echo "When using --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 guage"-  echo "You can omit '--' if the gauge args used do not start with a '-'."-  exit-}--# $1: message-die () {-  >&2 echo -e "Error: $1"-  exit 1-}--set_benchmarks() {-  if test -z "$BENCHMARKS"-  then-    BENCHMARKS=$DEFAULT_BENCHMARKS-  elif test "$BENCHMARKS" = "all"-  then-    BENCHMARKS=$ALL_BENCHMARKS-  fi-  echo "Using benchmark suites [$BENCHMARKS]"-}--# $1: benchmark name (linear, nested, base)-find_report_prog() {-    local prog_name="chart"-    hash -r-    local prog_path=$($STACK exec which $prog_name)-    if test -x "$prog_path"-    then-      echo $prog_path-    else-      return 1-    fi-}--# $1: benchmark name (linear, nested, base)-build_report_prog() {-    local prog_name="chart"-    local prog_path=$($STACK exec which $prog_name)--    hash -r-    if test ! -x "$prog_path" -a "$BUILD_ONCE" = "0"-    then-      echo "Building bench-graph executables"-      BUILD_ONCE=1-      $STACK build --flag "streamly:dev" || die "build failed"-    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=$(find_report_prog) || \-          die "Cannot find bench-graph executable"-      echo "Using bench-graph 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 guage as an argument. Unfortunately it cannot find its-# own path currently.--# The path is dependent on the architecture and cabal version.-# Use this command to find the exe if this script fails with an error:-# find .stack-work/ -type f -name "benchmarks"--find_bench_prog () {-  local bench_name=$1-  local bench_prog=`$STACK path --dist-dir`/build/$bench_name/$bench_name-  if test -x "$bench_prog"-  then-    echo $bench_prog-  else-    return 1-  fi-}--bench_output_file() {-    local bench_name=$1-    echo "charts/$bench_name/results.csv"-}--# --min-duration 0 means exactly one iteration per sample. We use a million-# iterations in the benchmarking code explicitly and do not use the iterations-# done by the benchmarking tool.-#-# Benchmarking tool by default discards the first iteration to remove-# aberrations due to initial evaluations etc. We do not discard it because we-# are anyway doing iterations in the benchmarking code and many of them so that-# any constant factor gets amortized and anyway it is a cost that we pay in-# real life.-#-# We can pass --min-samples value from the command line as second argument-# after the benchmark name in case we want to use more than one sample.--run_bench () {-  local bench_name=$1-  local output_file=$(bench_output_file $bench_name)-  local bench_prog-  bench_prog=$(find_bench_prog $bench_name) || \-    die "Cannot find benchmark executable for benchmark $bench_name"--  mkdir -p `dirname $output_file`--  echo "Running benchmark $bench_name ..."--  $bench_prog $SPEED_OPTIONS \-    --csvraw=$output_file \-    -v 2 \-    --measure-with $bench_prog $GAUGE_ARGS || die "Benchmarking failed"-}--run_benches() {-    for i in $1-    do-      run_bench $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"-    git checkout "$BASE" || die "Checkout of base commit [$BASE] failed"--    $STACK build --bench --no-run-benchmarks || die "build failed"-    run_benches "$bench_list"--    echo "Checking out candidate commit [$CANDIDATE] for benchmarking"-    git checkout "$CANDIDATE" || \-        die "Checkout of candidate [$CANDIDATE] commit failed"--    $STACK build --bench --no-run-benchmarks || die "build failed"-    run_benches "$bench_list"-    # 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 "$COMPARE" = "0"-  then-    run_benches "$bench_list"-  else-    run_benches_comparing "$bench_list"-  fi-}--run_reports() {-    local prog-    prog=$(find_report_prog) || \-      die "Cannot find bench-graph executable"-    echo--    for i in $1-    do-        echo "Generating reports for ${i}..."-        $prog --benchmark $i-    done-}--#------------------------------------------------------------------------------# Execution starts here-#-------------------------------------------------------------------------------DEFAULT_BENCHMARKS="linear"-ALL_BENCHMARKS="linear linear-async linear-rate nested base"--COMPARE=0-BASE=-CANDIDATE=--APPEND=0-RAW=0-GRAPH=0-MEASURE=1-SPEED_OPTIONS="--quick --min-samples 10 --time-limit 1 --min-duration 0"--STACK=stack-GAUGE_ARGS=--BUILD_ONCE=0--#------------------------------------------------------------------------------# Read command line-#-------------------------------------------------------------------------------while test -n "$1"-do-  case $1 in-    -h|--help|help) print_help ;;-    --slow) SPEED_OPTIONS="--min-duration 0"; shift ;;-    --append) APPEND=1; shift ;;-    --benchmarks) shift; BENCHMARKS=$1; shift ;;-    --base) shift; BASE=$1; shift ;;-    --candidate) shift; CANDIDATE=$1; shift ;;-    --compare) COMPARE=1; shift ;;-    --raw) RAW=1; shift ;;-    --graphs) GRAPH=1; shift ;;-    --no-measure) MEASURE=0; shift ;;-    --) shift; break ;;-    -*|--*) print_help ;;-    *) break ;;-  esac-done-GAUGE_ARGS=$*--echo "Using stack command [$STACK]"-set_benchmarks--#------------------------------------------------------------------------------# Build stuff-#-------------------------------------------------------------------------------# We need to build the report progs first at the current (latest) commit before-# checking out any other commit for benchmarking.-build_report_progs "$BENCHMARKS"--#------------------------------------------------------------------------------# Run benchmarks-#-------------------------------------------------------------------------------if test "$MEASURE" = "1"-then-  $STACK build --bench --no-run-benchmarks || die "build failed"-  run_measurements "$BENCHMARKS"-fi--#------------------------------------------------------------------------------# Run reports-#-------------------------------------------------------------------------------if test "$RAW" = "0"-then-    run_reports "$BENCHMARKS"-fi
− benchmark/BaseStreams.hs 
@@ -1,134 +0,0 @@--- |--- Module      : Main--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--{-# LANGUAGE CPP                       #-}--import Control.DeepSeq (NFData)--- import Data.Functor.Identity (Identity, runIdentity)-import System.Random (randomRIO)--import Gauge-import qualified StreamDOps as D-import qualified StreamKOps as K---- 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 benchIO #-}-benchIO :: String -> (a IO Int -> IO ()) -> (Int -> a IO Int) -> Benchmark-benchIO name run f = bench name $ nfIO $ randomRIO (1,1000) >>= run . f--benchFold :: NFData b-    => String -> (t IO Int -> IO b) -> (Int -> t IO Int) -> Benchmark-benchFold name f src = bench name $ nfIO $ randomRIO (1,1000) >>= f . src--{--_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark-_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)--}--main :: IO ()-main =-  defaultMain-    [ bgroup "streamD"-      [ bgroup "generation"-        [ benchIO "unfoldr"      D.toNull D.sourceUnfoldr-        , benchIO "unfoldrM"     D.toNull D.sourceUnfoldrM-        , benchIO "fromEnum"     D.toNull D.sourceFromEnum--        , benchIO "fromList" D.toNull D.sourceFromList-        -- , benchIO "fromFoldableM" D.sourceFromFoldableM-        ]-      , bgroup "elimination"-        [ benchIO "toNull" D.toNull D.sourceUnfoldrM-        , benchIO "uncons" D.uncons D.sourceUnfoldrM-        , benchIO "nullHeadTail" D.nullHeadTail D.sourceUnfoldrM-        ]-      , bgroup "transformation"-        [ benchIO "scanlM'" D.scan D.sourceUnfoldrM-        , benchIO "map"  D.map D.sourceUnfoldrM-        , benchIO "mapM" D.mapM D.sourceUnfoldrM-        ]-      , bgroup "filtering"-        [ benchIO "filter-even"    D.filterEven D.sourceUnfoldrM-        , benchIO "filter-all-out" D.filterAllOut D.sourceUnfoldrM-        , benchIO "filter-all-in"  D.filterAllIn D.sourceUnfoldrM-        , benchIO "take-all"       D.takeAll D.sourceUnfoldrM-        , benchIO "takeWhile-true" D.takeWhileTrue D.sourceUnfoldrM-        , benchIO "drop-all"       D.dropAll D.sourceUnfoldrM-        , benchIO "dropWhile-true" D.dropWhileTrue D.sourceUnfoldrM-        ]-      , benchIO "zip" D.zip D.sourceUnfoldrM-      , bgroup "compose"-        [ benchIO "mapM" D.composeMapM D.sourceUnfoldrM-#if __GLASGOW_HASKELL__ != 802-        , benchIO "map-with-all-in-filter" D.composeMapAllInFilter D.sourceUnfoldrM-        , benchIO "all-in-filters" D.composeAllInFilters D.sourceUnfoldrM-        , benchIO "all-out-filters" D.composeAllOutFilters D.sourceUnfoldrM-#endif-        ]-        -- Scaling with same operation in sequence-      , bgroup "compose-scaling"-        [ benchIO "1" (D.composeScaling 1) D.sourceUnfoldrM-        , benchIO "2" (D.composeScaling 2) D.sourceUnfoldrM-        , benchIO "3" (D.composeScaling 3) D.sourceUnfoldrM-        , benchIO "4" (D.composeScaling 4) D.sourceUnfoldrM-        ]-      ]-    , bgroup "streamK"-      [ bgroup "generation"-        [ benchIO "unfoldr"       K.toNull K.sourceUnfoldr-        , benchIO "unfoldrM"      K.toNull K.sourceUnfoldrM-        -- , benchIO "fromEnum"     K.toNull K.sourceFromEnum--        , benchIO "fromFoldable"  K.toNull K.sourceFromFoldable-        -- , benchIO "fromFoldableM" K.toNull K.sourceFromFoldableM--        -- appends-        , benchIO "foldMapWith"  K.toNull K.sourceFoldMapWith-        , benchIO "foldMapWithM" K.toNull K.sourceFoldMapWithM-        ]-      , bgroup "elimination"-        [ benchIO "toNull" K.toNull K.sourceUnfoldrM-        , benchIO "uncons" K.uncons K.sourceUnfoldrM-        , benchFold "init" K.init   K.sourceUnfoldrM-        , benchFold "tail" K.tail   K.sourceUnfoldrM-        , benchIO "nullHeadTail" K.nullHeadTail K.sourceUnfoldrM-        , benchFold "toList" K.toList K.sourceUnfoldrM-        , benchFold "fold"   K.foldl  K.sourceUnfoldrM-        , benchFold "last"   K.last   K.sourceUnfoldrM-        ]-      , bgroup "transformation"-        [ benchIO "scan"   K.scan K.sourceUnfoldrM-        , benchIO "map"    K.map K.sourceUnfoldrM-        , benchIO "mapM"   K.mapM K.sourceUnfoldrM-        -- , benchIO "concat" K.concat K.sourceUnfoldrM-        ]-      , bgroup "filtering"-        [ benchIO "filter-even"    K.filterEven K.sourceUnfoldrM-        , benchIO "filter-all-out" K.filterAllOut K.sourceUnfoldrM-        , benchIO "filter-all-in"  K.filterAllIn K.sourceUnfoldrM-        , benchIO "take-all"       K.takeAll K.sourceUnfoldrM-        , benchIO "takeWhile-true" K.takeWhileTrue K.sourceUnfoldrM-        , benchIO "drop-all"       K.dropAll K.sourceUnfoldrM-        , benchIO "dropWhile-true" K.dropWhileTrue K.sourceUnfoldrM-        ]-      , benchIO "zip" K.zip K.sourceUnfoldrM-      , bgroup "compose"-        [ benchIO "mapM" K.composeMapM K.sourceUnfoldrM-        , benchIO "map-with-all-in-filter" K.composeMapAllInFilter K.sourceUnfoldrM-        , benchIO "all-in-filters" K.composeAllInFilters K.sourceUnfoldrM-        , benchIO "all-out-filters" K.composeAllOutFilters K.sourceUnfoldrM-        ]-        -- Scaling with same operation in sequence-      , bgroup "compose-scaling"-        [ benchIO "1" (K.composeScaling 1) K.sourceUnfoldrM-        , benchIO "2" (K.composeScaling 2) K.sourceUnfoldrM-        , benchIO "3" (K.composeScaling 3) K.sourceUnfoldrM-        , benchIO "4" (K.composeScaling 4) K.sourceUnfoldrM-        ]-      ]-    ]
− benchmark/Chart.hs 
@@ -1,200 +0,0 @@-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main where--import Control.Exception (handle, catch, SomeException, ErrorCall(..))-import Control.Monad.Trans.State-import Control.Monad.Trans.Maybe-import Data.List-import Data.List.Split-import Data.Ord (comparing)-import System.Environment (getArgs)-import Control.Monad.IO.Class (liftIO)-import Control.Monad (mzero)--import BenchShow----------------------------------------------------------------------------------- Command line parsing---------------------------------------------------------------------------------data BenchType = Linear | LinearAsync | LinearRate | Nested | Base--data Options = Options-    { genGraphs :: Bool-    , benchType :: BenchType-    }--defaultOptions = Options False Linear--setGenGraphs val = do-    (args, opts) <- get-    put (args, opts { genGraphs = val })--setBenchType val = do-    (args, opts) <- get-    put (args, opts { benchType = 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 "linear" -> setBenchType Linear-        Just "linear-async" -> setBenchType LinearAsync-        Just "linear-rate" -> setBenchType LinearRate-        Just "nested" -> setBenchType Nested-        Just "base" -> setBenchType Base-        Just str -> do-                liftIO $ putStrLn $ "unrecognized benchmark type " <> str-                mzero-        Nothing -> do-                liftIO $ putStrLn "please provide a benchmark type "-                mzero---- totally imperative style option parsing-parseOptions :: IO (Maybe Options)-parseOptions = do-    args <- getArgs-    runMaybeT $ flip evalStateT (args, defaultOptions) $ do-        x <- shift-        case x of-            Just "--graphs" -> setGenGraphs True-            Just "--benchmark" -> parseBench-            Just str -> do-                liftIO $ putStrLn $ "Unrecognized option " <> str-                mzero-            Nothing -> return ()-        fmap snd get--ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->-    putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")----------------------------------------------------------------------------------- Linear composition charts---------------------------------------------------------------------------------makeLinearGraphs :: Config -> String -> IO ()-makeLinearGraphs cfg inputFile = do-    ignoringErr $ graph inputFile "operations" $ cfg-        { title = Just "Streamly operations"-        , classifyBenchmark = \b ->-                if not ("serially/" `isPrefixOf` b)-                   || "/generation" `isInfixOf` b-                   || "/compose" `isInfixOf` b-                   || "/concat" `isSuffixOf` b-                then Nothing-                else Just ("Streamly", last $ splitOn "/" b)-        }--    ignoringErr $ graph inputFile "generation" $ cfg-        { title = Just "Stream generation"-        , classifyBenchmark = \b ->-                if "serially/generation" `isPrefixOf` b-                then Just ("Streamly", last $ splitOn "/" b)-                else Nothing-        }--    ignoringErr $ graph inputFile "composition" $ cfg-        { title = Just "Streamly composition performance"-        , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose/"-        }--    ignoringErr $ graph inputFile "composition-scaling"-        $ cfg-        { title = Just "Streamly composition scaling"-        , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose-"-        }----------------------------------------------------------------------------------- Nested composition charts---------------------------------------------------------------------------------makeNestedGraphs :: Config -> String -> IO ()-makeNestedGraphs cfg inputFile =-    ignoringErr $ graph inputFile "nested-serial-diff" $ cfg-        { title = Just "Nested serial"-        , classifyBenchmark = \b ->-            let ls = splitOn "/" b-            in case head ls of-                "serially" -> Just (head ls, last ls)-                _ -> Nothing-        }----------------------------------------------------------------------------------- Charts for parallel streams---------------------------------------------------------------------------------makeLinearAsyncGraphs :: Config -> String -> IO ()-makeLinearAsyncGraphs cfg inputFile = do-    putStrLn "Not implemented"-    return ()--makeLinearRateGraphs :: Config -> String -> IO ()-makeLinearRateGraphs cfg inputFile = do-    putStrLn "Not implemented"-    return ()----------------------------------------------------------------------------------- Charts for base streams---------------------------------------------------------------------------------makeBaseGraphs :: Config -> String -> IO ()-makeBaseGraphs cfg inputFile = do-    putStrLn "Not implemented"-    return ()----------------------------------------------------------------------------------- text reports---------------------------------------------------------------------------------benchShow Options{..} cfg func inp out =-    if genGraphs-    then func cfg {outputDir = Just out} inp-    else-        ignoringErr $ report inp Nothing $ cfg-            { selectBenchmarks =-                  \f ->-                        reverse-                      $ fmap fst-                      $ either-                          (const $ either error id $ f $ ColumnIndex 0)-                          (sortOn snd)-                          $ f $ ColumnIndex 1-            }--main :: IO ()-main = do-    let cfg = defaultConfig { presentation = Groups PercentDiff }-    res <- parseOptions--    case res of-        Nothing -> do-            putStrLn "cannot parse options"-            return ()-        Just opts@Options{..} ->-            case benchType of-                Linear -> benchShow opts cfg makeLinearGraphs-                            "charts/linear/results.csv"-                            "charts/linear"-                LinearAsync -> benchShow opts cfg makeLinearAsyncGraphs-                            "charts/linear-async/results.csv"-                            "charts/linear-async"-                LinearRate -> benchShow opts cfg makeLinearRateGraphs-                            "charts/linear-rate/results.csv"-                            "charts/linear-rate"-                Nested -> benchShow opts cfg makeNestedGraphs-                            "charts/nested/results.csv"-                            "charts/nested"-                Base -> benchShow opts cfg makeBaseGraphs-                            "charts/base/results.csv"-                            "charts/base"
− benchmark/Linear.hs 
@@ -1,126 +0,0 @@--- |--- Module      : Main--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--import Control.DeepSeq (NFData)--- import Data.Functor.Identity (Identity, runIdentity)-import System.Random (randomRIO)-import qualified LinearOps as Ops--import Streamly-import Gauge---- 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.------ | Takes a fold method, and uses it with a default source.-{-# INLINE benchIO #-}-benchIO :: (IsStream t, NFData b) => String -> (t IO Int -> IO b) -> Benchmark-benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source---- | Takes a source, and uses it with a default drain/fold method.-{-# INLINE benchSrcIO #-}-benchSrcIO-    :: (t IO Int -> SerialT IO Int)-    -> String-    -> (Int -> t IO Int)-    -> Benchmark-benchSrcIO t name f-    = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f--{--_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark-_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)--}--main :: IO ()-main =-  defaultMain-    [ bgroup "serially"-      [ bgroup "generation"-        [ -- Most basic, barely stream continuations running-          benchSrcIO serially "unfoldr" Ops.sourceUnfoldr-        , benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM-        , benchSrcIO serially "fromList" Ops.sourceFromList-        , benchSrcIO serially "fromListM" Ops.sourceFromListM-        -- These are essentially cons and consM-        , benchSrcIO serially "fromFoldable" Ops.sourceFromFoldable-        , benchSrcIO serially "fromFoldableM" Ops.sourceFromFoldableM-        -- These are essentially appends-        , benchSrcIO serially "foldMapWith" Ops.sourceFoldMapWith-        , benchSrcIO serially "foldMapWithM" Ops.sourceFoldMapWithM-        ]-      , bgroup "elimination"-        [ benchIO "toNull" $ Ops.toNull serially-        , benchIO "uncons" Ops.uncons-        , benchIO "init" Ops.init-        , benchIO "tail" Ops.tail-        , benchIO "nullHeadTail" Ops.nullHeadTail-        , benchIO "mapM_" Ops.mapM_-        , benchIO "toList" Ops.toList-        , benchIO "foldr" Ops.foldr-        , benchIO "foldr1" Ops.foldr1-        , benchIO "foldrM" Ops.foldrM-        , benchIO "foldl'" Ops.foldl'-        , benchIO "foldl1'" Ops.foldl1'--        , benchIO "last" Ops.last-        , benchIO "length" Ops.length-        , benchIO "elem" Ops.elem-        , benchIO "notElem" Ops.notElem-        , benchIO "all" Ops.all-        , benchIO "any" Ops.any-        , benchIO "and" Ops.and-        , benchIO "or" Ops.or-        , benchIO "find" Ops.find-        , benchIO "findIndex" Ops.findIndex-        , benchIO "elemIndex" Ops.elemIndex-        , benchIO "maximum" Ops.maximum-        , benchIO "minimum" Ops.minimum-        , benchIO "sum" Ops.sum-        , benchIO "product" Ops.product-        ]-      , bgroup "transformation"-        [ benchIO "scan" Ops.scan-        , benchIO "map" Ops.map-        , benchIO "fmap" Ops.fmap-        , benchIO "mapM" (Ops.mapM serially)-        , benchIO "mapMaybe" Ops.mapMaybe-        , benchIO "mapMaybeM" Ops.mapMaybeM-        , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->-            Ops.sequence serially (Ops.sourceUnfoldrMAction n)-        , benchIO "findIndices" Ops.findIndices-        , benchIO "elemIndices" Ops.elemIndices-        -- , benchIO "concat" Ops.concat-        ]-      , bgroup "filtering"-        [ benchIO "filter-even" Ops.filterEven-        , benchIO "filter-all-out" Ops.filterAllOut-        , benchIO "filter-all-in" Ops.filterAllIn-        , benchIO "take-all" Ops.takeAll-        , benchIO "takeWhile-true" Ops.takeWhileTrue-        , benchIO "takeWhileM-true" Ops.takeWhileMTrue-        , benchIO "drop-all" Ops.dropAll-        , benchIO "dropWhile-true" Ops.dropWhileTrue-        , benchIO "dropWhileM-true" Ops.dropWhileMTrue-        ]-      , benchIO "zip" Ops.zip-      , benchIO "zipM" Ops.zipM-      , bgroup "compose"-        [ benchIO "mapM" Ops.composeMapM-        , benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter-        , benchIO "all-in-filters" Ops.composeAllInFilters-        , benchIO "all-out-filters" Ops.composeAllOutFilters-        ]-        -- Scaling with same operation in sequence-      , bgroup "compose-scaling"-        [ benchIO "1" $ Ops.composeScaling 1-        , benchIO "2" $ Ops.composeScaling 2-        , benchIO "3" $ Ops.composeScaling 3-        , benchIO "4" $ Ops.composeScaling 4-        ]-      ]-      ]
− benchmark/LinearAsync.hs 
@@ -1,92 +0,0 @@--- |--- Module      : Main--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--import Control.DeepSeq (NFData)--- import Data.Functor.Identity (Identity, runIdentity)-import System.Random (randomRIO)-import qualified LinearOps as Ops--import Streamly-import Gauge---- 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.------ | Takes a fold method, and uses it with a default source.-{-# INLINE benchIO #-}-benchIO :: (IsStream t, NFData b) => String -> (t IO Int -> IO b) -> Benchmark-benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source---- | Takes a source, and uses it with a default drain/fold method.-{-# INLINE benchSrcIO #-}-benchSrcIO-    :: (t IO Int -> SerialT IO Int)-    -> String-    -> (Int -> t IO Int)-    -> Benchmark-benchSrcIO t name f-    = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f--{--_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark-_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)--}--main :: IO ()-main =-  defaultMain-    [ bgroup "asyncly"-        [ -- benchIO "unfoldr" $ Ops.toNull asyncly-          benchSrcIO asyncly "unfoldrM" Ops.sourceUnfoldrM-        -- , benchSrcIO asyncly "fromFoldable" Ops.sourceFromFoldable-        , benchSrcIO asyncly "fromFoldableM" Ops.sourceFromFoldableM-        -- , benchSrcIO asyncly "foldMapWith" Ops.sourceFoldMapWith-        , benchSrcIO asyncly "foldMapWithM" Ops.sourceFoldMapWithM-        , benchIO "mapM"   $ Ops.mapM asyncly-        , benchSrcIO asyncly "unfoldrM maxThreads 1"-            (maxThreads 1 . Ops.sourceUnfoldrM)-        , benchSrcIO asyncly "unfoldrM maxBuffer 1 (1000 ops)"-            (maxBuffer 1 . Ops.sourceUnfoldrMN 1000)-        ]-      , bgroup "wAsyncly"-        [ -- benchIO "unfoldr" $ Ops.toNull wAsyncly-          benchSrcIO wAsyncly "unfoldrM" Ops.sourceUnfoldrM-        -- , benchSrcIO wAsyncly "fromFoldable" Ops.sourceFromFoldable-        , benchSrcIO wAsyncly "fromFoldableM" Ops.sourceFromFoldableM-        -- , benchSrcIO wAsyncly "foldMapWith" Ops.sourceFoldMapWith-        , benchSrcIO wAsyncly "foldMapWithM" Ops.sourceFoldMapWithM-        , benchIO "mapM"   $ Ops.mapM wAsyncly-        ]-      -- unfoldr and fromFoldable are always serial and thereofore the same for-      -- all stream types.-      , bgroup "aheadly"-        [ -- benchIO "unfoldr" $ Ops.toNull aheadly-          benchSrcIO aheadly "unfoldrM" Ops.sourceUnfoldrM-        , benchSrcIO aheadly "fromFoldableM" Ops.sourceFromFoldableM-        -- , benchSrcIO aheadly "foldMapWith" Ops.sourceFoldMapWith-        , benchSrcIO aheadly "foldMapWithM" Ops.sourceFoldMapWithM-        , benchIO       "mapM"  $ Ops.mapM aheadly-        , benchSrcIO aheadly "unfoldrM maxThreads 1"-            (maxThreads 1 . Ops.sourceUnfoldrM)-        , benchSrcIO aheadly "unfoldrM maxBuffer 1 (1000 ops)"-            (maxBuffer 1 . Ops.sourceUnfoldrMN 1000)-        -- , benchSrcIO aheadly "fromFoldable" Ops.sourceFromFoldable-        ]-     -- XXX need to use smaller streams to finish in reasonable time-      , bgroup "parallely"-        [ --benchIO "unfoldr" $ Ops.toNull parallely-          benchSrcIO parallely "unfoldrM" Ops.sourceUnfoldrM-        --, benchSrcIO parallely "fromFoldable" Ops.sourceFromFoldable-        , benchSrcIO parallely "fromFoldableM" Ops.sourceFromFoldableM-        -- , benchSrcIO parallely "foldMapWith" Ops.sourceFoldMapWith-        , benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM-        , benchIO "mapM" $ Ops.mapM parallely-        -- Zip has only one parallel flavor-        , benchIO "zip" Ops.zipAsync-        , benchIO "zipM" Ops.zipAsyncM-        ]-      ]
− benchmark/LinearOps.hs 
@@ -1,324 +0,0 @@--- |--- Module      : BenchmarkOps--- Copyright   : (c) 2018 Harendra Kumar------ License     : MIT--- Maintainer  : harendra.kumar@gmail.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}--module LinearOps where--import Control.Monad (when)-import Data.Maybe (fromJust)-import Prelude-       (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),-        subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry)--import qualified Streamly          as S-import qualified Streamly.Prelude  as S--value, maxValue :: Int-#ifdef LINEAR_ASYNC-value = 10000-#else-value = 100000-#endif-maxValue = value + 1------------------------------------------------------------------------------------ Benchmark ops-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.SerialT m a--{-# INLINE source #-}-source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int-source n = S.serially $ sourceUnfoldrM n--- source n = S.serially $ sourceFromList n--{-# INLINE sourceFromList #-}-sourceFromList :: (Monad m, S.IsStream t) => Int -> t m Int-sourceFromList n = S.fromList [n..n+value]--{-# INLINE sourceFromListM #-}-sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int-sourceFromListM n = S.fromListM (Prelude.fmap return [n..n+value])--{-# INLINE sourceFromFoldable #-}-sourceFromFoldable :: S.IsStream t => Int -> t m Int-sourceFromFoldable n = S.fromFoldable [n..n+value]--{-# INLINE sourceFromFoldableM #-}-sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int-sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])--{-# INLINE sourceFoldMapWith #-}-sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))-    => Int -> t m Int-sourceFoldMapWith n = S.foldMapWith (S.<>) S.yield [n..n+value]--{-# INLINE sourceFoldMapWithM #-}-sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))-    => Int -> t m Int-sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]--{-# INLINE sourceUnfoldr #-}-sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> t m Int-sourceUnfoldr n = S.unfoldr step n-    where-    step cnt =-        if cnt > n + value-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t 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 :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t 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 sourceUnfoldrMAction #-}-sourceUnfoldrMAction :: (S.IsStream t, S.MonadAsync m) => Int -> t m (m Int)-sourceUnfoldrMAction n = S.serially $ S.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else return (Just (return cnt, cnt + 1))------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.runStream--{-# INLINE toList #-}-{-# INLINE foldr #-}-{-# INLINE foldrM #-}-toList, foldr, foldrM :: Monad m => Stream m Int -> m [Int]--{-# INLINE last #-}-{-# INLINE maximum #-}-{-# INLINE minimum #-}-{-# INLINE find #-}-{-# INLINE findIndex #-}-{-# INLINE elemIndex #-}-{-# INLINE foldl1' #-}-{-# INLINE foldr1 #-}-last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1 :: Monad m => Stream m Int -> m (Maybe Int)--{-# INLINE foldl' #-}-{-# INLINE length #-}-{-# INLINE sum #-}-{-# INLINE product #-}-foldl', length, sum, product :: Monad m => Stream m Int -> m Int--{-# INLINE all #-}-{-# INLINE any #-}-{-# INLINE and #-}-{-# INLINE or #-}-{-# INLINE elem #-}-{-# INLINE notElem #-}-elem, notElem, all, any, and, or :: Monad m => Stream m Int -> m Bool--{-# INLINE toNull #-}-toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()-toNull t = runStream . t--{-# 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 = S.init s >>= Prelude.mapM_ S.runStream--{-# INLINE tail #-}-tail :: Monad m => Stream m a -> m ()-tail s = S.tail s >>= Prelude.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 >>= Prelude.mapM_ nullHeadTail--mapM_  = S.mapM_ (\_ -> return ())-toList = S.toList-foldr  = S.foldr (:) []-foldr1 = S.foldr1 (+)-foldrM = S.foldrM (\a xs -> return (a : xs)) []-foldl' = S.foldl' (+) 0-foldl1' = S.foldl1' (+)-last   = S.last-elem   = S.elem maxValue-notElem = S.notElem maxValue-length = S.length-all    = S.all (<= maxValue)-any    = S.any (> maxValue)-and    = S.and . S.map (<= maxValue)-or     = S.or . S.map (> maxValue)-find   = S.find (== maxValue)-findIndex = S.findIndex (== maxValue)-elemIndex = S.elemIndex maxValue-maximum = S.maximum-minimum = S.minimum-sum    = S.sum-product = S.product------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{-# INLINE transform #-}-transform :: Monad m => Stream m a -> m ()-transform = runStream--{-# INLINE scan #-}-{-# INLINE mapM_ #-}-{-# INLINE map #-}-{-# INLINE fmap #-}-{-# INLINE mapMaybe #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE takeWhileMTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE dropWhileMTrue #-}-{-# INLINE findIndices #-}-{-# INLINE elemIndices #-}-scan, mapM_, map, fmap, mapMaybe, filterEven, filterAllOut,-    filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropAll,-    dropWhileTrue, dropWhileMTrue,-    findIndices, elemIndices-    :: Monad m-    => Stream m Int -> m ()--{-# INLINE mapMaybeM #-}-mapMaybeM :: S.MonadAsync m => Stream m Int -> m ()--{-# INLINE mapM #-}-mapM :: (S.IsStream t, S.MonadAsync m)-    => (t m Int -> S.SerialT m Int) -> t m Int -> m ()--{-# INLINE sequence #-}-sequence :: (S.IsStream t, S.MonadAsync m)-    => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()--scan          = transform . S.scanl' (+) 0-fmap          = transform . Prelude.fmap (+1)-map           = transform . S.map (+1)-mapM t        = transform . t . S.mapM return-mapMaybe      = transform . S.mapMaybe-    (\x -> if Prelude.odd x then Nothing else Just ())-mapMaybeM     = transform . S.mapMaybeM-    (\x -> if Prelude.odd x then return Nothing else return $ Just ())-sequence t    = transform . t . S.sequence-filterEven    = transform . S.filter even-filterAllOut  = transform . S.filter (> maxValue)-filterAllIn   = transform . S.filter (<= maxValue)-takeOne       = transform . S.take 1-takeAll       = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-takeWhileMTrue = transform . S.takeWhileM (return . (<= maxValue))-dropAll       = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)-dropWhileMTrue = transform . S.dropWhileM (return . (<= maxValue))-findIndices    = transform . S.findIndices (== maxValue)-elemIndices    = transform . S.elemIndices maxValue------------------------------------------------------------------------------------ Zipping and concat----------------------------------------------------------------------------------{-# INLINE zip #-}-{-# INLINE zipM #-}-{-# INLINE concat #-}-zip, zipM, concat  :: Monad m => Stream m Int -> m ()--{-# INLINE zipAsync #-}-{-# INLINE zipAsyncM #-}-zipAsync, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()--zip src       = do-    r <- S.tail src-    let src1 = fromJust r-    transform (S.zipWith (,) src src1)-zipM src      =  do-    r <- S.tail src-    let src1 = fromJust r-    transform (S.zipWithM (curry return) src src1)-zipAsync src  = do-    r <- S.tail src-    let src1 = fromJust r-    transform (S.zipAsyncWith (,) src src1)-zipAsyncM src = do-    r <- S.tail src-    let src1 = fromJust r-    transform (S.zipAsyncWithM (curry return) src src1)-concat _n     = return ()------------------------------------------------------------------------------------ Composition----------------------------------------------------------------------------------{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f--{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-composeAllInFilters, composeAllOutFilters,-    composeMapAllInFilter-    :: Monad m-    => Stream m Int -> m ()-composeMapM :: S.MonadAsync m => Stream m Int -> m ()--composeMapM           = compose (S.mapM return)-composeAllInFilters   = compose (S.filter (<= maxValue))-composeAllOutFilters  = compose (S.filter (> maxValue))-composeMapAllInFilter =-    compose (S.filter (<= maxValue) . Prelude.fmap (subtract 1))--{-# INLINABLE composeScaling #-}-composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling m =-    case m of-        1 -> transform . f-        2 -> transform . f . f-        3 -> transform . f . f . f-        4 -> transform . f . f . f . f-        _ -> undefined-    where f = S.filter (<= maxValue)
− benchmark/LinearRate.hs 
@@ -1,60 +0,0 @@--- |--- Module      : Main--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com---- Rate benchmarks are kept separate because they need more running time to--- provide stable results.---- import Data.Functor.Identity (Identity, runIdentity)-import System.Random (randomRIO)-import qualified LinearOps as Ops--import Streamly-import Gauge---- | Takes a source, and uses it with a default drain/fold method.-{-# INLINE benchSrcIO #-}-benchSrcIO-    :: (t IO Int -> SerialT IO Int)-    -> String-    -> (Int -> t IO Int)-    -> Benchmark-benchSrcIO t name f-    = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f--{--_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark-_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)--}--main :: IO ()-main =-  defaultMain-    -- XXX arbitrarily large rate should be the same as rate Nothing-    [ bgroup "avgrate"-      [ bgroup "asyncly"-        [ -- benchIO "unfoldr" $ Ops.toNull asyncly-          benchSrcIO asyncly "unfoldrM" Ops.sourceUnfoldrM-        , benchSrcIO asyncly "unfoldrM/Nothing"-            (rate Nothing . Ops.sourceUnfoldrM)-        , benchSrcIO asyncly "unfoldrM/1,000,000"-            (avgRate 1000000 . Ops.sourceUnfoldrM)-        , benchSrcIO asyncly "unfoldrM/3,000,000"-            (avgRate 3000000 . Ops.sourceUnfoldrM)-        , benchSrcIO asyncly "unfoldrM/10,000,000/maxThreads1"-            (maxThreads 1 . avgRate 10000000 . Ops.sourceUnfoldrM)-        , benchSrcIO asyncly "unfoldrM/10,000,000"-            (avgRate 10000000 . Ops.sourceUnfoldrM)-        , benchSrcIO asyncly "unfoldrM/20,000,000"-            (avgRate 20000000 . Ops.sourceUnfoldrM)-        ]-      , bgroup "aheadly"-        [-          benchSrcIO aheadly "unfoldrM/1,000,000"-            (avgRate 1000000 . Ops.sourceUnfoldrM)-        ]-      ]-    ]
+ benchmark/NanoBenchmarks.hs view
@@ -0,0 +1,127 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-------------------------------------------------------------------------------+-- Investigate specific benchmarks more closely in isolation, possibly looking+-- at GHC generated code for optimizing specific problematic cases.+-------------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++import Data.Char (ord)+import Streamly.Internal.Data.Stream (Stream)+import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))++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 Test.Tasty.Bench+import System.Random++maxValue :: Int+maxValue = 100000++drain :: Monad m => S.Stream m a -> m ()+drain = S.fold FL.drain++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Stream m Int+sourceUnfoldrM = S.unfoldrM step 0+    where+    step cnt =+        if cnt > maxValue+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE sourceUnfoldrMN #-}+sourceUnfoldrMN :: Monad m => Int -> Stream m Int+sourceUnfoldrMN n = S.unfoldrM step n+    where+    step cnt =+        if cnt > n+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE sourceUnfoldr #-}+sourceUnfoldr :: Monad m => Int -> Stream m Int+sourceUnfoldr n = S.unfoldr step n+    where+    step cnt =+        if cnt > n + maxValue+        then Nothing+        else Just (cnt, cnt + 1)++-------------------------------------------------------------------------------+-- take-drop composition+-------------------------------------------------------------------------------++takeAllDropOne :: Monad m => Stream m Int -> Stream m Int+takeAllDropOne = S.drop 1 . S.take maxValue++-- Requires -fspec-constr-recursive=5 for better fused code+-- The number depends on how many times we compose it++{-# INLINE takeDrop #-}+takeDrop :: Monad m => Stream m Int -> m ()+takeDrop = drain .+    takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne++-------------------------------------------------------------------------------+-- dropWhileFalse composition+-------------------------------------------------------------------------------++dropWhileFalse :: Monad m => Stream m Int -> Stream m Int+dropWhileFalse = S.dropWhile (> maxValue)++-- Requires -fspec-constr-recursive=5 for better fused code+-- The number depends on how many times we compose it++{-# INLINE dropWhileFalseX4 #-}+dropWhileFalseX4 :: Monad m => Stream m Int -> m ()+dropWhileFalseX4 = drain+    . dropWhileFalse . dropWhileFalse . dropWhileFalse .  dropWhileFalse++-------------------------------------------------------------------------------+-- iteration+-------------------------------------------------------------------------------++{-# INLINE iterateSource #-}+iterateSource+    :: Monad m+    => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int+iterateSource g i n = f i (sourceUnfoldrMN n)+    where+        f (0 :: Int) m = g m+        f x m = g (f (x - 1) m)++-- Keep only the benchmark that is to be investiagted and comment out the rest.+-- We keep all of them enabled by default for testing the build.+main :: IO ()+main = do+    defaultMain [bench "unfoldr" $ nfIO $+        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 $ drain $ iterateSource (S.mapM return) 100000 10]++    inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode+    defaultMain [mkBenchText "splitOn abc...xyz" inText $ do+                S.fold FL.length+                    (Internal.splitOnSeq+                        (A.fromList+                            $ map (fromIntegral . ord) "abcdefghijklmnopqrstuvwxyz"+                        )+                        FL.drain+                        $ IFH.read inText+                    )+                    >>= print+                ]+    where++    mkBenchText name h action =+        env (hSeek h AbsoluteSeek 0) (\_ -> bench name $ nfIO action)
− benchmark/Nested.hs 
@@ -1,84 +0,0 @@--- |--- Module      : Main--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--import Control.DeepSeq (NFData)-import Data.Functor.Identity (Identity, runIdentity)-import System.Random (randomRIO)-import qualified NestedOps as Ops-import Streamly-import Gauge--benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark-benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f--_benchId :: (NFData b) => String -> (Int -> Identity b) -> Benchmark-_benchId name f = bench name $ nf (\g -> runIdentity (g 1))  f--main :: IO ()-main =-  -- TBD Study scaling with 10, 100, 1000 loop iterations-  defaultMain-    [ bgroup "serially"-      [ benchIO "toNull"         $ Ops.toNull         serially-      , benchIO "toList"         $ Ops.toList         serially-   --   , benchIO "toListSome"     $ Ops.toListSome     serially-      , benchIO "filterAllOut"   $ Ops.filterAllOut   serially-      , benchIO "filterAllIn"    $ Ops.filterAllIn    serially-      , benchIO "filterSome"     $ Ops.filterSome     serially-      , benchIO "breakAfterSome" $ Ops.breakAfterSome serially-      ]--    , bgroup "wSerially"-      [ benchIO "toNull"         $ Ops.toNull         wSerially-      , benchIO "toList"         $ Ops.toList         wSerially-    --  , benchIO "toListSome"     $ Ops.toListSome     wSerially-      , benchIO "filterAllOut"   $ Ops.filterAllOut   wSerially-      , benchIO "filterAllIn"    $ Ops.filterAllIn    wSerially-      , benchIO "filterSome"     $ Ops.filterSome     wSerially-      , benchIO "breakAfterSome" $ Ops.breakAfterSome wSerially-      ]--    , bgroup "aheadly"-      [ benchIO "toNull"         $ Ops.toNull         aheadly-      , benchIO "toList"         $ Ops.toList         aheadly-     -- , benchIO "toListSome"     $ Ops.toListSome     aheadly-      , benchIO "filterAllOut"   $ Ops.filterAllOut   aheadly-      , benchIO "filterAllIn"    $ Ops.filterAllIn    aheadly-      , benchIO "filterSome"     $ Ops.filterSome     aheadly-      , benchIO "breakAfterSome" $ Ops.breakAfterSome aheadly-      ]--    , bgroup "asyncly"-      [ benchIO "toNull"         $ Ops.toNull         asyncly-      , benchIO "toList"         $ Ops.toList         asyncly-    --  , benchIO "toListSome"     $ Ops.toListSome     asyncly-      , benchIO "filterAllOut"   $ Ops.filterAllOut   asyncly-      , benchIO "filterAllIn"    $ Ops.filterAllIn    asyncly-      , benchIO "filterSome"     $ Ops.filterSome     asyncly-      , benchIO "breakAfterSome" $ Ops.breakAfterSome asyncly-      ]--    , bgroup "wAsyncly"-      [ benchIO "toNull"         $ Ops.toNull         wAsyncly-      , benchIO "toList"         $ Ops.toList         wAsyncly-     -- , benchIO "toListSome"     $ Ops.toListSome     wAsyncly-      , benchIO "filterAllOut"   $ Ops.filterAllOut   wAsyncly-      , benchIO "filterAllIn"    $ Ops.filterAllIn    wAsyncly-      , benchIO "filterSome"     $ Ops.filterSome     wAsyncly-      , benchIO "breakAfterSome" $ Ops.breakAfterSome wAsyncly-      ]--    , bgroup "parallely"-      [ benchIO "toNull"         $ Ops.toNull         parallely-      , benchIO "toList"         $ Ops.toList         parallely-      --, benchIO "toListSome"     $ Ops.toListSome     parallely-      , benchIO "filterAllOut"   $ Ops.filterAllOut   parallely-      , benchIO "filterAllIn"    $ Ops.filterAllIn    parallely-      , benchIO "filterSome"     $ Ops.filterSome     parallely-      , benchIO "breakAfterSome" $ Ops.breakAfterSome parallely-      ]-    ]
− benchmark/NestedOps.hs 
@@ -1,141 +0,0 @@--- |--- Module      : BenchmarkOps--- Copyright   : (c) 2018 Harendra Kumar------ License     : MIT--- Maintainer  : harendra.kumar@gmail.com--{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--module NestedOps where--import Control.Exception (try)-import GHC.Exception (ErrorCall)--import qualified Streamly          as S-import qualified Streamly.Prelude  as S--sumCount :: Int-sumCount = 1000000--prodCount :: Int-prodCount = 100------------------------------------------------------------------------------------ Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.SerialT m a--{-# INLINE source #-}-source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int-source = sourceUnfoldrM--{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int-sourceUnfoldrM n value = S.serially $ S.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else return (Just (cnt, cnt + 1))--{-# INLINE sourceUnfoldr #-}-sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int-sourceUnfoldr start n = S.unfoldr step start-    where-    step cnt =-        if cnt > start + n-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.runStream--{-# INLINE runToList #-}-runToList :: Monad m => Stream m a -> m [a]-runToList = S.toList------------------------------------------------------------------------------------ Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-toNull-    :: (S.IsStream t, S.MonadAsync m, Monad (t m))-    => (t m Int -> S.SerialT m Int) -> Int -> m ()-toNull t start = runStream . t $ do-    x <- source start prodCount-    y <- source start prodCount-    return $ x + y--{-# INLINE toList #-}-toList-    :: (S.IsStream t, S.MonadAsync m, Monad (t m))-    => (t m Int -> S.SerialT m Int) -> Int -> m [Int]-toList t start = runToList . t $ do-    x <- source start prodCount-    y <- source start prodCount-    return $ x + y--{-# INLINE toListSome #-}-toListSome-    :: (S.IsStream t, S.MonadAsync m, Monad (t m))-    => (t m Int -> S.SerialT m Int) -> Int -> m [Int]-toListSome t start =-    runToList . t $ S.take 1000 $ do-        x <- source start prodCount-        y <- source start prodCount-        return $ x + y--{-# INLINE filterAllOut #-}-filterAllOut-    :: (S.IsStream t, S.MonadAsync m, Monad (t m))-    => (t m Int -> S.SerialT m Int) -> Int -> m ()-filterAllOut t start = runStream . t $ do-    x <- source start prodCount-    y <- source start prodCount-    let s = x + y-    if s < 0-    then return s-    else S.nil--{-# INLINE filterAllIn #-}-filterAllIn-    :: (S.IsStream t, S.MonadAsync m, Monad (t m))-    => (t m Int -> S.SerialT m Int) -> Int -> m ()-filterAllIn t start = runStream . t $ do-    x <- source start prodCount-    y <- source start prodCount-    let s = x + y-    if s > 0-    then return s-    else S.nil--{-# INLINE filterSome #-}-filterSome-    :: (S.IsStream t, S.MonadAsync m, Monad (t m))-    => (t m Int -> S.SerialT m Int) -> Int -> m ()-filterSome t start = runStream . t $ do-    x <- source start prodCount-    y <- source start prodCount-    let s = x + y-    if s > 1100000-    then return s-    else S.nil--{-# INLINE breakAfterSome #-}-breakAfterSome-    :: (S.IsStream t, Monad (t IO))-    => (t IO Int -> S.SerialT IO Int) -> Int -> IO ()-breakAfterSome t start = do-    (_ :: Either ErrorCall ()) <- try $ runStream . t $ do-        x <- source start prodCount-        y <- source start prodCount-        let s = x + y-        if s > 1100000-        then error "break"-        else return s-    return ()
+ benchmark/README.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.
− benchmark/StreamDOps.hs 
@@ -1,175 +0,0 @@--- |--- Module      : StreamDOps--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--{-# LANGUAGE FlexibleContexts #-}--module StreamDOps where--import Control.Monad (when)-import Prelude-        (Monad, Int, (+), ($), (.), return, (>), even, (<=),-         subtract, undefined, Maybe(..), not, mapM_, (>>=))--import qualified Streamly.Streams.StreamD as S--value, maxValue :: Int-value = 100000-maxValue = value + 1000------------------------------------------------------------------------------------ Benchmark ops----------------------------------------------------------------------------------{-# INLINE uncons #-}-{-# INLINE nullHeadTail #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{--{-# INLINE concat #-}--}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-uncons, nullHeadTail, map, scan, filterEven, filterAllOut,-    filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,-    -- concat,-    composeAllInFilters, composeAllOutFilters, composeMapAllInFilter-    :: Monad m-    => Stream m Int -> m ()--{-# INLINE composeMapM #-}-composeMapM :: Monad m => Stream m Int -> m ()--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-{-# INLINE foldl #-}-foldl :: Monad m => Stream m Int -> m Int-{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)--{-# INLINE toNull #-}-{-# INLINE mapM #-}-toNull, mapM :: Monad m => Stream m Int -> m ()------------------------------------------------------------------------------------ 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 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 sourceFromEnum #-}-sourceFromEnum :: Monad m => Int -> Stream m Int-sourceFromEnum n = S.enumFromStepN n 1 value--{-# INLINE sourceFromList #-}-sourceFromList :: Monad m => Int -> Stream m Int-sourceFromList n = S.fromList [n..n+value]--{-# INLINE source #-}-source :: Monad m => Int -> Stream m Int-source = sourceUnfoldrM------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.runStream--toNull = runStream-uncons s = do-    r <- S.uncons s-    case r of-        Nothing -> return ()-        Just (_, t) -> uncons t-nullHeadTail s = do-    r <- S.null s-    when (not r) $ do-        _ <- S.head s-        S.tail s >>= mapM_ nullHeadTail-toList = S.toList-foldl  = S.foldl' (+) 0-last   = S.last------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{-# INLINE transform #-}-transform :: Monad m => Stream m a -> m ()-transform = runStream--scan          = transform . S.scanlM' (\a b -> return (a + b)) 0-map           = transform . S.map (+1)-mapM          = transform . S.mapM return-filterEven    = transform . S.filter even-filterAllOut  = transform . S.filter (> maxValue)-filterAllIn   = transform . S.filter (<= maxValue)-takeOne       = transform . S.take 1-takeAll       = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll       = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)------------------------------------------------------------------------------------ Zipping and concat----------------------------------------------------------------------------------zip src       = transform $ S.zipWith (,) src src--- concat _n     = return ()------------------------------------------------------------------------------------ Composition----------------------------------------------------------------------------------{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f--composeMapM           = compose (S.mapM return)-composeAllInFilters   = compose (S.filter (<= maxValue))-composeAllOutFilters  = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . S.map (subtract 1))--{-# INLINABLE composeScaling #-}-composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling m =-    case m of-        1 -> transform . f-        2 -> transform . f . f-        3 -> transform . f . f . f-        4 -> transform . f . f . f . f-        _ -> undefined-    where f = S.filter (<= maxValue)
− benchmark/StreamKOps.hs 
@@ -1,205 +0,0 @@--- |--- Module      : StreamKOps--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--{-# LANGUAGE FlexibleContexts #-}--module StreamKOps where--import Control.Monad (when)-import Prelude-       (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),-        subtract, undefined, Maybe(..), not, mapM_, (>>=))--import qualified Streamly.Streams.StreamK as S-import qualified Streamly.Streams.Prelude as S-import qualified Streamly.SVar as S--value, maxValue :: Int-value = 100000-maxValue = value + 1000------------------------------------------------------------------------------------ Benchmark ops----------------------------------------------------------------------------------{-# INLINE toNull #-}-{-# INLINE uncons #-}-{-# INLINE nullHeadTail #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{-# INLINE concat #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, uncons, nullHeadTail, scan, map, filterEven, filterAllOut,-    filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,-    concat, composeAllInFilters, composeAllOutFilters,-    composeMapAllInFilter-    :: Monad m-    => Stream m Int -> m ()--{-# INLINE composeMapM #-}-composeMapM :: S.MonadAsync m => Stream m Int -> m ()--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-{-# INLINE foldl #-}-foldl :: Monad m => Stream m Int -> m Int-{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)--{-# INLINE mapM #-}-mapM :: S.MonadAsync m => Stream m Int -> m ()------------------------------------------------------------------------------------ Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.Stream m a--{-# INLINE sourceUnfoldr #-}-sourceUnfoldr :: 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 sourceUnfoldrM #-}-sourceUnfoldrM :: S.MonadAsync 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 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 = S.foldMapWith S.serial S.yield [n..n+value]--{-# INLINE sourceFoldMapWithM #-}-sourceFoldMapWithM :: Monad m => Int -> Stream m Int-sourceFoldMapWithM n = S.foldMapWith S.serial (S.yieldM . return) [n..n+value]--{-# INLINE source #-}-source :: S.MonadAsync m => Int -> Stream m Int-source = sourceUnfoldrM------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.runStream--toNull = runStream-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-    mapM_ S.runStream t--{-# INLINE tail #-}-tail :: (Monad m, S.IsStream t) => t m a -> m ()-tail s = S.tail s >>= mapM_ tail---- | If the stream is not null get its head and tail and then do the same to--- the tail.-nullHeadTail s = do-    r <- S.null s-    when (not r) $ do-        _ <- S.head s-        S.tail s >>= mapM_ nullHeadTail--toList = S.toList-foldl  = S.foldl' (+) 0-last   = S.last------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{-# INLINE transform #-}-transform :: Monad m => Stream m a -> m ()-transform = runStream--scan          = transform . S.scanl' (+) 0-map           = transform . fmap (+1)-mapM          = transform . S.mapM return-filterEven    = transform . S.filter even-filterAllOut  = transform . S.filter (> maxValue)-filterAllIn   = transform . S.filter (<= maxValue)-takeOne       = transform . S.take 1-takeAll       = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll       = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)------------------------------------------------------------------------------------ Zipping and concat----------------------------------------------------------------------------------zip src       = transform $ S.zipWith (,) src src-concat _n     = return ()------------------------------------------------------------------------------------ Composition----------------------------------------------------------------------------------{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f--composeMapM           = compose (S.mapM return)-composeAllInFilters   = compose (S.filter (<= maxValue))-composeAllOutFilters  = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . fmap (subtract 1))--{-# INLINABLE composeScaling #-}-composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling m =-    case m of-        1 -> transform . f-        2 -> transform . f . f-        3 -> transform . f . f . f-        4 -> transform . f . f . f . f-        _ -> undefined-    where f = S.filter (<= maxValue)
+ benchmark/Streamly/Benchmark/Data/Array.hs view
@@ -0,0 +1,145 @@+{-# 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 :: 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.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)+        , 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 "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"++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/Common.hs view
@@ -0,0 +1,185 @@+-------------------------------------------------------------------------------+-- 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)++-------------------------------------------------------------------------------+-- Bench Ops+-------------------------------------------------------------------------------++{-# INLINE sourceUnfoldr #-}+sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)+sourceUnfoldr value n = S.fold (A.createOf value) $ S.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 = 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.createOf value) $ S.fromList [n..n+value]++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE composeN #-}+composeN :: P.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 P.>>= f+        3 -> f x P.>>= f P.>>= f+        4 -> f x P.>>= f P.>>= f P.>>= f+        _ -> undefined++{-# INLINE scanl' #-}+{-# INLINE scanl1' #-}+{-# INLINE map #-}++scanl' , scanl1', map+    :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)+++{-# INLINE onArray #-}+onArray+    :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)+    -> Stream Int+    -> m (Stream Int)+onArray value f arr = S.fold (A.createOf value) $ f $ S.unfold A.reader arr++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 #-}+eqInstance :: Stream Int -> Bool+eqInstance src = src == src++{-# INLINE eqInstanceNotEq #-}+eqInstanceNotEq :: Stream Int -> Bool+eqInstanceNotEq src = src P./= src++{-# INLINE ordInstance #-}+ordInstance :: Stream Int -> Bool+ordInstance src = src P.< src++{-# INLINE ordInstanceMin #-}+ordInstanceMin :: Stream Int -> Stream Int+ordInstanceMin src = P.min src src++{-# INLINE showInstance #-}+showInstance :: Stream Int -> P.String+showInstance = P.show++{-# INLINE pureFoldl' #-}+pureFoldl' :: MonadIO m => Stream Int -> m Int+pureFoldl' = S.fold (Fold.foldl' (+) 0) . S.unfold A.reader++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE unfoldReadDrain #-}+unfoldReadDrain :: MonadIO m => Stream Int -> m ()+unfoldReadDrain = S.fold Fold.drain . S.unfold A.reader++{-# INLINE toStreamRevDrain #-}+toStreamRevDrain :: MonadIO m => Stream Int -> m ()+toStreamRevDrain = S.fold Fold.drain . A.readRev++-------------------------------------------------------------------------------+-- Bench groups+-------------------------------------------------------------------------------++common_o_1_space_generation :: Int -> [Benchmark]+common_o_1_space_generation value =+    [ bgroup+        "generation"+        [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)+        , benchIOSrc+              "fromList . intFromTo"+              (sourceIntFromToFromList value)+        , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)+        , benchIOSrc "writeN . fromList" (sourceFromList value)+        , benchPureSink value "show" showInstance+        ]+    ]++common_o_1_space_elimination :: Int -> [Benchmark]+common_o_1_space_elimination value =+    [ bgroup "elimination"+        [ benchPureSink value "id" id+        , benchPureSink value "==" eqInstance+        , benchPureSink value "/=" eqInstanceNotEq+        , benchPureSink value "<" ordInstance+        , benchPureSink value "min" ordInstanceMin+        , benchIOSink value "foldl'" pureFoldl'+        , benchIOSink value "read" unfoldReadDrain+        , benchIOSink value "toStreamRev" toStreamRevDrain+        ]+      ]++common_o_n_heap_serial :: Int -> [Benchmark]+common_o_n_heap_serial value =+    [ bgroup "elimination"+        [+        -- Converting the stream to an array+            benchFold "writeN" (S.fold (A.createOf value))+                (P.sourceUnfoldrM value)+         ]+    ]++common_o_1_space_transformation :: Int -> [Benchmark]+common_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)+        ]+   ]++common_o_1_space_transformationX4 :: Int -> [Benchmark]+common_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)+        ]+      ]++commonBenchmarks :: Int -> [Benchmark]+commonBenchmarks size =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ common_o_1_space_generation size+            , common_o_1_space_elimination size+            , common_o_1_space_transformation size+            , common_o_1_space_transformationX4 size+            ]+        , bgroup (o_n_space_prefix moduleName) $+             common_o_n_heap_serial size+        ]
+ benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE FlexibleContexts #-}++import Control.DeepSeq (NFData(..))+import Control.Monad.IO.Class (MonadIO)+import Data.Functor ((<&>))+import System.Random (randomRIO)++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 Test.Tasty.Bench+import Streamly.Benchmark.Common hiding (benchPureSrc)+import qualified Stream.Common as P++import Prelude as P hiding (map)
+ 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/SmallArray.hs view
@@ -0,0 +1,95 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++{-# LANGUAGE CPP #-}++#include "Streamly/Benchmark/Data/Array/CommonImports.hs"++import Control.DeepSeq (deepseq)++import qualified Streamly.Internal.Data.SmallArray as A+type Stream = A.SmallArray++#include "Streamly/Benchmark/Data/Array/Common.hs"++-------------------------------------------------------------------------------+-- 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++-------------------------------------------------------------------------------+-- Bench groups+-------------------------------------------------------------------------------++o_1_space_generation :: Int -> [Benchmark]+o_1_space_generation value =+    [ bgroup+        "generation"+        [ let testStr =+                  "fromListN " +++                  show (value + 1) +++                  "[1" ++ concat (replicate value ",1") ++ "]"+           in testStr `deepseq` bench "read" (nf readInstance testStr)+        ]+    ]++{-+o_1_space_elimination :: Int -> [Benchmark]+o_1_space_elimination value =+    [ bgroup "elimination"+        [+#ifdef DEVBUILD+{-+          benchPureSink value "foldable/foldl'" foldableFoldl'+        , benchPureSink value "foldable/sum" foldableSum+-}+#endif+        ]+      ]+-}++moduleName :: String+moduleName = "Data.SmallArray"++defStreamSize :: Int+defStreamSize = 128++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/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/Fold.hs view
@@ -0,0 +1,747 @@+-- |+-- Module      : Streamly.Benchmark.Data.Fold+-- Copyright   : (c) 2018 Composewell+--+-- 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 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.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.MutArray (MutArray)++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.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 Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common+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 :: 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++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++{-# INLINE any #-}+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 -> Stream m a -> m Bool+all value = Stream.fold (FL.all (<= value))++{-# INLINE take #-}+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 ()+sequence_ value =+    foldr f (FL.fromPure ()) (Prelude.replicate value (FL.take 1 FL.drain))++    where++    {-# INLINE f #-}+    f m k = FL.concatMap (const k) m++-------------------------------------------------------------------------------+-- Filter+-------------------------------------------------------------------------------++{-# INLINE filter #-}+filter :: Monad m => Int -> Stream m Int -> m ()+filter _ = Stream.fold (FL.filter even 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 -> Stream m Int -> m (Bool, Bool)+splitAllAny value =+    Stream.fold+        (FL.splitWith (,)+            (FL.all (<= (value `div` 2)))+            (FL.any (> value))+        )++{-# 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 => Stream m Int -> m (Either Int Int)+shortest = Stream.fold (FL.shortest FL.sum FL.length)++{-# INLINE longest #-}+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 => Stream m Int -> m (Int, Int)+teeSumLength = Stream.fold (FL.teeWith (,) FL.sum FL.length)++{-# INLINE teeAllAny #-}+teeAllAny :: (Monad m, Ord a) => a -> Stream m a -> m (Bool, Bool)+teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)++    where++    all_ = FL.all (<= value)+    any_ = FL.any (> value)++{-# INLINE teeWithFst #-}+teeWithFst :: Monad m => Stream m Int -> m (Int, Int)+teeWithFst = Stream.fold (FL.teeWithFst (,) FL.sum FL.length)++{-# INLINE teeWithMin #-}+teeWithMin :: Monad m => Stream m Int -> m (Int, Int)+teeWithMin = Stream.fold (FL.teeWithMin (,) FL.sum FL.length)++{-# INLINE distribute #-}+distribute :: Monad m => Stream m Int -> m [Int]+distribute = Stream.fold (FL.distribute [FL.sum, FL.length])++-------------------------------------------------------------------------------+-- Partitioning+-------------------------------------------------------------------------------++{-# INLINE oddEven #-}+oddEven :: Int -> Either Int Int+oddEven x = if odd x then Left x else Right x++{-# INLINE partition #-}+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 => Stream m Int -> m (Int, Int)+partitionByFstM =+    Stream.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)++{-# INLINE partitionByMinM #-}+partitionByMinM :: Monad m => Stream m Int -> m (Int, Int)+partitionByMinM =+    Stream.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)++{-# 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 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 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 => 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 => Stream m Int -> m (Int, Int)+unzipWithFstM = do+    let f a = return (a + 1, a)+    Stream.fold (FL.unzipWithFstM f FL.sum FL.length)++{-# INLINE unzipWithMinM #-}+unzipWithMinM :: Monad m => Stream m Int -> m (Int, Int)+unzipWithMinM = do+    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" (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"+              (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"+              (Stream.fold FL.variance . fmap (fromIntegral :: Int -> Double))+        , benchIOSink+              value+              "stdDev"+              (Stream.fold FL.stdDev . fmap (fromIntegral :: Int -> Double))+-}+        , benchIOSink+              value+              "mconcat"+              (Stream.fold FL.mconcat . fmap (Last . Just))+        , benchIOSink+              value+              "foldMap"+              (Stream.fold (FL.foldMap (Last . Just)))+        , benchIOSink+              value+              "foldMapM"+              (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"+              (Stream.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))+        , benchIOSink+              value+              "findIndex"+              (Stream.fold (FL.findIndex (== (value + 1))))+        , benchIOSink+              value+              "elemIndex"+              (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" (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" (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" (Stream.fold fld)+        , benchIOSink+              value+              "rsequence"+              (Stream.fold (FL.rmapM id (return <$> FL.drain)))+        , benchIOSink value "rmapM" (Stream.fold (FL.rmapM return FL.drain))+        , benchIOSink+              value+              "pipe-mapM"+              (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"+            (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"+            (Stream.fold $ FL.postscanl Scanl.sum FL.drain)+        ]+    ]++o_1_space_serial_composition :: Int -> [Benchmark]+o_1_space_serial_composition value =+      [ bgroup+            "composition"+            [ 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+            , benchIOSink value "teeWithFst (sum, length)" teeWithFst+            , benchIOSink value "teeWithMin (sum, length)" teeWithMin+            , benchIOSink value "distribute [sum, length]" distribute+            , benchIOSink value "partition (sum, length)" partition+            , benchIOSink value "partitionByFstM (sum, length)" partitionByFstM+            , benchIOSink value "partitionByMinM (sum, length)" partitionByMinM+            , benchIOSink value "unzip (sum, length)" unzip+            , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM+            , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM+            ]+      ]++o_n_space_serial :: Int -> [Benchmark]+o_n_space_serial value =+    [ benchIOSink value "sequence_/100" $ Stream.fold (sequence_ (value `div` 100))+    ]++o_n_heap_serial :: Int -> [Benchmark]+o_n_heap_serial value =+    [ bgroup "elimination"+      -- Left folds for building a structure are inherently non-streaming+      -- as the structure cannot be lazily consumed until fully built.+            [+              benchIOSink value "toList" (Stream.fold FL.toList)+            , benchIOSink value "toListRev" (Stream.fold FL.toListRev)+            , benchIOSink value "toStream"+                (Stream.fold FL.toStream+                    :: Stream IO a -> IO (Stream Identity a))+            , benchIOSink value "toStreamRev"+                (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 = do+#ifndef FUSION_CHECK+    env <- mkHandleBenchEnv+    runWithCLIOpts defaultStreamSize (allBenchmarks env)++    where++    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
@@ -0,0 +1,886 @@++#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+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Main+  (+    main+  ) where++import Control.Applicative ((<|>))+import Control.DeepSeq (NFData(..))+import Data.Function ((&))+import Data.Functor (($>))+import Data.Monoid (Sum(..))+import GHC.Magic (inline)+import GHC.Magic (noinline)+import System.IO (Handle)+import System.Random (randomRIO)+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 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.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Parser as PR+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Stream as Stream++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common+import Streamly.Benchmark.Common.Handle++-------------------------------------------------------------------------------+-- 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))++-- | 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+    :: NFData b+    => Int -> String -> (Stream IO Int -> IO b) -> Benchmark+benchIOSink value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value++-------------------------------------------------------------------------------+-- Parsers+-------------------------------------------------------------------------------++{-# INLINE takeBetween #-}+takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())+takeBetween value = Stream.parse (PR.takeBetween 0 value Fold.drain)++{-# INLINE takeEQ #-}+takeEQ :: Monad m => Int -> Stream m a -> m (Either ParseError ())+takeEQ value = Stream.parse (PR.takeEQ value Fold.drain)++{-# INLINE takeGE #-}+takeGE :: Monad m => Int -> Stream m a -> m (Either ParseError ())+takeGE value = Stream.parse (PR.takeGE value Fold.drain)++{-# 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 :: 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 :: Monad m => Int -> Stream m a -> m (Either ParseError ())+takeP value = Stream.parse (PR.takeP value (PR.fromFold Fold.drain))++{-# INLINE groupBy #-}+groupBy :: Monad m => Stream m Int -> m (Either ParseError ())+groupBy = Stream.parse (PR.groupBy (<=) Fold.drain)++{-# INLINE groupByRolling #-}+groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())+groupByRolling = Stream.parse (PR.groupByRolling (<=) Fold.drain)++{-# INLINE wordBy #-}+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 :: Monad m => Stream m Int -> m (Either ParseError ())+manyWordByEven = Stream.parse (PR.many (PR.wordBy even Fold.drain) Fold.drain)++{-# INLINE many #-}+many :: Monad m => Stream m Int -> m (Either ParseError Int)+many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)++{-# INLINE manyAlt #-}+manyAlt :: Monad m => Stream m Int -> m Int+manyAlt xs = do+    x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs+    return $ Prelude.length x++{-# INLINE some #-}+some :: Monad m => Stream m Int -> m (Either ParseError Int)+some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)++{-# INLINE someAlt #-}+someAlt :: Monad m => Stream m Int -> m Int+someAlt xs = do+    x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs+    return $ Prelude.length x++{-# INLINE manyTill #-}+manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)+manyTill value =+    Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length)++{-# INLINE splitAp2 #-}+splitAp2 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ((), ()))+splitAp2 value =+    Stream.parse+        ((,)+            <$> 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 :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+splitApBefore value =+    Stream.parse+        (  PR.dropWhile (<= (value `div` 2))+        *> PR.dropWhile (<= value)+        )++{-# INLINE splitApAfter #-}+splitApAfter :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+splitApAfter value =+    Stream.parse+        (  PR.dropWhile (<= (value `div` 2))+        <* PR.dropWhile (<= 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_ :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+split_ value =+    Stream.parse+        (PR.split_+            (PR.dropWhile (<= (value `div` 2)))+            (PR.dropWhile (<= value))+        )++-- 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 :: Monad m+    => Int -> Stream m Int -> m ((), ())+teeAllAny value =+    Stream.parse+        (PR.teeWith (,)+            (PR.dropWhile (<= value))+            (PR.dropWhile (<= value))+        )++{-# INLINE teeFstAllAny #-}+teeFstAllAny :: Monad m+    => Int -> Stream m Int -> m ((), ())+teeFstAllAny value =+    Stream.parse+        (PR.teeWithFst (,)+            (PR.dropWhile (<= value))+            (PR.dropWhile (<= value))+        )++{-# INLINE shortestAllAny #-}+shortestAllAny :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+shortestAllAny value =+    Stream.parse+        (PR.shortest+            (PR.dropWhile (<= value))+            (PR.dropWhile (<= value))+        )++{-# INLINE longestAllAny #-}+longestAllAny :: Monad m+    => Int -> Stream m Int -> m (Either ParseError ())+longestAllAny value =+    Stream.parse+        (PR.longest+            (PR.dropWhile (<= value))+            (PR.dropWhile (<= value))+        )+-}++-------------------------------------------------------------------------------+-- Spanning+-------------------------------------------------------------------------------++{-# 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+-------------------------------------------------------------------------------++-- 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 :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+lookAhead value =+    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 :: Monad m => Int -> Stream m Int -> m Int+sequenceA value xs = do+    x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs+    return $ length x++-- quadratic complexity+{-# INLINE sequence #-}+sequence :: Monad m => Int -> Stream m Int -> m Int+sequence value xs = do+    x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs+    return $ length x++{-# INLINE sequence_ #-}+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 :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)+choiceAsum value =+    Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))+        AP.<|> PR.satisfy (> 0))++{-+{-# INLINE choice #-}+choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)+choice value =+    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 :: Monad m => Int -> Stream m Int -> m ()+parseMany n =+      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 :: Monad m => Int -> Stream m Int -> m ()+parseIterate n =+      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+-------------------------------------------------------------------------------++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 "takeBetween" $ takeBetween value+    , benchIOSink value "takeWhile" $ takeWhile value+    , benchIOSink value "takeWhileP" $ takeWhileP value+    , benchIOSink value "takeP" $ takeP 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 "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 "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 "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 (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env+          $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh+    , mkBench "S.parseMany (Fold.take 1 Fold.sum)" env+          $ \inh _ -> inline parseManyChunksOfSum 1 inh+    ]++o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]+o_1_space_serial_unfold bound arrays =+    [ bench "parseMany/Unfold/1000 arrays/take all"+        $ nfIO $ parseManyUnfoldArrays bound arrays+    , bench "parseMany/Unfold/1000 arrays/take 1"+        $ nfIO $ parseManyUnfoldArrays 1 arrays+    ]++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++    -- o-n-heap because of backtracking+    , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"+        $ takeFramedByEsc_ value++    -- non-linear time complexity (parserD)+    , benchIOSink value "split_" $ split_ 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 = 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)+        , bgroup+              (o_1_space_prefix moduleName ++ "/filesystem")+              (o_1_space_filesystem env)+        , 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/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
@@ -0,0 +1,658 @@+-- |+-- Module      : Streamly.Benchmark.Data.Stream.StreamD+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# 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 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 as S+import qualified Streamly.Internal.Data.Unfold as UF+import qualified Streamly.Internal.Data.Fold as FL++import Streamly.Benchmark.Common++#ifdef INSPECTION+import GHC.Types (SPEC(..))+import Test.Inspection+#endif++-- We try to keep the total number of iterations same irrespective of nesting+-- of the loops so that the overhead is easy to compare.+value, value2, value3, value16, maxValue :: Int+value = 100000+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++-------------------------------------------------------------------------------+-- 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 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 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 sourceIntFromTo #-}+sourceIntFromTo :: Monad m => Int -> Stream m Int+sourceIntFromTo n = S.enumerateFromToIntegral n (n + value)++{-# INLINE sourceFromList #-}+sourceFromList :: Monad m => Int -> Stream m Int+sourceFromList n = S.fromList [n..n+value]++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE runStream #-}+runStream :: Monad m => Stream m a -> m ()+runStream = S.drain++{-# 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 #-}+{-# INLINE nullTail #-}+{-# INLINE headTail #-}+uncons, nullTail, headTail+    :: Monad m+    => Stream m Int -> m ()++uncons s = do+    r <- S.uncons s+    case r of+        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++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 fmapD #-}+{-# INLINE mapM #-}+{-# INLINE mapMaybe #-}+{-# INLINE mapMaybeM #-}+{-# INLINE filterEven #-}+{-# INLINE filterAllOut #-}+{-# INLINE filterAllIn #-}+{-# INLINE _takeOne #-}+{-# INLINE takeAll #-}+{-# INLINE takeWhileTrue #-}+{-# INLINE _takeWhileMTrue #-}+{-# INLINE dropOne #-}+{-# INLINE dropAll #-}+{-# INLINE dropWhileTrue #-}+{-# INLINE _dropWhileMTrue #-}+{-# INLINE dropWhileFalse #-}+{-# INLINE _foldrS #-}+{-# INLINE _foldlS #-}+{-# INLINE intersperse #-}+scan, map, fmapD, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,+    filterAllIn, _takeOne, takeAll, takeWhileTrue, _takeWhileMTrue, dropOne,+    dropAll, dropWhileTrue, _dropWhileMTrue, dropWhileFalse, _foldrS, _foldlS,+    intersperse+    :: Monad m+    => Int -> Stream m Int -> m ()++scan          n = composeN n $ S.scanl' (+) 0+fmapD         n = composeN n $ Prelude.fmap (+1)+map           n = composeN n $ S.map (+1)+mapM          n = composeN n $ S.mapM return+mapMaybe      n = composeN n $ S.mapMaybe+    (\x -> if Prelude.odd x then Nothing else Just x)+mapMaybeM     n = composeN n $ S.mapMaybeM+    (\x -> if Prelude.odd x then return Nothing else return $ Just x)+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)+_takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))+dropOne        n = composeN n $ S.drop 1+dropAll        n = composeN n $ S.drop maxValue+dropWhileTrue  n = composeN n $ S.dropWhile (<= maxValue)+_dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))+dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)+_foldrS        n = composeN n $ S.foldrS S.cons S.nil+_foldlS         n = composeN n $ S.foldlS (flip S.cons) S.nil+intersperse    n = composeN n $ S.intersperse maxValue++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 10000++{-# INLINE iterateSource #-}+iterateSource+    :: Monad 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+    :: Monad 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++{-# INLINE iterateM #-}+iterateM :: Monad m => Int -> Stream m Int+iterateM i = S.take maxIters (S.iterateM (\x -> return (x + 1)) (return i))++-------------------------------------------------------------------------------+-- Zipping+-------------------------------------------------------------------------------++{-# INLINE eqBy #-}+eqBy :: (Monad m, P.Eq a) => S.Stream m a -> m P.Bool+eqBy src = S.eqBy (==) src src++{-# INLINE cmpBy #-}+cmpBy :: (Monad m, P.Ord a) => S.Stream m a -> m P.Ordering+cmpBy src = S.cmpBy P.compare src src++{-# INLINE zip #-}+zip :: Monad m => Stream m Int -> m ()+zip src = transform $ S.zipWith (,) src 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+-------------------------------------------------------------------------------++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+    (+) <$> 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++-------------------------------------------------------------------------------+-- ConcatMap+-------------------------------------------------------------------------------++-- concatMap unfoldrM/unfoldrM++{-# INLINE concatMap #-}+concatMap :: Int -> Int -> Int -> IO ()+concatMap outer inner n =+    S.drain $ S.concatMap+        (\_ -> sourceUnfoldrMN inner n)+        (sourceUnfoldrMN 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+        (\_ -> sourceUnfoldrN inner n)+        (sourceUnfoldrN 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) (sourceUnfoldrMN outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapRepl+inspect $ 'concatMapRepl `hasNoType` ''SPEC+#endif++-- unfoldMany replicate/unfoldrM++{-# INLINE unfoldManyRepl #-}+unfoldManyRepl :: Int -> Int -> Int -> IO ()+unfoldManyRepl outer inner n =+    S.drain+         $ S.unfoldEach+               UF.replicateM+               (S.map ((inner,) . return) (sourceUnfoldrMN outer n))++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'unfoldManyRepl+inspect $ 'unfoldManyRepl `hasNoType` ''S.ConcatMapUState+inspect $ 'unfoldManyRepl `hasNoType` ''SPEC+#endif++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.StreamD"++o_1_space :: [Benchmark]+o_1_space =+    [ bgroup (o_1_space_prefix moduleName)+      [ bgroup "generation"+        [ benchFold "unfoldr"      toNull sourceUnfoldr+        , benchFold "unfoldrM"     toNull sourceUnfoldrM+        , benchFold "intFromTo"    toNull sourceIntFromTo++        , benchFold "fromList" toNull sourceFromList+        ]+      , bgroup "elimination"+        [ benchFold "toNull"   toNull   sourceUnfoldrM+        , benchFold "mapM_"    mapM_    sourceUnfoldrM+        , benchFold "uncons"   uncons   sourceUnfoldrM+        , benchFold "foldBreak" foldBreak sourceUnfoldrM+        , benchFold "foldl'" foldl    sourceUnfoldrM+        , benchFold "last"   last     sourceUnfoldrM+        ]+      , bgroup "nested"+        [ benchFold "toNullAp" toNullApNested (sourceUnfoldrMN value2)+        , benchFold "toNull"   toNullNested   (sourceUnfoldrMN value2)+        , benchFold "toNull3"  toNullNested3  (sourceUnfoldrMN value3)+        , benchFold "filterAllIn"  filterAllInNested  (sourceUnfoldrMN value2)+        , benchFold "filterAllOut"  filterAllOutNested  (sourceUnfoldrMN value2)+        , benchFold "toNullApPure" toNullApNested (sourceUnfoldrN value2)+        , benchFold "toNullPure"   toNullNested   (sourceUnfoldrN value2)+        , benchFold "toNull3Pure"  toNullNested3  (sourceUnfoldrN value3)+        , benchFold "filterAllInPure"  filterAllInNested  (sourceUnfoldrN value2)+        , benchFold "filterAllOutPure"  filterAllOutNested  (sourceUnfoldrN value2)+        ]+      , bgroup "transformation"+        [ benchFold "scan"      (scan      1) sourceUnfoldrM+        , benchFold "map"       (map       1) sourceUnfoldrM+        , benchFold "fmap"      (fmapD     1) sourceUnfoldrM+        , benchFold "mapM"      (mapM      1) sourceUnfoldrM+        , benchFold "mapMaybe"  (mapMaybe  1) sourceUnfoldrM+        , benchFold "mapMaybeM" (mapMaybeM 1) sourceUnfoldrM+        ]+      , bgroup "transformationX4"+        [ benchFold "scan"      (scan      4) sourceUnfoldrM+        , benchFold "map"       (map       4) sourceUnfoldrM+        , benchFold "fmap"      (fmapD     4) sourceUnfoldrM+        , benchFold "mapM"      (mapM      4) sourceUnfoldrM+        , benchFold "mapMaybe"  (mapMaybe  4) sourceUnfoldrM+        , benchFold "mapMaybeM" (mapMaybeM 4) sourceUnfoldrM+        -- XXX this is horribly slow+        -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)+        ]++      , bgroup "concat"+        [ benchIOSrc1 "concatMapPure (n of 1)"+            (concatMapPure value 1)+        , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"+            (concatMapPure value2 value2)+        , benchIOSrc1 "concatMapPure (1 of n)"+            (concatMapPure 1 value)++        , benchIOSrc1 "concatMap (n of 1)"+            (concatMap value 1)+        , benchIOSrc1 "concatMap (sqrt n of sqrt n)"+            (concatMap value2 value2)+        , benchIOSrc1 "concatMap (1 of n)"+            (concatMap 1 value)++        -- concatMap vs unfoldMany+        , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"+            (concatMapRepl value2 value2)+        , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"+            (unfoldManyRepl value2 value2)+        ]+      , bgroup "filtering"+        [ benchFold "filter-even"     (filterEven     1) sourceUnfoldrM+        , benchFold "filter-all-out"  (filterAllOut   1) sourceUnfoldrM+        , benchFold "filter-all-in"   (filterAllIn    1) sourceUnfoldrM+        , benchFold "take-all"        (takeAll        1) sourceUnfoldrM+        , benchFold "takeWhile-true"  (takeWhileTrue  1) sourceUnfoldrM+        , benchFold "drop-one"        (dropOne        1) sourceUnfoldrM+        , benchFold "drop-all"        (dropAll        1) sourceUnfoldrM+        , benchFold "dropWhile-true"  (dropWhileTrue  1) sourceUnfoldrM+        , benchFold "dropWhile-false" (dropWhileFalse 1) sourceUnfoldrM+        ]+      , bgroup "filteringX4"+        [ benchFold "filter-even"     (filterEven     4) sourceUnfoldrM+        , benchFold "filter-all-out"  (filterAllOut   4) sourceUnfoldrM+        , benchFold "filter-all-in"   (filterAllIn    4) sourceUnfoldrM+        , benchFold "take-all"        (takeAll        4) sourceUnfoldrM+        , benchFold "takeWhile-true"  (takeWhileTrue  4) sourceUnfoldrM+        , benchFold "drop-one"        (dropOne        4) sourceUnfoldrM+        , benchFold "drop-all"        (dropAll        4) sourceUnfoldrM+        , benchFold "dropWhile-true"  (dropWhileTrue  4) sourceUnfoldrM+        , benchFold "dropWhile-false" (dropWhileFalse 4) sourceUnfoldrM+        ]+      , bgroup "zipping"+        [ benchFold "eqBy"  eqBy  sourceUnfoldrM+        , benchFold "cmpBy" cmpBy sourceUnfoldrM+        , benchFold   "zip"   zip   sourceUnfoldrM+        ]+      , bgroup "mixed"+        [ benchFold "scan-map"    (scanMap    1) sourceUnfoldrM+        , benchFold "drop-map"    (dropMap    1) sourceUnfoldrM+        , benchFold "drop-scan"   (dropScan   1) sourceUnfoldrM+        , benchFold "take-drop"   (takeDrop   1) sourceUnfoldrM+        , benchFold "take-scan"   (takeScan   1) sourceUnfoldrM+        , benchFold "take-map"    (takeMap    1) sourceUnfoldrM+        , benchFold "filter-drop" (filterDrop 1) sourceUnfoldrM+        , benchFold "filter-take" (filterTake 1) sourceUnfoldrM+        , benchFold "filter-scan" (filterScan 1) sourceUnfoldrM+        , benchFold "filter-map"  (filterMap  1) sourceUnfoldrM+        ]+      , bgroup "mixedX2"+        [ benchFold "scan-map"    (scanMap    2) sourceUnfoldrM+        , benchFold "drop-map"    (dropMap    2) sourceUnfoldrM+        , benchFold "drop-scan"   (dropScan   2) sourceUnfoldrM+        , benchFold "take-drop"   (takeDrop   2) sourceUnfoldrM+        , benchFold "take-scan"   (takeScan   2) sourceUnfoldrM+        , benchFold "take-map"    (takeMap    2) sourceUnfoldrM+        , benchFold "filter-drop" (filterDrop 2) sourceUnfoldrM+        , benchFold "filter-take" (filterTake 2) sourceUnfoldrM+        , benchFold "filter-scan" (filterScan 2) sourceUnfoldrM+        , benchFold "filter-map"  (filterMap  2) sourceUnfoldrM+        ]+      , bgroup "mixedX4"+        [ benchFold "scan-map"    (scanMap    4) sourceUnfoldrM+        , benchFold "drop-map"    (dropMap    4) sourceUnfoldrM+        , benchFold "drop-scan"   (dropScan   4) sourceUnfoldrM+        , benchFold "take-drop"   (takeDrop   4) sourceUnfoldrM+        , benchFold "take-scan"   (takeScan   4) sourceUnfoldrM+        , benchFold "take-map"    (takeMap    4) sourceUnfoldrM+        , benchFold "filter-drop" (filterDrop 4) sourceUnfoldrM+        , benchFold "filter-take" (filterTake 4) sourceUnfoldrM+        , benchFold "filter-scan" (filterScan 4) sourceUnfoldrM+        , benchFold "filter-map"  (filterMap  4) sourceUnfoldrM+        ]+      ]+    ]++-- | Takes a source, and uses it with a default drain/fold method.+{-# INLINE benchD #-}+benchD :: P.String -> (Int -> Stream P.IO Int) -> Benchmark+benchD name f = bench name $ nfIO $ randomRIO (1,1) >>= toNull . f++o_n_stack :: [Benchmark]+o_n_stack =+    [ bgroup (o_n_stack_prefix moduleName)+      [ bgroup "elimination"+        [ benchFold "tail"   tail     sourceUnfoldrM+        , benchFold "nullTail" nullTail sourceUnfoldrM+        , benchFold "headTail" headTail sourceUnfoldrM+        ]+      , bgroup "transformation"+        [+          -- this is horribly slow+          -- benchFold "foldrS"    (_foldrS    1) sourceUnfoldrM+          -- XXX why do these need so much stack+          benchFold "intersperse" (intersperse 1) (sourceUnfoldrMN value2)+        , benchFold "interspersePure" (intersperse 1) (sourceUnfoldrN value2)+        ]+      , bgroup "transformationX4"+        [+          benchFold "intersperse" (intersperse 4) (sourceUnfoldrMN value16)+        ]+      , bgroup "iterated"+        [ benchD "mapM"                 iterateMapM+        , benchD "scan(1/10)"           iterateScan+        , benchD "filterEven"           iterateFilterEven+        , benchD "takeAll"              iterateTakeAll+        , benchD "dropOne"              iterateDropOne+        , benchD "dropWhileFalse(1/10)" iterateDropWhileFalse+        , benchD "dropWhileTrue"        iterateDropWhileTrue+        , benchD "iterateM"             iterateM+        ]+      ]+    ]++o_n_space :: [Benchmark]+o_n_space =+    [ bgroup (o_n_space_prefix moduleName)+      [ bgroup "elimination"+        [ benchFold "toList" toList   sourceUnfoldrM+        ]+      , bgroup "transformation"+        [++        -- This is horribly slow, never finishes+        -- benchFold "foldlS"    (_foldlS    1) sourceUnfoldrM+        ]+      ]+    ]++main :: IO ()+main = defaultMain $ concat [o_1_space, o_n_stack, o_n_space]
+ 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
@@ -0,0 +1,873 @@+-- |+-- Module      : Streamly.Benchmark.Data.Fold+-- Copyright   : (c) 2018 Composewell+-- License     : MIT+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# 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.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)++import qualified Prelude+import qualified Streamly.FileSystem.Handle as FH+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Unfold as UF+#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 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++{-# INLINE benchIO #-}+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++-- generate numbers up to the argument value+{-# INLINE source #-}+source :: Monad m => Int -> Unfold m Int Int+source n = UF.second n UF.enumerateFromToIntegral++-------------------------------------------------------------------------------+-- Benchmark helpers+-------------------------------------------------------------------------------++{-# INLINE drainGeneration #-}+drainGeneration :: Monad m => Unfold m a b -> a -> m ()+drainGeneration unf seed = UF.fold FL.drain unf seed++{-# INLINE drainTransformation #-}+drainTransformation ::+       Monad m => Unfold m a b -> (Unfold m a b -> Unfold m c d) -> c -> m ()+drainTransformation unf f seed = drainGeneration (f unf) seed++{-# INLINE drainTransformationDefault #-}+drainTransformationDefault ::+       Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()+drainTransformationDefault to =+    drainTransformation (UF.second to UF.enumerateFromToIntegral)++{-# INLINE drainProduct #-}+drainProduct ::+       Monad m+    => Unfold m a b+    -> Unfold m c d+    -> (Unfold m a b -> Unfold m c d -> Unfold m e f)+    -> e+    -> m ()+drainProduct unf1 unf2 f seed = drainGeneration (f unf1 unf2) seed++{-# INLINE drainProductDefault #-}+drainProductDefault ::+       Monad m+    => Int+    -> (Unfold m Int Int -> Unfold m Int Int -> Unfold m e f)+    -> e+    -> m ()+drainProductDefault to = drainProduct src src++    where++    src = UF.second to UF.enumerateFromToIntegral++-------------------------------------------------------------------------------+-- Operations on input+-------------------------------------------------------------------------------++{-# INLINE lmap #-}+lmap :: Monad m => Int -> Int -> m ()+lmap size start =+    drainTransformationDefault (size + start) (UF.lmap (+ 1)) start++{-# INLINE lmapM #-}+lmapM :: Monad m => Int -> Int -> m ()+lmapM size start =+    drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start++{-# INLINE both #-}+both :: Monad m => Int -> Int -> m ()+both size start =+    drainTransformationDefault (size + start) (UF.supply start) ()+++{-# INLINE first #-}+first :: Monad m => Int -> Int -> m ()+first size start =+    drainTransformation+        (UF.take size UF.enumerateFromThenIntegral)+        (UF.first start)+        1++{-# INLINE second #-}+second :: Monad m => Int -> Int -> m ()+second size start =+    drainTransformation+        (UF.take size UF.enumerateFromThenIntegral)+        (UF.second 1)+        start++{-# INLINE discardFirst #-}+discardFirst :: Monad m => Int -> Int -> m ()+discardFirst size start =+    drainTransformationDefault (size + start) UF.discardFirst (start, start)++{-# INLINE discardSecond #-}+discardSecond :: Monad m => Int -> Int -> m ()+discardSecond size start =+    drainTransformationDefault (size + start) UF.discardSecond (start, start)++{-# INLINE swap #-}+swap :: Monad m => Int -> Int -> m ()+swap size start =+    drainTransformation+        (UF.take size UF.enumerateFromThenIntegral)+        UF.swap+        (1, start)++-------------------------------------------------------------------------------+-- Stream generation+-------------------------------------------------------------------------------++{-# INLINE fromStream #-}+fromStream :: Int -> Int -> IO ()+fromStream size start =+    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.+{-# INLINE fromStreamK #-}+fromStreamK :: Monad m => Int -> Int -> m ()+fromStreamK size start = drainGeneration UF.fromStreamK (K.replicate size start)++{-# INLINE fromStreamD #-}+fromStreamD :: Monad m => Int -> Int -> m ()+fromStreamD size start =+    drainGeneration UF.fromStreamD (D.replicate size start)++{-# INLINE _nilM #-}+_nilM :: Monad m => Int -> Int -> m ()+_nilM _ start = drainGeneration (UF.nilM return) start++{-# INLINE consM #-}+consM :: Monad m => Int -> Int -> m ()+consM size start =+    drainTransformationDefault (size + start) (UF.consM return) start++{-# INLINE _functionM #-}+_functionM :: Monad m => Int -> Int -> m ()+_functionM _ start = drainGeneration (UF.functionM return) start++{-# INLINE _function #-}+_function :: Monad m => Int -> Int -> m ()+_function _ start = drainGeneration (UF.function id) start++{-# INLINE _identity #-}+_identity :: Monad m => Int -> Int -> m ()+_identity _ start = drainGeneration UF.identity start++{-# INLINE _const #-}+_const :: Monad m => Int -> Int -> m ()+_const size start =+    drainGeneration (UF.take size (UF.fromEffect (return start))) undefined++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Int -> Unfold m Int Int+sourceUnfoldrM size start = UF.unfoldrM step++    where++    step i =+        return+            $ if i < start + size+              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]++{-# INLINE fromListM #-}+fromListM :: Monad m => Int -> Int -> m ()+fromListM size start =+    drainGeneration UF.fromListM (Prelude.map return [start .. start + size])++{-# INLINE _fromSVar #-}+_fromSVar :: Int -> Int -> m ()+_fromSVar = undefined++{-# INLINE _fromProducer #-}+_fromProducer :: Int -> Int -> m ()+_fromProducer = undefined++{-# INLINE replicateM #-}+replicateM :: Monad m => Int -> Int -> m ()+replicateM size start = drainGeneration UF.replicateM (size, return start)++{-# INLINE repeatM #-}+repeatM :: Monad m => Int -> Int -> m ()+repeatM size start = drainGeneration (UF.take size UF.repeatM) (return start)++{-# INLINE iterateM #-}+iterateM :: Monad m => Int -> Int -> m ()+iterateM size start =+    drainGeneration (UF.take size (UF.iterateM return)) (return start)++{-# INLINE fromIndicesM #-}+fromIndicesM :: Monad m => Int -> Int -> m ()+fromIndicesM size start =+    drainGeneration (UF.take size (UF.fromIndicesM return)) start++{-# INLINE enumerateFromThenIntegral #-}+enumerateFromThenIntegral :: Monad m => Int -> Int -> m ()+enumerateFromThenIntegral size start =+    drainGeneration (UF.take size UF.enumerateFromThenIntegral) (start, 1)++{-# INLINE enumerateFromToIntegral #-}+enumerateFromToIntegral :: Monad m => Int -> Int -> m ()+enumerateFromToIntegral size start =+    drainGeneration+    ( UF.second+      (size + start)+      UF.enumerateFromToIntegral+    ) start++{-# INLINE enumerateFromIntegral #-}+enumerateFromIntegral :: Monad m => Int -> Int -> m ()+enumerateFromIntegral size start =+    drainGeneration (UF.take size UF.enumerateFromIntegral) start++{-# INLINE enumerateFromStepNum #-}+enumerateFromStepNum :: Monad m => Int -> Int -> m ()+enumerateFromStepNum size start =+    drainGeneration (UF.take size (UF.enumerateFromThenNum)) (start, 1)++{-# INLINE enumerateFromNum #-}+enumerateFromNum :: Monad m => Int -> Int -> m ()+enumerateFromNum size start = drainGeneration (UF.take size UF.enumerateFromNum) start++{-# INLINE enumerateFromToFractional #-}+enumerateFromToFractional :: Monad m => Int -> Int -> m ()+enumerateFromToFractional size start =+    let intToDouble x = (fromInteger (fromIntegral x)) :: Double+     in drainGeneration+            ( UF.second+              (intToDouble $ start + size)+              UF.enumerateFromToFractional+            )+            (intToDouble start)++-------------------------------------------------------------------------------+-- 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++{-# INLINE mapM #-}+mapM :: Monad m => Int -> Int -> m ()+mapM size start =+    drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start++{-# INLINE mapM2 #-}+mapM2 :: Monad m => Int -> Int -> m ()+mapM2 size start =+    drainTransformationDefault+        size+        (UF.mapM (\(a, b) -> return $ a + b) . UF.carry)+        start++-------------------------------------------------------------------------------+-- Stream filtering+-------------------------------------------------------------------------------++{-# INLINE takeWhileM #-}+takeWhileM :: Monad m => Int -> Int -> m ()+takeWhileM size start =+    drainTransformationDefault+        size+        (UF.takeWhileM (\b -> return (b <= size + start)))+        start++{-# INLINE takeWhile #-}+takeWhile :: Monad m => Int -> Int -> m ()+takeWhile size start =+    drainTransformationDefault+        size+        (UF.takeWhile (\b -> b <= size + start))+        start++{-# INLINE take #-}+take :: Monad m => Int -> Int -> m ()+take size start = drainTransformationDefault (size + start) (UF.take size) start++{-# INLINE filter #-}+filter :: Monad m => Int -> Int -> m ()+filter size start =+    drainTransformationDefault (size + start) (UF.filter (\_ -> True)) start++{-# INLINE filterM #-}+filterM :: Monad m => Int -> Int -> m ()+filterM size start =+    drainTransformationDefault+        (size + start)+        (UF.filterM (\_ -> (return True)))+        start++{-# INLINE _dropOne #-}+_dropOne :: Monad m => Int -> Int -> m ()+_dropOne size start =+    drainTransformationDefault (size + start) (UF.drop 1) start++{-# INLINE dropAll #-}+dropAll :: Monad m => Int -> Int -> m ()+dropAll size start =+    drainTransformationDefault (size + start) (UF.drop (size + 1)) start++{-# INLINE dropWhileTrue #-}+dropWhileTrue :: Monad m => Int -> Int -> m ()+dropWhileTrue size start =+    drainTransformationDefault+        (size + start)+        (UF.dropWhileM (\_ -> return True))+        start++{-# INLINE dropWhileFalse #-}+dropWhileFalse :: Monad m => Int -> Int -> m ()+dropWhileFalse size start =+    drainTransformationDefault+        (size + start)+        (UF.dropWhileM (\_ -> return False))+        start++{-# INLINE dropWhileMTrue #-}+dropWhileMTrue :: Monad m => Int -> Int -> m ()+dropWhileMTrue size start =+    drainTransformationDefault+        size+        (UF.dropWhileM (\_ -> return True))+        start++{-# INLINE dropWhileMFalse #-}+dropWhileMFalse :: Monad m => Int -> Int -> m ()+dropWhileMFalse size start =+    drainTransformationDefault+        size+        (UF.dropWhileM (\_ -> return False))+        start++-------------------------------------------------------------------------------+-- Stream combination+-------------------------------------------------------------------------------++{-# INLINE zipWith #-}+zipWith :: Monad m => Int -> Int -> m ()+zipWith size start =+    drainProductDefault (size + start) (UF.zipWith (+)) start++{-# INLINE zipWithM #-}+zipWithM :: Monad m => Int -> Int -> m ()+zipWithM size start =+    drainProductDefault+        (size + start)+        (UF.zipWithM (\a b -> return $ a + b))+        start++{-# INLINE teeZipWith #-}+teeZipWith :: Monad m => Int -> Int -> m ()+teeZipWith size start =+    drainProductDefault (size + start) (UF.zipWith (+)) start++-------------------------------------------------------------------------------+-- 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.crossApply` s) start++{-# INLINE _apDiscardFst #-}+_apDiscardFst :: Int -> Int -> m ()+_apDiscardFst = undefined++{-# INLINE _apDiscardSnd #-}+_apDiscardSnd :: Int -> Int -> m ()+_apDiscardSnd = undefined++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++-- 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 -> Int -> m ()+concatMapM inner outer start =+    drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start++    where++    unfoldInGen i = return (UF.second (i + inner) UF.enumerateFromToIntegral)+    unfoldOut = UF.second (start + outer) UF.enumerateFromToIntegral++{-# INLINE toNull #-}+toNull :: Monad m => Int -> Int -> m ()+toNull value start =+    let end = start + nthRoot 2 value+        src = source end+        {-+        u = do+            x <- src+            y <- src+            return (x + y)+        -}+        u = src `UF.bind` \x ->+            src `UF.bind` \y ->+                UF.fromPure (x + y)+     in UF.fold FL.drain u start+++{-# INLINE toNull3 #-}+toNull3 :: Monad m => Int -> Int -> m ()+toNull3 value start =+    let end = start + nthRoot 3 value+        src = source end+        {-+        u = do+            x <- src+            y <- src+            z <- src+            return (x + y + z)+        -}+        u = src `UF.bind` \x ->+            src `UF.bind` \y ->+            src `UF.bind` \z ->+                UF.fromPure (x + y + z)+     in UF.fold FL.drain u start++{-# INLINE toList #-}+toList :: Monad m => Int -> Int -> m [Int]+toList value start = do+    let end = start + nthRoot 2 value+        src = source end+        {-+        u = do+            x <- src+            y <- src+            return (x + y)+        -}+        u = src `UF.bind` \x ->+            src `UF.bind` \y ->+                UF.fromPure (x + y)+     in UF.fold FL.toList u start++{-# INLINE toListSome #-}+toListSome :: Monad m => Int -> Int -> m [Int]+toListSome value start = do+    let end = start + nthRoot 2 value+        src = source end+        {-+        u = do+            x <- src+            y <- src+            return (x + y)+        -}+        u = src `UF.bind` \x ->+            src `UF.bind` \y ->+                UF.fromPure (x + y)+     in UF.fold FL.toList (UF.take 1000 u) start++{-# INLINE filterAllOut #-}+filterAllOut :: Monad m => Int -> Int -> m ()+filterAllOut value start = do+    let end = start + nthRoot 2 value+        src = source end+        {-+        u = do+            x <- src+            y <- src+        -}+        u = src `UF.bind` \x ->+            src `UF.bind` \y ->+            let s = x + y+             in if s < 0+                then UF.fromPure s+                else UF.nilM (return . const ())+     in UF.fold FL.drain u start++{-# INLINE filterAllIn #-}+filterAllIn :: Monad m => Int -> Int -> m ()+filterAllIn value start = do+    let end = start + nthRoot 2 value+        src = source end+        {-+        u = do+            x <- src+            y <- src+        -}+        u = src `UF.bind` \x ->+            src `UF.bind` \y ->+            let s = x + y+             in if s > 0+                then UF.fromPure s+                else UF.nilM (return . const ())+     in UF.fold FL.drain u start++{-# INLINE filterSome #-}+filterSome :: Monad m => Int -> Int -> m ()+filterSome value start = do+    let end = start + nthRoot 2 value+        src = source end+        {-+        u = do+            x <- src+            y <- src+        -}+        u = src `UF.bind` \x ->+            src `UF.bind` \y ->+            let s = x + y+             in if s > 1100000+                then UF.fromPure s+                else UF.nilM (return . const ())+     in UF.fold FL.drain u start++{-# INLINE breakAfterSome #-}+breakAfterSome :: Int -> Int -> IO ()+breakAfterSome value start =+    let end = start + nthRoot 2 value+        src = source end+        {-+        u = do+            x <- src+            y <- src+        -}+        u = src `UF.bind` \x ->+            src `UF.bind` \y ->+            let s = x + y+             in if s > 1100000+                then error "break"+                else UF.fromPure s+     in do+        (_ :: Either ErrorCall ()) <- try $ UF.fold FL.drain u start+        return ()++-------------------------------------------------------------------------------+-- Benchmark ops+-------------------------------------------------------------------------------++{-# 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+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Unfold"++o_1_space_transformation_input :: Int -> [Benchmark]+o_1_space_transformation_input size =+    [ bgroup+          "transformation/input"+          [ benchIO "lmap" $ lmap size+          , benchIO "lmapM" $ lmapM 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+          ]+    ]++o_1_space_generation :: Int -> [Benchmark]+o_1_space_generation size =+    [ bgroup+          "generation"+          [ benchIO "fromStream" $ fromStream size+          , benchIO "fromStreamK" $ fromStreamK size+          , benchIO "fromStreamD" $ fromStreamD size+          -- Very small benchmarks, reporting in ns+          -- , benchIO "nilM" $ nilM size+          , benchIO "consM" $ consM size+          -- , benchIO "functionM" $ functionM size+          -- , benchIO "function" $ function size+          -- , benchIO "identity" $ identity size+          -- , benchIO "const" $ const size+          , benchIO "unfoldrM" $ unfoldrM size+          , benchIO "fromList" $ fromList size+          , benchIO "fromListM" $ fromListM size+          -- Unimplemented+          -- , benchIO "fromSVar" $ fromSVar size+          -- , benchIO "fromProducer" $ fromProducer size+          , benchIO "replicateM" $ replicateM size+          , benchIO "repeatM" $ repeatM size+          , benchIO "iterateM" $ iterateM size+          , benchIO "fromIndicesM" $ fromIndicesM size+          , benchIO "enumerateFromThenIntegral" $ enumerateFromThenIntegral size+          , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size+          , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size+          , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size+          , benchIO "enumerateFromNum" $ enumerateFromNum size+          , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size+          ]+    ]++o_1_space_transformation :: Int -> [Benchmark]+o_1_space_transformation size =+    [ bgroup+          "transformation"+          [ benchIO "map" $ map size+          , benchIO "mapM" $ mapM size+          , benchIO "mapM2" $ mapM2 size+          , benchIO "postscan" $ postscan size+          ]+    ]++o_1_space_filtering :: Int -> [Benchmark]+o_1_space_filtering size =+    [ bgroup+          "filtering"+          [ benchIO "takeWhileM" $ takeWhileM size+          , benchIO "takeWhile" $ takeWhile size+          , benchIO "take" $ take size+          , benchIO "filter" $ filter size+          , benchIO "filterM" $ filterM size+          -- Very small benchmark, reporting in ns+          -- , benchIO "dropOne" $ dropOne size+          , benchIO "dropAll" $ dropAll size+          , benchIO "dropWhileTrue" $ dropWhileTrue size+          , benchIO "dropWhileFalse" $ dropWhileFalse size+          , benchIO "dropWhileMTrue" $ dropWhileMTrue size+          , benchIO "dropWhileMFalse" $ dropWhileMFalse size+          ]+    ]++o_1_space_zip :: Int -> [Benchmark]+o_1_space_zip size =+    [ bgroup+          "zip"+          [ benchIO "zipWithM" $ zipWithM size+          , benchIO "zipWith" $ zipWith size+          , benchIO "teeZipWith" $ teeZipWith 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 "crossApply outer=inner=(sqrt Max)" $ toNullAp size+          -- Unimplemented+          -- , benchIO "apDiscardFst" $ apDiscardFst size+          -- , benchIO "apDiscardSnd" $ apDiscardSnd 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 "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 "toList2" $ toList size+          , benchIO "toListSome2" $ toListSome size+          ]+    ]++-------------------------------------------------------------------------------+-- Unfold Exception Benchmarks+-------------------------------------------------------------------------------+-- | Send the file contents to /dev/null with exception handling+readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()+readWriteOnExceptionUnfold inh devNull =+    let readEx = UF.onException (\_ -> hClose inh) FH.reader+    in S.fold (FH.write devNull) $ S.unfold readEx inh++#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold+-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step+#endif++-- | Send the file contents to /dev/null with exception handling+readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()+readWriteHandleExceptionUnfold inh devNull =+    let handler (_e :: SomeException) = hClose inh >> return 10+        readEx = UF.handle (UF.functionM handler) FH.reader+    in S.fold (FH.write devNull) $ S.unfold readEx inh++#ifdef INSPECTION+-- 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.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.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.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.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 =+    [ bgroup "exceptions"+       [ mkBenchSmall "UF.onException" env $ \inh _ ->+           readWriteOnExceptionUnfold inh (nullH env)+       , mkBenchSmall "UF.handle" env $ \inh _ ->+           readWriteHandleExceptionUnfold inh (nullH env)+       , mkBenchSmall "UF.finally_" env $ \inh _ ->+           readWriteFinally_Unfold 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+        ]+    ]+++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++main :: IO ()+main = do+    env <- mkHandleBenchEnv+    runWithCLIOpts defaultStreamSize (allBenchmarks env)++    where++    allBenchmarks env size =+        [ bgroup (o_1_space_prefix moduleName)+            $ Prelude.concat+                  [ o_1_space_transformation_input size+                  , o_1_space_generation size+                  , o_1_space_transformation size+                  , o_1_space_filtering size+                  , o_1_space_zip size+                  , o_1_space_nested env size+                  , o_1_space_copy_read_exceptions env+                  ]+        , bgroup (o_n_space_prefix moduleName)+            $ Prelude.concat [o_n_space_nested size]+        ]
+ 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
@@ -0,0 +1,52 @@+-- |+-- Module      : Streamly.Benchmark.FileSystem.Handle+-- 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+import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)++import qualified Handle.ReadWrite as RW+import qualified Handle.Read as RO++import Test.Tasty.Bench hiding (env)+import Prelude hiding (last, length)+import Streamly.Benchmark.Common++-------------------------------------------------------------------------------+--+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "FileSystem.Handle"++-------------------------------------------------------------------------------+--+-------------------------------------------------------------------------------++main :: IO ()+main = do+    env <- mkHandleBenchEnv+    defaultMain (allBenchmarks env)++    where++    allBenchmarks env =+        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat+            [ RO.allBenchmarks env+            , RW.allBenchmarks env+            ]+        ]
+ benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs view
@@ -0,0 +1,303 @@++-- |+-- Module      : Streamly.Benchmark.FileSystem.Handle+-- 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 Handle.Read+    (allBenchmarks)+where++import Data.Word (Word8)+import GHC.Magic (inline)+import GHC.Magic (noinline)+import System.IO (Handle)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.FileSystem.Handle as FH+import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Fold as FL+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.Data.Stream.Prelude as S+import qualified Streamly.Unicode.Stream as SS++import Test.Tasty.Bench hiding (env)+import Prelude hiding (last, length)+import Streamly.Benchmark.Common.Handle++#ifdef INSPECTION+import Streamly.Internal.Data.Stream (Step(..), FoldMany)++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+#endif++-- TBD reading with unfold++-------------------------------------------------------------------------------+-- unfold read+-------------------------------------------------------------------------------++-- | Get the last byte from a file bytestream.+readLast :: Handle -> IO (Maybe Word8)+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` ''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.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` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Count the number of lines in a file.+readCountLines :: Handle -> IO Int+readCountLines =+    S.fold Fold.length+        . IUS.lines FL.drain+        . SS.decodeLatin1+        . 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` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Count the number of words in a file.+readCountWords :: Handle -> IO Int+readCountWords =+    S.fold Fold.length+        . IUS.words FL.drain+        . SS.decodeLatin1+        . S.unfold FH.reader++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'readCountWords+-- inspect $ 'readCountWords `hasNoType` ''Step+#endif++-- | Sum the bytes in a file.+readSumBytes :: Handle -> IO Word8+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` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- XXX When we mark this with INLINE and we have two benchmarks using S.drain+-- in one benchmark group then somehow GHC ends up delaying the inlining of+-- readDrain. Since S.drain has an INLINE[2] for proper rule firing, that does+-- not work well because of delyaed inlining and the code does not fuse. We+-- need some way of propagating the inline phase information up so that we can+-- expedite inlining of the callers too automatically. The minimal example for+-- the problem can be created by using just two benchmarks in a bench group+-- both using "readDrain". Either GHC should be fixed or we can use+-- fusion-plugin to propagate INLINE phase information such that this problem+-- does not occur.+readDrain :: Handle -> IO ()+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.fold Fold.drain+     $ SS.decodeLatin1+     $ S.unfold FH.reader inh++readDecodeUtf8 :: Handle -> IO ()+readDecodeUtf8 inh =+   S.fold Fold.drain+     $ SS.decodeUtf8+     $ S.unfold FH.reader inh++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'readDecodeUtf8+-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''Step+#endif++o_1_space_reduce_read :: BenchEnv -> [Benchmark]+o_1_space_reduce_read env =+    [ bgroup "reduce/read"+        [ -- read raw bytes without any decoding+          mkBench "S.drain" env $ \inh _ ->+            readDrain inh+        , mkBench "S.last" env $ \inh _ ->+            readLast inh+        , mkBench "S.sum" env $ \inh _ ->+            readSumBytes inh++        -- read with Latin1 decoding+        , mkBench "SS.decodeLatin1" env $ \inh _ ->+            readDecodeLatin1 inh+        , mkBench "S.length" env $ \inh _ ->+            readCountBytes inh+        , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->+            readCountLines inh+        , mkBench "US.words . SS.decodeLatin1" env $ \inh _ ->+            readCountWords inh++        -- read with utf8 decoding+        , mkBenchSmall "SS.decodeUtf8" env $ \inh _ ->+            readDecodeUtf8 inh+        ]+    ]++-------------------------------------------------------------------------------+-- stream toBytes+-------------------------------------------------------------------------------++-- | Count the number of lines in a file.+getChunksConcatUnfoldCountLines :: Handle -> IO Int+getChunksConcatUnfoldCountLines inh =+    S.fold Fold.length+        $ IUS.lines FL.drain+        $ SS.decodeLatin1+        -- XXX replace with toBytes+        $ S.unfoldEach A.reader (IFH.readChunks inh)++#ifdef INSPECTION+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 _ ->+            getChunksConcatUnfoldCountLines inh+        ]+    ]++-------------------------------------------------------------------------------+-- reduce after grouping in chunks+-------------------------------------------------------------------------------++chunksOfSum :: Int -> Handle -> IO Int+chunksOfSum n inh =+    S.fold Fold.length $ IP.groupsOf n FL.sum (S.unfold FH.reader 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.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 groupsOf #-}+groupsOf :: Int -> Handle -> IO Int+groupsOf n inh =+    -- writeNUnsafe gives 2.5x boost here over writeN.+    S.fold Fold.length+        $ IP.groupsOf n (A.unsafeCreateOf n) (S.unfold FH.reader inh)++#ifdef INSPECTION+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 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.groupsOf " ++ show (bigSize env) ++  " FL.sum") env $+            \inh _ ->+                chunksOfSum (bigSize 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.foldMany1 (FL.take " ++ show (bigSize env) ++ " FL.sum)")+            env+            $ \inh _ -> noinline foldMany1ChunksOfSum (bigSize env) inh+        , mkBench+            "S.foldMany1 (FL.take 1 FL.sum)"+            env+            $ \inh _ -> inline foldMany1ChunksOfSum 1 inh+        , mkBench+            ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")+            env+            $ \inh _ -> noinline foldManyChunksOfSum (bigSize env) inh+        , mkBench+            "S.foldMany (FL.take 1 FL.sum)"+            env+            $ \inh _ -> inline foldManyChunksOfSum 1 inh++        -- folding chunks to arrays+        , 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 "A.chunksOf 10" env $ \inh _ ->+            chunksOf 10 inh+        , mkBench "A.chunksOf 1000" env $ \inh _ ->+            chunksOf 1000 inh+        ]+    ]++allBenchmarks :: BenchEnv -> [Benchmark]+allBenchmarks env = Prelude.concat+    [ o_1_space_reduce_read env+    , o_1_space_reduce_toBytes env+    , o_1_space_reduce_read_grouped env+    ]
+ benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs view
@@ -0,0 +1,213 @@++-- |+-- Module      : Streamly.Benchmark.FileSystem.Handle+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3-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 Handle.ReadWrite+    (allBenchmarks)+where++import System.IO (Handle)+import Prelude hiding (last, length)+import Streamly.Internal.System.IO (defaultChunkSize)++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 as A+import qualified Streamly.Data.Stream.Prelude as S++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common.Handle++#ifdef INSPECTION+import Streamly.Internal.Data.Stream (Step(..))++import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.Tuple.Strict as Strict+import qualified Streamly.Internal.Data.MutArray as MutArray++import Test.Inspection+#endif++-------------------------------------------------------------------------------+-- copy chunked+-------------------------------------------------------------------------------++-- | Copy file+copyChunks :: Handle -> Handle -> IO ()+copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.readChunks inh++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'copyChunks+inspect $ 'copyChunks `hasNoType` ''Step+#endif++o_1_space_copy_chunked :: BenchEnv -> [Benchmark]+o_1_space_copy_chunked env =+    [ bgroup "copy/getChunks"+        [ mkBench "toNull" env $ \inH _ ->+            copyChunks inH (nullH env)+        , mkBench "raw" env $ \inH outH ->+            copyChunks inH outH+        ]+    ]++-------------------------------------------------------------------------------+-- copy unfold+-------------------------------------------------------------------------------++-- | Copy file+copyStream :: Handle -> Handle -> IO ()+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` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe+                                                   -- FH.read/A.read+inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf+#endif++o_1_space_copy_read :: BenchEnv -> [Benchmark]+o_1_space_copy_read env =+    [ bgroup "copy/read"+        [ mkBench "rawToNull" env $ \inh _ ->+            copyStream inh (nullH env)+        , mkBench "rawToFile" env $ \inh outh ->+            copyStream inh outh+        ]+    ]++-------------------------------------------------------------------------------+-- copy stream+-------------------------------------------------------------------------------++-- | Send the file contents to /dev/null+readFromBytesNull :: Handle -> Handle -> IO ()+readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.reader inh++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'readFromBytesNull+inspect $ 'readFromBytesNull `hasNoType` ''Step+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+readWithFromBytesNull :: Handle -> Handle -> IO ()+readWithFromBytesNull inh devNull =+    IFH.putBytes devNull+        $ S.unfold FH.readerWith (defaultChunkSize, inh)++#ifdef INSPECTION+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+-- Implicitly benchmarked via 'readFromBytesNull'+_readChunks :: Handle -> Handle -> IO ()+_readChunks inh devNull = IUF.fold fld unf inh++    where++    fld = FH.write devNull+    unf = IUF.unfoldEach A.reader FH.chunkReader++-- | Send the chunk content to /dev/null+-- Implicitly benchmarked via 'readWithFromBytesNull'+_readChunksWith :: Handle -> Handle -> IO ()+_readChunksWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)++    where++    fld = FH.write devNull+    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.readWith" env $ \inh _ ->+            readWithFromBytesNull inh (nullH env)+        ]+    ]++-- | Send the file contents ('defaultChunkSize') to /dev/null+writeReadWith :: Handle -> Handle -> IO ()+writeReadWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)++    where++    fld = FH.writeWith defaultChunkSize devNull+    unf = FH.readerWith++#ifdef INSPECTION+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+writeRead :: Handle -> Handle -> IO ()+writeRead inh devNull = IUF.fold fld unf inh++    where++    fld = FH.write devNull+    unf = FH.reader++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'writeRead+inspect $ 'writeRead `hasNoType` ''Step+inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many+inspect $ 'writeRead `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe+                                                  -- FH.read/A.read+#endif++o_1_space_copy :: BenchEnv -> [Benchmark]+o_1_space_copy env =+    [ bgroup "copy"+        [ mkBench "FH.write . FH.read" env $ \inh _ ->+            writeRead inh (nullH env)+        , mkBench "FH.writeWith . FH.readWith" env $ \inh _ ->+            writeReadWith inh (nullH env)+        ]+    ]++-------------------------------------------------------------------------------+--+-------------------------------------------------------------------------------++allBenchmarks :: BenchEnv -> [Benchmark]+allBenchmarks env = Prelude.concat+    [ o_1_space_copy_chunked env+    , o_1_space_copy_read env+    , o_1_space_copy_fromBytes env+    , o_1_space_copy env+    ]
+ benchmark/Streamly/Benchmark/Prelude/Adaptive.hs view
@@ -0,0 +1,143 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- 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 (liftIO)+import Test.Tasty.Bench+import Streamly.Prelude as S+import System.Random (randomRIO)++-- 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 = "Prelude.Adaptive"++value :: Int+value = 1000++{-# INLINE source #-}+source :: IsStream t => (Int, Int) -> t IO Int+source range = S.replicateM value $ do+    r <- randomRIO range+    when (r /= 0) $ liftIO $ threadDelay r+    return r++{-# INLINE run #-}+run :: IsStream t => (Int, Int) -> (Int, Int) -> (t IO Int -> SerialT IO Int) -> IO ()+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+medium = 20+high = 30++{-# INLINE noDelay #-}+noDelay :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+noDelay = run (0,0) (0,0)++{-# INLINE alwaysConstSlowSerial #-}+alwaysConstSlowSerial :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysConstSlowSerial = run (0,0) (medium,medium)++{-# INLINE alwaysConstSlow #-}+alwaysConstSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysConstSlow = run (low,low) (medium,medium)++{-# INLINE alwaysConstFast #-}+alwaysConstFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysConstFast = run (high,high) (medium,medium)++{-# INLINE alwaysVarSlow #-}+alwaysVarSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysVarSlow = run (low,low) (low,high)++{-# INLINE alwaysVarFast #-}+alwaysVarFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysVarFast = run (high,high) (low,high)++-- XXX add variable producer tests as well++{-# INLINE runVarSometimesFast #-}+runVarSometimesFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+runVarSometimesFast = run (medium,medium) (low,high)++{-# INLINE randomVar #-}+randomVar :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+randomVar = run (low,high) (low,high)++main :: IO ()+main =+  defaultMain [bgroup moduleName allBenchmarks]++  where++  allBenchmarks =+    [+      bgroup "serialConstantSlowConsumer"+      [ bench "serially"    $ nfIO $ alwaysConstSlowSerial fromSerial+      , bench "wSerially"   $ nfIO $ alwaysConstSlowSerial fromWSerial+      ]+    , bgroup "default"+      [ bench "serially"   $ nfIO $ noDelay fromSerial+      , bench "wSerially"  $ nfIO $ noDelay fromWSerial+      , bench "aheadly"    $ nfIO $ noDelay fromAhead+      , bench "asyncly"    $ nfIO $ noDelay fromAsync+      , bench "wAsyncly"   $ nfIO $ noDelay fromWAsync+      , bench "parallely"  $ nfIO $ noDelay fromParallel+      ]+    , bgroup "constantSlowConsumer"+      [ bench "aheadly"    $ nfIO $ alwaysConstSlow fromAhead+      , bench "asyncly"    $ nfIO $ alwaysConstSlow fromAsync+      , bench "wAsyncly"   $ nfIO $ alwaysConstSlow fromWAsync+      , bench "parallely"  $ nfIO $ alwaysConstSlow fromParallel+      ]+   ,  bgroup "constantFastConsumer"+      [ bench "aheadly"    $ nfIO $ alwaysConstFast fromAhead+      , bench "asyncly"    $ nfIO $ alwaysConstFast fromAsync+      , bench "wAsyncly"   $ nfIO $ alwaysConstFast fromWAsync+      , bench "parallely"  $ nfIO $ alwaysConstFast fromParallel+      ]+   ,  bgroup "variableSlowConsumer"+      [ bench "aheadly"    $ nfIO $ alwaysVarSlow fromAhead+      , bench "asyncly"    $ nfIO $ alwaysVarSlow fromAsync+      , bench "wAsyncly"   $ nfIO $ alwaysVarSlow fromWAsync+      , bench "parallely"  $ nfIO $ alwaysVarSlow fromParallel+      ]+   ,  bgroup "variableFastConsumer"+      [ bench "aheadly"    $ nfIO $ alwaysVarFast fromAhead+      , bench "asyncly"    $ nfIO $ alwaysVarFast fromAsync+      , bench "wAsyncly"   $ nfIO $ alwaysVarFast fromWAsync+      , bench "parallely"  $ nfIO $ alwaysVarFast fromParallel+      ]+   ,  bgroup "variableSometimesFastConsumer"+      [ bench "aheadly"    $ nfIO $ runVarSometimesFast fromAhead+      , bench "asyncly"    $ nfIO $ runVarSometimesFast fromAsync+      , bench "wAsyncly"   $ nfIO $ runVarSometimesFast fromWAsync+      , bench "parallely"  $ nfIO $ runVarSometimesFast fromParallel+      ]+   ,  bgroup "variableFullOverlap"+      [ bench "aheadly"    $ nfIO $ randomVar fromAhead+      , bench "asyncly"    $ nfIO $ randomVar fromAsync+      , bench "wAsyncly"   $ nfIO $ randomVar fromWAsync+      , bench "parallely"  $ nfIO $ randomVar fromParallel+      ]+   ]
+ benchmark/Streamly/Benchmark/Prelude/Ahead.hs view
@@ -0,0 +1,135 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Prelude hiding (mapM)++import Streamly.Prelude (fromAhead, fromSerial, ahead, maxBuffer, maxThreads)+import qualified Streamly.Prelude as S++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude++import Test.Tasty.Bench++moduleName :: String+moduleName = "Prelude.Ahead"++-------------------------------------------------------------------------------+-- Benchmark groups+-------------------------------------------------------------------------------++-- unfoldr and fromFoldable are always serial and therefore the same for+-- all stream types. They can be removed to reduce the number of benchmarks.+o_1_space_generation :: Int -> [Benchmark]+o_1_space_generation value =+    [ bgroup "generation"+        [ benchIOSrc fromAhead "unfoldr" (sourceUnfoldr value)+        , benchIOSrc fromAhead "unfoldrM" (sourceUnfoldrM value)+        , benchIOSrc fromAhead "fromFoldable" (sourceFromFoldable value)+        , benchIOSrc fromAhead "fromFoldableM" (sourceFromFoldableM value)+        , benchIOSrc fromAhead "unfoldrM maxThreads 1"+            (maxThreads 1 . sourceUnfoldrM value)+        , benchIOSrc fromAhead "unfoldrM maxBuffer 1 (x/10 ops)"+            (maxBuffer 1 . sourceUnfoldrM (value `div` 10))+        ]+    ]++o_1_space_mapping :: Int -> [Benchmark]+o_1_space_mapping value =+    [ bgroup "mapping"+        [ benchIOSink value "map" $ mapN fromAhead 1+        , benchIOSink value "fmap" $ fmapN fromAhead 1+        , benchIOSink value "mapM" $ mapM fromAhead 1 . fromSerial+        ]+    ]++o_1_space_concatFoldable :: Int -> [Benchmark]+o_1_space_concatFoldable value =+    [ bgroup+        "concat-foldable"+        [ benchIOSrc fromAhead "foldMapWith (<>) (List)"+            (sourceFoldMapWith value)+        , benchIOSrc fromAhead "foldMapWith (<>) (Stream)"+            (sourceFoldMapWithStream value)+        , benchIOSrc fromAhead "foldMapWithM (<>) (List)"+            (sourceFoldMapWithM value)+        , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"+            (concatFoldableWith value)+        , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"+            (concatForFoldableWith value)+        , benchIOSrc fromAhead "foldMapM (List)" (sourceFoldMapM value)+        ]+    ]++o_1_space_concatMap :: Int -> [Benchmark]+o_1_space_concatMap value =+    value2 `seq`+        [ bgroup "concat"+            -- This is for comparison with foldMapWith+            [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"+                (S.concatMapWith ahead id . sourceConcatMapId value)++            , benchIO "concatMapWith (n of 1)"+                  (concatStreamsWith ahead value 1)+            , benchIO "concatMapWith (sqrt x of sqrt x)"+                  (concatStreamsWith ahead value2 value2)+            , benchIO "concatMapWith (1 of n)"+                  (concatStreamsWith ahead 1 value)+            ]+        ]++    where++    value2 = round $ sqrt (fromIntegral value :: Double)++-------------------------------------------------------------------------------+-- Monadic outer product+-------------------------------------------------------------------------------++o_1_space_outerProduct :: Int -> [Benchmark]+o_1_space_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toNullAp"       $ toNullAp value fromAhead+        , benchIO "toNull"         $ toNullM value fromAhead+        , benchIO "toNull3"        $ toNullM3 value fromAhead+        , benchIO "filterAllOut"   $ filterAllOutM value fromAhead+        , benchIO "filterAllIn"    $ filterAllInM value fromAhead+        , benchIO "filterSome"     $ filterSome value fromAhead+        , benchIO "breakAfterSome" $ breakAfterSome value fromAhead++        ]+    ]++o_n_space_outerProduct :: Int -> [Benchmark]+o_n_space_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toList"         $ toListM value fromAhead+        , benchIO "toListSome"     $ toListSome value fromAhead+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_generation value+            , o_1_space_mapping value+            , o_1_space_concatFoldable value+            , o_1_space_concatMap value+            , o_1_space_outerProduct value+            ]+        , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)+        ]
+ benchmark/Streamly/Benchmark/Prelude/Async.hs view
@@ -0,0 +1,204 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Prelude hiding (mapM)++import Streamly.Prelude (fromAsync, async, maxBuffer, maxThreads, fromSerial)+import qualified Streamly.Prelude as S+import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude++import Test.Tasty.Bench++moduleName :: String+moduleName = "Prelude.Async"++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++o_1_space_generation :: Int -> [Benchmark]+o_1_space_generation value =+    -- These basically test the performance of consMAsync+    [ bgroup "generation"+        [ benchIOSrc fromAsync "unfoldr" (sourceUnfoldr value)+        , benchIOSrc fromAsync "unfoldrM" (sourceUnfoldrM value)+        , benchIOSrc fromAsync "fromListM" (sourceFromListM value)+        , benchIOSrc fromAsync "fromFoldable (List)" (sourceFromFoldable value)+        , benchIOSrc fromAsync "fromFoldableM (List)" (sourceFromFoldableM value)+        , benchIOSrc fromAsync "unfoldrM maxThreads 1"+            (maxThreads 1 . sourceUnfoldrM value)+        , benchIOSrc fromAsync "unfoldrM maxBuffer 1 (x/10 ops)"+            (maxBuffer 1 . sourceUnfoldrM (value `div` 10))+        ]+    ]++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++{-# INLINE foldrSShared #-}+foldrSShared :: Int -> Int -> IO ()+foldrSShared count n =+      S.drain+    $ fromAsync+    $ Transform.foldrSShared (\x xs -> S.consM (return x) xs) S.nil+    $ fromSerial+    $ sourceUnfoldrM count n++o_1_space_mapping :: Int -> [Benchmark]+o_1_space_mapping value =+    [ bgroup "mapping"+        [ benchIOSink value "map" $ mapN fromAsync 1+        , benchIOSink value "fmap" $ fmapN fromAsync 1+        , benchIOSrc1 "foldrSShared" (foldrSShared value)+        -- This basically tests the performance of consMAsync+        , benchIOSink value "mapM" $ mapM fromAsync 1 . fromSerial+        ]+    ]++-------------------------------------------------------------------------------+-- Size conserving transformations (reordering, buffering, etc.)+-------------------------------------------------------------------------------++o_n_heap_buffering :: Int -> [Benchmark]+o_n_heap_buffering value =+    [bgroup "buffered" [benchIOSink value "mkAsync" (mkAsync fromAsync)]]++-------------------------------------------------------------------------------+-- Joining+-------------------------------------------------------------------------------++{-# INLINE async2 #-}+async2 :: Int -> Int -> IO ()+async2 count n =+    S.drain $+        (sourceUnfoldrM count n) `async` (sourceUnfoldrM count (n + 1))++{-# INLINE async4 #-}+async4 :: Int -> Int -> IO ()+async4 count n =+    S.drain $+                  (sourceUnfoldrM count (n + 0))+        `async` (sourceUnfoldrM count (n + 1))+        `async` (sourceUnfoldrM count (n + 2))+        `async` (sourceUnfoldrM count (n + 3))++{-# INLINE async2n2 #-}+async2n2 :: Int -> Int -> IO ()+async2n2 count n =+    S.drain $+        ((sourceUnfoldrM count (n + 0))+            `async` (sourceUnfoldrM count (n + 1)))+        `async` ((sourceUnfoldrM count (n + 2))+            `async` (sourceUnfoldrM count (n + 3)))++o_1_space_joining :: Int -> [Benchmark]+o_1_space_joining value =+    [ bgroup "joining"+        [ benchIOSrc1 "async (2 of n/2)" (async2 (value `div` 2))+        , benchIOSrc1 "async (4 of n/4)" (async4 (value `div` 4))+        , benchIOSrc1 "async (2 of (2 of n/4)" (async2n2 (value `div` 4))+        ]+    ]++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++-- These basically test the performance of folding streams with `async`+o_1_space_concatFoldable :: Int -> [Benchmark]+o_1_space_concatFoldable value =+    [ bgroup "concat-foldable"+        [ benchIOSrc fromAsync "foldMapWith (<>) (List)"+            (sourceFoldMapWith value)+        , benchIOSrc fromAsync "foldMapWith (<>) (Stream)"+            (sourceFoldMapWithStream value)+        , benchIOSrc fromAsync "foldMapWithM (<>) (List)"+            (sourceFoldMapWithM value)+        , benchIOSrc fromAsync "S.concatFoldableWith (<>) (List)"+            (concatFoldableWith value)+        , benchIOSrc fromAsync "S.concatForFoldableWith (<>) (List)"+            (concatForFoldableWith value)+        , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)+        ]+    ]++-- These basically test the performance of concating streams with `async`+o_1_space_concatMap :: Int -> [Benchmark]+o_1_space_concatMap value =+    value2 `seq`+        [ bgroup "concat"+            -- This is for comparison with foldMapWith+            [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"+                (S.concatMapWith async id . sourceConcatMapId value)++            , benchIO "concatMapWith (n of 1)"+                  (concatStreamsWith async value 1)+            , benchIO "concatMapWith (sqrt x of sqrt x)"+                  (concatStreamsWith async value2 value2)+            , benchIO "concatMapWith (1 of n)"+                  (concatStreamsWith async 1 value)+            ]+        ]++    where++    value2 = round $ sqrt (fromIntegral value :: Double)++-------------------------------------------------------------------------------+-- Monadic outer product+-------------------------------------------------------------------------------++o_1_space_outerProduct :: Int -> [Benchmark]+o_1_space_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toNullAp"       $ toNullAp value fromAsync+        , benchIO "toNull"         $ toNullM value fromAsync+        , benchIO "toNull3"        $ toNullM3 value fromAsync+        , benchIO "filterAllOut"   $ filterAllOutM value fromAsync+        , benchIO "filterAllIn"    $ filterAllInM value fromAsync+        , benchIO "filterSome"     $ filterSome value fromAsync+        , benchIO "breakAfterSome" $ breakAfterSome value fromAsync++        ]+    ]++o_n_space_outerProduct :: Int -> [Benchmark]+o_n_space_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toList"         $ toListM value fromAsync+        , benchIO "toListSome"     $ toListSome value fromAsync+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks+++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_generation value+            , o_1_space_mapping value+            , o_1_space_concatFoldable value+            , o_1_space_concatMap value+            , o_1_space_outerProduct value+            , o_1_space_joining value+            ]+        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering value)+        , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)+        ]
+ benchmark/Streamly/Benchmark/Prelude/Concurrent.hs view
@@ -0,0 +1,111 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# 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.Prelude+    ( IsStream, SerialT, serial, async, fromAsync, ahead, fromAhead, wAsync+    , fromWAsync, parallel, fromParallel+    )++import Test.Tasty.Bench+import qualified Streamly.Prelude as S++-------------------------------------------------------------------------------+-- 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 :: IsStream t+    => Int -> Int -> Int -> (t IO Int -> SerialT IO Int) -> IO ()+append buflen tcount d t =+    let work = (\i -> when (d /= 0) (threadDelay d) >> return i)+    in S.drain+        $ t+        $ S.maxBuffer buflen+        $ S.maxThreads (-1)+        $ S.fromFoldableM $ fmap work [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+    -> (forall a. SerialT IO a -> SerialT IO a -> SerialT IO a)+    -> IO ()+concated buflen threads d elems t =+    let work = \i -> S.replicateM i (when (d /= 0) (threadDelay d) >> return i)+    in S.drain+        $ S.adapt+        $ S.maxThreads (-1)+        $ S.maxBuffer buflen+        $ S.concatMapWith t work+        $ S.replicate threads elems++appendGroup :: Int -> Int -> Int -> [Benchmark]+appendGroup buflen threads usec =+    [ -- bench "serial"   $ nfIO $ append buflen threads delay fromSerial+      bench "ahead"    $ nfIO $ append buflen threads usec fromAhead+    , bench "async"    $ nfIO $ append buflen threads usec fromAsync+    , bench "wAsync"   $ nfIO $ append buflen threads usec fromWAsync+    , bench "parallel" $ nfIO $ append buflen threads usec fromParallel+    ]++concatGroup :: Int -> Int -> Int -> Int -> [Benchmark]+concatGroup buflen threads usec n =+    [ bench "serial"   $ nfIO $ concated buflen threads usec n serial+    , bench "ahead"    $ nfIO $ concated buflen threads usec n ahead+    , bench "async"    $ nfIO $ concated buflen threads usec n async+    , bench "wAsync"   $ nfIO $ concated buflen threads usec n wAsync+    , bench "parallel" $ nfIO $ concated buflen threads usec n parallel+    ]++main :: IO ()+main =+#ifdef MIN_VERSION_gauge+  defaultMainWith (defaultConfig+    { timeLimit = Just 0+    , minSamples = Just 1+    , minDuration = 0+    , includeFirstIter = True+    , quickMode = True+    })+#else+    defaultMain+#endif++    [ -- bgroup "append/buf-1-threads-10k-0sec"  (appendGroup 1 10000 0)+    -- , bgroup "append/buf-100-threads-100k-0sec"  (appendGroup 100 100000 0)+      bgroup "stream1x10k/buf10k-threads10k-5sec"  (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 "streams100x500k/buf100-threads100"  (concatGroup 100 100 0 500000)++    , bench "forkIO/threads10k-5sec" $+        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/Prelude/Merge.hs view
@@ -0,0 +1,298 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE BangPatterns #-}+{-# 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++import Streamly.Internal.Data.Stream.IsStream (SerialT)+import qualified Data.List as List+import qualified Streamly.Internal.Data.Stream.IsStream as Stream+-- import qualified Streamly.Internal.Data.Unfold as Unfold++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude++import Test.Tasty.Bench++#ifdef INSPECTION+import GHC.Types (SPEC(..))+import Test.Inspection++import qualified Streamly.Internal.Data.Stream as D+#endif++moduleName :: String+moduleName = "Prelude.Merge"++-------------------------------------------------------------------------------+-- Merging+-------------------------------------------------------------------------------++{-# INLINE mergeWith #-}+mergeWith ::+    (  (Int -> Int -> Ordering)+    -> SerialT IO Int+    -> SerialT IO Int+    -> SerialT IO Int+    )+    -> (Int -> Int -> Ordering)+    -> Int -> Int -> IO ()+mergeWith g cmp count n =+    Stream.drain+        $ g+            cmp+            (sourceUnfoldrM count n)+            (sourceUnfoldrM count (n + 1))++{-# INLINE mergeWithM #-}+mergeWithM ::+    (  (Int -> Int -> IO Ordering)+    -> SerialT IO Int+    -> SerialT IO Int+    -> SerialT IO Int+    )+    -> (Int -> Int -> Ordering)+    -> Int -> Int -> IO ()+mergeWithM g cmp count n =+    Stream.drain+        $ g+            (\a b -> return $ cmp a b)+            (sourceUnfoldrM count n)+            (sourceUnfoldrM count (n + 1))++{-# INLINE mergeBy #-}+mergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()+mergeBy = mergeWith Stream.mergeBy++{-# INLINE mergeByM #-}+mergeByM :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()+mergeByM = mergeWithM Stream.mergeByM++{-# INLINE mergeByMFused #-}+mergeByMFused :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()+mergeByMFused = mergeWithM Stream.mergeByMFused++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'mergeBy+inspect $ 'mergeBy `hasNoType` ''SPEC+inspect $ 'mergeBy `hasNoType` ''D.Step++inspect $ hasNoTypeClasses 'mergeByM+inspect $ 'mergeByM `hasNoType` ''SPEC+inspect $ 'mergeByM `hasNoType` ''D.Step++{-# INLINE _mergeByMFusedCheck #-}+_mergeByMFusedCheck :: IO ()+_mergeByMFusedCheck = mergeWithM Stream.mergeByMFused compare 0 0++inspect $ hasNoTypeClasses '_mergeByMFusedCheck+inspect $ '_mergeByMFusedCheck `hasNoType` ''SPEC+inspect $ '_mergeByMFusedCheck `hasNoType` ''D.Step+#endif++{-# INLINE concatPairsWithMergeBy #-}+concatPairsWithMergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> Int -> IO ()+concatPairsWithMergeBy cmp = concatPairsWith (Stream.mergeBy cmp)++{-# INLINE concatPairsWithMergeByFused #-}+concatPairsWithMergeByFused ::+    (Int -> Int -> Ordering) -> Int -> Int -> Int -> IO ()+concatPairsWithMergeByFused cmp =+    concatPairsWith (Stream.mergeByMFused (\x y -> return $ cmp x y))++-------------------------------------------------------------------------------+-- Interleaving+-------------------------------------------------------------------------------++o_1_space_joining :: Int -> [Benchmark]+o_1_space_joining value =+    [ bgroup "joining (2 of n/2)"+        [ benchIOSrc1+            "mergeBy compare"+            (mergeBy compare (value `div` 2))+        , benchIOSrc1+            "mergeByM compare"+            (mergeByM compare (value `div` 2))+        , benchIOSrc1+            "mergeByMFused compare"+            (mergeByMFused compare (value `div` 2))++        , benchIOSrc1+            "mergeBy (flip compare)"+            (mergeBy (flip compare) (value `div` 2))+        , benchIOSrc1+            "mergeByM (flip compare)"+            (mergeByM (flip compare) (value `div` 2))+        , benchIOSrc1+            "mergeByMFused (flip compare)"+            (mergeByMFused (flip compare) (value `div` 2))++        , benchIOSrc1+            "concatPairsWithMergeBy compare"+            (concatPairsWithMergeBy compare 2 (value `div` 2))+        , benchIOSrc1+            "concatPairsWithMergeBy (flip compare)"+            (concatPairsWithMergeBy (flip compare) 2 (value `div` 2))++        , benchIOSrc1+            "concatPairsWithMergeByFused compare"+            (concatPairsWithMergeByFused compare 2 (value `div` 2))+        , benchIOSrc1+            "concatPairsWithMergeByFused (flip compare)"+            (concatPairsWithMergeByFused (flip compare) 2 (value `div` 2))+        ]+    ]++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++{-+{-# INLINE sourceUnfoldrMUF #-}+-- (count, value)+sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int+sourceUnfoldrMUF count = UF.unfoldrM step+    where+    step (cnt, start) =+        return $+            if cnt > start + count+            then Nothing+            else Just (cnt, (cnt + 1, start))++{-# INLINE unfoldManyMergeBy #-}+unfoldManyMergeBy :: Int -> Int -> Int -> IO ()+unfoldManyMergeBy outer inner n =+    S.drain $ (Internal.unfoldManyMergeBy compare)+        -- (UF.lmap return (UF.replicateM inner))+        (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))+        (sourceUnfoldrM outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'unfoldManyMergeBy+-- inspect $ 'unfoldManyMergeBy `hasNoType` ''SPEC+-- inspect $ 'unfoldManyMergeBy `hasNoType`+--      ''D.ConcatUnfoldMergeState+#endif+-}++{-# INLINE sortBy #-}+sortBy :: (Int -> Int -> Ordering) -> SerialT IO Int -> IO ()+sortBy cmp = Stream.drain . Stream.sortBy cmp++{-+-- For fair comparison with concatPairs, removed sorted segmentation+{-# INLINE listSortBy #-}+listSortBy :: (a -> a -> Ordering) -> [a] -> [a]+listSortBy cmp = mergeAll . sequences+  where+    sequences = fmap (: [])++    mergeAll [x] = x+    mergeAll xs  = mergeAll (mergePairs xs)++    mergePairs (a:b:xs) = let !x = merge a b+                          in x : mergePairs xs+    mergePairs xs       = xs++    merge as@(a:as') bs@(b:bs')+      | a `cmp` b == GT = b:merge as  bs'+      | otherwise       = a:merge as' bs+    merge [] bs         = bs+    merge as []         = as+-}++o_n_heap_concat :: Int -> [Benchmark]+o_n_heap_concat value =+    [ bgroup "concatPairsWith"+        [ benchIOSrc1+            "concatPairsWithMergeBy compare (n of 1)"+            (concatPairsWithMergeBy compare value 1)+        , benchIOSrc1+            "concatPairsWithMergeBy compare (sqrtVal of sqrtVal)"+            (concatPairsWithMergeBy compare sqrtVal sqrtVal)++        , benchIOSrc1+            "concatPairsWithMergeBy (flip compare) (n of 1)"+            (concatPairsWithMergeBy (flip compare) value 1)+        , benchIOSrc1+            "concatPairsWithMergeBy (flip compare) (sqrtVal of sqrtVal)"+            (concatPairsWithMergeBy (flip compare) sqrtVal sqrtVal)++        , benchIOSrc1+            "concatPairsWithMergeByFused compare (n of 1)"+            (concatPairsWithMergeByFused compare value 1)+        , benchIOSrc1+            "concatPairsWithMergeByFused compare (sqrtVal of sqrtVal)"+            (concatPairsWithMergeByFused compare sqrtVal sqrtVal)+        ]+    -- TODO: change sourceUnfoldrM to generate alternating bigger and lower+    -- numbers to simulate a random input for a worst case sort benchmark. We+    -- can use 0 and value as two ints in the state and alternate each in the+    -- output streams, incrementing the lower number of decrementing the higher+    -- number.+    , bgroup "sorting"+        [ benchIOSink value "sortBy compare" (sortBy compare)+        , benchIOSink value "sortBy (flip compare)" (sortBy (flip compare))+        , benchIOSink value "sortBy compare randomized"+            (sortBy compare . Stream.map (\x -> if even x then x + 2 else x))+        {-+        , bench "sortByLists compare"+            $ nf (\x -> listSortBy compare [1..x]) value+        , bench "sortByLists (flip compare)"+            $ nf (\x -> listSortBy (flip compare) [1..x]) value+        , bench "sortByLists compare randomized"+            $ nf (\x -> listSortBy compare+                    (map (\n -> if even n then n + 2 else n) [1..x])+                 )+                 value+        -}+        , bench "sortByLists compare"+            $ nf (\x -> List.sortBy compare [1..x]) value+        , bench "sortByLists (flip compare)"+            $ nf (\x -> List.sortBy (flip compare) [1..x]) value+        , bench "sortByLists compare randomized"+            $ nf (\x -> List.sortBy compare+                    (map (\n -> if even n then n + 2 else n) [1..x])+                 )+                 value+        ]+    ]++    where++    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.+--+main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks size =+        [ bgroup (o_1_space_prefix moduleName) (o_1_space_joining size)+        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)+        ]
+ benchmark/Streamly/Benchmark/Prelude/Parallel.hs view
@@ -0,0 +1,240 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE FlexibleContexts #-}++import Prelude hiding (mapM)++import Data.Function ((&))+import Streamly.Prelude+       ( SerialT, fromParallel, parallel, fromSerial, maxBuffer, maxThreads)++import qualified Streamly.Prelude  as S+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Stream.IsStream as Internal++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude++import Test.Tasty.Bench++moduleName :: String+moduleName = "Prelude.Parallel"++-------------------------------------------------------------------------------+-- Merging+-------------------------------------------------------------------------------++{-# INLINE mergeAsyncByM #-}+mergeAsyncByM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int+mergeAsyncByM count n =+    S.mergeAsyncByM+        (\a b -> return (a `compare` b))+        (sourceUnfoldrM count n)+        (sourceUnfoldrM count (n + 1))++{-# INLINE mergeAsyncBy #-}+mergeAsyncBy :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int+mergeAsyncBy count n =+    S.mergeAsyncBy+        compare+        (sourceUnfoldrM count n)+        (sourceUnfoldrM count (n + 1))++-------------------------------------------------------------------------------+-- Application/fold+-------------------------------------------------------------------------------++{-# INLINE parAppMap #-}+parAppMap :: S.MonadAsync m => SerialT m Int -> m ()+parAppMap src = S.drain $ S.map (+1) S.|$ src++{-# INLINE parAppSum #-}+parAppSum :: S.MonadAsync m => SerialT m Int -> m ()+parAppSum src = (S.sum S.|$. src) >>= \x -> seq x (return ())++{-# INLINE (|&) #-}+(|&) :: S.MonadAsync m => SerialT m Int -> m ()+(|&) src = src S.|& S.map (+ 1) & S.drain++{-# INLINE (|&.) #-}+(|&.) :: S.MonadAsync m => SerialT m Int -> m ()+(|&.) src = (src S.|&. S.sum) >>= \x -> seq x (return ())++-------------------------------------------------------------------------------+-- Tapping+-------------------------------------------------------------------------------++{-# INLINE tapAsyncS #-}+tapAsyncS :: S.MonadAsync m => Int -> SerialT m Int -> m ()+tapAsyncS n = composeN n $ Internal.tapAsyncK S.sum++{-# INLINE tapAsync #-}+tapAsync :: S.MonadAsync m => Int -> SerialT m Int -> m ()+tapAsync n = composeN n $ Internal.tapAsync FL.sum++o_1_space_merge_app_tap :: Int -> [Benchmark]+o_1_space_merge_app_tap value =+    [ bgroup "merge-app-tap"+        [ benchIOSrc fromSerial "mergeAsyncBy (2,x/2)"+              (mergeAsyncBy (value `div` 2))+        , benchIOSrc fromSerial "mergeAsyncByM (2,x/2)"+              (mergeAsyncByM (value `div` 2))+        -- Parallel stages in a pipeline+        , benchIOSink value "parAppMap" parAppMap+        , benchIOSink value "parAppSum" parAppSum+        , benchIOSink value "(|&)" (|&)+        , benchIOSink value "(|&.)" (|&.)+        , benchIOSink value "tapAsync" (tapAsync 1)+        , benchIOSink value "tapAsyncS" (tapAsyncS 1)+        ]+    ]++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++o_n_heap_generation :: Int -> [Benchmark]+o_n_heap_generation value =+    [ bgroup+        "generation"+        [ benchIOSrc fromParallel "unfoldr" (sourceUnfoldr value)+        , benchIOSrc fromParallel "unfoldrM" (sourceUnfoldrM value)+        , benchIOSrc fromParallel "fromFoldable" (sourceFromFoldable value)+        , benchIOSrc fromParallel "fromFoldableM" (sourceFromFoldableM value)+        , benchIOSrc fromParallel "unfoldrM maxThreads 1"+              (maxThreads 1 . sourceUnfoldrM value)+        , benchIOSrc fromParallel "unfoldrM maxBuffer 1 (x/10 ops)"+              (maxBuffer 1 . sourceUnfoldrM (value `div` 10))+        ]+    ]++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++o_n_heap_mapping :: Int -> [Benchmark]+o_n_heap_mapping value =+    [ bgroup "mapping"+        [ benchIOSink value "map" $ mapN fromParallel 1+        , benchIOSink value "fmap" $ fmapN fromParallel 1+        , benchIOSink value "mapM" $ mapM fromParallel 1 . fromSerial+        ]+    ]+++-------------------------------------------------------------------------------+-- Joining+-------------------------------------------------------------------------------++{-# INLINE parallel2 #-}+parallel2 :: Int -> Int -> IO ()+parallel2 count n =+    S.drain $+        (sourceUnfoldrM count n) `parallel` (sourceUnfoldrM count (n + 1))++o_1_space_joining :: Int -> [Benchmark]+o_1_space_joining value =+    [ bgroup "joining"+        [ benchIOSrc1 "parallel (2 of n/2)" (parallel2 (value `div` 2))+        ]+    ]++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++o_n_heap_concatFoldable :: Int -> [Benchmark]+o_n_heap_concatFoldable value =+    [ bgroup+        "concat-foldable"+        [ benchIOSrc fromParallel "foldMapWith (<>) (List)"+            (sourceFoldMapWith value)+        , benchIOSrc fromParallel "foldMapWith (<>) (Stream)"+            (sourceFoldMapWithStream value)+        , benchIOSrc fromParallel "foldMapWithM (<>) (List)"+            (sourceFoldMapWithM value)+        , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"+            (concatFoldableWith value)+        , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"+            (concatForFoldableWith value)+        , benchIOSrc fromParallel "foldMapM (List)" (sourceFoldMapM value)+        ]+    ]++o_n_heap_concat :: Int -> [Benchmark]+o_n_heap_concat value =+    value2 `seq`+        [ bgroup "concat"+            -- This is for comparison with foldMapWith+            [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"+                (S.concatMapWith parallel id . sourceConcatMapId value)++            , benchIO "concatMapWith (n of 1)"+                  (concatStreamsWith parallel value 1)+            , benchIO "concatMapWith (sqrt x of sqrt x)"+                  (concatStreamsWith parallel value2 value2)+            , benchIO "concatMapWith (1 of n)"+                  (concatStreamsWith parallel 1 value)+            ]+        ]++    where++    value2 = round $ sqrt (fromIntegral value :: Double)++-------------------------------------------------------------------------------+-- Monadic outer product+-------------------------------------------------------------------------------++o_n_heap_outerProduct :: Int -> [Benchmark]+o_n_heap_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toNullAp" $ toNullAp value fromParallel+        , benchIO "toNull" $ toNullM value fromParallel+        , benchIO "toNull3" $ toNullM3 value fromParallel+        , benchIO "filterAllOut" $ filterAllOutM value fromParallel+        , benchIO "filterAllIn" $ filterAllInM value fromParallel+        , benchIO "filterSome" $ filterSome value fromParallel+        , benchIO "breakAfterSome" $ breakAfterSome value fromParallel+        ]+    ]++o_n_space_outerProduct :: Int -> [Benchmark]+o_n_space_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toList" $ toListM value fromParallel+        -- XXX disabled due to a bug for now+        -- , benchIO "toListSome" $ toListSome value fromParallel+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_merge_app_tap value+            , o_1_space_joining value+            ]+        , bgroup (o_n_heap_prefix moduleName) $ concat+            [ o_n_heap_generation value+            , o_n_heap_mapping value+            , o_n_heap_concatFoldable value+            , o_n_heap_concat value+            , o_n_heap_outerProduct value+            ]+        , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)+        ]
+ benchmark/Streamly/Benchmark/Prelude/Rate.hs view
@@ -0,0 +1,110 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Streamly.Prelude (fromAsync, fromAhead, maxThreads, IsStream, MonadAsync)+import qualified Streamly.Prelude as S++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude++import Test.Tasty.Bench++moduleName :: String+moduleName = "Prelude.Rate"++-------------------------------------------------------------------------------+-- Average Rate+-------------------------------------------------------------------------------++{-# INLINE rateNothing #-}+rateNothing :: (MonadAsync m, IsStream t) => Int -> Int -> t m Int+rateNothing value = S.rate Nothing . sourceUnfoldrM value++{-# INLINE avgRate #-}+avgRate :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int+avgRate value rate_ = S.avgRate rate_ . sourceUnfoldrM value++{-# INLINE avgRateThreads1 #-}+avgRateThreads1 :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int+avgRateThreads1 value rate_ =+    maxThreads 1 . S.avgRate rate_ . sourceUnfoldrM value++{-# INLINE minRate #-}+minRate :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int+minRate value rate_ = S.minRate rate_ . sourceUnfoldrM value++{-# INLINE maxRate #-}+maxRate :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int+maxRate value rate_ = S.minRate rate_ . sourceUnfoldrM value++{-# INLINE constRate #-}+constRate :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int+constRate value rate_ = S.constRate rate_ . sourceUnfoldrM value++-- XXX arbitrarily large rate should be the same as rate Nothing+o_1_space_async :: Int -> [Benchmark]+o_1_space_async value =+    [ bgroup+          "asyncly"+          [ bgroup+                "avgRate"+                -- benchIO "unfoldr" $ toNull fromAsync+                -- benchIOSrc fromAsync "unfoldrM" (sourceUnfoldrM value)+                [ benchIOSrc fromAsync "Nothing" $ rateNothing value+                , benchIOSrc fromAsync "1M" $ avgRate value 1000000+                , benchIOSrc fromAsync "3M" $ avgRate value 3000000+                , benchIOSrc fromAsync "10M/maxThreads1"+                      $ avgRateThreads1 value 10000000+                , benchIOSrc fromAsync "10M" $ avgRate value 10000000+                , benchIOSrc fromAsync "20M" $ avgRate value 20000000+                ]+          , bgroup+                "minRate"+                [ benchIOSrc fromAsync "1M" $ minRate value 1000000+                , benchIOSrc fromAsync "10M" $ minRate value 10000000+                , benchIOSrc fromAsync "20M" $ minRate value 20000000+                ]+          , bgroup+                "maxRate"+                [ -- benchIOSrc fromAsync "10K" $ maxRate value 10000+                  benchIOSrc fromAsync "10M" $ maxRate value 10000000+                ]+          , bgroup+                "constRate"+                [ -- benchIOSrc fromAsync "10K" $ constRate value 10000+                  benchIOSrc fromAsync "1M" $ constRate value 1000000+                , benchIOSrc fromAsync "10M" $ constRate value 10000000+                ]+          ]+    ]++o_1_space_ahead :: Int -> [Benchmark]+o_1_space_ahead value =+    [ bgroup+        "aheadly"+        [ benchIOSrc fromAhead "avgRate/1M" $ avgRate value 1000000+        , benchIOSrc fromAhead "minRate/1M" $ minRate value 1000000+        , benchIOSrc fromAhead "maxRate/1M" $ maxRate value 1000000+        , benchIOSrc fromAsync "constRate/1M" $ constRate 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/Prelude/WAsync.hs view
@@ -0,0 +1,186 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Prelude hiding (mapM)++import Streamly.Prelude (fromWAsync, fromSerial, wAsync, maxBuffer, maxThreads)+import qualified Streamly.Prelude as S++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude++import Test.Tasty.Bench++moduleName :: String+moduleName = "Prelude.WAsync"++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++o_1_space_generation :: Int -> [Benchmark]+o_1_space_generation value =+    [ bgroup "generation"+        [ benchIOSrc fromWAsync "unfoldr" (sourceUnfoldr value)+        , benchIOSrc fromWAsync "unfoldrM" (sourceUnfoldrM value)+        , benchIOSrc fromWAsync "fromFoldable" (sourceFromFoldable value)+        , benchIOSrc fromWAsync "fromFoldableM" (sourceFromFoldableM value)+        , benchIOSrc fromWAsync "unfoldrM maxThreads 1"+            (maxThreads 1 . sourceUnfoldrM value)+        , benchIOSrc fromWAsync "unfoldrM maxBuffer 1 (x/10 ops)"+            (maxBuffer 1 . sourceUnfoldrM (value `div` 10))+        ]+    ]++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++o_1_space_mapping :: Int -> [Benchmark]+o_1_space_mapping value =+    [ bgroup "mapping"+        [ benchIOSink value "map" $ mapN fromWAsync 1+        , benchIOSink value "fmap" $ fmapN fromWAsync 1+        , benchIOSink value "mapM" $ mapM fromWAsync 1 . fromSerial+        ]+    ]++-------------------------------------------------------------------------------+-- Joining+-------------------------------------------------------------------------------++{-# INLINE wAsync2 #-}+wAsync2 :: Int -> Int -> IO ()+wAsync2 count n =+    S.drain $+        (sourceUnfoldrM count n) `wAsync` (sourceUnfoldrM count (n + 1))++{-# INLINE wAsync4 #-}+wAsync4 :: Int -> Int -> IO ()+wAsync4 count n =+    S.drain $+                  (sourceUnfoldrM count (n + 0))+        `wAsync` (sourceUnfoldrM count (n + 1))+        `wAsync` (sourceUnfoldrM count (n + 2))+        `wAsync` (sourceUnfoldrM count (n + 3))++{-# INLINE wAsync2n2 #-}+wAsync2n2 :: Int -> Int -> IO ()+wAsync2n2 count n =+    S.drain $+        ((sourceUnfoldrM count (n + 0))+            `wAsync` (sourceUnfoldrM count (n + 1)))+        `wAsync` ((sourceUnfoldrM count (n + 2))+            `wAsync` (sourceUnfoldrM count (n + 3)))++o_1_space_joining :: Int -> [Benchmark]+o_1_space_joining value =+    [ bgroup "joining"+        [ benchIOSrc1 "wAsync (2 of n/2)" (wAsync2 (value `div` 2))+        , benchIOSrc1 "wAsync (4 of n/4)" (wAsync4 (value `div` 4))+        , benchIOSrc1 "wAsync (2 of (2 of n/4)" (wAsync2n2 (value `div` 4))+        ]+    ]++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++o_1_space_concatFoldable :: Int -> [Benchmark]+o_1_space_concatFoldable value =+    [ bgroup "concat-foldable"+        [ benchIOSrc fromWAsync "foldMapWith (<>) (List)"+            (sourceFoldMapWith value)+        , benchIOSrc fromWAsync "foldMapWith (<>) (Stream)"+            (sourceFoldMapWithStream value)+        , benchIOSrc fromWAsync "foldMapWithM (<>) (List)"+            (sourceFoldMapWithM value)+        , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"+            (concatFoldableWith value)+        , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"+            (concatForFoldableWith value)+        , benchIOSrc fromWAsync "foldMapM (List)" (sourceFoldMapM value)+        ]+    ]++-- When we merge streams using wAsync the size of the queue increases+-- slowly because of the binary composition adding just one more item+-- to the work queue only after every scheduling pass through the+-- work queue.+--+-- We should see the memory consumption increasing slowly if these+-- benchmarks are left to run on infinite number of streams of infinite+-- sizes.+o_1_space_concatMap :: Int -> [Benchmark]+o_1_space_concatMap value =+    value2 `seq`+        [ bgroup "concat"+            -- This is for comparison with foldMapWith+            [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"+                (S.concatMapWith wAsync id . sourceConcatMapId value)++            , benchIO "concatMapWith (n of 1)"+                  (concatStreamsWith wAsync value 1)+            , benchIO "concatMapWith (sqrt x of sqrt x)"+                  (concatStreamsWith wAsync value2 value2)+            , benchIO "concatMapWith (1 of n)"+                  (concatStreamsWith wAsync 1 value)+            ]+        ]++    where++    value2 = round $ sqrt (fromIntegral value :: Double)++-------------------------------------------------------------------------------+-- Monadic outer product+-------------------------------------------------------------------------------++o_n_heap_outerProduct :: Int -> [Benchmark]+o_n_heap_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toNullAp"       $ toNullAp value fromWAsync+        , benchIO "toNull"         $ toNullM value fromWAsync+        , benchIO "toNull3"        $ toNullM3 value fromWAsync+        , benchIO "filterAllOut"   $ filterAllOutM value fromWAsync+        , benchIO "filterAllIn"    $ filterAllInM value fromWAsync+        , benchIO "filterSome"     $ filterSome value fromWAsync+        , benchIO "breakAfterSome" $ breakAfterSome value fromWAsync++        ]+    ]++o_n_space_outerProduct :: Int -> [Benchmark]+o_n_space_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toList"         $ toListM value fromWAsync+        , benchIO "toListSome"     $ toListSome value fromWAsync+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_generation value+            , o_1_space_mapping value+            , o_1_space_joining value+            , o_1_space_concatFoldable value+            , o_1_space_concatMap value+            ]+        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_outerProduct value)+        , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)+        ]
+ benchmark/Streamly/Benchmark/Prelude/WSerial.hs view
@@ -0,0 +1,369 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- 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++import Streamly.Prelude (wSerial, fromWSerial)+import qualified Streamly.Prelude as S+import qualified Streamly.Internal.Data.Stream.IsStream as Internal+import qualified Streamly.Internal.Data.Unfold as UF++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude++import Test.Tasty.Bench++#ifdef INSPECTION+import GHC.Types (SPEC(..))+import Test.Inspection++import qualified Streamly.Internal.Data.Stream as D+#endif++moduleName :: String+moduleName = "Prelude.WSerial"++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++o_1_space_mapping :: Int -> [Benchmark]+o_1_space_mapping value =+    [ bgroup "mapping"+        [ benchIOSink value "fmap" $ fmapN fromWSerial 1 ]+    ]++-------------------------------------------------------------------------------+-- Interleaving+-------------------------------------------------------------------------------++{-# INLINE wSerial2 #-}+wSerial2 :: Int -> Int -> IO ()+wSerial2 value n =+    S.drain $ wSerial+        (sourceUnfoldrM (value `div` 2) n)+        (sourceUnfoldrM (value `div` 2) (n + 1))++{-# INLINE interleave2 #-}+interleave2 :: Int -> Int -> IO ()+interleave2 value n =+    S.drain $+    Internal.interleave+        (sourceUnfoldrM (value `div` 2) n)+        (sourceUnfoldrM (value `div` 2) (n + 1))++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'interleave2+inspect $ 'interleave2 `hasNoType` ''SPEC+inspect $ 'interleave2 `hasNoType` ''D.InterleaveState+#endif++{-# INLINE roundRobin2 #-}+roundRobin2 :: Int -> Int -> IO ()+roundRobin2 value n =+    S.drain $+    Internal.roundrobin+        (sourceUnfoldrM (value `div` 2) n)+        (sourceUnfoldrM (value `div` 2) (n + 1))++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'roundRobin2+inspect $ 'roundRobin2 `hasNoType` ''SPEC+inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState+#endif++{-# INLINE sourceUnfoldrMUF #-}+-- (count, value)+sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int+sourceUnfoldrMUF count = UF.unfoldrM step+    where+    step (cnt, start) =+        return $+            if cnt > start + count+            then Nothing+            else Just (cnt, (cnt + 1, start))++{-# INLINE unfoldManyInterleave #-}+unfoldManyInterleave :: Int -> Int -> Int -> IO ()+unfoldManyInterleave outer inner n =+    S.drain $ Internal.unfoldManyInterleave+        -- (UF.lmap return (UF.replicateM inner))+        (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))+        (sourceUnfoldrM outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'unfoldManyInterleave+-- inspect $ 'unfoldManyInterleave `hasNoType` ''SPEC+-- inspect $ 'unfoldManyInterleave `hasNoType`+--      ''D.ConcatUnfoldInterleaveState+#endif++{-# INLINE unfoldManyRoundRobin #-}+unfoldManyRoundRobin :: Int -> Int -> Int -> IO ()+unfoldManyRoundRobin outer inner n =+    S.drain $ Internal.unfoldManyRoundRobin+        -- (UF.lmap return (UF.replicateM inner))+        (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))+        (sourceUnfoldrM outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'unfoldManyRoundRobin+-- inspect $ 'unfoldManyRoundRobin `hasNoType` ''SPEC+-- inspect $ 'unfoldManyRoundRobin `hasNoType`+--      ''D.ConcatUnfoldInterleaveState+#endif++{-# INLINE concatPairsWithWSerial #-}+concatPairsWithWSerial :: Int -> Int -> Int -> IO ()+concatPairsWithWSerial = concatPairsWith Internal.wSerial++{-# INLINE concatPairsWithRoundrobin #-}+concatPairsWithRoundrobin :: Int -> Int -> Int -> IO ()+concatPairsWithRoundrobin = concatPairsWith Internal.roundrobin++{-# INLINE concatMapWithWSerial #-}+concatMapWithWSerial :: Int -> Int -> Int -> IO ()+concatMapWithWSerial = concatStreamsWith wSerial++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapWithWSerial+inspect $ 'concatMapWithWSerial `hasNoType` ''SPEC+#endif++o_1_space_joining :: Int -> [Benchmark]+o_1_space_joining value =+    [ bgroup "joining (2 of n/2)"+        [ benchIOSrc1 "wSerial" (wSerial2 value)+        , benchIOSrc1 "interleave" (interleave2 value)+        , benchIOSrc1 "roundRobin" (roundRobin2 value)+        , benchIOSrc1+              "concatMapWithWSerial"+              (concatMapWithWSerial 2 (value `div` 2))+        , benchIOSrc1+              "concatMapWithInterleave"+              (concatStreamsWith Internal.interleave 2 (value `div` 2))+        , benchIOSrc1+              "concatMapWithRoundrobin"+              (concatStreamsWith Internal.roundrobin 2 (value `div` 2))+        , benchIOSrc1+              "unfoldManyInterleave"+              (unfoldManyInterleave 2 (value `div` 2))+        , benchIOSrc1+            "concatPairsWithWSerial"+            (concatPairsWithWSerial 2 (value `div` 2))+        , benchIOSrc1+            "concatPairsWithRoundrobin"+            (concatPairsWithRoundrobin 2 (value `div` 2))+        ]+    ]++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++o_1_space_concat :: Int -> [Benchmark]+o_1_space_concat value =+    [ bgroup "concatMapWith"+        [ benchIOSrc1+            "concatMapWithWSerial (n of 1)"+            (concatStreamsWith wSerial value 1)+        , benchIOSrc1+            "concatMapWithWSerial (sqrtVal of sqrtVal)"+            (concatStreamsWith wSerial sqrtVal sqrtVal)+        ]+    ]++    where++    sqrtVal = round $ sqrt (fromIntegral value :: Double)++o_n_space_concat :: Int -> [Benchmark]+o_n_space_concat value =+    [ bgroup "concatMapWith"+        [+        -- concatMapWith using StreamD versions of interleave operations are+        -- all quadratic, we just measure the sqrtVal benchmark for comparison.+          benchIOSrc1+            "concatMapWithInterleave (sqrtVal of 1)"+            (concatStreamsWith Internal.interleave sqrtVal 1)+        , benchIOSrc1+            "concatMapWithInterleave (sqrtVal of sqrtVal)"+            (concatStreamsWith Internal.interleave sqrtVal sqrtVal)+        , benchIOSrc1+            "concatMapWithRoundrobin (sqrtVal of sqrtVal)"+            (concatStreamsWith Internal.roundrobin sqrtVal sqrtVal)+        ]+    ]++    where++    sqrtVal = round $ sqrt (fromIntegral value :: Double)++{-# INLINE concatPairsWithInterleave #-}+concatPairsWithInterleave :: Int -> Int -> Int -> IO ()+concatPairsWithInterleave = concatPairsWith Internal.interleave++{-# INLINE concatPairsWithInterleaveSuffix #-}+concatPairsWithInterleaveSuffix :: Int -> Int -> Int -> IO ()+concatPairsWithInterleaveSuffix = concatPairsWith Internal.interleaveSuffix++{-# INLINE concatPairsWithInterleaveInfix #-}+concatPairsWithInterleaveInfix :: Int -> Int -> Int -> IO ()+concatPairsWithInterleaveInfix = concatPairsWith Internal.interleaveInfix++{-# INLINE concatPairsWithInterleaveMin #-}+concatPairsWithInterleaveMin :: Int -> Int -> Int -> IO ()+concatPairsWithInterleaveMin = concatPairsWith Internal.interleaveMin++o_n_heap_concat :: Int -> [Benchmark]+o_n_heap_concat value =+    [ bgroup "concatPairsWith"+        [+          benchIOSrc1+              "unfoldManyInterleave (n of 1)"+              (unfoldManyInterleave value 1)+        , benchIOSrc1+              "unfoldManyInterleave (sqrtVal of sqrtVal)"+              (unfoldManyInterleave sqrtVal sqrtVal)++        , benchIOSrc1+              "unfoldManyRoundRobin (n of 1)"+              (unfoldManyRoundRobin value 1)+        , benchIOSrc1+              "unfoldManyRoundRobin (sqrtVal of sqrtVal)"+              (unfoldManyRoundRobin sqrtVal sqrtVal)++        , benchIOSrc1+            "concatPairsWithWSerial (n of 1)"+            (concatPairsWithWSerial value 1)+        , benchIOSrc1+            "concatPairsWithWSerial (sqrtVal of sqrtVal)"+            (concatPairsWithWSerial sqrtVal sqrtVal)++        , benchIOSrc1+            "concatPairsWithInterleave (n of 1)"+            (concatPairsWithInterleave value 1)+        , benchIOSrc1+            "concatPairsWithInterleave (sqrtVal of sqrtVal)"+            (concatPairsWithInterleave sqrtVal sqrtVal)++        , benchIOSrc1+            "concatPairsWithInterleaveSuffix (n of 1)"+            (concatPairsWithInterleaveSuffix value 1)+        , benchIOSrc1+            "concatPairsWithInterleaveSuffix (sqrtVal of sqrtVal)"+            (concatPairsWithInterleaveSuffix sqrtVal sqrtVal)++        , benchIOSrc1+            "concatPairsWithInterleaveInfix (n of 1)"+            (concatPairsWithInterleaveInfix value 1)+        , benchIOSrc1+            "concatPairsWithInterleaveInfix (sqrtVal of sqrtVal)"+            (concatPairsWithInterleaveInfix sqrtVal sqrtVal)++        , benchIOSrc1+            "concatPairsWithInterleaveMin (n of 1)"+            (concatPairsWithInterleaveMin value 1)+        , benchIOSrc1+            "concatPairsWithInterleaveMin (sqrtVal of sqrtVal)"+            (concatPairsWithInterleaveMin sqrtVal sqrtVal)++        , benchIOSrc1+            "concatPairsWithRoundrobin (n of 1)"+            (concatPairsWithRoundrobin value 1)+        , benchIOSrc1+            "concatPairsWithRoundrobin (sqrtVal of sqrtVal)"+            (concatPairsWithRoundrobin sqrtVal sqrtVal)+        ]+    ]++    where++    sqrtVal = round $ sqrt (fromIntegral value :: Double)++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++o_1_space_outerProduct :: Int -> [Benchmark]+o_1_space_outerProduct value =+    [ bgroup "outer-product"+        [ benchIO+            "drain applicative (+) (sqrtVal of sqrtVal)"+            (toNullAp value fromWSerial)+        , benchIO+            "drain monad (+) (sqrtVal of sqrtVal)"+            (toNullM value fromWSerial)+        , benchIO+            "drain monad (+) (cbrtVal of cbrtVal of cbrtVal)"+            (toNullM3 value fromWSerial)+        , benchIO+            "filterAllOut monad (+) (sqrtVal of sqrtVal)"+            (filterAllOutM value fromWSerial)+        , benchIO+            "filterAllIn monad (+) (sqrtVal of sqrtVal)"+            (filterAllInM value fromWSerial)+        , benchIO+            "filterSome monad (+) (sqrtVal of sqrtVal)"+            (filterSome value fromWSerial)+        , benchIO+            "breakAfterSome monad (+) (sqrtVal of sqrtVal)"+            (breakAfterSome value fromWSerial)+        ]+    ]++o_n_space_outerProduct :: Int -> [Benchmark]+o_n_space_outerProduct value =+    [ bgroup+        "outer-product"+        [ benchIO+            "toList monad (+) (sqrtVal of sqrtVal)"+            (toListM value fromWSerial)+        , benchIO+            "toListSome monad (+) (sqrtVal of sqrtVal)"+            (toListSome value fromWSerial)+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks+++    where++    allBenchmarks size =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_mapping size+            , o_1_space_joining size+            , o_1_space_concat size+            , o_1_space_outerProduct size+            ]+        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)+        , bgroup (o_n_space_prefix moduleName) $+            o_n_space_outerProduct size ++ o_n_space_concat size+        ]
+ benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs view
@@ -0,0 +1,97 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE FlexibleContexts #-}++import Streamly.Prelude (fromSerial)+import qualified Streamly.Prelude  as S++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude++import Test.Tasty.Bench++moduleName :: String+moduleName = "Prelude.ZipAsync"++-------------------------------------------------------------------------------+-- Zipping+-------------------------------------------------------------------------------++{-# INLINE zipAsyncWith #-}+zipAsyncWith :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)+zipAsyncWith count n =+    S.zipAsyncWith (,) (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))++{-# INLINE zipAsyncWithM #-}+zipAsyncWithM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)+zipAsyncWithM count n =+    S.zipAsyncWithM+        (curry return)+        (sourceUnfoldrM count n)+        (sourceUnfoldrM count (n + 1))++{-# INLINE zipAsyncAp #-}+zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)+zipAsyncAp count n =+    S.fromZipAsync $+        (,) <$> sourceUnfoldrM count n <*> sourceUnfoldrM count (n + 1)++fromZipAsyncTraverse :: String -> Int -> Benchmark+fromZipAsyncTraverse name count =+    bench name+        $ nfIO+        $ S.drain $ S.fromZipAsync $ traverse S.fromPure [0 :: Int .. count]++o_1_space_joining :: Int -> [Benchmark]+o_1_space_joining value =+    [ bgroup "joining"+        [ benchIOSrc fromSerial "zipAsyncWith (2,x/2)" (zipAsyncWith+                                                      (value `div` 2))+        , benchIOSrc fromSerial "zipAsyncWithM (2,x/2)" (zipAsyncWithM+                                                       (value `div` 2))+        , benchIOSrc fromSerial "zipAsyncAp (2,x/2)" (zipAsyncAp (value `div` 2))+        , benchIOSink value "fmap zipAsyncly" $ fmapN S.fromZipAsync 1+        ]+    ]++o_n_heap_joining :: Int -> [Benchmark]+o_n_heap_joining value =+    [ bgroup "joining"+        [ fromZipAsyncTraverse "ZipAsync Applicative (x/100)" (value `div` 100)+        ]+    ]++-------------------------------------------------------------------------------+-- Monad outer product+-------------------------------------------------------------------------------++o_1_space_outerProduct :: Int -> [Benchmark]+o_1_space_outerProduct value =+    [ bgroup "monad-outer-product"+        [ benchIO "toNullAp" $ toNullAp value S.fromZipAsync+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks size =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ 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
@@ -0,0 +1,187 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- 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++import Prelude hiding (zipWith)++import Streamly.Prelude (MonadAsync)+import qualified Streamly.Prelude  as S++import Streamly.Benchmark.Common+import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM)++import Test.Tasty.Bench++#ifdef INSPECTION+import GHC.Types (SPEC(..))+import Test.Inspection++import qualified Streamly.Internal.Data.Stream as D+#endif++moduleName :: String+moduleName = "Prelude.ZipSerial"++-------------------------------------------------------------------------------+-- Zipping+-------------------------------------------------------------------------------++-- XXX somehow copying this definition here instead of importing it performs+-- better. Need to investigate why.+{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: (S.IsStream t, MonadAsync m) => Int -> Int -> t m Int+sourceUnfoldrM count start = S.unfoldrM step start+    where+    step cnt =+        if cnt > start + count+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE zipWith #-}+zipWith :: Int -> Int -> IO ()+zipWith count n =+    S.drain $+    S.zipWith+        (,)+        (S.fromSerial $ sourceUnfoldrM count n)+        (S.fromSerial $ sourceUnfoldrM count (n + 1))++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'zipWith+inspect $ 'zipWith `hasNoType` ''SPEC+inspect $ 'zipWith `hasNoType` ''D.Step+#endif++{-# INLINE zipWithM #-}+zipWithM :: Int -> Int -> IO ()+zipWithM count n =+    S.drain $+    S.zipWithM+        (curry return)+        (sourceUnfoldrM count n)+        (sourceUnfoldrM count (n + 1))++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'zipWithM+inspect $ 'zipWithM `hasNoType` ''SPEC+inspect $ 'zipWithM `hasNoType` ''D.Step+#endif++{-+{-# INLINE concatMapWithZip #-}+concatMapWithZip :: Int -> Int -> Int -> IO ()+concatMapWithZip = concatStreamsWith (S.zipWith (+))+-}++{-# INLINE concatPairsWithZip #-}+concatPairsWithZip :: Int -> Int -> Int -> IO ()+concatPairsWithZip = concatPairsWith (S.zipWith (+))++o_1_space_joining :: Int -> [Benchmark]+o_1_space_joining value =+    [ bgroup "joining"+        [ benchIOSrc1 "zip (2 of n/2)" (zipWith (value `div` 2))+        , benchIOSrc1 "zipM (2 of n/2)" (zipWithM (value `div` 2))+        {-+        -- Not correct because of nil stream at end issue.+        , benchIOSrc1 "concatMapWithZip (+) (2 of n/2)"+            (concatMapWithZip 2 (value `div` 2))+        -}+        ]+    ]++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++o_1_space_mapping :: Int -> [Benchmark]+o_1_space_mapping value =+    [ bgroup "mapping"+        [ benchIOSink value "fmap" $ fmapN S.fromZipSerial 1+        ]+    ]++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++o_n_heap_concat :: Int -> [Benchmark]+o_n_heap_concat value =+    [ bgroup "concatPairsWith"+        [ {- -- This fails with stack overflow.+            benchIOSrc1 "concatMapWithZip (n of 1)"+            (concatMapWithZip value 1)+        -- Not correct because of nil stream at end issue.+        , benchIOSrc1 "concatMapWithZip (sqrtVal of sqrtVal)"+            (concatMapWithZip sqrtVal sqrtVal)+        -}+          benchIOSrc1 "concatPairsWithZip (n of 1)"+            (concatPairsWithZip value 1)+        , benchIOSrc1 "concatPairsWithZip (sqrtVal of sqrtVal)"+            (concatPairsWithZip sqrtVal sqrtVal)+        , benchIOSrc1 "concatPairsWithZip (+) (2 of n/2)"+            (concatPairsWithZip 2 (value `div` 2))+        ]+    ]++    where++    sqrtVal = round $ sqrt (fromIntegral value :: Double)++-------------------------------------------------------------------------------+-- Monad outer product+-------------------------------------------------------------------------------++{-+-- Not correct because of nil stream at end issue.+o_1_space_outerProduct :: Int -> [Benchmark]+o_1_space_outerProduct value =+    [ bgroup "monad-outer-product"+        -- XXX needs fixing+        [ benchIO "toNullAp" $ toNullAp value S.zipSerially+        ]+    ]+-}++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++-- In addition to gauge options, the number of elements in the stream can be+-- passed using the --stream-size option.+--+main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks size =+        [ bgroup (o_1_space_prefix moduleName) $ concat+            [ o_1_space_joining size+            , o_1_space_mapping size+            -- XXX need to fix, timing in ns+            -- , o_1_space_outerProduct size+            ]+        , bgroup (o_n_heap_prefix moduleName) $ concat+            [ o_n_heap_concat size+            ]+        ]
+ benchmark/Streamly/Benchmark/Unicode/Char.hs view
@@ -0,0 +1,90 @@+{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-}++--+-- Module      : Streamly.Unicode.Char+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Control.DeepSeq (NFData(..))+import Streamly.Internal.Data.Array (Array)+import System.FilePath (dropExtensions, takeFileName)+import System.FilePath.Posix ((</>))+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 as Array+import qualified Streamly.Internal.Data.Stream as IsStream+import qualified System.Directory as Dir++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "Unicode.Char"++dataDir :: FilePath+dataDir = "benchmark/Streamly/Benchmark/Unicode/data"++-- Truncate or expand all datasets to this size to provide a normalized+-- measurement view across all datasets and to reduce the effect of noise+-- because of the datasets being too small.+dataSetSize :: Int+dataSetSize = 1000000++-- 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)++strInput :: FilePath -> (String, IO String)+strInput file = (dataName file, fmap (take dataSetSize . cycle) (readFile file))++    where++    dataName = dropExtensions . takeFileName++arrInput :: FilePath -> (String, IO (Array Char))+arrInput file = second (fmap Array.fromList) (strInput file)++    where++    second f (a, b) = (a, f b)++--------------------------------------------------------------------------------+-- Benchmarks+--------------------------------------------------------------------------------++benchFunctions :: [(String, Array Char -> IO ())]+benchFunctions =+    [ ("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 ()+main = do+    cdir <- Dir.getCurrentDirectory+    dataFiles <- fmap (dataDir </>) <$> Dir.listDirectory (cdir </> dataDir)+    defaultMain+        [ bgroup+              (o_1_space_prefix moduleName)+              (makeBench <$> benchFunctions <*> map arrInput dataFiles)+        ]
+ 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
@@ -0,0 +1,362 @@++--+-- Module      : Streamly.Unicode.Stream+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# 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++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# 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 as Array+import qualified Streamly.Data.Fold as Fold+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 as UnicodeArr+import qualified Streamly.Internal.Unicode.Stream as Unicode+import qualified Streamly.Internal.Data.Array as Array++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common+import Streamly.Benchmark.Common.Handle++#ifdef INSPECTION+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 Test.Inspection+#endif++moduleName :: String+moduleName = "Unicode.Stream"++-- | Copy file+{-# NOINLINE copyCodecUtf8ArraysLenient #-}+copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()+copyCodecUtf8ArraysLenient inh outh =+   Stream.fold (Handle.write outh)+     $ Unicode.encodeUtf8'+     $ Unicode.decodeUtf8Chunks+     $ Handle.readChunks inh++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient+-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''Step+#endif++o_1_space_decode_encode_chunked :: BenchEnv -> [Benchmark]+o_1_space_decode_encode_chunked env =+    [ bgroup "decode-encode/toChunks"+        [+        mkBenchSmall "encodeUtf8' . decodeUtf8Arrays" env $ \inH outH ->+            copyCodecUtf8ArraysLenient inH outH+        ]+    ]++-------------------------------------------------------------------------------+-- 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+      $ splitOnSuffix (== '\n') Fold.toList+      $ Unicode.decodeLatin1+      $ Stream.unfold Handle.reader inh++{-# NOINLINE linesUnlinesArrayWord8Copy #-}+linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()+linesUnlinesArrayWord8Copy inh outh =+    Stream.fold (Handle.write outh)+      $ 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+{-# NOINLINE linesUnlinesArrayCharCopy #-}+linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()+linesUnlinesArrayCharCopy inh outh =+    Stream.fold (Handle.write outh)+      $ Unicode.encodeLatin1'+      $ UnicodeArr.unlines+      $ UnicodeArr.lines+      $ Unicode.decodeLatin1+      $ Stream.unfold Handle.reader inh++#ifdef INSPECTION+inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Unbox]+-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step+#endif++-- XXX to write this we need to be able to map decodeUtf8 on the Array.read fold.+-- For that we have to write decodeUtf8 as a Pipe.+{-+{-# INLINE linesUnlinesArrayUtf8Copy #-}+linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()+linesUnlinesArrayUtf8Copy inh outh =+    Stream.fold (Handle.write outh)+      $ Unicode.encodeLatin1'+      $ Stream.intercalate (Array.fromList [10]) (pipe Unicode.decodeUtf8P Array.read)+      $ Stream.splitOnSuffix (== '\n') (IFold.map Unicode.encodeUtf8' Array.write)+      $ Unicode.decodeLatin1+      $ Stream.unfold Handle.read inh+-}++-- | Word, unwords and copy+{-# NOINLINE wordsUnwordsCopyWord8 #-}+wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()+wordsUnwordsCopyWord8 inh outh =+    Stream.fold (Handle.write outh)+        $ Stream.unfoldEachEndBy 32 Unfold.fromList+        $ Stream.wordsBy isSp Fold.toList+        $ Stream.unfold Handle.reader inh++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8+-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step+#endif++-- | Word, unwords and copy+{-# NOINLINE wordsUnwordsCopy #-}+wordsUnwordsCopy :: Handle -> Handle -> IO ()+wordsUnwordsCopy inh outh =+    Stream.fold (Handle.write outh)+      $ Unicode.encodeLatin1'+      $ Unicode.unwords Unfold.fromList+      -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn+      -- with -funfolding-use-threshold=300.  With wordsBy it does not fuse+      -- even with high limits for inlining and spec-constr ghc options. With+      -- -funfolding-use-threshold=400 it performs pretty well and there+      -- is no evidence in the core that a join point involving Step+      -- constructors is not getting inlined. Not being able to fuse at all in+      -- this case could be an unknown issue, need more investigation.+      $ Stream.wordsBy isSpace Fold.toList+      -- -- $ Stream.splitOn isSpace Fold.toList+      $ Unicode.decodeLatin1+      $ Stream.unfold Handle.reader inh++#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy+-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step+#endif++{-# NOINLINE wordsUnwordsCharArrayCopy #-}+wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()+wordsUnwordsCharArrayCopy inh outh =+    Stream.fold (Handle.write outh)+      $ Unicode.encodeLatin1'+      $ UnicodeArr.unwords+      $ UnicodeArr.words+      $ Unicode.decodeLatin1+      $ Stream.unfold Handle.reader inh++o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]+o_1_space_copy_read_group_ungroup env =+    [ bgroup "ungroup-group"+        [ mkBenchSmall "unlines . splitOnSuffix ([Word8])" env+            $ \inh outh -> linesUnlinesCopy inh outh+        , mkBenchSmall "interposeSuffix . splitOnSuffix (Array Word8)" env+            $ \inh outh -> linesUnlinesArrayWord8Copy inh outh+        , mkBenchSmall "UnicodeArr.unlines . UnicodeArr.lines (Array Char)" env+            $ \inh outh -> linesUnlinesArrayCharCopy inh outh++        , mkBenchSmall "interposeSuffix . wordsBy ([Word8])" env+            $ \inh outh -> wordsUnwordsCopyWord8 inh outh+        , mkBenchSmall "unwords . wordsBy ([Char])" env+            $ \inh outh -> wordsUnwordsCopy inh outh+        , mkBenchSmall "UnicodeArr.unwords . UnicodeArr.words (Array Char)" env+            $ \inh outh -> wordsUnwordsCharArrayCopy inh outh+        ]+    ]++-------------------------------------------------------------------------------+-- copy unfold+-------------------------------------------------------------------------------++-- | Copy file (encodeLatin1')+{-# NOINLINE copyStreamLatin1' #-}+copyStreamLatin1' :: Handle -> Handle -> IO ()+copyStreamLatin1' inh outh =+   Stream.fold (Handle.write outh)+     $ Unicode.encodeLatin1'+     $ Unicode.decodeLatin1+     $ 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` ''Fold.Step+inspect $ 'copyStreamLatin1' `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe+                                                             -- Handle.read/Array.read+inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf+#endif++-- | Copy file (encodeLatin1)+{-# NOINLINE copyStreamLatin1 #-}+copyStreamLatin1 :: Handle -> Handle -> IO ()+copyStreamLatin1 inh outh =+   Stream.fold (Handle.write outh)+     $ Unicode.encodeLatin1+     $ Unicode.decodeLatin1+     $ 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` ''Fold.ManyState+inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.Step+inspect $ 'copyStreamLatin1 `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe+                                                            -- Handle.read/Array.read+inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf+#endif++-- | Copy file+_copyStreamUtf8' :: Handle -> Handle -> IO ()+_copyStreamUtf8' inh outh =+   Stream.fold (Handle.write outh)+     $ Unicode.encodeUtf8'+     $ Unicode.decodeUtf8'+     $ 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+-- inspect $ '_copyStreamUtf8 `hasNoType` ''Array.FlattenState+-- inspect $ '_copyStreamUtf8 `hasNoType` ''D.ConcatMapUState+#endif++-- | Copy file+{-# NOINLINE copyStreamUtf8 #-}+copyStreamUtf8 :: Handle -> Handle -> IO ()+copyStreamUtf8 inh outh =+   Stream.fold (Handle.write outh)+     $ Unicode.encodeUtf8+     $ Unicode.decodeUtf8+     $ Stream.unfold Handle.reader inh++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'copyStreamUtf8+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Step+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Array.FlattenState+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState+#endif++{-# NOINLINE _copyStreamUtf8'Fold #-}+_copyStreamUtf8'Fold :: Handle -> Handle -> IO ()+_copyStreamUtf8'Fold inh outh =+   Stream.fold (Handle.write outh)+     $ Unicode.encodeUtf8+     $ 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.catRights $ Stream.parseMany+           (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure)+     $ Stream.unfold Handle.reader inh++o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]+o_1_space_decode_encode_read env =+    [ bgroup "decode-encode"+        [+        -- This needs an ascii file, as decode just errors out.+          mkBench "encodeLatin1' . decodeLatin1" env $ \inh outh ->+            copyStreamLatin1' inh outh+        , mkBench "encodeLatin1 . decodeLatin1" env $ \inh outh ->+            copyStreamLatin1 inh outh+#ifdef INCLUDE_STRICT_UTF8+        -- Requires valid unicode input+        , mkBench "encodeUtf8' . decodeUtf8'" env $ \inh outh ->+            _copyStreamUtf8' inh outh+        , mkBench "encodeUtf8' . foldMany writeCharUtf8'" env $ \inh outh ->+            _copyStreamUtf8'Fold inh outh+#endif+        , mkBenchSmall "encodeUtf8 . parseMany parseCharUtf8" env+              $ \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)++    where++    allBenchmarks env =+        [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat+            [ o_1_space_copy_read_group_ungroup env+            , o_1_space_decode_encode_chunked env+            , 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
@@ -0,0 +1,55 @@+--+-- Module      : Streamly.Unicode.Utf8+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Char (chr)+import Streamly.Internal.Unicode.Utf8 (Utf8)++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common++import qualified Streamly.Internal.Unicode.Utf8 as Utf8++--------------------------------------------------------------------------------+-- Utilities+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "Unicode.Stream"++--------------------------------------------------------------------------------+-- Benchmarks+--------------------------------------------------------------------------------++{-# INLINE pack #-}+pack :: Int -> Utf8+pack i = Utf8.pack $ chr <$> [1 .. i]++{-# INLINE packUnpack #-}+packUnpack :: Int -> String+packUnpack = Utf8.unpack . pack++--------------------------------------------------------------------------------+-- Main function+--------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup+              moduleName+              [ bench "pack" $ whnf pack value+              , bench "pack + unpack" $ whnf packUnpack value+              ]+        ]
+ benchmark/Streamly/Benchmark/Unicode/data/AllChars.txt view
@@ -0,0 +1,216 @@+This page contains characters from each of the Unicode character blocks.++Basic Latin+! " # $ % & ' ( ) * + , - . / 0 1 2 3 4 5 6 7 8 9 : ; < = > ? @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ ` a b c d e f g h i j k l m n o p q r s t u v w x y z { | } ~+Latin-1 Supplement+  ¡ ¢ £ ¤ ¥ ¦ § ¨ © ª « ¬ ­ ® ¯ ° ± ² ³ ´ µ ¶ · ¸ ¹ º » ¼ ½ ¾ ¿ À Á Â Ã Ä Å Æ Ç È É Ê Ë Ì Í Î Ï Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß à á â ã ä å æ ç è é ê ë ì í î ï ð ñ ò ó ô õ ö ÷ ø ù ú û ü ý þ ÿ+Latin Extended-A+Ā ā Ă ă Ą ą Ć ć Ĉ ĉ Ċ ċ Č č Ď ď Đ đ Ē ē Ĕ ĕ Ė ė Ę ę Ě ě Ĝ ĝ Ğ ğ Ġ ġ Ģ ģ Ĥ ĥ Ħ ħ Ĩ ĩ Ī ī Ĭ ĭ Į į İ ı IJ ij Ĵ ĵ Ķ ķ ĸ Ĺ ĺ Ļ ļ Ľ ľ Ŀ ŀ Ł ł Ń ń Ņ ņ Ň ň ʼn Ŋ ŋ Ō ō Ŏ ŏ Ő ő Œ œ Ŕ ŕ Ŗ ŗ Ř ř Ś ś Ŝ ŝ Ş ş Š š Ţ ţ Ť ť Ŧ ŧ Ũ ũ Ū ū Ŭ ŭ Ů ů Ű ű Ų ų Ŵ ŵ Ŷ ŷ Ÿ Ź ź Ż ż Ž ž ſ+Latin Extended-B+ƀ Ɓ Ƃ ƃ Ƅ ƅ Ɔ Ƈ ƈ Ɖ Ɗ Ƌ ƌ ƍ Ǝ Ə Ɛ Ƒ ƒ Ɠ Ɣ ƕ Ɩ Ɨ Ƙ ƙ ƚ ƛ Ɯ Ɲ ƞ Ɵ Ơ ơ Ƣ ƣ Ƥ ƥ Ʀ Ƨ ƨ Ʃ ƪ ƫ Ƭ ƭ Ʈ Ư ư Ʊ Ʋ Ƴ ƴ Ƶ ƶ Ʒ Ƹ ƹ ƺ ƻ Ƽ ƽ ƾ ƿ ǀ ǁ ǂ ǃ DŽ Dž dž LJ Lj lj NJ Nj nj Ǎ ǎ Ǐ ǐ Ǒ ǒ Ǔ ǔ Ǖ ǖ Ǘ ǘ Ǚ ǚ Ǜ ǜ ǝ Ǟ ǟ Ǡ ǡ Ǣ ǣ Ǥ ǥ Ǧ ǧ Ǩ ǩ Ǫ ǫ Ǭ ǭ Ǯ ǯ ǰ DZ Dz dz Ǵ ǵ Ƕ Ƿ Ǹ ǹ Ǻ ǻ Ǽ ǽ Ǿ ǿ ...+IPA Extensions+ɐ ɑ ɒ ɓ ɔ ɕ ɖ ɗ ɘ ə ɚ ɛ ɜ ɝ ɞ ɟ ɠ ɡ ɢ ɣ ɤ ɥ ɦ ɧ ɨ ɩ ɪ ɫ ɬ ɭ ɮ ɯ ɰ ɱ ɲ ɳ ɴ ɵ ɶ ɷ ɸ ɹ ɺ ɻ ɼ ɽ ɾ ɿ ʀ ʁ ʂ ʃ ʄ ʅ ʆ ʇ ʈ ʉ ʊ ʋ ʌ ʍ ʎ ʏ ʐ ʑ ʒ ʓ ʔ ʕ ʖ ʗ ʘ ʙ ʚ ʛ ʜ ʝ ʞ ʟ ʠ ʡ ʢ ʣ ʤ ʥ ʦ ʧ ʨ ʩ ʪ ʫ ʬ ʭ+Spacing Modifier Letters+ʰ ʱ ʲ ʳ ʴ ʵ ʶ ʷ ʸ ʹ ʺ ʻ ʼ ʽ ʾ ʿ ˀ ˁ ˂ ˃ ˄ ˅ ˆ ˇ ˈ ˉ ˊ ˋ ˌ ˍ ˎ ˏ ː ˑ ˒ ˓ ˔ ˕ ˖ ˗ ˘ ˙ ˚ ˛ ˜ ˝ ˞ ˟ ˠ ˡ ˢ ˣ ˤ ˥ ˦ ˧ ˨ ˩ ˪ ˫ ˬ ˭ ˮ+Combining Diacritical Marks+̀ ́ ̂ ̃ ̄ ̅ ̆ ̇ ̈ ̉ ̊ ̋ ̌ ̍ ̎ ̏ ̐ ̑ ̒ ̓ ̔ ̕ ̖ ̗ ̘ ̙ ̚ ̛ ̜ ̝ ̞ ̟ ̠ ̡ ̢ ̣ ̤ ̥ ̦ ̧ ̨ ̩ ̪ ̫ ̬ ̭ ̮ ̯ ̰ ̱ ̲ ̳ ̴ ̵ ̶ ̷ ̸ ̹ ̺ ̻ ̼ ̽ ̾ ̿ ̀ ́ ͂ ̓ ̈́ ͅ ͆ ͇ ͈ ͉ ͊ ͋ ͌ ͍ ͎ ͏ ͠ ͡ ͢ ͣ ͤ ͥ ͦ ͧ ͨ ͩ ͪ ͫ ͬ ͭ ͮ ͯ+Greek and Coptic+ʹ ͵ ͺ ; ΄ ΅ Ά · Έ Ή Ί Ό Ύ Ώ ΐ Α Β Γ Δ Ε Ζ Η Θ Ι Κ Λ Μ Ν Ξ Ο Π Ρ Σ Τ Υ Φ Χ Ψ Ω Ϊ Ϋ ά έ ή ί ΰ α β γ δ ε ζ η θ ι κ λ μ ν ξ ο π ρ ς σ τ υ φ χ ψ ω ϊ ϋ ό ύ ώ ϐ ϑ ϒ ϓ ϔ ϕ ϖ ϗ Ϙ ϙ Ϛ ϛ Ϝ ϝ Ϟ ϟ Ϡ ϡ Ϣ ϣ Ϥ ϥ Ϧ ϧ Ϩ ϩ Ϫ ϫ Ϭ ϭ Ϯ ϯ ϰ ϱ ϲ ϳ ϴ ϵ ϶+Cyrillic+Ѐ Ё Ђ Ѓ Є Ѕ І Ї Ј Љ Њ Ћ Ќ Ѝ Ў Џ А Б В Г Д Е Ж З И Й К Л М Н О П Р С Т У Ф Х Ц Ч Ш Щ Ъ Ы Ь Э Ю Я а б в г д е ж з и й к л м н о п р с т у ф х ц ч ш щ ъ ы ь э ю я ѐ ё ђ ѓ є ѕ і ї ј љ њ ћ ќ ѝ ў џ Ѡ ѡ Ѣ ѣ Ѥ ѥ Ѧ ѧ Ѩ ѩ Ѫ ѫ Ѭ ѭ Ѯ ѯ Ѱ ѱ Ѳ ѳ Ѵ ѵ Ѷ ѷ Ѹ ѹ Ѻ ѻ Ѽ ѽ Ѿ ѿ ...+Cyrillic Supplementary+Ԁ ԁ Ԃ ԃ Ԅ ԅ Ԇ ԇ Ԉ ԉ Ԋ ԋ Ԍ ԍ Ԏ ԏ+Armenian+Ա Բ Գ Դ Ե Զ Է Ը Թ Ժ Ի Լ Խ Ծ Կ Հ Ձ Ղ Ճ Մ Յ Ն Շ Ո Չ Պ Ջ Ռ Ս Վ Տ Ր Ց Ւ Փ Ք Օ Ֆ ՙ ՚ ՛ ՜ ՝ ՞ ՟ ա բ գ դ ե զ է ը թ ժ ի լ խ ծ կ հ ձ ղ ճ մ յ ն շ ո չ պ ջ ռ ս վ տ ր ց ւ փ ք օ ֆ և ։ ֊+Hebrew+֑ ֒ ֓ ֔ ֕ ֖ ֗ ֘ ֙ ֚ ֛ ֜ ֝ ֞ ֟ ֠ ֡ ֣ ֤ ֥ ֦ ֧ ֨ ֩ ֪ ֫ ֬ ֭ ֮ ֯ ְ ֱ ֲ ֳ ִ ֵ ֶ ַ ָ ֹ ֻ ּ ֽ ־ ֿ ׀ ׁ ׂ ׃ ׄ א ב ג ד ה ו ז ח ט י ך כ ל ם מ ן נ ס ע ף פ ץ צ ק ר ש ת װ ױ ײ ׳ ״+Arabic+، ؛ ؟ ء آ أ ؤ إ ئ ا ب ة ت ث ج ح خ د ذ ر ز س ش ص ض ط ظ ع غ ـ ف ق ك ل م ن ه و ى ي ً ٌ ٍ َ ُ ِ ّ ْ ٓ ٔ ٕ ٠ ١ ٢ ٣ ٤ ٥ ٦ ٧ ٨ ٩ ٪ ٫ ٬ ٭ ٮ ٯ ٰ ٱ ٲ ٳ ٴ ٵ ٶ ٷ ٸ ٹ ٺ ٻ ټ ٽ پ ٿ ڀ ځ ڂ ڃ ڄ څ چ ڇ ڈ ډ ڊ ڋ ڌ ڍ ڎ ڏ ڐ ڑ ڒ ړ ڔ ڕ ږ ڗ ژ ڙ ښ ڛ ڜ ڝ ڞ ڟ ڠ ڡ ڢ ڣ ڤ ڥ ڦ ڧ ڨ ک ڪ ګ ڬ ...+Syriac+܀ ܁ ܂ ܃ ܄ ܅ ܆ ܇ ܈ ܉ ܊ ܋ ܌ ܍ ܏ ܐ ܑ ܒ ܓ ܔ ܕ ܖ ܗ ܘ ܙ ܚ ܛ ܜ ܝ ܞ ܟ ܠ ܡ ܢ ܣ ܤ ܥ ܦ ܧ ܨ ܩ ܪ ܫ ܬ ܰ ܱ ܲ ܳ ܴ ܵ ܶ ܷ ܸ ܹ ܺ ܻ ܼ ܽ ܾ ܿ ݀ ݁ ݂ ݃ ݄ ݅ ݆ ݇ ݈ ݉ ݊+Thaana+ހ ށ ނ ރ ބ ޅ ކ އ ވ މ ފ ދ ތ ލ ގ ޏ ސ ޑ ޒ ޓ ޔ ޕ ޖ ޗ ޘ ޙ ޚ ޛ ޜ ޝ ޞ ޟ ޠ ޡ ޢ ޣ ޤ ޥ ަ ާ ި ީ ު ޫ ެ ޭ ޮ ޯ ް ޱ+Devanagari+ँ ं ः अ आ इ ई उ ऊ ऋ ऌ ऍ ऎ ए ऐ ऑ ऒ ओ औ क ख ग घ ङ च छ ज झ ञ ट ठ ड ढ ण त थ द ध न ऩ प फ ब भ म य र ऱ ल ळ ऴ व श ष स ह ़ ऽ ा ि ी ु ू ृ ॄ ॅ ॆ े ै ॉ ॊ ो ौ ् ॐ ॑ ॒ ॓ ॔ क़ ख़ ग़ ज़ ड़ ढ़ फ़ य़ ॠ ॡ ॢ ॣ । ॥ ० १ २ ३ ४ ५ ६ ७ ८ ९ ॰+Bengali+ঁ ং ঃ অ আ ই ঈ উ ঊ ঋ ঌ এ ঐ ও ঔ ক খ গ ঘ ঙ চ ছ জ ঝ ঞ ট ঠ ড ঢ ণ ত থ দ ধ ন প ফ ব ভ ম য র ল শ ষ স হ ় া ি ী ু ূ ৃ ৄ ে ৈ ো ৌ ্ ৗ ড় ঢ় য় ৠ ৡ ৢ ৣ ০ ১ ২ ৩ ৪ ৫ ৬ ৭ ৮ ৯ ৰ ৱ ৲ ৳ ৴ ৵ ৶ ৷ ৸ ৹ ৺+Gurmukhi+ਂ ਅ ਆ ਇ ਈ ਉ ਊ ਏ ਐ ਓ ਔ ਕ ਖ ਗ ਘ ਙ ਚ ਛ ਜ ਝ ਞ ਟ ਠ ਡ ਢ ਣ ਤ ਥ ਦ ਧ ਨ ਪ ਫ ਬ ਭ ਮ ਯ ਰ ਲ ਲ਼ ਵ ਸ਼ ਸ ਹ ਼ ਾ ਿ ੀ ੁ ੂ ੇ ੈ ੋ ੌ ੍ ਖ਼ ਗ਼ ਜ਼ ੜ ਫ਼ ੦ ੧ ੨ ੩ ੪ ੫ ੬ ੭ ੮ ੯ ੰ ੱ ੲ ੳ ੴ+Gujarati+ઁ ં ઃ અ આ ઇ ઈ ઉ ઊ ઋ ઍ એ ઐ ઑ ઓ ઔ ક ખ ગ ઘ ઙ ચ છ જ ઝ ઞ ટ ઠ ડ ઢ ણ ત થ દ ધ ન પ ફ બ ભ મ ય ર લ ળ વ શ ષ સ હ ઼ ઽ ા િ ી ુ ૂ ૃ ૄ ૅ ે ૈ ૉ ો ૌ ્ ૐ ૠ ૦ ૧ ૨ ૩ ૪ ૫ ૬ ૭ ૮ ૯+Oriya+ଁ ଂ ଃ ଅ ଆ ଇ ଈ ଉ ଊ ଋ ଌ ଏ ଐ ଓ ଔ କ ଖ ଗ ଘ ଙ ଚ ଛ ଜ ଝ ଞ ଟ ଠ ଡ ଢ ଣ ତ ଥ ଦ ଧ ନ ପ ଫ ବ ଭ ମ ଯ ର ଲ ଳ ଶ ଷ ସ ହ ଼ ଽ ା ି ୀ ୁ ୂ ୃ େ ୈ ୋ ୌ ୍ ୖ ୗ ଡ଼ ଢ଼ ୟ ୠ ୡ ୦ ୧ ୨ ୩ ୪ ୫ ୬ ୭ ୮ ୯ ୰+Tamil+ஂ ஃ அ ஆ இ ஈ உ ஊ எ ஏ ஐ ஒ ஓ ஔ க ங ச ஜ ஞ ட ண த ந ன ப ம ய ர ற ல ள ழ வ ஷ ஸ ஹ ா ி ீ ு ூ ெ ே ை ொ ோ ௌ ் ௗ ௧ ௨ ௩ ௪ ௫ ௬ ௭ ௮ ௯ ௰ ௱ ௲+Telugu+ఁ ం ః అ ఆ ఇ ఈ ఉ ఊ ఋ ఌ ఎ ఏ ఐ ఒ ఓ ఔ క ఖ గ ఘ ఙ చ ఛ జ ఝ ఞ ట ఠ డ ఢ ణ త థ ద ధ న ప ఫ బ భ మ య ర ఱ ల ళ వ శ ష స హ ా ి ీ ు ూ ృ ౄ ె ే ై ొ ో ౌ ్ ౕ ౖ ౠ ౡ ౦ ౧ ౨ ౩ ౪ ౫ ౬ ౭ ౮ ౯+Kannada+ಂ ಃ ಅ ಆ ಇ ಈ ಉ ಊ ಋ ಌ ಎ ಏ ಐ ಒ ಓ ಔ ಕ ಖ ಗ ಘ ಙ ಚ ಛ ಜ ಝ ಞ ಟ ಠ ಡ ಢ ಣ ತ ಥ ದ ಧ ನ ಪ ಫ ಬ ಭ ಮ ಯ ರ ಱ ಲ ಳ ವ ಶ ಷ ಸ ಹ ಾ ಿ ೀ ು ೂ ೃ ೄ ೆ ೇ ೈ ೊ ೋ ೌ ್ ೕ ೖ ೞ ೠ ೡ ೦ ೧ ೨ ೩ ೪ ೫ ೬ ೭ ೮ ೯+Malayalam+ം ഃ അ ആ ഇ ഈ ഉ ഊ ഋ ഌ എ ഏ ഐ ഒ ഓ ഔ ക ഖ ഗ ഘ ങ ച ഛ ജ ഝ ഞ ട ഠ ഡ ഢ ണ ത ഥ ദ ധ ന പ ഫ ബ ഭ മ യ ര റ ല ള ഴ വ ശ ഷ സ ഹ ാ ി ീ ു ൂ ൃ െ േ ൈ ൊ ോ ൌ ് ൗ ൠ ൡ ൦ ൧ ൨ ൩ ൪ ൫ ൬ ൭ ൮ ൯+Sinhala+ං ඃ අ ආ ඇ ඈ ඉ ඊ උ ඌ ඍ ඎ ඏ ඐ එ ඒ ඓ ඔ ඕ ඖ ක ඛ ග ඝ ඞ ඟ ච ඡ ජ ඣ ඤ ඥ ඦ ට ඨ ඩ ඪ ණ ඬ ත ථ ද ධ න ඳ ප ඵ බ භ ම ඹ ය ර ල ව ශ ෂ ස හ ළ ෆ ් ා ැ ෑ ි ී ු ූ ෘ ෙ ේ ෛ ො ෝ ෞ ෟ ෲ ෳ ෴+Thai+ก ข ฃ ค ฅ ฆ ง จ ฉ ช ซ ฌ ญ ฎ ฏ ฐ ฑ ฒ ณ ด ต ถ ท ธ น บ ป ผ ฝ พ ฟ ภ ม ย ร ฤ ล ฦ ว ศ ษ ส ห ฬ อ ฮ ฯ ะ ั า ำ ิ ี ึ ื ุ ู ฺ ฿ เ แ โ ใ ไ ๅ ๆ ็ ่ ้ ๊ ๋ ์ ํ ๎ ๏ ๐ ๑ ๒ ๓ ๔ ๕ ๖ ๗ ๘ ๙ ๚ ๛+Lao+ກ ຂ ຄ ງ ຈ ຊ ຍ ດ ຕ ຖ ທ ນ ບ ປ ຜ ຝ ພ ຟ ມ ຢ ຣ ລ ວ ສ ຫ ອ ຮ ຯ ະ ັ າ ຳ ິ ີ ຶ ື ຸ ູ ົ ຼ ຽ ເ ແ ໂ ໃ ໄ ໆ ່ ້ ໊ ໋ ໌ ໍ ໐ ໑ ໒ ໓ ໔ ໕ ໖ ໗ ໘ ໙ ໜ ໝ+Tibetan+ༀ ༁ ༂ ༃ ༄ ༅ ༆ ༇ ༈ ༉ ༊ ་ ༌ ། ༎ ༏ ༐ ༑ ༒ ༓ ༔ ༕ ༖ ༗ ༘ ༙ ༚ ༛ ༜ ༝ ༞ ༟ ༠ ༡ ༢ ༣ ༤ ༥ ༦ ༧ ༨ ༩ ༪ ༫ ༬ ༭ ༮ ༯ ༰ ༱ ༲ ༳ ༴ ༵ ༶ ༷ ༸ ༹ ༺ ༻ ༼ ༽ ༾ ༿ ཀ ཁ ག གྷ ང ཅ ཆ ཇ ཉ ཊ ཋ ཌ ཌྷ ཎ ཏ ཐ ད དྷ ན པ ཕ བ བྷ མ ཙ ཚ ཛ ཛྷ ཝ ཞ ཟ འ ཡ ར ལ ཤ ཥ ས ཧ ཨ ཀྵ ཪ ཱ ི ཱི ུ ཱུ ྲྀ ཷ ླྀ ཹ ེ ཻ ོ ཽ ཾ ཿ ྀ ཱྀ ྂ ྃ ྄ ྅ ྆ ...+Myanmar+က ခ ဂ ဃ င စ ဆ ဇ ဈ ဉ ည ဋ ဌ ဍ ဎ ဏ တ ထ ဒ ဓ န ပ ဖ ဗ ဘ မ ယ ရ လ ဝ သ ဟ ဠ အ ဣ ဤ ဥ ဦ ဧ ဩ ဪ ာ ိ ီ ု ူ ေ ဲ ံ ့ း ္ ၀ ၁ ၂ ၃ ၄ ၅ ၆ ၇ ၈ ၉ ၊ ။ ၌ ၍ ၎ ၏ ၐ ၑ ၒ ၓ ၔ ၕ ၖ ၗ ၘ ၙ+Georgian+Ⴀ Ⴁ Ⴂ Ⴃ Ⴄ Ⴅ Ⴆ Ⴇ Ⴈ Ⴉ Ⴊ Ⴋ Ⴌ Ⴍ Ⴎ Ⴏ Ⴐ Ⴑ Ⴒ Ⴓ Ⴔ Ⴕ Ⴖ Ⴗ Ⴘ Ⴙ Ⴚ Ⴛ Ⴜ Ⴝ Ⴞ Ⴟ Ⴠ Ⴡ Ⴢ Ⴣ Ⴤ Ⴥ ა ბ გ დ ე ვ ზ თ ი კ ლ მ ნ ო პ ჟ რ ს ტ უ ფ ქ ღ ყ შ ჩ ც ძ წ ჭ ხ ჯ ჰ ჱ ჲ ჳ ჴ ჵ ჶ ჷ ჸ ჻+Hangul Jamo+ᄀ ᄁ ᄂ ᄃ ᄄ ᄅ ᄆ ᄇ ᄈ ᄉ ᄊ ᄋ ᄌ ᄍ ᄎ ᄏ ᄐ ᄑ ᄒ ᄓ ᄔ ᄕ ᄖ ᄗ ᄘ ᄙ ᄚ ᄛ ᄜ ᄝ ᄞ ᄟ ᄠ ᄡ ᄢ ᄣ ᄤ ᄥ ᄦ ᄧ ᄨ ᄩ ᄪ ᄫ ᄬ ᄭ ᄮ ᄯ ᄰ ᄱ ᄲ ᄳ ᄴ ᄵ ᄶ ᄷ ᄸ ᄹ ᄺ ᄻ ᄼ ᄽ ᄾ ᄿ ᅀ ᅁ ᅂ ᅃ ᅄ ᅅ ᅆ ᅇ ᅈ ᅉ ᅊ ᅋ ᅌ ᅍ ᅎ ᅏ ᅐ ᅑ ᅒ ᅓ ᅔ ᅕ ᅖ ᅗ ᅘ ᅙ ᅟ ᅠ ᅡ ᅢ ᅣ ᅤ ᅥ ᅦ ᅧ ᅨ ᅩ ᅪ ᅫ ᅬ ᅭ ᅮ ᅯ ᅰ ᅱ ᅲ ᅳ ᅴ ᅵ ᅶ ᅷ ᅸ ᅹ ᅺ ᅻ ᅼ ᅽ ᅾ ᅿ ᆀ ᆁ ᆂ ᆃ ᆄ ...+Ethiopic+ሀ ሁ ሂ ሃ ሄ ህ ሆ ለ ሉ ሊ ላ ሌ ል ሎ ሏ ሐ ሑ ሒ ሓ ሔ ሕ ሖ ሗ መ ሙ ሚ ማ ሜ ም ሞ ሟ ሠ ሡ ሢ ሣ ሤ ሥ ሦ ሧ ረ ሩ ሪ ራ ሬ ር ሮ ሯ ሰ ሱ ሲ ሳ ሴ ስ ሶ ሷ ሸ ሹ ሺ ሻ ሼ ሽ ሾ ሿ ቀ ቁ ቂ ቃ ቄ ቅ ቆ ቈ ቊ ቋ ቌ ቍ ቐ ቑ ቒ ቓ ቔ ቕ ቖ ቘ ቚ ቛ ቜ ቝ በ ቡ ቢ ባ ቤ ብ ቦ ቧ ቨ ቩ ቪ ቫ ቬ ቭ ቮ ቯ ተ ቱ ቲ ታ ቴ ት ቶ ቷ ቸ ቹ ቺ ቻ ቼ ች ቾ ቿ ኀ ኁ ኂ ኃ ኄ ኅ ኆ ኈ ኊ ...+Cherokee+Ꭰ Ꭱ Ꭲ Ꭳ Ꭴ Ꭵ Ꭶ Ꭷ Ꭸ Ꭹ Ꭺ Ꭻ Ꭼ Ꭽ Ꭾ Ꭿ Ꮀ Ꮁ Ꮂ Ꮃ Ꮄ Ꮅ Ꮆ Ꮇ Ꮈ Ꮉ Ꮊ Ꮋ Ꮌ Ꮍ Ꮎ Ꮏ Ꮐ Ꮑ Ꮒ Ꮓ Ꮔ Ꮕ Ꮖ Ꮗ Ꮘ Ꮙ Ꮚ Ꮛ Ꮜ Ꮝ Ꮞ Ꮟ Ꮠ Ꮡ Ꮢ Ꮣ Ꮤ Ꮥ Ꮦ Ꮧ Ꮨ Ꮩ Ꮪ Ꮫ Ꮬ Ꮭ Ꮮ Ꮯ Ꮰ Ꮱ Ꮲ Ꮳ Ꮴ Ꮵ Ꮶ Ꮷ Ꮸ Ꮹ Ꮺ Ꮻ Ꮼ Ꮽ Ꮾ Ꮿ Ᏸ Ᏹ Ᏺ Ᏻ Ᏼ+Unified Canadian Aboriginal Syllabics+ᐁ ᐂ ᐃ ᐄ ᐅ ᐆ ᐇ ᐈ ᐉ ᐊ ᐋ ᐌ ᐍ ᐎ ᐏ ᐐ ᐑ ᐒ ᐓ ᐔ ᐕ ᐖ ᐗ ᐘ ᐙ ᐚ ᐛ ᐜ ᐝ ᐞ ᐟ ᐠ ᐡ ᐢ ᐣ ᐤ ᐥ ᐦ ᐧ ᐨ ᐩ ᐪ ᐫ ᐬ ᐭ ᐮ ᐯ ᐰ ᐱ ᐲ ᐳ ᐴ ᐵ ᐶ ᐷ ᐸ ᐹ ᐺ ᐻ ᐼ ᐽ ᐾ ᐿ ᑀ ᑁ ᑂ ᑃ ᑄ ᑅ ᑆ ᑇ ᑈ ᑉ ᑊ ᑋ ᑌ ᑍ ᑎ ᑏ ᑐ ᑑ ᑒ ᑓ ᑔ ᑕ ᑖ ᑗ ᑘ ᑙ ᑚ ᑛ ᑜ ᑝ ᑞ ᑟ ᑠ ᑡ ᑢ ᑣ ᑤ ᑥ ᑦ ᑧ ᑨ ᑩ ᑪ ᑫ ᑬ ᑭ ᑮ ᑯ ᑰ ᑱ ᑲ ᑳ ᑴ ᑵ ᑶ ᑷ ᑸ ᑹ ᑺ ᑻ ᑼ ᑽ ᑾ ᑿ ᒀ ...+Ogham+  ᚁ ᚂ ᚃ ᚄ ᚅ ᚆ ᚇ ᚈ ᚉ ᚊ ᚋ ᚌ ᚍ ᚎ ᚏ ᚐ ᚑ ᚒ ᚓ ᚔ ᚕ ᚖ ᚗ ᚘ ᚙ ᚚ ᚛ ᚜+Runic+ᚠ ᚡ ᚢ ᚣ ᚤ ᚥ ᚦ ᚧ ᚨ ᚩ ᚪ ᚫ ᚬ ᚭ ᚮ ᚯ ᚰ ᚱ ᚲ ᚳ ᚴ ᚵ ᚶ ᚷ ᚸ ᚹ ᚺ ᚻ ᚼ ᚽ ᚾ ᚿ ᛀ ᛁ ᛂ ᛃ ᛄ ᛅ ᛆ ᛇ ᛈ ᛉ ᛊ ᛋ ᛌ ᛍ ᛎ ᛏ ᛐ ᛑ ᛒ ᛓ ᛔ ᛕ ᛖ ᛗ ᛘ ᛙ ᛚ ᛛ ᛜ ᛝ ᛞ ᛟ ᛠ ᛡ ᛢ ᛣ ᛤ ᛥ ᛦ ᛧ ᛨ ᛩ ᛪ ᛫ ᛬ ᛭ ᛮ ᛯ ᛰ+Tagalog+ᜀ ᜁ ᜂ ᜃ ᜄ ᜅ ᜆ ᜇ ᜈ ᜉ ᜊ ᜋ ᜌ ᜎ ᜏ ᜐ ᜑ ᜒ ᜓ ᜔+Hanunoo+ᜠ ᜡ ᜢ ᜣ ᜤ ᜥ ᜦ ᜧ ᜨ ᜩ ᜪ ᜫ ᜬ ᜭ ᜮ ᜯ ᜰ ᜱ ᜲ ᜳ ᜴ ᜵ ᜶+Buhid+ᝀ ᝁ ᝂ ᝃ ᝄ ᝅ ᝆ ᝇ ᝈ ᝉ ᝊ ᝋ ᝌ ᝍ ᝎ ᝏ ᝐ ᝑ ᝒ ᝓ+Tagbanwa+ᝠ ᝡ ᝢ ᝣ ᝤ ᝥ ᝦ ᝧ ᝨ ᝩ ᝪ ᝫ ᝬ ᝮ ᝯ ᝰ ᝲ ᝳ+Khmer+ក ខ គ ឃ ង ច ឆ ជ ឈ ញ ដ ឋ ឌ ឍ ណ ត ថ ទ ធ ន ប ផ ព ភ ម យ រ ល វ ឝ ឞ ស ហ ឡ អ ឣ ឤ ឥ ឦ ឧ ឨ ឩ ឪ ឫ ឬ ឭ ឮ ឯ ឰ ឱ ឲ ឳ ឴ ឵ ា ិ ី ឹ ឺ ុ ូ ួ ើ ឿ ៀ េ ែ ៃ ោ ៅ ំ ះ ៈ ៉ ៊ ់ ៌ ៍ ៎ ៏ ័ ៑ ្ ៓ ។ ៕ ៖ ៗ ៘ ៙ ៚ ៛ ៜ ០ ១ ២ ៣ ៤ ៥ ៦ ៧ ៨ ៩+Mongolian+᠀ ᠁ ᠂ ᠃ ᠄ ᠅ ᠆ ᠇ ᠈ ᠉ ᠊ ᠋ ᠌ ᠍ ᠎ ᠐ ᠑ ᠒ ᠓ ᠔ ᠕ ᠖ ᠗ ᠘ ᠙ ᠠ ᠡ ᠢ ᠣ ᠤ ᠥ ᠦ ᠧ ᠨ ᠩ ᠪ ᠫ ᠬ ᠭ ᠮ ᠯ ᠰ ᠱ ᠲ ᠳ ᠴ ᠵ ᠶ ᠷ ᠸ ᠹ ᠺ ᠻ ᠼ ᠽ ᠾ ᠿ ᡀ ᡁ ᡂ ᡃ ᡄ ᡅ ᡆ ᡇ ᡈ ᡉ ᡊ ᡋ ᡌ ᡍ ᡎ ᡏ ᡐ ᡑ ᡒ ᡓ ᡔ ᡕ ᡖ ᡗ ᡘ ᡙ ᡚ ᡛ ᡜ ᡝ ᡞ ᡟ ᡠ ᡡ ᡢ ᡣ ᡤ ᡥ ᡦ ᡧ ᡨ ᡩ ᡪ ᡫ ᡬ ᡭ ᡮ ᡯ ᡰ ᡱ ᡲ ᡳ ᡴ ᡵ ᡶ ᡷ ᢀ ᢁ ᢂ ᢃ ᢄ ᢅ ᢆ ᢇ ᢈ ᢉ ᢊ ᢋ ᢌ ᢍ ᢎ ...+Latin Extended Additional+Ḁ ḁ Ḃ ḃ Ḅ ḅ Ḇ ḇ Ḉ ḉ Ḋ ḋ Ḍ ḍ Ḏ ḏ Ḑ ḑ Ḓ ḓ Ḕ ḕ Ḗ ḗ Ḙ ḙ Ḛ ḛ Ḝ ḝ Ḟ ḟ Ḡ ḡ Ḣ ḣ Ḥ ḥ Ḧ ḧ Ḩ ḩ Ḫ ḫ Ḭ ḭ Ḯ ḯ Ḱ ḱ Ḳ ḳ Ḵ ḵ Ḷ ḷ Ḹ ḹ Ḻ ḻ Ḽ ḽ Ḿ ḿ Ṁ ṁ Ṃ ṃ Ṅ ṅ Ṇ ṇ Ṉ ṉ Ṋ ṋ Ṍ ṍ Ṏ ṏ Ṑ ṑ Ṓ ṓ Ṕ ṕ Ṗ ṗ Ṙ ṙ Ṛ ṛ Ṝ ṝ Ṟ ṟ Ṡ ṡ Ṣ ṣ Ṥ ṥ Ṧ ṧ Ṩ ṩ Ṫ ṫ Ṭ ṭ Ṯ ṯ Ṱ ṱ Ṳ ṳ Ṵ ṵ Ṷ ṷ Ṹ ṹ Ṻ ṻ Ṽ ṽ Ṿ ṿ ...+Greek Extended+ἀ ἁ ἂ ἃ ἄ ἅ ἆ ἇ Ἀ Ἁ Ἂ Ἃ Ἄ Ἅ Ἆ Ἇ ἐ ἑ ἒ ἓ ἔ ἕ Ἐ Ἑ Ἒ Ἓ Ἔ Ἕ ἠ ἡ ἢ ἣ ἤ ἥ ἦ ἧ Ἠ Ἡ Ἢ Ἣ Ἤ Ἥ Ἦ Ἧ ἰ ἱ ἲ ἳ ἴ ἵ ἶ ἷ Ἰ Ἱ Ἲ Ἳ Ἴ Ἵ Ἶ Ἷ ὀ ὁ ὂ ὃ ὄ ὅ Ὀ Ὁ Ὂ Ὃ Ὄ Ὅ ὐ ὑ ὒ ὓ ὔ ὕ ὖ ὗ Ὑ Ὓ Ὕ Ὗ ὠ ὡ ὢ ὣ ὤ ὥ ὦ ὧ Ὠ Ὡ Ὢ Ὣ Ὤ Ὥ Ὦ Ὧ ὰ ά ὲ έ ὴ ή ὶ ί ὸ ό ὺ ύ ὼ ώ ᾀ ᾁ ᾂ ᾃ ᾄ ᾅ ᾆ ᾇ ᾈ ᾉ ᾊ ᾋ ᾌ ᾍ ...+General Punctuation+                      ​ ‌ ‍ ‎ ‏ ‐ ‑ ‒ – — ― ‖ ‗ ‘ ’ ‚ ‛ “ ” „ ‟ † ‡ • ‣ ․ ‥ … ‧ 
 
 ‪ ‫ ‬ ‭ ‮   ‰ ‱ ′ ″ ‴ ‵ ‶ ‷ ‸ ‹ › ※ ‼ ‽ ‾ ‿ ⁀ ⁁ ⁂ ⁃ ⁄ ⁅ ⁆ ⁇ ⁈ ⁉ ⁊ ⁋ ⁌ ⁍ ⁎ ⁏ ⁐ ⁑ ⁒ ⁗   ⁠ ⁡ ⁢ ⁣      +Superscripts and Subscripts+⁰ ⁱ ⁴ ⁵ ⁶ ⁷ ⁸ ⁹ ⁺ ⁻ ⁼ ⁽ ⁾ ⁿ ₀ ₁ ₂ ₃ ₄ ₅ ₆ ₇ ₈ ₉ ₊ ₋ ₌ ₍ ₎+Currency Symbols+₠ ₡ ₢ ₣ ₤ ₥ ₦ ₧ ₨ ₩ ₪ ₫ € ₭ ₮ ₯ ₰ ₱+Combining Diacritical Marks for Symbols+⃐ ⃑ ⃒ ⃓ ⃔ ⃕ ⃖ ⃗ ⃘ ⃙ ⃚ ⃛ ⃜ ⃝ ⃞ ⃟ ⃠ ⃡ ⃢ ⃣ ⃤ ⃥ ⃦ ⃧ ⃨ ⃩ ⃪+Letterlike Symbols+℀ ℁ ℂ ℃ ℄ ℅ ℆ ℇ ℈ ℉ ℊ ℋ ℌ ℍ ℎ ℏ ℐ ℑ ℒ ℓ ℔ ℕ № ℗ ℘ ℙ ℚ ℛ ℜ ℝ ℞ ℟ ℠ ℡ ™ ℣ ℤ ℥ Ω ℧ ℨ ℩ K Å ℬ ℭ ℮ ℯ ℰ ℱ Ⅎ ℳ ℴ ℵ ℶ ℷ ℸ ℹ ℺ ℽ ℾ ℿ ⅀ ⅁ ⅂ ⅃ ⅄ ⅅ ⅆ ⅇ ⅈ ⅉ ⅊ ⅋+Number Forms+⅓ ⅔ ⅕ ⅖ ⅗ ⅘ ⅙ ⅚ ⅛ ⅜ ⅝ ⅞ ⅟ Ⅰ Ⅱ Ⅲ Ⅳ Ⅴ Ⅵ Ⅶ Ⅷ Ⅸ Ⅹ Ⅺ Ⅻ Ⅼ Ⅽ Ⅾ Ⅿ ⅰ ⅱ ⅲ ⅳ ⅴ ⅵ ⅶ ⅷ ⅸ ⅹ ⅺ ⅻ ⅼ ⅽ ⅾ ⅿ ↀ ↁ ↂ Ↄ+Arrows+← ↑ → ↓ ↔ ↕ ↖ ↗ ↘ ↙ ↚ ↛ ↜ ↝ ↞ ↟ ↠ ↡ ↢ ↣ ↤ ↥ ↦ ↧ ↨ ↩ ↪ ↫ ↬ ↭ ↮ ↯ ↰ ↱ ↲ ↳ ↴ ↵ ↶ ↷ ↸ ↹ ↺ ↻ ↼ ↽ ↾ ↿ ⇀ ⇁ ⇂ ⇃ ⇄ ⇅ ⇆ ⇇ ⇈ ⇉ ⇊ ⇋ ⇌ ⇍ ⇎ ⇏ ⇐ ⇑ ⇒ ⇓ ⇔ ⇕ ⇖ ⇗ ⇘ ⇙ ⇚ ⇛ ⇜ ⇝ ⇞ ⇟ ⇠ ⇡ ⇢ ⇣ ⇤ ⇥ ⇦ ⇧ ⇨ ⇩ ⇪ ⇫ ⇬ ⇭ ⇮ ⇯ ⇰ ⇱ ⇲ ⇳ ⇴ ⇵ ⇶ ⇷ ⇸ ⇹ ⇺ ⇻ ⇼ ⇽ ⇾ ⇿+Mathematical Operators+∀ ∁ ∂ ∃ ∄ ∅ ∆ ∇ ∈ ∉ ∊ ∋ ∌ ∍ ∎ ∏ ∐ ∑ − ∓ ∔ ∕ ∖ ∗ ∘ ∙ √ ∛ ∜ ∝ ∞ ∟ ∠ ∡ ∢ ∣ ∤ ∥ ∦ ∧ ∨ ∩ ∪ ∫ ∬ ∭ ∮ ∯ ∰ ∱ ∲ ∳ ∴ ∵ ∶ ∷ ∸ ∹ ∺ ∻ ∼ ∽ ∾ ∿ ≀ ≁ ≂ ≃ ≄ ≅ ≆ ≇ ≈ ≉ ≊ ≋ ≌ ≍ ≎ ≏ ≐ ≑ ≒ ≓ ≔ ≕ ≖ ≗ ≘ ≙ ≚ ≛ ≜ ≝ ≞ ≟ ≠ ≡ ≢ ≣ ≤ ≥ ≦ ≧ ≨ ≩ ≪ ≫ ≬ ≭ ≮ ≯ ≰ ≱ ≲ ≳ ≴ ≵ ≶ ≷ ≸ ≹ ≺ ≻ ≼ ≽ ≾ ≿ ...+Miscellaneous Technical+⌀ ⌁ ⌂ ⌃ ⌄ ⌅ ⌆ ⌇ ⌈ ⌉ ⌊ ⌋ ⌌ ⌍ ⌎ ⌏ ⌐ ⌑ ⌒ ⌓ ⌔ ⌕ ⌖ ⌗ ⌘ ⌙ ⌚ ⌛ ⌜ ⌝ ⌞ ⌟ ⌠ ⌡ ⌢ ⌣ ⌤ ⌥ ⌦ ⌧ ⌨ 〈 〉 ⌫ ⌬ ⌭ ⌮ ⌯ ⌰ ⌱ ⌲ ⌳ ⌴ ⌵ ⌶ ⌷ ⌸ ⌹ ⌺ ⌻ ⌼ ⌽ ⌾ ⌿ ⍀ ⍁ ⍂ ⍃ ⍄ ⍅ ⍆ ⍇ ⍈ ⍉ ⍊ ⍋ ⍌ ⍍ ⍎ ⍏ ⍐ ⍑ ⍒ ⍓ ⍔ ⍕ ⍖ ⍗ ⍘ ⍙ ⍚ ⍛ ⍜ ⍝ ⍞ ⍟ ⍠ ⍡ ⍢ ⍣ ⍤ ⍥ ⍦ ⍧ ⍨ ⍩ ⍪ ⍫ ⍬ ⍭ ⍮ ⍯ ⍰ ⍱ ⍲ ⍳ ⍴ ⍵ ⍶ ⍷ ⍸ ⍹ ⍺ ⍻ ⍼ ⍽ ⍾ ⍿ ...+Control Pictures+␀ ␁ ␂ ␃ ␄ ␅ ␆ ␇ ␈ ␉ ␊ ␋ ␌ ␍ ␎ ␏ ␐ ␑ ␒ ␓ ␔ ␕ ␖ ␗ ␘ ␙ ␚ ␛ ␜ ␝ ␞ ␟ ␠ ␡ ␢ ␣ ␤ ␥ ␦+Optical Character Recognition+⑀ ⑁ ⑂ ⑃ ⑄ ⑅ ⑆ ⑇ ⑈ ⑉ ⑊+Enclosed Alphanumerics+① ② ③ ④ ⑤ ⑥ ⑦ ⑧ ⑨ ⑩ ⑪ ⑫ ⑬ ⑭ ⑮ ⑯ ⑰ ⑱ ⑲ ⑳ ⑴ ⑵ ⑶ ⑷ ⑸ ⑹ ⑺ ⑻ ⑼ ⑽ ⑾ ⑿ ⒀ ⒁ ⒂ ⒃ ⒄ ⒅ ⒆ ⒇ ⒈ ⒉ ⒊ ⒋ ⒌ ⒍ ⒎ ⒏ ⒐ ⒑ ⒒ ⒓ ⒔ ⒕ ⒖ ⒗ ⒘ ⒙ ⒚ ⒛ ⒜ ⒝ ⒞ ⒟ ⒠ ⒡ ⒢ ⒣ ⒤ ⒥ ⒦ ⒧ ⒨ ⒩ ⒪ ⒫ ⒬ ⒭ ⒮ ⒯ ⒰ ⒱ ⒲ ⒳ ⒴ ⒵ Ⓐ Ⓑ Ⓒ Ⓓ Ⓔ Ⓕ Ⓖ Ⓗ Ⓘ Ⓙ Ⓚ Ⓛ Ⓜ Ⓝ Ⓞ Ⓟ Ⓠ Ⓡ Ⓢ Ⓣ Ⓤ Ⓥ Ⓦ Ⓧ Ⓨ Ⓩ ⓐ ⓑ ⓒ ⓓ ⓔ ⓕ ⓖ ⓗ ⓘ ⓙ ⓚ ⓛ ⓜ ⓝ ⓞ ⓟ ...+Box Drawing+─ ━ │ ┃ ┄ ┅ ┆ ┇ ┈ ┉ ┊ ┋ ┌ ┍ ┎ ┏ ┐ ┑ ┒ ┓ └ ┕ ┖ ┗ ┘ ┙ ┚ ┛ ├ ┝ ┞ ┟ ┠ ┡ ┢ ┣ ┤ ┥ ┦ ┧ ┨ ┩ ┪ ┫ ┬ ┭ ┮ ┯ ┰ ┱ ┲ ┳ ┴ ┵ ┶ ┷ ┸ ┹ ┺ ┻ ┼ ┽ ┾ ┿ ╀ ╁ ╂ ╃ ╄ ╅ ╆ ╇ ╈ ╉ ╊ ╋ ╌ ╍ ╎ ╏ ═ ║ ╒ ╓ ╔ ╕ ╖ ╗ ╘ ╙ ╚ ╛ ╜ ╝ ╞ ╟ ╠ ╡ ╢ ╣ ╤ ╥ ╦ ╧ ╨ ╩ ╪ ╫ ╬ ╭ ╮ ╯ ╰ ╱ ╲ ╳ ╴ ╵ ╶ ╷ ╸ ╹ ╺ ╻ ╼ ╽ ╾ ╿+Block Elements+▀ ▁ ▂ ▃ ▄ ▅ ▆ ▇ █ ▉ ▊ ▋ ▌ ▍ ▎ ▏ ▐ ░ ▒ ▓ ▔ ▕ ▖ ▗ ▘ ▙ ▚ ▛ ▜ ▝ ▞ ▟+Geometric Shapes+■ □ ▢ ▣ ▤ ▥ ▦ ▧ ▨ ▩ ▪ ▫ ▬ ▭ ▮ ▯ ▰ ▱ ▲ △ ▴ ▵ ▶ ▷ ▸ ▹ ► ▻ ▼ ▽ ▾ ▿ ◀ ◁ ◂ ◃ ◄ ◅ ◆ ◇ ◈ ◉ ◊ ○ ◌ ◍ ◎ ● ◐ ◑ ◒ ◓ ◔ ◕ ◖ ◗ ◘ ◙ ◚ ◛ ◜ ◝ ◞ ◟ ◠ ◡ ◢ ◣ ◤ ◥ ◦ ◧ ◨ ◩ ◪ ◫ ◬ ◭ ◮ ◯ ◰ ◱ ◲ ◳ ◴ ◵ ◶ ◷ ◸ ◹ ◺ ◻ ◼ ◽ ◾ ◿+Miscellaneous Symbols+☀ ☁ ☂ ☃ ☄ ★ ☆ ☇ ☈ ☉ ☊ ☋ ☌ ☍ ☎ ☏ ☐ ☑ ☒ ☓ ☖ ☗ ☙ ☚ ☛ ☜ ☝ ☞ ☟ ☠ ☡ ☢ ☣ ☤ ☥ ☦ ☧ ☨ ☩ ☪ ☫ ☬ ☭ ☮ ☯ ☰ ☱ ☲ ☳ ☴ ☵ ☶ ☷ ☸ ☹ ☺ ☻ ☼ ☽ ☾ ☿ ♀ ♁ ♂ ♃ ♄ ♅ ♆ ♇ ♈ ♉ ♊ ♋ ♌ ♍ ♎ ♏ ♐ ♑ ♒ ♓ ♔ ♕ ♖ ♗ ♘ ♙ ♚ ♛ ♜ ♝ ♞ ♟ ♠ ♡ ♢ ♣ ♤ ♥ ♦ ♧ ♨ ♩ ♪ ♫ ♬ ♭ ♮ ♯ ♰ ♱ ♲ ♳ ♴ ♵ ♶ ♷ ♸ ♹ ♺ ♻ ♼ ♽ ⚀ ⚁ ⚂ ⚃ ⚄ ...+Dingbats+✁ ✂ ✃ ✄ ✆ ✇ ✈ ✉ ✌ ✍ ✎ ✏ ✐ ✑ ✒ ✓ ✔ ✕ ✖ ✗ ✘ ✙ ✚ ✛ ✜ ✝ ✞ ✟ ✠ ✡ ✢ ✣ ✤ ✥ ✦ ✧ ✩ ✪ ✫ ✬ ✭ ✮ ✯ ✰ ✱ ✲ ✳ ✴ ✵ ✶ ✷ ✸ ✹ ✺ ✻ ✼ ✽ ✾ ✿ ❀ ❁ ❂ ❃ ❄ ❅ ❆ ❇ ❈ ❉ ❊ ❋ ❍ ❏ ❐ ❑ ❒ ❖ ❘ ❙ ❚ ❛ ❜ ❝ ❞ ❡ ❢ ❣ ❤ ❥ ❦ ❧ ❨ ❩ ❪ ❫ ❬ ❭ ❮ ❯ ❰ ❱ ❲ ❳ ❴ ❵ ❶ ❷ ❸ ❹ ❺ ❻ ❼ ❽ ❾ ❿ ➀ ➁ ➂ ➃ ➄ ➅ ➆ ➇ ➈ ➉ ➊ ➋ ➌ ...+Miscellaneous Mathematical Symbols-A+⟐ ⟑ ⟒ ⟓ ⟔ ⟕ ⟖ ⟗ ⟘ ⟙ ⟚ ⟛ ⟜ ⟝ ⟞ ⟟ ⟠ ⟡ ⟢ ⟣ ⟤ ⟥ ⟦ ⟧ ⟨ ⟩ ⟪ ⟫+Supplemental Arrows-A+⟰ ⟱ ⟲ ⟳ ⟴ ⟵ ⟶ ⟷ ⟸ ⟹ ⟺ ⟻ ⟼ ⟽ ⟾ ⟿+Braille Patterns+⠀ ⠁ ⠂ ⠃ ⠄ ⠅ ⠆ ⠇ ⠈ ⠉ ⠊ ⠋ ⠌ ⠍ ⠎ ⠏ ⠐ ⠑ ⠒ ⠓ ⠔ ⠕ ⠖ ⠗ ⠘ ⠙ ⠚ ⠛ ⠜ ⠝ ⠞ ⠟ ⠠ ⠡ ⠢ ⠣ ⠤ ⠥ ⠦ ⠧ ⠨ ⠩ ⠪ ⠫ ⠬ ⠭ ⠮ ⠯ ⠰ ⠱ ⠲ ⠳ ⠴ ⠵ ⠶ ⠷ ⠸ ⠹ ⠺ ⠻ ⠼ ⠽ ⠾ ⠿ ⡀ ⡁ ⡂ ⡃ ⡄ ⡅ ⡆ ⡇ ⡈ ⡉ ⡊ ⡋ ⡌ ⡍ ⡎ ⡏ ⡐ ⡑ ⡒ ⡓ ⡔ ⡕ ⡖ ⡗ ⡘ ⡙ ⡚ ⡛ ⡜ ⡝ ⡞ ⡟ ⡠ ⡡ ⡢ ⡣ ⡤ ⡥ ⡦ ⡧ ⡨ ⡩ ⡪ ⡫ ⡬ ⡭ ⡮ ⡯ ⡰ ⡱ ⡲ ⡳ ⡴ ⡵ ⡶ ⡷ ⡸ ⡹ ⡺ ⡻ ⡼ ⡽ ⡾ ⡿ ...+Supplemental Arrows-B+⤀ ⤁ ⤂ ⤃ ⤄ ⤅ ⤆ ⤇ ⤈ ⤉ ⤊ ⤋ ⤌ ⤍ ⤎ ⤏ ⤐ ⤑ ⤒ ⤓ ⤔ ⤕ ⤖ ⤗ ⤘ ⤙ ⤚ ⤛ ⤜ ⤝ ⤞ ⤟ ⤠ ⤡ ⤢ ⤣ ⤤ ⤥ ⤦ ⤧ ⤨ ⤩ ⤪ ⤫ ⤬ ⤭ ⤮ ⤯ ⤰ ⤱ ⤲ ⤳ ⤴ ⤵ ⤶ ⤷ ⤸ ⤹ ⤺ ⤻ ⤼ ⤽ ⤾ ⤿ ⥀ ⥁ ⥂ ⥃ ⥄ ⥅ ⥆ ⥇ ⥈ ⥉ ⥊ ⥋ ⥌ ⥍ ⥎ ⥏ ⥐ ⥑ ⥒ ⥓ ⥔ ⥕ ⥖ ⥗ ⥘ ⥙ ⥚ ⥛ ⥜ ⥝ ⥞ ⥟ ⥠ ⥡ ⥢ ⥣ ⥤ ⥥ ⥦ ⥧ ⥨ ⥩ ⥪ ⥫ ⥬ ⥭ ⥮ ⥯ ⥰ ⥱ ⥲ ⥳ ⥴ ⥵ ⥶ ⥷ ⥸ ⥹ ⥺ ⥻ ⥼ ⥽ ⥾ ⥿+Miscellaneous Mathematical Symbols-B+⦀ ⦁ ⦂ ⦃ ⦄ ⦅ ⦆ ⦇ ⦈ ⦉ ⦊ ⦋ ⦌ ⦍ ⦎ ⦏ ⦐ ⦑ ⦒ ⦓ ⦔ ⦕ ⦖ ⦗ ⦘ ⦙ ⦚ ⦛ ⦜ ⦝ ⦞ ⦟ ⦠ ⦡ ⦢ ⦣ ⦤ ⦥ ⦦ ⦧ ⦨ ⦩ ⦪ ⦫ ⦬ ⦭ ⦮ ⦯ ⦰ ⦱ ⦲ ⦳ ⦴ ⦵ ⦶ ⦷ ⦸ ⦹ ⦺ ⦻ ⦼ ⦽ ⦾ ⦿ ⧀ ⧁ ⧂ ⧃ ⧄ ⧅ ⧆ ⧇ ⧈ ⧉ ⧊ ⧋ ⧌ ⧍ ⧎ ⧏ ⧐ ⧑ ⧒ ⧓ ⧔ ⧕ ⧖ ⧗ ⧘ ⧙ ⧚ ⧛ ⧜ ⧝ ⧞ ⧟ ⧠ ⧡ ⧢ ⧣ ⧤ ⧥ ⧦ ⧧ ⧨ ⧩ ⧪ ⧫ ⧬ ⧭ ⧮ ⧯ ⧰ ⧱ ⧲ ⧳ ⧴ ⧵ ⧶ ⧷ ⧸ ⧹ ⧺ ⧻ ⧼ ⧽ ⧾ ⧿+Supplemental Mathematical Operators+⨀ ⨁ ⨂ ⨃ ⨄ ⨅ ⨆ ⨇ ⨈ ⨉ ⨊ ⨋ ⨌ ⨍ ⨎ ⨏ ⨐ ⨑ ⨒ ⨓ ⨔ ⨕ ⨖ ⨗ ⨘ ⨙ ⨚ ⨛ ⨜ ⨝ ⨞ ⨟ ⨠ ⨡ ⨢ ⨣ ⨤ ⨥ ⨦ ⨧ ⨨ ⨩ ⨪ ⨫ ⨬ ⨭ ⨮ ⨯ ⨰ ⨱ ⨲ ⨳ ⨴ ⨵ ⨶ ⨷ ⨸ ⨹ ⨺ ⨻ ⨼ ⨽ ⨾ ⨿ ⩀ ⩁ ⩂ ⩃ ⩄ ⩅ ⩆ ⩇ ⩈ ⩉ ⩊ ⩋ ⩌ ⩍ ⩎ ⩏ ⩐ ⩑ ⩒ ⩓ ⩔ ⩕ ⩖ ⩗ ⩘ ⩙ ⩚ ⩛ ⩜ ⩝ ⩞ ⩟ ⩠ ⩡ ⩢ ⩣ ⩤ ⩥ ⩦ ⩧ ⩨ ⩩ ⩪ ⩫ ⩬ ⩭ ⩮ ⩯ ⩰ ⩱ ⩲ ⩳ ⩴ ⩵ ⩶ ⩷ ⩸ ⩹ ⩺ ⩻ ⩼ ⩽ ⩾ ⩿ ...+CJK Radicals Supplement+⺀ ⺁ ⺂ ⺃ ⺄ ⺅ ⺆ ⺇ ⺈ ⺉ ⺊ ⺋ ⺌ ⺍ ⺎ ⺏ ⺐ ⺑ ⺒ ⺓ ⺔ ⺕ ⺖ ⺗ ⺘ ⺙ ⺛ ⺜ ⺝ ⺞ ⺟ ⺠ ⺡ ⺢ ⺣ ⺤ ⺥ ⺦ ⺧ ⺨ ⺩ ⺪ ⺫ ⺬ ⺭ ⺮ ⺯ ⺰ ⺱ ⺲ ⺳ ⺴ ⺵ ⺶ ⺷ ⺸ ⺹ ⺺ ⺻ ⺼ ⺽ ⺾ ⺿ ⻀ ⻁ ⻂ ⻃ ⻄ ⻅ ⻆ ⻇ ⻈ ⻉ ⻊ ⻋ ⻌ ⻍ ⻎ ⻏ ⻐ ⻑ ⻒ ⻓ ⻔ ⻕ ⻖ ⻗ ⻘ ⻙ ⻚ ⻛ ⻜ ⻝ ⻞ ⻟ ⻠ ⻡ ⻢ ⻣ ⻤ ⻥ ⻦ ⻧ ⻨ ⻩ ⻪ ⻫ ⻬ ⻭ ⻮ ⻯ ⻰ ⻱ ⻲ ⻳+Kangxi Radicals+⼀ ⼁ ⼂ ⼃ ⼄ ⼅ ⼆ ⼇ ⼈ ⼉ ⼊ ⼋ ⼌ ⼍ ⼎ ⼏ ⼐ ⼑ ⼒ ⼓ ⼔ ⼕ ⼖ ⼗ ⼘ ⼙ ⼚ ⼛ ⼜ ⼝ ⼞ ⼟ ⼠ ⼡ ⼢ ⼣ ⼤ ⼥ ⼦ ⼧ ⼨ ⼩ ⼪ ⼫ ⼬ ⼭ ⼮ ⼯ ⼰ ⼱ ⼲ ⼳ ⼴ ⼵ ⼶ ⼷ ⼸ ⼹ ⼺ ⼻ ⼼ ⼽ ⼾ ⼿ ⽀ ⽁ ⽂ ⽃ ⽄ ⽅ ⽆ ⽇ ⽈ ⽉ ⽊ ⽋ ⽌ ⽍ ⽎ ⽏ ⽐ ⽑ ⽒ ⽓ ⽔ ⽕ ⽖ ⽗ ⽘ ⽙ ⽚ ⽛ ⽜ ⽝ ⽞ ⽟ ⽠ ⽡ ⽢ ⽣ ⽤ ⽥ ⽦ ⽧ ⽨ ⽩ ⽪ ⽫ ⽬ ⽭ ⽮ ⽯ ⽰ ⽱ ⽲ ⽳ ⽴ ⽵ ⽶ ⽷ ⽸ ⽹ ⽺ ⽻ ⽼ ⽽ ⽾ ⽿ ...+Ideographic Description Characters+⿰ ⿱ ⿲ ⿳ ⿴ ⿵ ⿶ ⿷ ⿸ ⿹ ⿺ ⿻+CJK Symbols and Punctuation+　 、 。 〃 〄 々 〆 〇 〈 〉 《 》 「 」 『 』 【 】 〒 〓 〔 〕 〖 〗 〘 〙 〚 〛 〜 〝 〞 〟 〠 〡 〢 〣 〤 〥 〦 〧 〨 〩 〪 〫 〬 〭 〮 〯 〰 〱 〲 〳 〴 〵 〶 〷 〸 〹 〺 〻 〼 〽 〾 〿+Hiragana+ぁ あ ぃ い ぅ う ぇ え ぉ お か が き ぎ く ぐ け げ こ ご さ ざ し じ す ず せ ぜ そ ぞ た だ ち ぢ っ つ づ て で と ど な に ぬ ね の は ば ぱ ひ び ぴ ふ ぶ ぷ へ べ ぺ ほ ぼ ぽ ま み む め も ゃ や ゅ ゆ ょ よ ら り る れ ろ ゎ わ ゐ ゑ を ん ゔ ゕ ゖ ゙ ゚ ゛ ゜ ゝ ゞ ゟ+Katakana+゠ ァ ア ィ イ ゥ ウ ェ エ ォ オ カ ガ キ ギ ク グ ケ ゲ コ ゴ サ ザ シ ジ ス ズ セ ゼ ソ ゾ タ ダ チ ヂ ッ ツ ヅ テ デ ト ド ナ ニ ヌ ネ ノ ハ バ パ ヒ ビ ピ フ ブ プ ヘ ベ ペ ホ ボ ポ マ ミ ム メ モ ャ ヤ ュ ユ ョ ヨ ラ リ ル レ ロ ヮ ワ ヰ ヱ ヲ ン ヴ ヵ ヶ ヷ ヸ ヹ ヺ ・ ー ヽ ヾ ヿ+Bopomofo+ㄅ ㄆ ㄇ ㄈ ㄉ ㄊ ㄋ ㄌ ㄍ ㄎ ㄏ ㄐ ㄑ ㄒ ㄓ ㄔ ㄕ ㄖ ㄗ ㄘ ㄙ ㄚ ㄛ ㄜ ㄝ ㄞ ㄟ ㄠ ㄡ ㄢ ㄣ ㄤ ㄥ ㄦ ㄧ ㄨ ㄩ ㄪ ㄫ ㄬ+Hangul Compatibility Jamo+ㄱ ㄲ ㄳ ㄴ ㄵ ㄶ ㄷ ㄸ ㄹ ㄺ ㄻ ㄼ ㄽ ㄾ ㄿ ㅀ ㅁ ㅂ ㅃ ㅄ ㅅ ㅆ ㅇ ㅈ ㅉ ㅊ ㅋ ㅌ ㅍ ㅎ ㅏ ㅐ ㅑ ㅒ ㅓ ㅔ ㅕ ㅖ ㅗ ㅘ ㅙ ㅚ ㅛ ㅜ ㅝ ㅞ ㅟ ㅠ ㅡ ㅢ ㅣ ㅤ ㅥ ㅦ ㅧ ㅨ ㅩ ㅪ ㅫ ㅬ ㅭ ㅮ ㅯ ㅰ ㅱ ㅲ ㅳ ㅴ ㅵ ㅶ ㅷ ㅸ ㅹ ㅺ ㅻ ㅼ ㅽ ㅾ ㅿ ㆀ ㆁ ㆂ ㆃ ㆄ ㆅ ㆆ ㆇ ㆈ ㆉ ㆊ ㆋ ㆌ ㆍ ㆎ+Kanbun+㆐ ㆑ ㆒ ㆓ ㆔ ㆕ ㆖ ㆗ ㆘ ㆙ ㆚ ㆛ ㆜ ㆝ ㆞ ㆟+Bopomofo Extended+ㆠ ㆡ ㆢ ㆣ ㆤ ㆥ ㆦ ㆧ ㆨ ㆩ ㆪ ㆫ ㆬ ㆭ ㆮ ㆯ ㆰ ㆱ ㆲ ㆳ ㆴ ㆵ ㆶ ㆷ+Katakana Phonetic Extensions+ㇰ ㇱ ㇲ ㇳ ㇴ ㇵ ㇶ ㇷ ㇸ ㇹ ㇺ ㇻ ㇼ ㇽ ㇾ ㇿ+Enclosed CJK Letters and Months+㈀ ㈁ ㈂ ㈃ ㈄ ㈅ ㈆ ㈇ ㈈ ㈉ ㈊ ㈋ ㈌ ㈍ ㈎ ㈏ ㈐ ㈑ ㈒ ㈓ ㈔ ㈕ ㈖ ㈗ ㈘ ㈙ ㈚ ㈛ ㈜ ㈠ ㈡ ㈢ ㈣ ㈤ ㈥ ㈦ ㈧ ㈨ ㈩ ㈪ ㈫ ㈬ ㈭ ㈮ ㈯ ㈰ ㈱ ㈲ ㈳ ㈴ ㈵ ㈶ ㈷ ㈸ ㈹ ㈺ ㈻ ㈼ ㈽ ㈾ ㈿ ㉀ ㉁ ㉂ ㉃ ㉑ ㉒ ㉓ ㉔ ㉕ ㉖ ㉗ ㉘ ㉙ ㉚ ㉛ ㉜ ㉝ ㉞ ㉟ ㉠ ㉡ ㉢ ㉣ ㉤ ㉥ ㉦ ㉧ ㉨ ㉩ ㉪ ㉫ ㉬ ㉭ ㉮ ㉯ ㉰ ㉱ ㉲ ㉳ ㉴ ㉵ ㉶ ㉷ ㉸ ㉹ ㉺ ㉻ ㉿ ㊀ ㊁ ㊂ ㊃ ㊄ ㊅ ㊆ ㊇ ㊈ ㊉ ㊊ ㊋ ㊌ ㊍ ㊎ ㊏ ㊐ ㊑ ㊒ ...+CJK Compatibility+㌀ ㌁ ㌂ ㌃ ㌄ ㌅ ㌆ ㌇ ㌈ ㌉ ㌊ ㌋ ㌌ ㌍ ㌎ ㌏ ㌐ ㌑ ㌒ ㌓ ㌔ ㌕ ㌖ ㌗ ㌘ ㌙ ㌚ ㌛ ㌜ ㌝ ㌞ ㌟ ㌠ ㌡ ㌢ ㌣ ㌤ ㌥ ㌦ ㌧ ㌨ ㌩ ㌪ ㌫ ㌬ ㌭ ㌮ ㌯ ㌰ ㌱ ㌲ ㌳ ㌴ ㌵ ㌶ ㌷ ㌸ ㌹ ㌺ ㌻ ㌼ ㌽ ㌾ ㌿ ㍀ ㍁ ㍂ ㍃ ㍄ ㍅ ㍆ ㍇ ㍈ ㍉ ㍊ ㍋ ㍌ ㍍ ㍎ ㍏ ㍐ ㍑ ㍒ ㍓ ㍔ ㍕ ㍖ ㍗ ㍘ ㍙ ㍚ ㍛ ㍜ ㍝ ㍞ ㍟ ㍠ ㍡ ㍢ ㍣ ㍤ ㍥ ㍦ ㍧ ㍨ ㍩ ㍪ ㍫ ㍬ ㍭ ㍮ ㍯ ㍰ ㍱ ㍲ ㍳ ㍴ ㍵ ㍶ ㍻ ㍼ ㍽ ㍾ ㍿ ㎀ ㎁ ㎂ ㎃ ...+CJK Unified Ideographs Extension A+㐀 㐁 㐂 㐃 㐄 㐅 㐆 㐇 㐈 㐉 㐊 㐋 㐌 㐍 㐎 㐏 㐐 㐑 㐒 㐓 㐔 㐕 㐖 㐗 㐘 㐙 㐚 㐛 㐜 㐝 㐞 㐟 㐠 㐡 㐢 㐣 㐤 㐥 㐦 㐧 㐨 㐩 㐪 㐫 㐬 㐭 㐮 㐯 㐰 㐱 㐲 㐳 㐴 㐵 㐶 㐷 㐸 㐹 㐺 㐻 㐼 㐽 㐾 㐿 㑀 㑁 㑂 㑃 㑄 㑅 㑆 㑇 㑈 㑉 㑊 㑋 㑌 㑍 㑎 㑏 㑐 㑑 㑒 㑓 㑔 㑕 㑖 㑗 㑘 㑙 㑚 㑛 㑜 㑝 㑞 㑟 㑠 㑡 㑢 㑣 㑤 㑥 㑦 㑧 㑨 㑩 㑪 㑫 㑬 㑭 㑮 㑯 㑰 㑱 㑲 㑳 㑴 㑵 㑶 㑷 㑸 㑹 㑺 㑻 㑼 㑽 㑾 㑿 ...+CJK Unified Ideographs+一 丁 丂 七 丄 丅 丆 万 丈 三 上 下 丌 不 与 丏 丐 丑 丒 专 且 丕 世 丗 丘 丙 业 丛 东 丝 丞 丟 丠 両 丢 丣 两 严 並 丧 丨 丩 个 丫 丬 中 丮 丯 丰 丱 串 丳 临 丵 丶 丷 丸 丹 为 主 丼 丽 举 丿 乀 乁 乂 乃 乄 久 乆 乇 么 义 乊 之 乌 乍 乎 乏 乐 乑 乒 乓 乔 乕 乖 乗 乘 乙 乚 乛 乜 九 乞 也 习 乡 乢 乣 乤 乥 书 乧 乨 乩 乪 乫 乬 乭 乮 乯 买 乱 乲 乳 乴 乵 乶 乷 乸 乹 乺 乻 乼 乽 乾 乿 ...+Yi Syllables+ꀀ ꀁ ꀂ ꀃ ꀄ ꀅ ꀆ ꀇ ꀈ ꀉ ꀊ ꀋ ꀌ ꀍ ꀎ ꀏ ꀐ ꀑ ꀒ ꀓ ꀔ ꀕ ꀖ ꀗ ꀘ ꀙ ꀚ ꀛ ꀜ ꀝ ꀞ ꀟ ꀠ ꀡ ꀢ ꀣ ꀤ ꀥ ꀦ ꀧ ꀨ ꀩ ꀪ ꀫ ꀬ ꀭ ꀮ ꀯ ꀰ ꀱ ꀲ ꀳ ꀴ ꀵ ꀶ ꀷ ꀸ ꀹ ꀺ ꀻ ꀼ ꀽ ꀾ ꀿ ꁀ ꁁ ꁂ ꁃ ꁄ ꁅ ꁆ ꁇ ꁈ ꁉ ꁊ ꁋ ꁌ ꁍ ꁎ ꁏ ꁐ ꁑ ꁒ ꁓ ꁔ ꁕ ꁖ ꁗ ꁘ ꁙ ꁚ ꁛ ꁜ ꁝ ꁞ ꁟ ꁠ ꁡ ꁢ ꁣ ꁤ ꁥ ꁦ ꁧ ꁨ ꁩ ꁪ ꁫ ꁬ ꁭ ꁮ ꁯ ꁰ ꁱ ꁲ ꁳ ꁴ ꁵ ꁶ ꁷ ꁸ ꁹ ꁺ ꁻ ꁼ ꁽ ꁾ ꁿ ...+Yi Radicals+꒐ ꒑ ꒒ ꒓ ꒔ ꒕ ꒖ ꒗ ꒘ ꒙ ꒚ ꒛ ꒜ ꒝ ꒞ ꒟ ꒠ ꒡ ꒢ ꒣ ꒤ ꒥ ꒦ ꒧ ꒨ ꒩ ꒪ ꒫ ꒬ ꒭ ꒮ ꒯ ꒰ ꒱ ꒲ ꒳ ꒴ ꒵ ꒶ ꒷ ꒸ ꒹ ꒺ ꒻ ꒼ ꒽ ꒾ ꒿ ꓀ ꓁ ꓂ ꓃ ꓄ ꓅ ꓆+Hangul Syllables+가 각 갂 갃 간 갅 갆 갇 갈 갉 갊 갋 갌 갍 갎 갏 감 갑 값 갓 갔 강 갖 갗 갘 같 갚 갛 개 객 갞 갟 갠 갡 갢 갣 갤 갥 갦 갧 갨 갩 갪 갫 갬 갭 갮 갯 갰 갱 갲 갳 갴 갵 갶 갷 갸 갹 갺 갻 갼 갽 갾 갿 걀 걁 걂 걃 걄 걅 걆 걇 걈 걉 걊 걋 걌 걍 걎 걏 걐 걑 걒 걓 걔 걕 걖 걗 걘 걙 걚 걛 걜 걝 걞 걟 걠 걡 걢 걣 걤 걥 걦 걧 걨 걩 걪 걫 걬 걭 걮 걯 거 걱 걲 걳 건 걵 걶 걷 걸 걹 걺 걻 걼 걽 걾 걿 ...+Private Use Area+                                                                                                                                ...+CJK Compatibility Ideographs+豈 更 車 賈 滑 串 句 龜 龜 契 金 喇 奈 懶 癩 羅 蘿 螺 裸 邏 樂 洛 烙 珞 落 酪 駱 亂 卵 欄 爛 蘭 鸞 嵐 濫 藍 襤 拉 臘 蠟 廊 朗 浪 狼 郎 來 冷 勞 擄 櫓 爐 盧 老 蘆 虜 路 露 魯 鷺 碌 祿 綠 菉 錄 鹿 論 壟 弄 籠 聾 牢 磊 賂 雷 壘 屢 樓 淚 漏 累 縷 陋 勒 肋 凜 凌 稜 綾 菱 陵 讀 拏 樂 諾 丹 寧 怒 率 異 北 磻 便 復 不 泌 數 索 參 塞 省 葉 說 殺 辰 沈 拾 若 掠 略 亮 兩 凉 梁 糧 良 諒 量 勵 ...+Alphabetic Presentation Forms+ff fi fl ffi ffl ſt st ﬓ ﬔ ﬕ ﬖ ﬗ יִ ﬞ ײַ ﬠ ﬡ ﬢ ﬣ ﬤ ﬥ ﬦ ﬧ ﬨ ﬩ שׁ שׂ שּׁ שּׂ אַ אָ אּ בּ גּ דּ הּ וּ זּ טּ יּ ךּ כּ לּ מּ נּ סּ ףּ פּ צּ קּ רּ שּ תּ וֹ בֿ כֿ פֿ ﭏ+Arabic Presentation Forms-A+ﭐ ﭑ ﭒ ﭓ ﭔ ﭕ ﭖ ﭗ ﭘ ﭙ ﭚ ﭛ ﭜ ﭝ ﭞ ﭟ ﭠ ﭡ ﭢ ﭣ ﭤ ﭥ ﭦ ﭧ ﭨ ﭩ ﭪ ﭫ ﭬ ﭭ ﭮ ﭯ ﭰ ﭱ ﭲ ﭳ ﭴ ﭵ ﭶ ﭷ ﭸ ﭹ ﭺ ﭻ ﭼ ﭽ ﭾ ﭿ ﮀ ﮁ ﮂ ﮃ ﮄ ﮅ ﮆ ﮇ ﮈ ﮉ ﮊ ﮋ ﮌ ﮍ ﮎ ﮏ ﮐ ﮑ ﮒ ﮓ ﮔ ﮕ ﮖ ﮗ ﮘ ﮙ ﮚ ﮛ ﮜ ﮝ ﮞ ﮟ ﮠ ﮡ ﮢ ﮣ ﮤ ﮥ ﮦ ﮧ ﮨ ﮩ ﮪ ﮫ ﮬ ﮭ ﮮ ﮯ ﮰ ﮱ ﯓ ﯔ ﯕ ﯖ ﯗ ﯘ ﯙ ﯚ ﯛ ﯜ ﯝ ﯞ ﯟ ﯠ ﯡ ﯢ ﯣ ﯤ ﯥ ﯦ ﯧ ﯨ ﯩ ﯪ ﯫ ﯬ ﯭ ﯮ ﯯ ﯰ ...+Variation Selectors+︀ ︁ ︂ ︃ ︄ ︅ ︆ ︇ ︈ ︉ ︊ ︋ ︌ ︍ ︎ ️+Combining Half Marks+︠ ︡ ︢ ︣+CJK Compatibility Forms+︰ ︱ ︲ ︳ ︴ ︵ ︶ ︷ ︸ ︹ ︺ ︻ ︼ ︽ ︾ ︿ ﹀ ﹁ ﹂ ﹃ ﹄ ﹅ ﹆ ﹉ ﹊ ﹋ ﹌ ﹍ ﹎ ﹏+Small Form Variants+﹐ ﹑ ﹒ ﹔ ﹕ ﹖ ﹗ ﹘ ﹙ ﹚ ﹛ ﹜ ﹝ ﹞ ﹟ ﹠ ﹡ ﹢ ﹣ ﹤ ﹥ ﹦ ﹨ ﹩ ﹪ ﹫+Arabic Presentation Forms-B+ﹰ ﹱ ﹲ ﹳ ﹴ ﹶ ﹷ ﹸ ﹹ ﹺ ﹻ ﹼ ﹽ ﹾ ﹿ ﺀ ﺁ ﺂ ﺃ ﺄ ﺅ ﺆ ﺇ ﺈ ﺉ ﺊ ﺋ ﺌ ﺍ ﺎ ﺏ ﺐ ﺑ ﺒ ﺓ ﺔ ﺕ ﺖ ﺗ ﺘ ﺙ ﺚ ﺛ ﺜ ﺝ ﺞ ﺟ ﺠ ﺡ ﺢ ﺣ ﺤ ﺥ ﺦ ﺧ ﺨ ﺩ ﺪ ﺫ ﺬ ﺭ ﺮ ﺯ ﺰ ﺱ ﺲ ﺳ ﺴ ﺵ ﺶ ﺷ ﺸ ﺹ ﺺ ﺻ ﺼ ﺽ ﺾ ﺿ ﻀ ﻁ ﻂ ﻃ ﻄ ﻅ ﻆ ﻇ ﻈ ﻉ ﻊ ﻋ ﻌ ﻍ ﻎ ﻏ ﻐ ﻑ ﻒ ﻓ ﻔ ﻕ ﻖ ﻗ ﻘ ﻙ ﻚ ﻛ ﻜ ﻝ ﻞ ﻟ ﻠ ﻡ ﻢ ﻣ ﻤ ﻥ ﻦ ﻧ ﻨ ﻩ ﻪ ﻫ ﻬ ﻭ ﻮ ﻯ ﻰ ...+Halfwidth and Fullwidth Forms+！ ＂ ＃ ＄ ％ ＆ ＇ （ ） ＊ ＋ ， － ． ／ ０ １ ２ ３ ４ ５ ６ ７ ８ ９ ： ； ＜ ＝ ＞ ？ ＠ Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ Ｉ Ｊ Ｋ Ｌ Ｍ Ｎ Ｏ Ｐ Ｑ Ｒ Ｓ Ｔ Ｕ Ｖ Ｗ Ｘ Ｙ Ｚ ［ ＼ ］ ＾ ＿ ｀ ａ ｂ ｃ ｄ ｅ ｆ ｇ ｈ ｉ ｊ ｋ ｌ ｍ ｎ ｏ ｐ ｑ ｒ ｓ ｔ ｕ ｖ ｗ ｘ ｙ ｚ ｛ ｜ ｝ ～ ｟ ｠ ｡ ｢ ｣ ､ ･ ｦ ｧ ｨ ｩ ｪ ｫ ｬ ｭ ｮ ｯ ｰ ｱ ｲ ｳ ｴ ｵ ｶ ｷ ｸ ｹ ｺ ｻ ｼ ｽ ｾ ｿ ﾀ ...+Specials+    �+Old Italic+𐌀 𐌁 𐌂 𐌃 𐌄 𐌅 𐌆 𐌇 𐌈 𐌉 𐌊 𐌋 𐌌 𐌍 𐌎 𐌏 𐌐 𐌑 𐌒 𐌓 𐌔 𐌕 𐌖 𐌗 𐌘 𐌙 𐌚 𐌛 𐌜 𐌝 𐌞 𐌠 𐌡 𐌢 𐌣+Gothic+𐌰 𐌱 𐌲 𐌳 𐌴 𐌵 𐌶 𐌷 𐌸 𐌹 𐌺 𐌻 𐌼 𐌽 𐌾 𐌿 𐍀 𐍁 𐍂 𐍃 𐍄 𐍅 𐍆 𐍇 𐍈 𐍉 𐍊+Deseret+𐐀 𐐁 𐐂 𐐃 𐐄 𐐅 𐐆 𐐇 𐐈 𐐉 𐐊 𐐋 𐐌 𐐍 𐐎 𐐏 𐐐 𐐑 𐐒 𐐓 𐐔 𐐕 𐐖 𐐗 𐐘 𐐙 𐐚 𐐛 𐐜 𐐝 𐐞 𐐟 𐐠 𐐡 𐐢 𐐣 𐐤 𐐥 𐐨 𐐩 𐐪 𐐫 𐐬 𐐭 𐐮 𐐯 𐐰 𐐱 𐐲 𐐳 𐐴 𐐵 𐐶 𐐷 𐐸 𐐹 𐐺 𐐻 𐐼 𐐽 𐐾 𐐿 𐑀 𐑁 𐑂 𐑃 𐑄 𐑅 𐑆 𐑇 𐑈 𐑉 𐑊 𐑋 𐑌 𐑍+Byzantine Musical Symbols+𝀀 𝀁 𝀂 𝀃 𝀄 𝀅 𝀆 𝀇 𝀈 𝀉 𝀊 𝀋 𝀌 𝀍 𝀎 𝀏 𝀐 𝀑 𝀒 𝀓 𝀔 𝀕 𝀖 𝀗 𝀘 𝀙 𝀚 𝀛 𝀜 𝀝 𝀞 𝀟 𝀠 𝀡 𝀢 𝀣 𝀤 𝀥 𝀦 𝀧 𝀨 𝀩 𝀪 𝀫 𝀬 𝀭 𝀮 𝀯 𝀰 𝀱 𝀲 𝀳 𝀴 𝀵 𝀶 𝀷 𝀸 𝀹 𝀺 𝀻 𝀼 𝀽 𝀾 𝀿 𝁀 𝁁 𝁂 𝁃 𝁄 𝁅 𝁆 𝁇 𝁈 𝁉 𝁊 𝁋 𝁌 𝁍 𝁎 𝁏 𝁐 𝁑 𝁒 𝁓 𝁔 𝁕 𝁖 𝁗 𝁘 𝁙 𝁚 𝁛 𝁜 𝁝 𝁞 𝁟 𝁠 𝁡 𝁢 𝁣 𝁤 𝁥 𝁦 𝁧 𝁨 𝁩 𝁪 𝁫 𝁬 𝁭 𝁮 𝁯 𝁰 𝁱 𝁲 𝁳 𝁴 𝁵 𝁶 𝁷 𝁸 𝁹 𝁺 𝁻 𝁼 𝁽 𝁾 𝁿 ...+Musical Symbols+𝄀 𝄁 𝄂 𝄃 𝄄 𝄅 𝄆 𝄇 𝄈 𝄉 𝄊 𝄋 𝄌 𝄍 𝄎 𝄏 𝄐 𝄑 𝄒 𝄓 𝄔 𝄕 𝄖 𝄗 𝄘 𝄙 𝄚 𝄛 𝄜 𝄝 𝄞 𝄟 𝄠 𝄡 𝄢 𝄣 𝄤 𝄥 𝄦 𝄪 𝄫 𝄬 𝄭 𝄮 𝄯 𝄰 𝄱 𝄲 𝄳 𝄴 𝄵 𝄶 𝄷 𝄸 𝄹 𝄺 𝄻 𝄼 𝄽 𝄾 𝄿 𝅀 𝅁 𝅂 𝅃 𝅄 𝅅 𝅆 𝅇 𝅈 𝅉 𝅊 𝅋 𝅌 𝅍 𝅎 𝅏 𝅐 𝅑 𝅒 𝅓 𝅔 𝅕 𝅖 𝅗 𝅘 𝅙 𝅚 𝅛 𝅜 𝅝 𝅗𝅥 𝅘𝅥 𝅘𝅥𝅮 𝅘𝅥𝅯 𝅘𝅥𝅰 𝅘𝅥𝅱 𝅘𝅥𝅲 𝅥 𝅦 𝅧 𝅨 𝅩 𝅪 𝅫 𝅬 𝅭 𝅮 𝅯 𝅰 𝅱 𝅲 𝅳 𝅴 𝅵 𝅶 𝅷 𝅸 𝅹 𝅺 𝅻 𝅼 𝅽 𝅾 𝅿 𝆀 𝆁 𝆂 ...+Mathematical Alphanumeric Symbols+𝐀 𝐁 𝐂 𝐃 𝐄 𝐅 𝐆 𝐇 𝐈 𝐉 𝐊 𝐋 𝐌 𝐍 𝐎 𝐏 𝐐 𝐑 𝐒 𝐓 𝐔 𝐕 𝐖 𝐗 𝐘 𝐙 𝐚 𝐛 𝐜 𝐝 𝐞 𝐟 𝐠 𝐡 𝐢 𝐣 𝐤 𝐥 𝐦 𝐧 𝐨 𝐩 𝐪 𝐫 𝐬 𝐭 𝐮 𝐯 𝐰 𝐱 𝐲 𝐳 𝐴 𝐵 𝐶 𝐷 𝐸 𝐹 𝐺 𝐻 𝐼 𝐽 𝐾 𝐿 𝑀 𝑁 𝑂 𝑃 𝑄 𝑅 𝑆 𝑇 𝑈 𝑉 𝑊 𝑋 𝑌 𝑍 𝑎 𝑏 𝑐 𝑑 𝑒 𝑓 𝑔 𝑖 𝑗 𝑘 𝑙 𝑚 𝑛 𝑜 𝑝 𝑞 𝑟 𝑠 𝑡 𝑢 𝑣 𝑤 𝑥 𝑦 𝑧 𝑨 𝑩 𝑪 𝑫 𝑬 𝑭 𝑮 𝑯 𝑰 𝑱 𝑲 𝑳 𝑴 𝑵 𝑶 𝑷 𝑸 𝑹 𝑺 𝑻 𝑼 𝑽 𝑾 𝑿 𝒀 ...+CJK Unified Ideographs Extension B+𠀀 𠀁 𠀂 𠀃 𠀄 𠀅 𠀆 𠀇 𠀈 𠀉 𠀊 𠀋 𠀌 𠀍 𠀎 𠀏 𠀐 𠀑 𠀒 𠀓 𠀔 𠀕 𠀖 𠀗 𠀘 𠀙 𠀚 𠀛 𠀜 𠀝 𠀞 𠀟 𠀠 𠀡 𠀢 𠀣 𠀤 𠀥 𠀦 𠀧 𠀨 𠀩 𠀪 𠀫 𠀬 𠀭 𠀮 𠀯 𠀰 𠀱 𠀲 𠀳 𠀴 𠀵 𠀶 𠀷 𠀸 𠀹 𠀺 𠀻 𠀼 𠀽 𠀾 𠀿 𠁀 𠁁 𠁂 𠁃 𠁄 𠁅 𠁆 𠁇 𠁈 𠁉 𠁊 𠁋 𠁌 𠁍 𠁎 𠁏 𠁐 𠁑 𠁒 𠁓 𠁔 𠁕 𠁖 𠁗 𠁘 𠁙 𠁚 𠁛 𠁜 𠁝 𠁞 𠁟 𠁠 𠁡 𠁢 𠁣 𠁤 𠁥 𠁦 𠁧 𠁨 𠁩 𠁪 𠁫 𠁬 𠁭 𠁮 𠁯 𠁰 𠁱 𠁲 𠁳 𠁴 𠁵 𠁶 𠁷 𠁸 𠁹 𠁺 𠁻 𠁼 𠁽 𠁾 𠁿 ...+CJK Compatibility Ideographs Supplement+丽 丸 乁 𠄢 你 侮 侻 倂 偺 備 僧 像 㒞 𠘺 免 兔 兤 具 𠔜 㒹 內 再 𠕋 冗 冤 仌 冬 况 𩇟 凵 刃 㓟 刻 剆 割 剷 㔕 勇 勉 勤 勺 包 匆 北 卉 卑 博 即 卽 卿 卿 卿 𠨬 灰 及 叟 𠭣 叫 叱 吆 咞 吸 呈 周 咢 哶 唐 啓 啣 善 善 喙 喫 喳 嗂 圖 嘆 圗 噑 噴 切 壮 城 埴 堍 型 堲 報 墬 𡓤 売 壷 夆 多 夢 奢 𡚨 𡛪 姬 娛 娧 姘 婦 㛮 㛼 嬈 嬾 嬾 𡧈 寃 寘 寧 寳 𡬘 寿 将 当 尢 㞁 屠 屮 峀 岍 𡷤 嵃 𡷦 嵮 嵫 ...+Tags+󠀁 󠀠 󠀡 󠀢 󠀣 󠀤 󠀥 󠀦 󠀧 󠀨 󠀩 󠀪 󠀫 󠀬 󠀭 󠀮 󠀯 󠀰 󠀱 󠀲 󠀳 󠀴 󠀵 󠀶 󠀷 󠀸 󠀹 󠀺 󠀻 󠀼 󠀽 󠀾 󠀿 󠁀 󠁁 󠁂 󠁃 󠁄 󠁅 󠁆 󠁇 󠁈 󠁉 󠁊 󠁋 󠁌 󠁍 󠁎 󠁏 󠁐 󠁑 󠁒 󠁓 󠁔 󠁕 󠁖 󠁗 󠁘 󠁙 󠁚 󠁛 󠁜 󠁝 󠁞 󠁟 󠁠 󠁡 󠁢 󠁣 󠁤 󠁥 󠁦 󠁧 󠁨 󠁩 󠁪 󠁫 󠁬 󠁭 󠁮 󠁯 󠁰 󠁱 󠁲 󠁳 󠁴 󠁵 󠁶 󠁷 󠁸 󠁹 󠁺 󠁻 󠁼 󠁽 󠁾 󠁿+Supplementary Private Use Area-A+󰀀 󰀁 󰀂 󰀃 󰀄 󰀅 󰀆 󰀇 󰀈 󰀉 󰀊 󰀋 󰀌 󰀍 󰀎 󰀏 󰀐 󰀑 󰀒 󰀓 󰀔 󰀕 󰀖 󰀗 󰀘 󰀙 󰀚 󰀛 󰀜 󰀝 󰀞 󰀟 󰀠 󰀡 󰀢 󰀣 󰀤 󰀥 󰀦 󰀧 󰀨 󰀩 󰀪 󰀫 󰀬 󰀭 󰀮 󰀯 󰀰 󰀱 󰀲 󰀳 󰀴 󰀵 󰀶 󰀷 󰀸 󰀹 󰀺 󰀻 󰀼 󰀽 󰀾 󰀿 󰁀 󰁁 󰁂 󰁃 󰁄 󰁅 󰁆 󰁇 󰁈 󰁉 󰁊 󰁋 󰁌 󰁍 󰁎 󰁏 󰁐 󰁑 󰁒 󰁓 󰁔 󰁕 󰁖 󰁗 󰁘 󰁙 󰁚 󰁛 󰁜 󰁝 󰁞 󰁟 󰁠 󰁡 󰁢 󰁣 󰁤 󰁥 󰁦 󰁧 󰁨 󰁩 󰁪 󰁫 󰁬 󰁭 󰁮 󰁯 󰁰 󰁱 󰁲 󰁳 󰁴 󰁵 󰁶 󰁷 󰁸 󰁹 󰁺 󰁻 󰁼 󰁽 󰁾 󰁿 ...+Supplementary Private Use Area-B+􀀀 􀀁 􀀂 􀀃 􀀄 􀀅 􀀆 􀀇 􀀈 􀀉 􀀊 􀀋 􀀌 􀀍 􀀎 􀀏 􀀐 􀀑 􀀒 􀀓 􀀔 􀀕 􀀖 􀀗 􀀘 􀀙 􀀚 􀀛 􀀜 􀀝 􀀞 􀀟 􀀠 􀀡 􀀢 􀀣 􀀤 􀀥 􀀦 􀀧 􀀨 􀀩 􀀪 􀀫 􀀬 􀀭 􀀮 􀀯 􀀰 􀀱 􀀲 􀀳 􀀴 􀀵 􀀶 􀀷 􀀸 􀀹 􀀺 􀀻 􀀼 􀀽 􀀾 􀀿 􀁀 􀁁 􀁂 􀁃 􀁄 􀁅 􀁆 􀁇 􀁈 􀁉 􀁊 􀁋 􀁌 􀁍 􀁎 􀁏 􀁐 􀁑 􀁒 􀁓 􀁔 􀁕 􀁖 􀁗 􀁘 􀁙 􀁚 􀁛 􀁜 􀁝 􀁞 􀁟 􀁠 􀁡 􀁢 􀁣 􀁤 􀁥 􀁦 􀁧 􀁨 􀁩 􀁪 􀁫 􀁬 􀁭 􀁮 􀁯 􀁰 􀁱 􀁲 􀁳 􀁴 􀁵 􀁶 􀁷 􀁸 􀁹 􀁺 􀁻 􀁼 􀁽 􀁾 􀁿 ...
+ benchmark/Streamly/Benchmark/Unicode/data/Deutsch.txt view
@@ -0,0 +1,153 @@+Der FC Bayern München (offiziell: Fußball-Club Bayern, München eingetragener Verein)[1] ist ein Sportverein aus München. Die seit 2002eine eigene Aktiengesellschaft ausgegliederte Profifußballabteilung ist deutscher Rekordmeister, Rekordsieger im DFB-Pokal, Ligapokal sowie Supercup und belegtder Ewigen Tabelle der Bundesliga den ersten Platz. Damit ist Bayern München im Profifußball der erfolgreichste deutsche Fußballverein.+Auf europäischer Ebene gehört der FC Bayern mit sechs Europapokalsiegen, davon vierder Champions League bzw. dem Europapokal der Landesmeister, zu den fünf erfolgreichsten Vereinen. Neben Juventus Turin und Ajax Amsterdam ist er einer der Vereine, die sowohl den Europapokal der Landesmeister, bzw. Champions League, den UEFA-Pokal, als auch den Europapokal der Pokalsieger gewinnen konnten. Zweimal gewann der FC Bayern München zudem den Weltpokal.+Auch wirtschaftlich gehört der Verein zu den weltweit erfolgreichsten: Nach der Saison 2009/10 belegten die Bayern Rang vierder Rangliste der umsatzstärksten Klubs und im April 2011 den gleichen Rangder Liste der wertvollsten Vereine des Forbes Magazine.[2] Mit 171.345 Vereinsmitgliedern (Stand: 18. November 2011) ist der FC Bayern einer der mitgliederstärksten Sportvereine weltweit. Innerhalb der letzten zwölf Monate stieg die Zahl um über 11.000 Mitglieder. Der Verein hat 2952 offizielle Fanclubs (Vorjahr: 2764) mit insgesamt 204.235 registrierten Mitgliedern. Dies ist ein Anstieg von über 12.000 Mitgliedern.[3][4]+Seit 1965 spielt der FC Bayern ununterbrochender Bundesliga, lediglich die ersten zwei Jahre nach Einführung der Bundesliga war die Mannschaft zweitklassig. Die zweite Mannschaft des FC Bayern spielt zurzeitder viertklassigen Regionalliga Süd. Sie gewannder Saison 2003/04 den Meistertitelder damals noch drittklassigen Regionalliga Süd.+Zum FC Bayern gehören zudem weitere Abteilungen, die auch einige Erfolge aufweisen können. So wurden die derzeitder Frauen-Bundesliga spielenden Fußballfrauen 1976 Deutscher Meister. Weitere Erfolge feierten die Basketballer mit zwei Meisterschaften und einem Pokalsieg, die Schachabteilung mit neun Deutschen Meisterschaften und einem Europapokalsieg sowie die Turner mit vier Deutschen Meisterschaften.++Am 27. Februar 1900 fand im Gasthaus „Bäckerhöfl“ eine Sitzung der Fußballabteilung des MTV München statt. Es war kurz zuvor zu einem Streit über die weitere Entwicklung der Fußballabteilung gekommen, da eine Generalversammlung des MTV dem Beitritt des Vereins zum süddeutschen Fußballverband eine Absage erteilt hatte. Um 21:30 Uhr verließen elf Männer, Nägele, Schmid, Karl, Wamsler, Ringler, Focke, Francke, Friedrich, Zöpfel, Pollack und John das Lokal und fanden sich im Restaurant „Gisela“Schwabing ein, um noch am selben Abend den FC Bayern München zu gründen.[5] Den Vorsitz führte Franz John, der auch der erste Vorsitzendeder Geschichte der Bayern werden sollte. Als Vereinsfarben wählte man Blau-Weiß, der Mitgliedsbeitrag wurde auf eine Mark festgesetzt.+Als erster Trainingsplatz diente der stadteigene, heute noch existierende Schyrenplatz. Der erste Gegner war im März 1900 der 1. Münchner FC 1896, der FC Bayern gewann das Spiel mit 5:2. Schnell stießen weitere Spieler zum Verein, so unter anderem drei Spieler der Fußballabteilung des TV München 1860. Im Frühjahr 1900 überließen die Geschäftsleute Wamsler dem FC Bayern ein Grundstück an der Clemensstraße als Spielstätte. Das erste Spiel einer langen und traditionsreichen Derbygeschichte zwischen dem FC Bayern und den „Sechzigern“ fand im Jahr 1902 statt. Der FC Bayern gewann das Spiel mit 3:0. Um den Spielbetrieb auszuweiten, beschloss der Verein 1906 den Übertritt zum Münchner Sport-Club, behielt aber eine gewisse Eigenständigkeit bei, was sichder Bezeichnung „F.A. Bayern im Münchner SC“ (F.A. = Fußballabteilung) ausdrückte. Infolge der Fusion trat Bayern nunweißen Hemden und roten Hosen an, diese Farben lösten damit das Blau-Weiß aus der Gründungszeit ab, die Bezeichnung Die Roten war geboren. Auf lokaler Ebene entwickelten sich die „Bayern“ zur unangefochtenen Nummer Eins im Fußball, im Wettbewerb auf süddeutscher Ebene waren sie hingegen weniger erfolgreich. Zu sehr dominierten zu dieser Zeit noch die Mannschaften, die bereitsden 1890er Jahren entlang des Oberrheins zwischen Freiburg und Frankfurt entstanden waren und sich weiterentwickelt hatten, das Fußballgeschehen.+1907 mussten die Bayern die Sportanlage an der Karl-Theodor-Straße aufgeben und zum Sportplatz an der Leopoldstraße umziehen. Eingeweiht wurde damit auch die erste Tribüne auf einem FußballplatzMünchen. Im Eröffnungsspiel gab es ein 8:1 gegen Wacker München. Bereits 1908 hatte der FC Bayern mehr als 300 Mitglieder, acht Mannschaften und mehr als 100 Jugendspieler. Dies hatte eine Satzungsänderung zur Folge, wodurch Verwaltungsarbeit und der Sportbereich getrennt wurden. Die Spieler hatten dadurch mehr Zeit sich auf den Sport zu konzentrieren. 1910 konnten sie das erste Mal an der Endrunde zur Süddeutschen Meisterschaft teilnehmen. Am Ende belegte der FCB den 2. Platz hinter dem Karlsruher FV. Im selben Jahr stellten die Bayern mit Max Gablonsky ihren ersten Nationalspieler.+Während des Ersten Weltkrieges kam der Sport zeitweise zum Erliegen und im Verein und dessen Umfeld gab es ein ständiges Auf und Ab. Erst von der Spielzeit 1919/20 an warSüddeutschland wieder ein regelmäßiger Ligabetrieb gewährleistet. Im Oktober 1919 traten die Bayern aus dem Münchner SC aus und fusionierten mit dem Turnverein Jahn zum TuSpV Bayern. William Townley wurde erneut als Trainer verpflichtet, womit man die Tradition der englischen Trainer im Verein fortsetzte. Bereitsden Vorkriegsjahren hatten die Bayern mit Coach Taylor, Hoer und Charles Griffith drei Engländer als Trainer, von denen letzterer der erste hauptberufliche Bayerntrainer war.+Im Frühjahr 1924 trennte man sich im Zuge der reinlichen Scheidung wieder vom TuSpV Bayern und trat fortan nur noch als eigenständiger Verein unter dem Namen „FC Bayern München“ auf. Mit dem Schotten Jim McPherson setzten die Bayern erneut auf einen britischen Trainer. 1926 spielten die Bayern um die Süddeutsche Meisterschaft. Die härtesten Konkurrenten kamen damals mit dem 1. FC Nürnberg und der SpVgg. Fürth, die damals als beste Mannschaft Deutschlands galt, aus Bayern. Das Rückspiel gegen Fürth im Grünwalder Stadion wurde live im Radio übertragen und nach einem dramatischen Spiel gewann der FCB mit 4:3. Die Bayern waren zum ersten Male Süddeutscher Meister, scheiterten dann aber schon im Achtelfinale um die deutsche MeisterschaftLeipzig gegen den SV Fortuna Leipzig 02 mit 0:2. Bereits 1928 gelang mit dem ungarischen Trainer Leo Weisz der Gewinn der zweiten Süddeutschen Meisterschaft. Erneut qualifizierte man sich damit zur Endrunde um die Deutsche Meisterschaft und über Siege gegen den FC Wacker Halle und die SpVgg Sülz 07 erreichte der FC Bayern das Halbfinale und feierte damit den bis dahin größten Erfolg der Vereinsgeschichte. Im Duisburger Wedaustadion unterlagen die Bayern dem Hamburger SV jedoch deutlich mit 2:8.+Nach drei gescheiterten Anläufen zum Gewinn der Deutschen Meisterschaftden Jahren 1926, 1928 und 1929 hatte man 1932 mehr Erfolg. Der Trainerwechsel von Kálmán Konrád zu Richard Dombi 1930 erwies sich somit im Nachhinein als gute Entscheidung. Das Finale um die Süddeutsche Meisterschaft verlor der FC Bayern gegen die Eintracht aus Frankfurt und ging als Süddeutscher Vizemeisterdie Endrunde um die Deutsche Meisterschaft. Der Reihe nach traf man auf Minerva 1893 Berlin und den Polizei SV Chemnitz, ehe man im Halbfinale dem Erzrivalen aus Franken, dem 1. FC Nürnberg, gegenüberstand. Das Spiel fandMannheim statt und die Bayern besiegten den bis dahin fünfmaligen Deutschen Meister mit 2:0. Die Tore erzielten Oskar Rohr und Hans Welker. Im Finale am 12. Juni 1932, dasNürnberg ausgetragen wurde, traf man erneut auf die Frankfurter Eintracht, gegen die man schon im Finale um die Süddeutsche Meisterschaft unterlegen war. Tausende Bayern-Fans machten sich auf den Weg, darunter auch etwa 400 Arbeitslose mit dem Fahrrad. Im Nachhinein übernahm der Verein die Kosten für diese Fans für Übernachtung und Eintrittskarten. Am Tage des Endspiels herrschten 30 Grad im Schatten und 55.000 Zuschauer sahen das Spiel im Stadion.der 35. Minute nahm der Frankfurter Hennes Straub auf der Torlinie die Hand zu Hilfe und es gab Elfmeter für den FC Bayern. „Ossi“ Rohr verwandelte sicher zum 1:0.der zweiten Hälfte drängten die Frankfurter auf den Ausgleich, dochder 75. Minute erzielte Franz Krumm das entscheidende 2:0 für Bayern. Nach dem Abpfiff hielt der FC Bayern München zum ersten Malder Vereinsgeschichte die Victoriader Hand. Zum ersten Mal wurde ein Verein aus München Deutscher Meister und die Mannschaft wurde begeistertder Landeshauptstadt empfangen. Die Siegesfeier fand im Münchener Löwenbräukeller statt, die Spieler wurden auf Pferdekutschen zur Feier gebracht.einer der Festreden hieß es, „was man schon im Vorjahr bei 1860 bestimmt gedacht, hat heuer FC Bayern fertig gebracht“.++1933 konnte der Titel nicht verteidigt werden, nachdem der Verein beide Spiele gegen den TSV 1860 München um die Süddeutsche Meisterschaft verloren hatte. Nach der NS-Übernahme der Regierungsgewalt unter der Führung Adolf Hitlers musste Präsident Kurt Landauer auf Grund seiner jüdischen Abstammung auf politischen Druck hin im selben Jahr zurücktreten. Trainer Dombi, ebenfalls jüdischer Abstammung, wechselte kurz daraufdie Schweiz. Der FC Bayern war, im Gegensatz zum Stadtrivalen 1860 München, bei den neuen Machthabern wegen Landauer und Dombi als „Judenclub“ verpönt. Erst Anfang 1943 konnte mit Josef Sauter ein NSDAP-Mitglied als Präsident im Verein eingesetzt werden, die Unterstützung einzelner Spieler für Landauer bei einem Gastspielder Schweiz hatte weitere Repressalien zur Folge.[6]+Zudem verließ auch Oskar Rohr den Verein, um Profispieler bei den Grasshoppers Zürich zu werden. Neuer Trainer wurde Hans Tauchert, der aber nicht an die alten Erfolge anknüpfen konnte und bereits 1934 durch Ludwig Hofmann ersetzt wurde. Hofmann verstarb aber bereits kurze Zeit später an einer Halserkrankung und Richard Michalke übernahm das Amt des Trainers. Damit war die Talfahrt allerdings noch nicht beendet und so stand man im Jahre 1939 kurz vor dem ersten Abstiegder Geschichte des Vereins, konnte die Klasse jedoch gerade noch halten. Im Verlauf des Krieges wurden die Gauligen weiter regionalisiert, um die Wege für die Vereine für Auswärtsspiele möglichst kurz zu halten. Waren die Bayern anfangsder Gauliga Bayern, spielten sie anschließendder Gauliga Südbayern, die durch die Aufteilung der Gauliga Bayern entstand. Kurz vor Ende des Krieges spielte mander Gauliga München-Oberbayern. Im Jahre 1944 konnten Die Roten wieder eine Süddeutsche Meisterschaft gewinnen und qualifizierten sich so erneut für die Endrunde um die Deutsche Meisterschaft. Bereits im Achtelfinale verlor man jedoch nach Verlängerung gegen den VfR Mannheim. Am 13. Juli desselben Jahres wurden die Geschäftsstelle und ein Teil des Archivs bei Bombenangriffen zerstört. Im darauffolgenden Jahr qualifizierte man sich unter Spielertrainer Conny Heidkamp erneut für die Endrunde um die Deutsche Meisterschaft. Die Endrunde wurde im Jahr des Endes des Zweiten Weltkriegs jedoch nicht ausgetragen. Da das Stadion an der Grünwalder Straße bei Bombenangriffen 1943 zerstört und erst im August 1945 wieder freigegeben wurde, trug der FC Bayern seine Spielediesen Jahren im Dantestadion (1943–1944), auf dem Platz an der Schlierseestraße (1944–1945) und auf dem Sportplatz der Hypobank an der Grünwalder Straße (1945) aus.++Nach Ende des Zweiten Weltkriegs wurden alle deutschen Sportvereine durch den Alliierten Kontrollrat aufgelöst und mussten zur Neugründung eine Lizenz beantragen. Spieler des FC Bayern fanden alsbald wieder zusammen, bestritten am 24. Juni 1945 gegen den FC Wacker München das erste Spiel nach Kriegsende und stiegen im November desselben Jahresden Spielbetrieb der Oberliga Süd ein. Der Neuanfang nach dem Krieg war schwierig, fast jährlich wechselten die Trainer und der sportliche Erfolg hielt sich zunächstGrenzen. Im Juni 1947 kehrte Kurt Landauer aus dem Exil zurück, wurde wenige Wochen später erneut zum 1. Vorsitzenden des Vereins gewählt. Seine vierte und letzte Amtszeit endete 1951.+Die Mitgliederzahlen des Vereines entwickelten sichden Nachkriegsjahren positiv. Bald zählte der FC Bayern erneut mehr als 1000 Mitglieder, auch die Jugendabteilungen erlebten regen Zulauf. 1949 erreichte man nochmals die Qualifikationsspiele zur Deutschen Meisterschaft über einen 3. Tabellenplatzder Oberliga.der Qualifikation traf man auf den FC St. Pauli, verlor aber im Wiederholungsspiel, das bereits am nächsten Tag ausgetragen wurde, mit 0:2. Danach begann eine längere sportliche Talfahrt des Vereins, die sogar im Abstieg gipfelte. 1954/55 stiegen die Bayern zum ersten und einzigen Maleihrer Geschichte aus der damaligen obersten Liga ab. Im Folgejahr gelang allerdings der sofortige Wiederaufstieg.++Einer der wenigen sportlichen Höhepunkte der 40er und 50er Jahre war der Gewinn des DFB-Pokals. Im Jahr des Wiederaufstiegs wollten die Bayern ursprünglich gar nicht am DFB-Pokal teilnehmen. Man wollte schlicht Reisekosten sparen. Doch der neue Trainer Willibald Hahn forderte unbedingt eine Teilnahme und konnte sich am Ende gegen die Vereinsführung durchsetzen. Nachdem im Halbfinale der 1. FC Saarbrücken mit 3:1 bezwungen wurde, wartete im Finale die Fortuna aus Düsseldorf. Das Finale fand am 29. Dezember 1957 im Augsburger Rosenaustadion vor 42.000 Zuschauern statt, darunter rund 12.000 Bayernfans. Am Tage des Spiels gab es starke Schneefälle und der Boden war mit Schnee bedeckt. Dies schien den Bayern, die als Außenseiterdas Spiel gingen, sehr entgegenzukommen. Von Anfang an dominierte der FC Bayern das Geschehen und die Fortuna hatte es nur ihrem Torwart Albert Görtz zu verdanken, dass das Spiel lange Zeit 0:0 stand.der 78. Minute gelang es dem überragenden Rudi Jobst nach dreimaligem Anlauf den Ball im Netz unterzubringen. Nachdem man die restliche Spielzeit unbeschadet überstand, war mit dem Abpfiff der erste DFB-Pokalsiegder Geschichte des FC Bayern erreicht.+Spieldaten des Endspiels um den DFB-Pokal 1957+Nach dem überraschenden Pokalerfolg und dem ersten großen Titel seit 1932 trat wieder die Tristesse der Oberliga ein. Man erreichte nur Platz sieben und es gab neuerlich finanzielle Probleme. Letzteres konnte durch Roland Endler gelöst werden. Der Geschäftsmann aus Neuss, ein großer Fan der Bayern, wurde neuer Präsident und die Finanznöte hatten ein Ende.+Mit dem neuen Trainer Adolf Patek ging es 1958/59 zunächst wieder aufwärts. Mit Platz vier zum Ende der Saison erzielte man das beste Resultat seit zehn Jahren.der darauffolgenden Saison wurden dem FC Bayern wegen einer sogenannten „Überbezahlung“ der Spielerder Saison 57/58 vier Punkte abgezogen. Als ursprüngliches Strafmaß waren acht Punkte Abzug vorgesehen, doch ein Einspruch der Bayern brachte eine Strafmilderung. Der Punktabzug führte dennoch dazu, dass der Verein die Endrunde um die Deutsche Meisterschaft verpasste und am Ende nur auf Platz fünf landete. Einziger Höhepunktder Spielzeit 1960/61 war der Sieg im Derby gegen den TSV 1860 München. Nach einem zwischenzeitlichem 2:2 wurden die Löwen am Ende mit 6:2 aus dem Stadion gefegt. Nach einem nur enttäuschenden 8. Platz im Folgejahr musste Trainer Patek seinen Hut nehmen. Für ihn kam Helmut Schneider.+In der Saison 1962/63 trat der Verein zum ersten Maleinem renommierten internationalen Wettbewerb auf: Im Viertelfinale des Messestädte-Pokals schied man gegen Dinamo Zagreb aus. National ging es für die Bayern darum, sich für die kommende neue Bundesliga zu qualifizieren. Deshalb musste mehr als nur der 8. Platz der Vorsaison herauskommen. Zudem begann am 28. April 1962 eine neue Ära beim FC Bayern. Zunächst nur kommissarisch für ein Jahr übernahm Wilhelm Neudecker das Präsidentenamt des Vereins. Es sollten weit mehr als nur das eine werden. Der neue Präsident ließ nur die Neuverpflichtung eines gestandenen Spielers zu. Dieser war Herbert Erhardt. Ansonsten durfte Trainer Schneider nur junge Talente an die Isar holen. Einer von ihnen war ein gewisser Sepp Maier. Am 30. Dezember 1962 musste Stammtorhüter Kosar im Angriff aushelfen und Sepp Maier gab sein Debüt für den FC Bayern als gerade mal 18-Jähriger. Bayern beendete die Saison auf dem 3. Tabellenplatz hinter dem 1. FC Nürnberg und dem TSV 1860 München. Damit verpasste man nicht nur die Endrunde um die Deutsche Meisterschaft, man erhielt am 11. Mai 1963 auch die Absage vom DFB für die neue Bundesliga. Die fadenscheinige Begründung lautete: „Das Gremium war der Auffassung, dass […] es nicht ratsam erscheint, zwei Vereinen am gleichen Ort eine Lizenz für die Bundesliga zu erteilen.“ Somit musste der FC Bayern 1963/64der neu geschaffenen Regionalliga antreten. Helmut Schneiders Vertrag war eigentlich schon verlängert, dennoch musste er daraufhin den Verein verlassen.+Für ihn kam Zlatko Čajkovski. Das erklärte Saisonziel war das Erreichen der Aufstiegsrunde zur Bundesliga. Dieses Ziel konnte mit einem zweiten Platz am Ende der Saison auch erreicht werden. Am 6. Juni 1964 besiegte man im ersten Spiel der Aufstiegsrunde den FC St. Pauli mit 4:0. Es war das erste Pflichtspiel des damals erst 18 Jahre alten Franz Beckenbauer.[7][8]seinem ersten Spiel für die Bayern gelang ihm auch gleich sein erstes Tor. Beckenbauer hatte sich gegen einen Wechsel zum TSV 1860 München und für den FC Bayern entschieden, nachdem ereinem Spiel seines SC München von 1906 gegen den TSV 1860 von einem Gegenspieler geohrfeigt worden war. Dem FC Bayern fehlte am Ende nur ein Punkt zum Aufstieg und es hieß einen neuen Anlauf zu nehmen. Hatten bereitsden beiden Jahren zuvor Maier und Beckenbauer verpflichtet werden können, fehlte jetzt nur noch ein Baustein als Grundlage für die bald folgenden großen Jahre des FC Bayern München. Im Frühjahr 1964 hatte sich der Präsident des TSV 1860 MünchenNördlingen angesagt, um der Familie Müller einen Besuch abzustatten, um deren Sohn zum TSV zu lotsen. Da auch die Bayern Interesse an dem kleinen bulligen Stürmer hatten und davon Wind bekamen, erschienen sie eine Stunde früherNördlingen. Der TSV bot dem jungen Mann nur einen Amateurvertrag über ein Jahr, der FC Bayern einen Profivertrag. Der spätere „Bomber der Nation“, Gerd Müller, wechselte daher im Sommer zum FC Bayern. Čajkovski war gar nicht begeistert von der Verpflichtung des jungen, gedrungenen Stürmers und sagte: „Was soll isch mit dieses Junge, diese Figur, unmöglich.“ Später nannte er ihn liebevoll „kleines dickes Müller“.[9]+Gleichseinem ersten Spiel am 18. Oktober 1964 traf Müller zum 3:0 gegen den Freiburger FC. Zum Ende der Saison 1964/65 stand man mit einem Rekordtorverhältnis von 146:32 als Meister der Regionalliga Süd fest. Gerd Müller erzielte dabei26 Spielen 33 Tore und trugseiner ersten Saison maßgeblich zur Meisterschaft bei.der Aufstiegsrunde machte man gegen Tennis Borussia Berlin alles klar. Der Verein gewann mit 8:0Berlin und stieg damitdie Bundesliga auf.+Vor der ersten Bundesligasaison der Bayern schimpfte Čajkovski, dass er keine fertigen Spieler habe und zufrieden wäre, wenn man die Klasse halten würde. Doch die Mannschaft sollte ihn Lügen strafen. Die Bayern starteten gleich voll durch. Auch wenn man am ersten Spieltag im Derby gegen den TSV 1860 mit 0:1 als Verlierer vom Platz ging, so standen die Bayern am vierten Spieltag das erste Mal an der Tabellenspitze der Bundesliga. Zwar konnte diese nicht gehalten werden, aber das prestigeträchtige Rückspiel gegen den Lokalrivalen TSV 1860 konnte mit 3:0 gewonnen werden, und am Ende belegte man einen mehr als beachtlichen dritten Tabellenplatz. Es war das einzige Malder Geschichte der Bundesliga, dass beide Teams aus München am Ende einer Saison unter den ersten Drei standen. Platz dreider Liga war den Bayern allerdings längst nicht genug. Es gelang ihnen zum zweiten Malder Vereinsgeschichte den DFB-Pokal zu holen. Nach einem klasse Spiel gegen den Meidericher SV behielten die Bayern mit 4:2 die Oberhand und brachten den Pokal nach Hause. Sepp Maier sagte nach dem Spiel: „Hoaß war’s, gschwitzt hamma, und gwunna a no. Grad sche war’s!“ 1966 kamen damit sowohl der Meister der Bundesliga als auch der Pokalsieger aus München.++In der nächsten Saison, 1966/67, blieb das Team nahezu unverändert. Einzig Franz „Bulle“ Roth kam aus Kaufbeuren hinzu, Georg Schwarzenbeck verstärkte das Team aus dem eigenen Nachwuchs. Nach dem Auftritt im inoffiziellen Messestädte-Pokal spielte der FC Bayern erstmalseinem von der UEFA veranstalteten internationalen Wettbewerb, dem Europapokal der Pokalsieger. Diese Saison des Pokalsiegerwettbewerbs wurde zum ersten großen Triumphzug der Bayern auf europäischer Bühne. Über Tatran Prešov, die Shamrock Rovers, Rapid Wien und Standard Lüttich erreichte der FC Bayern völlig überraschend das Finale, das fast zu einem Heimspiel mutierte, da esNürnberg stattfand. An gleicher Stelle hatten die Bayern schon 35 Jahre zuvor den ersten wichtigen Titel für den Verein gewinnen können.+Vor 71.000 Zuschauern erzielte Bulle Rothder Verlängerung (108. Minute) das 1:0 für die Münchner. Gegner im Finale waren die Glasgow Rangers, die zuvor im Achtelfinale den Titelverteidiger Borussia Dortmund aus dem Wettbewerb geworfen hatten. Roth, der Schütze zum einzigen Tor im Finale, hatte zwei Jahre zuvor nochder C-Klasse beim TSV Bertoldshofen gespielt und erzielte jetzt das entscheidende Tor zum ersten internationalen Titel des FC Bayern München. Nach Borussia Dortmund im Jahr zuvor gewann damit erneut ein deutscher Verein den Pokal der Pokalsieger.+Die reguläre Bundesliga-Saison schloss der FC Bayern zwar nur auf Platz sechs ab, jedoch konnte man den DFB-Pokal erfolgreich verteidigen. Auch dieses Finale fand nicht weit von München entfernt statt.Stuttgart sahen 68.000 Zuschauer den erneuten Pokaltriumph der Bayern. Mit 4:0, durch Tore von Müller (2), Ohlhauser und Brenninger (je 1), hatte der Hamburger SV mit Uwe Seeler keine Chance.++Dies war der dritte Pokalerfolg innerhalb von zwölf Monaten. Franz Beckenbauer wurde das erste Malseiner noch jungen Karriere zum „Fußballer des Jahres“ gewählt. Die darauf folgende Saison 1967/68 war nicht das Jahr der Bayern. Im Halbfinale des Europapokals der Pokalsieger 1967/68 scheiterte man am späteren Sieger AC Mailand, im DFB-Pokal warf der damalige Regionalligist VfL Bochum den Titelverteidiger im Halbfinale aus dem Wettbewerb. Die Bundesliga schloss man nur als Fünfter ab. Viel wichtiger aber war wohl, dass man erstmalsder Geschichte der Bundesliga am Erzrivalen TSV 1860 vorbeizog und zwar sowohlder Tabelle als auchder Gunst der ZuschauerMünchen. War vorher der TSV der größere von beiden Münchner Vereinen, so hat der FC Bayern München ihn jetzt überholt. Und daran änderte sich bis heute nichts.+Tschik Čajkovski verließ 1968 nach fünf erfolgreichen Jahren den Verein Richtung Hannover 96. Für ihn kam Branko Zebec. Mit ihm kamen auch Gustl Starek und Peter Pumm. Beide sollten sichZukunft als tragende Säulen seines Konzepts, das auf eine starke Defensive setzte, erweisen. Sein Rezept ging auf und die Bayern gewannen zum ersten Malder Vereinsgeschichte das Double aus Meisterschaft und Pokal. Gleichzeitig gelang zum ersten Mal seit 1937 wieder einem Verein das Double (damals dem FC Schalke 04). Eben jenen FC Schalke bezwang man im Pokalendspiel mit 2:1. Vor dem Spiel nahm Gerd Müller die Ehrung für den „Fußballer des Jahres“ entgegen und Branko Zebec holteseinem ersten Jahr als Trainer gleich Meisterschaft und Pokal.++Am 13. März 1970 löste Udo Lattek den bisherigen Trainer Zebec ab. Mit der Amtsübernahme Latteks begann für den FC Bayern eine neue, noch erfolgreichere Ära. Unter Lattek brachte der FC Bayern die Saison 1969/70 als Zweiter zu Ende. Gerd Müller wurde zum dritten Male Torschützenkönig der Bundesliga mit der Rekordtorzahl von 38 Toreneiner Saison. Zudem wurde er Torschützenkönig bei der Fußball-WM 1970Mexiko.diesem Sommer beendete der langjährige Kapitän Werner Olk seine aktive Karriere. Meister wurde Borussia Mönchengladbach vor den Bayern. Die Rivalität zwischen diesen beiden Vereinen sollte kennzeichnend für die 70er Jahre werden. Beide holtendieser Zeit insgesamt acht Mal die deutsche Meisterschaft. Auchder Folgesaison blieb den Münchnern erneut nur der zweite Platz hinter der Fohlen-Elf aus Gladbach. Belächelte man anfangs die Verpflichtung Latteks, so wurden die Kritiker doch schon früh eines Besseren belehrt. Udo Lattek war bis dahin ohne große Trainererfahrung, dochseiner ersten vollen Saison als Cheftrainer gewann sein Team den DFB-Pokal und wurde erneut Vizemeister. Vor dem Pokalfinale bekam Gerd Müller wiederum eine Auszeichnung als Torschützenkönig, diesmal jedoch sogar als bester Torschütze Europas. Im Finale gegen den 1. FC Köln lagen die Bayern schon nach 13 Minuten mit 0:1 zurück ehe Beckenbauerder 53. Minute ausgleichen konnte. Dem für Franz Roth eingewechselten Edgar Schneider gelang dannder 118. Minute das Siegtor. Die Bayern hatten damit bereits zum fünften Mal das Pokalfinale erreicht und den DFB-Pokal gewonnen. Noch kein Einziges der Finals ging verloren. Es sollte aber der vorerst letzte Pokaltriumph der Bayern für eine ganze Dekade sein. Nach Olkder Vorsaison verließen nun mit Ohlhauser und Starek zwei weitere Leistungsträger den Verein.+Spieldaten des Endspiels um den DFB-Pokal 1971+Vor Beginn der neuen Spielzeit verpflichtete der Verein zwei neue Spieler, die später noch die Zukunft des FC Bayern maßgebend bestimmen sollten: Uli Hoeneß und Paul Breitner. Beide waren damals gerade 18 Jahre alt. Die Saison 1971/72 wurde für den Verein zum Jahr der Rekorde. Vom ersten Spieltag an blieb man 14 SpieleFolge ohne Niederlage. Am Ende wurde man mit 55 Punkten und 101 erzielten Toren Meister. 40 Tore davon erzielte allein Gerd Müller. Zudem wurde Borussia Dortmund mit 11:1 vom Platz gefegt. Dies alles war noch nie dagewesender noch jungen Geschichte der Bundesliga. Einige der Rekorde haben bis heute Bestand. Am 28. Juni 1972 bestritt der FC Bayern München sein erstes Heimspiel im Olympiastadion. Es war gleichzeitig das letzte Spiel der Saison.einem „Endspiel“ um die Meisterschaft wurde der Tabellenzweite Schalke 04 mit 5:1 geschlagen. Bayern war somit erneut Meister. Die Münchner machten auchder nächsten Saison da weiter, wo sieder Vorsaison aufgehört hatten. Vom ersten bis zum letzten Spieltag hieß der Tabellenführer FC Bayern München und wurde mit elf Punkten Vorsprung Meister vor dem 1. FC Köln. Nun war der FCB bereit für höhere AufgabenEuropa. 1974 verteidigte man zum zweiten Mal hintereinander die Meisterschaft, Gerd Müller wurde zum dritten MalFolge Torschützenkönig der Bundesliga und der FC Bayern München bestieg nun zum ersten Mal „Europas Thron“.+In der ersten Runde des Europapokals der Landesmeister kamen die Bayern dabei erst durch ein Elfmeterschießen im Rückspiel beim schwedischen Meister Åtvidabergs FF eine Runde weiter. Danach kam es zum deutsch-deutschen Duell zwischen dem FC Bayern München und Dynamo Dresden. Zur Halbzeit führte Dynamo mit 3:2München, doch die Münchner konnten das Spiel noch drehen und mit 4:3 gewinnen. Somit hatte Dresden eine gute Ausgangssituation für das Rückspiel. Doch die Roten gingen bereits nach zwölf Minuten durch zwei Tore von Hoeneß mit 2:0Führung. Kurz nach der Halbzeitpause gelang den Sachsen allerdingsder 52. Minute der Ausgleich und vier Minuten später sogar der Führungstreffer zum 3:2. Gerd Müller glich jedochder 56. Minute zum 3:3-Endstand aus. Die nächsten beiden Runden überstand man relativ leicht gegen ZSKA Sofia und Újpest Budapest und stand im Finale Atlético Madrid gegenüber. Es war kein herausragendes Spiel und die Konsequenz war ein 0:0 nach 90 Minuten. Sechs Minuten vor Ende der Verlängerung gelang Luis Aragonés das 1:0 für Madrid durch einen Freistoß. Der Schiedsrichter hatte die Pfeife schon im Mund, als Georg „Katsche“ Schwarzenbeck den Ball von Beckenbauer zugespielt bekam. Er sah keine Anspielstation im Mittelfeld, Beckenbauer rief nur „Schieß einfach!“ und so hielt er aus 30 Metern einfach aufs Tor: 1:1der 119. Minute. Schwarzenbeck ging mit diesem Tordie Geschichte des Fußballs ein.+Das 1:1 bedeutete nach damaligen Regeln ein Wiederholungsspiel, das nur zwei Tage später an gleicher Stelle stattfinden sollte.diesem Spiel behielten die Münchner klar die Oberhand und schlugen Atlético mit 4:0. Zum ersten Mal gewann eine deutsche Mannschaft den Pokal der Landesmeister.++1974 verließ Paul Breitner den FC BayernRichtung Real Madrid und es kamen zwei neue Spieler, Klaus Wunder vom MSV Duisburg und ein erst 18-jähriger Stürmer namens Karl-Heinz Rummenigge aus Lippstadt. Rummenigge und Breitner sollten Jahre später als Breitnigge für Furore sorgen. Zunächst aber schied man als beste Mannschaft Europas gegen den MSV Duisburg bereitsder dritten Hauptrunde des DFB-Pokals aus.der Liga erreichte man nur den zehnten Tabellenplatz. Da esder Liga nicht lief, kam es zur Winterpause zu einem Krisengespräch zwischen Lattek und Präsident Neudecker. Lattek schilderte das Gespräch später so: „Herr Neudecker, wir müssen etwas ändern.“ worauf Neudecker mit „Sie haben recht. Sie sind gefeuert.“ antwortete. Neuer Trainer wurde Dettmar Cramer.+Mit Cramer konnte zwar auch nicht die Bundesligasaison gerettet werden, aber passend zum 75- jährigen Vereinsjubiläum gewann der FC Bayern erneut den Pokal der Landesmeister. Über den 1. FC Magdeburg, Ararat Eriwan und den AS Saint-Étienne konnte erneut das Finale erreicht werden. Auf den 1. FC Magdeburg hätte man bereits ein paar Tage früher im Europäischen Supercup treffen können, da Magdeburg den Pokal der Pokalsieger 1974 im Mai gegen den AC Mailand gewonnen hatte. Für den Supercup konnte man sich jedoch auf keinen Termin einigen, so dass das Aufeinandertreffen im Pokal der Landesmeister zusätzlich zum Supercup-Ersatz geriet. Ebenso wie im Jahr zuvor gegen Dynamo Dresden tat man sich auch gegen die Magdeburger schwer, kam aber letzten Endes doch eine Runde weiter.Paris, wo das Finale stattfand, setzten sich die Münchner klar mit 2:0 gegen Leeds United durch.+Spieldaten des Endspiels um den Pokal der Landesmeister 1975+1975/76 lief es zunächst auch unter Cramer nicht besserder Bundesliga. Zur Winterpause belegte man nur Platz zehn. Die Spiele um den UEFA Super Cup gegen Dynamo Kiew verlor man ebenfalls. Doch nach der Winterpause lief es besser und der Verein belegte am Ende den dritten Tabellenplatz. Im DFB-Pokal kamen die Bayern bisHalbfinale, wo man am Hamburger SV scheiterte. Nach Jeunesse Esch, Malmö FF und Benfica Lissabon standen die Bayern im Halbfinale des Pokals der Landesmeister Real Madrid gegenüber. Das Rückspiel im Olympiastadion war restlos ausverkauft, wollte man doch auch Paul Breitner und Günter NetzerDiensten von Real sehen. Nach einem 1:1 im Hinspiel gewann man mit zwei Toren von Gerd Müller 2:0 und zog zum dritten MalFolge ins Finale ein. Dort trafen die Münchner auf den AS Saint-Étienne. Franz Roth zeichnete sich schon wie im Vorjahr als Torschütze im Finale aus, diesmal jedoch gleich als Goldtorschütze: Sein 1:0der 57. Minute war das Einzigeder gesamten Partie und zum dritten Mal war der FC Bayern Gewinner des Landesmeisterpokals. Dieses war zuvor nur den Königlichen aus Madrid (fünf MalFolge) und Ajax Amsterdam von 1971 bis 1973 gelungen.+Nach den Jahren der internationalen Triumphe befand sich die Mannschaft im Umbruch. Einer der letzten großen Höhepunkte war der Gewinn des Weltpokals. Als erste deutsche Mannschaft holte man den Pokal gegen Cruzeiro Belo Horizonte, während man den Supercup erneut verlor, diesmal gegen den RSC Anderlecht. Franz Beckenbauer wurde zum Fußballer Europas gewählt und verließ zum Ende der Saison den FC BayernRichtung Cosmos New York.der Liga wurde man nur Zwölfter und erlebte eine der bittersten Heimpleiten der Geschichte, als man mit 0:7 gegen den FC Schalke 04 verlor. 65 Gegentoreeiner Spielzeit bedeuten den absoluten Negativrekord für die Münchner.+Im Dezember 1977 machte der Verein ein Tauschgeschäft mit Eintracht Frankfurt. Cramer wechselte im Tausch für Trainer Gyula Lóránt an den Main. Bayern wurde nur Tabellenzwölfter, die schlechteste Platzierung der Bundesligageschichte des FC Bayern. Zum Ende der Saison kam Paul Breitner zurück. Für 1,75 Millionen Mark wechselte er von Eintracht Braunschweig zurück an die Isar. Gyula Lóránt wurde bereits im Dezember 1978 beurlaubt und sein bisheriger Co-Trainer Pál Csernai übernahm das Amt des Trainers. Als Nachfolger war Max Merkel im Gespräch, doch die Mannschaft sprach sich gegen ihn aus. Gerd Müller folgte Franz Beckenbauer 1979die USA, Uli Hoeneß wechselte nach Nürnberg und der langjährige Präsident Neudecker trat nach 17 Jahren Amtszeit ab; neuer Präsident wurde Hoffmann. Einziger Lichtblickden unruhigen Zeiten war das neugeschaffene Duo Rummenigge und Breitner, auch Breitnigge genannt. Alleine 26 der erzielten 69 Tore gingen auf das Konto der beiden. Im April 1979 kehrte Uli Hoeneß zum FC Bayern zurück und wurde, obwohl gerade erst 27 Jahre alt, Manager des Vereins.++Im Juli 1979 erreichte den Verein die nächste Hiobsbotschaft. Sepp Maier verletzte sich nach einem Autounfall so schwer, dass die Katze von Anzing, wie er auch genannt wurde, seine Karriere frühzeitig beenden musste. Mit 35 Jahren hatte er 473 Bundesligaspiele bestritten, alle für den FC Bayern, davon 442 Spiele in Folge. Maiers Nachfolger wurde Walter Junghans. Auch der letzte Große der 70er-Ära musste seine Karriere frühzeitig beenden. Katsche Schwarzenbeck bestritt am 18. August 1979 sein letztes Bundesligaspiel gegen den FC Schalke 04. Er zog sich eine Achillessehnenverletzung zu, die ihn zwang, seine Karriere zu beenden. Schwarzenbeck bestritt 416 Bundesligaspiele für die Bayern, in denen er 16 Tore erzielte. Andere rückten dafür ins Rampenlicht beim FC Bayern. Klaus Augenthaler, inzwischen Stammspieler, Dieter Hoeneß, der vom VfB Stuttgart an die Isar kam und natürlich Karl-Heinz Rummenigge. Letzterer wurde 1979 zum Fußballer Europas gewählt.+Im DFB-Pokal schied man blamablerweise gegen die SpVgg Bayreuth schon in der dritten Hauptrunde aus. Als Vierter des Vorjahres in der Bundesliga startete man im UEFA-Pokal, erreichte dort das Halbfinale und unterlag dort abermals im deutsch-deutschen Duell der Eintracht aus Frankfurt trotz eines 2:0 im Hinspiel. Bereits im Jahr zuvor war man im Achtelfinale des UEFA-Pokals gegen Eintracht Frankfurt ausgeschieden. In der Rückrunde der Bundesliga lieferten sich die Bayern ein Kopf-an-Kopf-Rennen mit dem HSV. Erst am letzten Spieltag kam es zur Entscheidung über die Meisterschaft. Bayern München gewann zu Hause im Olympiastadion mit 2:1 durch Tore von Breitner und Rummenigge. Seit dem Gewinn des Weltpokals 1976 konnte nun der erste Titel für die Bayern und zugleich die erste Meisterschaft seit sechs Jahren gefeiert werden. Der Umbruch, eingeleitet 1977/78, war abgeschlossen und die Bayern fanden in die Erfolgsspur zurück.+1980/81 konnte der FC Bayern München erstmals wieder seinen Meistertitel verteidigen, wobei das Duo Breitnigge insgesamt 46 Tore erzielte. Im Pokal der Landesmeister gelangte man bis ins Halbfinale und eliminierte dabei u. a. Ajax Amsterdam. Auch im Halbfinale verlor man kein Spiel gegen den FC Liverpool, musste aber wegen der Auswärtstorregel nach dem 1:1 im Rückspiel in München die Segel streichen. Die Reds aus Liverpool holten im Finale ihren dritten Pokal der Landesmeister. In der dritten Hauptrunde des DFB-Pokals war erneut Endstation. Diesmal war es der 1. FC Kaiserslautern, der die Bayern früh stoppte.+Doch im folgenden Jahr holte der Verein elf Jahre nach dem letzten Sieg zum sechsten Mal den Pokal an die Isar. Das Finale im Frankfurter Waldstadion war eines der außergewöhnlichsten in der Geschichte dieses Wettbewerbs, denn Dieter Hoeneß spielte es trotz einer Kopfverletzung, die er sich im Spiel zuzog, mit Kopfverband zu Ende. Die Bayern lagen zur Halbzeit bereits mit 0:2 gegen den Erzrivalen aus Franken, dem 1. FC Nürnberg, zurück. Nach einem Kopfballduell mit Alois Reinhardt zog sich Hoeneß die schwere Kopfverletzung zu, die zunächst nur notdürftig verbunden wurde. In der Halbzeitpause redete sein Bruder Uli ihm zu, er solle die Zähne zusammenbeißen, denn man würde ihn brauchen. Daraufhin ließ Dieter Hoeneß die Wunde ohne Narkose nähen und erschien zur zweiten Halbzeit wieder auf dem Rasen. Der FC Bayern drehte das Spiel noch und Dieter Hoeneß gelang dabei sogar in der 89. Minute das entscheidende Tor zum 4:2 per Kopf. Auch im Europapokal war man wieder erfolgreicher und gelangte ins Finale des Pokals der Landesmeister, unterlag dort jedoch Aston Villa mit 0:1 trotz einer klaren Dominanz im Spielverlauf. In der Meisterschaft machten der HSV und der 1. FC Köln den Titel unter sich aus. Es blieb nur der 3. Platz für die Münchner, nachdem man am Bökelberg gegen Gladbach mit 0:3 unterlag.+Spieldaten des Endspiels um den DFB-Pokal 1982 und des Endspiels um den Europapokal der Landesmeister 1982+Im Juli 1983 kehrte Udo Lattek als Trainer nach München zurück. Pal Csernai wurde drei Spieltage vor Ablauf der Saison 1982/83 wegen Erfolglosigkeit entlassen. Der FC Bayern konnte diesmal keinen Titel holen und kam auch in kein Finale. So scheiterte man im Pokal der Pokalsieger an der Mannschaft von Alex Ferguson, dem FC Aberdeen, der später auch den Titel holte. In der Bundesliga belegte man nur Platz vier. Zum Saisonende beendete mit Paul Breitner erneut einer der Großen seine Karriere. Mit Jean-Marie Pfaff wurde jedoch auch schon ein neuer Publikumsliebling verpflichtet. Am 33. Spieltag gegen Schalke gab Michael Rummenigge, der Bruder von Karl-Heinz, seinen Einstand bei den Bayern. Unter Lattek folgten nun erneut sehr erfolgreiche Jahre. Die Mannschaft erreichte unter seiner Leitung dreimal hintereinander das Pokalfinale und musste sich nur 1985 Bayer Uerdingen geschlagen geben. Das Finale 1984 gegen Borussia Mönchengladbach musste im Elfmeterschießen entschieden werden. Ausgerechnet Lothar Matthäus, der zur folgenden Spielzeit an die Isar wechselte, verschoss den ersten Elfmeter für Gladbach.+Spieldaten des Endspiels um den DFB-Pokal 1984; Spieldaten des Endspiels um den DFB-Pokal 1985 und Spieldaten des Endspiels um den DFB-Pokal 1986+Erreichten die Bayern 1985 noch das Halbfinale des Europapokals der Pokalsieger, standen sie 1987 wieder im Finale des Pokals der Landesmeister. Dort traf man in Wien auf den FC Porto, der als Außenseiter in die Partie ging. Bis zur 78. Minute führten die Bayern mit 1:0 durch ein Tor von Ludwig Kögl, ehe Rabah Madjer durch ein sensationelles Hackentricktor der Ausgleich gelang. Nur zwei Minuten später folgte das 2:1 des FC Porto und der FC Bayern verpasste erneut die Chance auf den Gewinn des Europapokals der Landesmeister. Die Meisterschaft konnte man in den Jahren 1985 bis 1987 drei Mal in Folge gewinnen. Mit dem Gewinn der Meisterschaft 1986 löste man den 1. FC Nürnberg als Rekordmeister Deutschlands ab, wobei den Bayern in der Saison 1984/85 das seltene Kunststück gelang, vom ersten bis zum letzten Spieltag Tabellenführer der Bundesliga zu sein. Udo Lattek nahm zum Ende der Saison 1986/87 seinen Hut und verabschiedete sich zum letzten Male von den Bayern. In seinen zwei Amtszeiten als Trainer des FC Bayern München gewann er insgesamt sechs Meisterschaften, dreimal den DFB-Pokal und einmal den Landesmeisterpokal.+Spieldaten des Endspiels um den Europapokal der Landesmeister 1987+Auf Udo Lattek folgte Jupp Heynckes als Trainer bei den Bayern. In seiner ersten Saison als verantwortlicher Trainer sprang am Ende Platz zwei hinter Werder Bremen heraus. Es folgte erneut ein Umbruch in der Mannschaft, wobei fünf Nationalspieler den Verein verließen. Matthäus und Brehme gingen zu Inter Mailand und Jean-Marie Pfaff verließ den Verein in Richtung Lierse SK. Immerhin 156 Bundesligaspiele hatte Pfaff für die Bayern absolviert. Nachfolger von Pfaff wurde der damals 25-jährige Raimond Aumann. Neu verpflichtet wurden dafür u. a. Stefan Reuter, Olaf Thon und Roland Grahammer. So klappte es dann für Heynckes mit der Meisterschaft im zweiten Anlauf und Roland Wohlfarth wurde mit 17 Treffern Torschützenkönig der Bundesliga. Im DFB-Pokal war man dagegen nicht so erfolgreich und schied bereits in der dritten Runde gegen den Karlsruher SC aus. Im UEFA-Pokal erreichte man immerhin das Halbfinale. Dort scheiterten die Münchner am späteren Pokalsieger SSC Neapel mit dem damaligen Weltstar Diego Armando Maradona. In besserer Erinnerung aus jener Europapokalsaison 1988/89 dürfte jedoch das Achtelfinalrückspiel bei Inter Mailand sein. Nach einem 0:2 im Hinspiel schafften die Bayern das „Wunder von Mailand“ und gewannen das Rückspiel mit 3:1. Ebenfalls legendär war der Auftritt von Trainer Christoph Daum zusammen mit Bayern-Trainer Heynckes im ZDF-Sportstudio. Dabei kam es zum Eklat, als Daum meinte, dass eine Wetterkarte interessanter sei als ein Gespräch mit Heynckes und sich hinterher noch an seine Stirn tippte. Die Person Daum sollte den FC Bayern noch lange begleiten.++Für die Saison 1989/90, die ähnlich verlief wie die vorherige Saison, kamen sieben neue Spieler hinzu. Der Meistertitel wurde erfolgreich verteidigt, im DFB-Pokal schied der FC Bayern im Achtelfinale beim VfB Stuttgart aus und im Europapokal der Landesmeister wurde das Halbfinale erreicht, wo man am AC Mailand scheiterte. Das „Tor des Jahrzehnts“ gelang Klaus Augenthaler als er im Pokalspiel bei Eintracht Frankfurt aus 48,90 Metern das entscheidende 1:0 erzielte. Mit Augenthaler, Kohler, Pflügler, Reuter, Thon und Aumann fuhren gleich sechs Bayernspieler zur WM 1990 und kamen als Weltmeister zurück.+Die 90er Jahre begannen für die Bayern wie die 80er Jahre endeten. Mit dem Halbfinale im Pokal der Landesmeister erreichte der Verein zum dritten Mal in Folge die Runde der letzten Vier in einem Europapokalwettbewerb. Dies gelang zuletzt fast zehn Jahre zuvor, von 1980 bis 1982. Nach dem SSC Neapel und dem AC Mailand in den Jahren zuvor war diesmal Roter Stern Belgrad Endstation. Dabei schied die Mannschaft knapp und unglücklich aus. Bis zur 90. Minute des Rückspiels führte man mit 2:1 und wäre somit in der Verlängerung gewesen. Doch einen Flatterball von Klaus Augenthaler auf das eigene Tor vermochte Raimond Aumann nicht festzuhalten und mit einem 2:2 zog Roter Stern ins Finale ein. Im DFB-Pokal setzte es ein peinliches 0:1 in der ersten Runde bei den Amateuren vom FV 09 Weinheim, in der Liga wurde man Vizemeister hinter dem 1. FC Kaiserslautern.+Zur neuen Saison wechselten Kohler und Reuter zu Juventus Turin. Allein für Kohler erhielten die Bayern rund 15 Millionen Mark an Ablöse,[10] doch die Ablöse konnte den Verlust von Kohler nicht wettmachen. Thomas Berthold wurde vom AS Rom verpflichtet, konnte ihn aber nicht ersetzen. Klaus Augenthaler hatte zudem seine Karriere beendet, in der er 404 Bundesligaspiele für den FC Bayern absolvierte und siebenmal Meister und dreimal Pokalsieger wurde.[11] Raimond Aumann und Brian Laudrup erlitten beide einen Kreuzbandriss. Die Mannschaft bestand nur noch aus einem Gerippe. Für Aumann und den ebenfalls ausgefallenen Ersatztorwart Sven Scheuer wurde kurzfristig Toni Schumacher verpflichtet, der in acht Bundesligaspielen vor der Winterpause 91/92 für die etatmäßige Nummer 1 das Bayerntor hütete.+Nach dem Zweitrundenaus im Pokal gegen den FC Homburg und einer 1:4-Heimniederlage gegen die Stuttgarter Kickers war der Druck der Öffentlichkeit so groß, dass der Verein Jupp Heynckes am 8. Oktober 1991 entließ. Laut Raimond Aumann hatten die Spieler Tränen in den Augen, als sich Heynckes von ihnen verabschiedete.[12] Uli Hoeneß, der mit Jupp Heynckes befreundet ist und die Entscheidung der Entlassung mitgetragen hatte, sagte Jahre später mehrmals, dass es seine größte Fehlentscheidung gewesen sei.[13]+Betrachtet man die vier Jahre unter Heynckes mit zwei Vizemeisterschaften, zwei Meisterschaften und dem dreimaligen Erreichen des Halbfinals im Europapokal, kann man sicher von einer erfolgreichen Trainerära sprechen. Der öffentliche Druck, der letzten Endes zur Entlassung Jupp Heynckes führte, deutete bereits damals auf die gestiegenen Ansprüche des Vereins, der Fans und der Medien in München hin. Eine Dekade später sollten Trainer trotz zweier Doubles entlassen werden.+Nachfolger von Heynckes wurde Søren Lerby, der von 1983 bis 1986 89 Spiele für den FC Bayern absolviert hatte. Doch auch Lerby vermochte das Ruder nicht herumzureißen und so setzte es im Europapokal sogar eine der deftigsten Niederlagen in der Vereinsgeschichte. In der 2. Runde des UEFA-Pokals wurden die Bayern von B 1903 Kopenhagen mit 6:2 deklassiert. Am Ende belegten die Bayern nur Platz zehn in der Bundesliga und qualifizierten sich das erste Mal seit 1979 nicht für einen internationalen Wettbewerb. Im März 1992 wurde Erich Ribbeck als neuer Trainer und Nachfolger von Lerby verpflichtet. Zudem investierte der Verein im Sommer insgesamt 23,5 Millionen Mark in neue Spieler, für damalige Verhältnisse eine unglaubliche Summe. Allerdings verließen Stefan Effenberg und Brian Laudrup den Verein für 17 Millionen gemeinsam zum AC Florenz. Lothar Matthäus kehrte im Gegenzug nach vier Jahren in Italien an die Isar zurück. Dazu kamen Spieler wie Thomas Helmer, Mehmet Scholl und Jorginho. 32 Spieltage blieb der FC Bayern auf Platz eins der Tabelle und wurde am Ende doch nur Zweiter hinter Werder Bremen.+1994 holten die Münchner endlich den 13. Meistertitel. Zuvor war in der Winterpause Trainer Ribbeck entlassen worden und der damalige Vizepräsident Franz Beckenbauer übernahm zum ersten Mal den Trainerposten bei seinen Bayern.+Zur neuen Spielzeit 1994/1995 wurde Giovanni Trapattoni als Trainer verpflichtet, der jedoch nur ein Jahr an der Isar blieb. Die Sprachprobleme waren zu groß. Als neuer Torhüter stieß Oliver Kahn zu den Bayern, der später zu einer Ikone in München werden sollte. Im Herbst 1994 löste Franz Beckenbauer den seit 1985 amtierenden Fritz Scherer als Präsidenten des Gesamtvereins ab. In der Meisterschaft wurde der FC Bayern nur Sechster, doch konnte unter dem „Mister“ Trapattoni immerhin das Halbfinale des zwischenzeitlich in UEFA Champions League umbenannten Landesmeisterpokals erreicht werden, wo man gegen den späteren Gewinner Ajax Amsterdam allerdings chancenlos war. Wie schon 1990 leistete man sich im DFB-Pokal einen blamablen Ausrutscher in Runde eins. Diesmal hieß der Gegner Vestenbergsgreuth, gegen den man in Nürnberg mit 0:1 unterlag. Durch den Pokalsieg von Borussia Mönchengladbach gelangte der FC Bayern trotz des sechsten Tabellenplatzes doch noch ins internationale Geschäft und konnte in der Folgesaison am UEFA-Pokal teilnehmen. Franz Beckenbauer bezeichnete darauf hin den Wettbewerb als „Cup der Verlierer“.+Mit Otto Rehhagel kam in der Folgesaison ein renommierter Trainer an die Isar, der zuvor 14 Jahre lang den SV Werder Bremen trainiert hatte. Doch trotz Platz zwei in der Liga und des Einzugs ins Endspiel des UEFA-Pokals musste Rehhagel am 27. April 1996 seinen Posten räumen. Franz Beckenbauer nahm erneut Platz auf der Bank, doch es blieb in der Bundesliga beim zweiten Platz hinter Borussia Dortmund. Er gewann jedoch die beiden UEFA-Pokal-Endspiele gegen Girondins Bordeaux. Beckenbauer hatte damit den Europapokal der Pokalsieger, den Pokal der Landesmeister, den Weltpokal, die Europa- und die Weltmeisterschaft als Spieler und die WM und den UEFA-Pokal als Trainer gewonnen. Einzig den europäischen Supercup gewann er nie. Jürgen Klinsmann, der vor der Saison von den Tottenham Hotspurs nach München gewechselt war, stellte in dieser UEFA-Pokal-Saison mit 15 Turniertreffern einen neuen Rekord auf.[14]++Zur neuen Saison kehrte Giovanni Trapattoni an die Isar zurück und wurde mit dem FC Bayern Deutscher Meister der Saison 96/97. Es war sein erster Titel außerhalb Italiens. 1998 holte er mit den Bayern den DFB-Pokal gegen den MSV Duisburg. Der DFB-Pokalsieg 1998 war zugleich der erste Pokalsieg des Vereins seit nunmehr zwölf Jahren. Nach diesem Erfolg verließ der Italiener die Münchner zum zweiten Mal. Unvergessen blieb dabei seine bekannte Wutrede nach einem 0:1 gegen Schalke am 10. März 1998 in einer Pressekonferenz.+Spieldaten des DFB-Pokal Endspiels 1998+1998 kam der Meistermacher der Dortmunder Borussia, Ottmar Hitzfeld, als Trapattoni-Nachfolger nach München. Mit Hitzfeld kehrte auch Stefan Effenberg an die Isar zurück, der bereits von 1990 bis 1992 für den FC Bayern gespielt hatte. Er wurde in den nächsten Jahren zu Hitzfelds verlängertem Arm in der Mannschaft. Unter dem neuen Trainer wurde man auf Anhieb Meister. Dabei hatte man am Ende 15 Punkte Vorsprung auf den Vizemeister Bayer Leverkusen und das Triple schien möglich.+Die Meisterschaft bereits gesichert, stand man am 26. Mai 1999 im Champions-League-Finale in Barcelona der Mannschaft von Manchester United gegenüber, gegen die man in der Gruppenphase zweimal Unentschieden gespielt hatte. Bereits in der 6. Minute gingen die Bayern durch ein Tor von Mario Basler mit 1:0 in Führung. Der FC Bayern war auch im weiteren Verlauf des Spiels überlegen und hätte sowohl durch Mehmet Scholl als auch Carsten Jancker die Führung weiter ausbauen können. Beide trafen jedoch nur den Torpfosten beziehungsweise die Latte. In der 80. Minute ließ sich Lothar Matthäus, bis dahin einer der besten Spieler auf dem Platz, auf eigenen Wunsch auswechseln. Die Mannschaft hielt bis zur Nachspielzeit das 1:0, jedoch gelang es Manchester durch Tore von Sheringham und Solskjær das Spiel innerhalb von zwei Minuten noch in der Nachspielzeit zu drehen. Dieses Champions-League-Finale ging als eines der denkwürdigsten in die Geschichte ein und noch heute wird über die Auswechslung von Matthäus kontrovers diskutiert.+Zweieinhalb Wochen später war Matthäus erneut die tragische Figur, als es im DFB-Pokal-Endspiel gegen Werder Bremen nach Verlängerung 1:1 stand und das Elfmeterschießen entscheiden musste. Den letzten Elfmeter schoss Matthäus, doch Werder-Torwart Rost hielt und somit ging dieses Elfmeterschießen mit 4:5 verloren. Es war das erste Mal, dass der FC Bayern gleich zwei Endspiele in einer Saison verlor. Dies sollte sich in der Saison 2011/12 jedoch in zeitlich umgekehrter Reihenfolge wiederholen.+Spieldaten des DFB-Pokal-Endspiels 1999 und Spieldaten des Champions-League-Endspiels 1999+Wie fast jedes Jahr gab es auch zur Saison 1999/2000 Neuzugänge und Veränderungen beim FC Bayern. So kamen der damals 17-jährige Roque Santa Cruz, Patrik Andersson und Paulo Sérgio neu zum Verein, Thomas Helmer, Ali Daei und später Mario Basler verließen ihn. Die Saison verlief durchaus erfolgreich. Bayern wurde zum 16. Mal Meister, gewann zum 10. Mal den DFB-Pokal (in einer Neuauflage des letztjährigen Endspiels wurde Werder Bremen mit 3:0 besiegt) und erreichte das Halbfinale der Champions League, wo man gegen Real Madrid ausschied, gegen die man in der Gruppenphase noch zweimal gewinnen konnte. Zudem feierte der Verein im Frühjahr 2000 sein 100-jähriges Vereinsjubiläum. Zu diesem Anlass wurde ein Einladungsturnier mit Real Madrid, Manchester United und Galatasaray Istanbul ausgetragen, das der FC Bayern gewinnen konnte.+Die Entscheidung in der Meisterschaft fiel erst am letzten Spieltag. Seit dem 30. Spieltag der Saison hatte Bayer 04 Leverkusen die Tabelle der Bundesliga angeführt. Nach dem 33. Spieltag betrug der Vorsprung drei Punkte. Ein Unentschieden bei der SpVgg Unterhaching hätte der Elf um Trainer Christoph Daum für den ersten Titelgewinn selbst bei einem Sieg der Bayern gegen Werder Bremen gereicht. Doch es kam anders. Bayern erledigte seine Aufgabe zu Hause und gewann mit 3:1. Gleichzeitig gelang es nur wenige Kilometer entfernt den Leverkusenern nicht, den einen Punkt unter Dach und Fach zu bringen. Leverkusen verlor mit 0:2 beim Aufsteiger aus dem Vorort Münchens – Michael Ballack schoss dabei ein Eigentor zum 0:1 – und die Meisterschaft ging an den FC Bayern.++In der Saison 2000/01 gelang es dem FC Bayern, den Titel in der Bundesliga zu verteidigen; im DFB-Pokal scheiterte man bereits in der zweiten Runde im Elfmeterschießen beim 1. FC Magdeburg. Dafür gelang es 25 Jahre nach dem letzten Sieg im Europapokal der Landesmeister und zwei Jahre nach dem dramatischen Endspiel in Barcelona, diesen Pokal zum vierten Mal zu gewinnen.+Als Initialzündung für diesen Erfolg gilt das vorletzte Spiel der zweiten Gruppenphase bei Olympique Lyon. Der FC Bayern hatte nach einer schwachen Leistung mit 0:3 verloren, was Präsident Franz Beckenbauer beim Mitternachtsbankett zu einer berühmt gewordenen Wutrede („Uwe-Seeler-Traditionsmannschaft“) veranlasste. Die Rede zeigte Wirkung, die folgenden fünf Champions-League-Spiele (gegen Arsenal London, Manchester United und Real Madrid) wurden allesamt gewonnen und so stand man schließlich im Finale der Champions League, das man im Mailänder San Siro mit 5:4 im Elfmeterschießen gegen den FC Valencia gewann. Der Held der Partie war wieder einmal Torhüter Oliver Kahn, der drei Elfmeter parierte. Kahn hatte zuvor im Laufe der Saison schon häufig geglänzt, besonders im Halbfinalhinspiel gegen Real Madrid im Santiago Bernabéu.+Einige Tage zuvor war es in der Bundesliga zum Duell um die Meisterschaft gekommen. Bis zum 33. Spieltag war der FC Schalke 04 Tabellenführer. Dann verloren die Knappen ihr Spiel beim VfB Stuttgart durch ein Tor in der 90. Minute mit 0:1. Nur wenige Sekunden später erzielte Alexander Zickler den 2:1-Siegtreffer für den FC Bayern gegen den 1. FC Kaiserslautern. Schalke musste am 34. Spieltag gegen Unterhaching unbedingt gewinnen und auf eine Niederlage der Münchner im Hamburg hoffen, um doch noch Meister zu werden. Der FC Schalke gewann sein Spiel mit 5:3. Zeitgleich blieb die Partie in Hamburg lange torlos, doch in der 90. Minute ging der HSV durch einen Kopfball von Sergej Barbarez mit 1:0 in Führung.+Nach Gelsenkirchen, wo Schalkes Spiel bereits abgepfiffen war, drang die Nachricht, dass das Spiel in Hamburg aus sei und Bayern verloren habe, jedoch wurden im Parkstadion plötzlich Live-Bilder aus Hamburg auf der Anzeigetafel gezeigt. Dort war zu sehen, wie es für die von Oliver Kahn nach vorne gepeitschten Bayern in der dritten Minute der Nachspielzeit einen indirekten Freistoß im HSV-Strafraum gab, da der Torwart des HSV, Mathias Schober, einen Rückpass mit den Händen aufgenommen hatte. Stefan Effenberg nahm sich des Freistoßes an, legte den Ball auf Patrik Andersson vor und dieser schoss den Ball durch die Mauer ins Tor zum 1:1-Endstand. Somit wurde Bayern in der wohl dramatischsten Entscheidung der Bundesligageschichte erneut Meister; Torschütze Andersson verließ Bayern nach Ende der Saison zum FC Barcelona.+Die Saison 2001/02 verlief zunächst weniger erfolgreich. Schon die ersten Entscheidungen konnte der FC Bayern nicht für sich entscheiden. Man verlor im Ligapokal und im europäischen Supercup in Monaco mit 2:3 gegen den FC Liverpool. Am 27. November 2001 wurde in Tokio mit einem 1:0 nach Verlängerung gegen die Boca Juniors zum zweiten Mal nach 1976 der Weltpokal gewonnen. Schütze des Siegtores war Samuel Kuffour. Dies sollte jedoch der einzige Titel der Saison bleiben. In der Bundesliga erreichte man hinter Borussia Dortmund und Bayer Leverkusen nur Platz drei, in der Champions League war im Viertelfinale gegen Real Madrid und im DFB-Pokal im Halbfinale bei Schalke 04 Schluss.++Für Stefan Effenberg, der die Bayern am Ende der letzten Saison verlassen hatte, wurde Michael Ballack verpflichtet, der in der abgelaufenen Saison mit Leverkusen jeweils den zweiten Platz in der Bundesliga, im DFB-Pokal und in der Champions League erreichte. Zudem wechselte dessen Mannschaftskollege Zé Roberto zu den Bayern. Ein weiterer Neuzugang war Sebastian Deisler, der allerdings nach einer Verletzung gleich zu Beginn für lange Zeit ausfiel.+In der Champions-League-Saison 2002/03 konnten die Bayern aus sechs Spielen nur zwei Punkte durch die beiden Unentschieden gegen den RC Lens erringen. Gegen AC Mailand und Deportivo La Coruña setzte es je zwei Niederlagen. Besonders ein Spieler erwies sich dabei für Deportivo als sicherer Schütze und bezwang Oliver Kahn in zwei Spielen vier Mal: Roy Makaay. Im Sommer 2003 wechselte dieser dann für die damalige Rekordsumme von 18,7 Millionen Euro zum FC Bayern München.+Die Saison verlief national jedoch erfolgreich und in der Bundesliga erreichte Bayern am Ende einen Vorsprung von 16 Punkten auf den zweitplatzierten VfB Stuttgart. Zudem gelang erneut der Sieg im DFB-Pokal. Mit 3:1 besiegte man im Finale den 1. FC Kaiserslautern und erreichte so erneut das Double. In der Saison gab Bastian Schweinsteiger seinen Einstand bei den Profis des FC Bayern beim Champions-League-Heimspiel gegen den RC Lens.+Im Frühjahr 2003 kam mit der Kirch-Affäre der wohl größte Skandal der Vereinsgeschichte ans Licht.+Spieldaten des Endspiels um den DFB-Pokal 2003+Saison 2003/04 [Bearbeiten]+Vor der Saison 2003/04 wechselte Martín Demichelis von River Plate Buenos Aires zum FC Bayern. In dieser Saison waren die Münchner gegen den blendend aufspielenden, späteren Meister Werder Bremen mit einem starken Ailton jedoch nicht in der Lage, den Titel zu verteidigen. So blieb am Ende als Zweiter immer noch die direkte Qualifikation zur Champions League im darauf folgenden Jahr. 2003/04 reichte es dort nur zum Achtelfinale, in dem man wie zwei Jahre zuvor gegen Real Madrid ausschied. Im DFB-Pokal war im Viertelfinale bei Alemannia Aachen Endstation. Zum Ende der Saison löste der FC Bayern den Vertrag mit Trainer Hitzfeld, der noch bis Mitte 2005 datiert war, vorzeitig auf.+Saison 2004/05 [Bearbeiten]+Für Hitzfeld kam in der Folgesaison Felix Magath vom VfB Stuttgart. Mit ihm kam der an die Schwaben ausgeliehene Philipp Lahm zurück an die Säbener Straße. Zudem gelang es den Bayern, Lúcio von Bayer Leverkusen für die neue Saison zu verpflichten.+Der neue Trainer hatte auf Anhieb Erfolg mit den Bayern. So gelang es 2004/05 erneut, das Double zu holen. In der Bundesliga zog man zum Ende der zweiten Saisonhälfte einsam seine Kreise und hatte zum Schluss 77 Punkte auf dem Konto und 14 Punkte Vorsprung auf den Tabellenzweiten, den FC Schalke 04, der die Bayern in der Bundesligasaison zweimal schlagen konnte. Dabei hatte Schalke nach dem 25. Spieltag und dem 1:0-Heimsieg noch einen Drei-Punkte-Vorsprung vor den Münchnern, konnte diesen jedoch nicht behaupten und verlor in der Folgezeit 17 Punkte in neun Spielen auf die Bayern. Beide Mannschaften standen sich auch im Finale des DFB-Pokals gegenüber, das die Münchner etwas glücklich aber verdient mit 2:1 für sich entscheiden konnten. In der Champions League mussten die Bayern im Viertelfinale gegen den FC Chelsea die Segel streichen. Zum Ende der Saison bestritt man das letzte Bundesligaspiel im Olympiastadion. Die Begegnung wurde 6:3 gegen den 1. FC Nürnberg gewonnen und so endete die Ära in diesem Stadion mit der deutschen Meisterschaft, wie sie schon 1971/72 begonnen hatte.+Spieldaten des Endspiels um den DFB-Pokal 2005+Saison 2005/06 [Bearbeiten]+Mit der neuen Saison zogen die Bayern in die neu gebaute Allianz Arena um. Und diese wurde so erfolgreich fortgesetzt, wie die Vorsaison endete. In seiner zweiten Saison beim FC Bayern schaffte Magath dabei ein Novum. Unter ihm gelang es dem FC Bayern, als erste deutsche Mannschaft im Fußball der Männer das Double zu verteidigen. Dabei setzte man sich in der Bundesliga am Ende vor Werder Bremen und dem HSV durch. Im Endspiel um den DFB-Pokal bezwang man Eintracht Frankfurt mit 1:0 durch ein Tor von Claudio Pizarro. In der Champions League war im Achtelfinale Schluss. Dabei war man nach einem 1:1 im Hinspiel gegen den AC Mailand im Rückspiel in Italien chancenlos und verlor mit 1:4. Ende der Saison lief der Vertrag von Michael Ballack aus. Bayern machte ihm ein Angebot über 36 Millionen Euro für einen neuen vier Jahre laufenden Vertrag, doch nach langer Überlegung lehnte der Nationalspieler ab und wechselte ablösefrei zum FC Chelsea. Nach der Saison beendete Bixente Lizarazu seine Karriere beim FC Bayern.+Spieldaten des Endspiels um den DFB-Pokal 2006+Saison 2006/07 [Bearbeiten]+Für die Saison 2006/07 wurde kein neuer Spielmacher geholt. Allerdings konnten Lukas Podolski und Mark van Bommel verpflichtet werden. Die dritte Saison beim FC Bayern verlief für Magath dann weniger erfolgreich. Wie drei Jahre zuvor scheiterte man dieses Mal schon im Pokal-Achtelfinale an Alemannia Aachen. Einer der Torschützen für Aachen war Jan Schlaudraff, der im folgenden Sommer zu den Bayern wechseln sollte. Zudem drohte man in der Bundesliga, nur auf Platz vier liegend, die Qualifikation zur Champions League zu verpassen. Deshalb reagierte man beim FC Bayern und holte einen alten Bekannten als Trainer zurück. Am 31. Januar 2007 wurde Felix Magath nach zwei Double-Gewinnen in Folge durch seinen Vorgänger Ottmar Hitzfeld ersetzt. Doch auch er konnte die Qualifikation zur Champions League nicht erreichen und man blieb auf dem vierten Platz, der schlechtesten Platzierung der Bayern der letzten zwölf Jahre. In der Champions League selbst war erneut gegen den AC Mailand Endstation, diesmal im Viertelfinale. Man hatte sich zwar mit einem 2:2 in Mailand eine gute Ausgangsposition für das Rückspiel im eigenen Stadion erarbeitet, verlor dann aber mit 0:2. Durch dieses Ausscheiden und Platz vier in der Liga war man für die nächste Saison erstmals seit der Saison 1996/97 nicht für die Champions League qualifiziert und musste mit dem UEFA-Pokal vorliebnehmen. Nach dieser Saison beendete Mehmet Scholl seine lange Karriere beim FC Bayern. Zuvor hatte Sebastian Deisler im Januar sein Karriereende bekanntgegeben.+Saison 2007/08 [Bearbeiten]+Um eine Saison wie die des Vorjahres nicht erneut zu erleben, investierten die Bayern in der Vorbereitung zur neuen Saison eine Rekordsumme von rund 70 Millionen Euro. Dabei wurden alleine 25 Millionen Euro für Franck Ribéry von Olympique Marseille und 12,5 Millionen Euro für Luca Toni vom AC Florenz ausgegeben. Als dann neben der schon bekannten Verpflichtung von Jan Schlaudraff mit Miroslav Klose auch noch ein dritter neuer Stürmer eingekauft wurde, erbat Roy Makaay seine Freigabe und wechselte zu Feyenoord Rotterdam. Zudem wechselte Hasan Salihamidžić zu Juventus Turin. Vereinseigengewächs Owen Hargreaves, der schon lange Ambitionen für die Premier League geäußert hatte, wechselte für eine Ablösesumme von 25 Millionen Euro zu Manchester United. Neben den oben genannten Spielern wechselte auch Hamit Altıntop von Schalke 04 zu den Bayern.+Die hohen Investitionen lohnten sich und Bayern gelang in dieser Saison der fünfte Double-Gewinn in einem Jahrzehnt und der siebte Double-Gewinn überhaupt. Dabei wurde den Zuschauern auch spielerisch ein erfrischender Fußball geboten, bei dem vor allem Ribéry seine ausgezeichnete Technik unter Beweis stellte. Die Saison selbst verlief recht einseitig. Mit einem Start-Ziel-Sieg erreichte der FC Bayern am Ende einen Vorsprung von zehn Punkten auf Werder Bremen. Im DFB-Pokalfinale wurde Borussia Dortmund mit 2:1 nach Verlängerung besiegt. Im UEFA-Pokal schaffte man es bis ins Halbfinale und musste sich dort nach einem 1:1 im Hinspiel in München dem späteren Gewinner Zenit Sankt Petersburg mit 0:4 in St. Petersburg geschlagen geben.+Neben der herben Halbfinalpleite blieb dabei besonders das Viertelfinalrückspiel in Getafe in Erinnerung. Nach einem 1:1 im Hinspiel in München musste man beim FC Getafe antreten. Nachdem es lange 1:0 für die Gastgeber stand, konnte Ribéry den Rückstand in der 89. Minute ausgleichen. Dadurch kam es zur Verlängerung. Dort stand es schnell 3:1 für Getafe. Erst in der 115. Minute kamen die Bayern durch Luca Toni zum Anschlusstreffer und in der letzten Minute der Verlängerung schaffte es wiederum Toni den Ausgleich zu erzielen. Somit war man aufgrund der mehr geschossenen Auswärtstore im Halbfinale.+In der Winterpause der Saison kündigte Ottmar Hitzfeld bereits an, seinen zum Saisonende auslaufenden Vertrag bei Bayern nicht zu verlängern. Um ihn zu ersetzen, wurde für die neue Saison der ehemalige Spieler Jürgen Klinsmann als neuer Trainer verpflichtet.+Mit dem Rekord von acht gewonnenen Meisterschaften und sechs gewonnenen DFB-Pokalen verließ Oliver Kahn den FC Bayern. Kahn gelang es in seiner letzten Saison, den Rekord von Oliver Reck (22 Gegentore in 34 Spielen aus der Saison 1987/88) mit 21 Gegentoren in 34 Spielen zu unterbieten. Nach der Saison wurde er zum Ehrenspielführer des FC Bayern München ernannt.+Spieldaten des Endspiels um den DFB-Pokal 2008+Saison 2008/09 [Bearbeiten]+Zu Beginn der Saison 2008/09 stand Michael Rensing als die neue Nummer 1 im Tor der Bayern, verlor seinen Platz jedoch im April 2009 an Hans Jörg Butt. Zudem wechselten Tim Borowski und der italienische Weltmeister Massimo Oddo zum Rekordmeister. Nach anfänglichen Schwierigkeiten in der Bundesliga gelang es, sich bis zur Winterpause an den Spitzenreiter, den Aufsteiger TSG 1899 Hoffenheim, heranzuarbeiten und punktgleich mit der TSG überwinterte man auf Platz zwei. Nachdem man die Leistungen in der zweiten Hälfte der Saison nicht stabilisieren konnte, musste Jürgen Klinsmann fünf Spieltage vor Schluss seinen Platz räumen und wurde durch Jupp Heynckes als Cheftrainer und dessen Co-Trainer Hermann Gerland ersetzt.[15] Unter dem neuen Trainer konnte sich die Mannschaft mit vier Siegen und einem Unentschieden hinter dem neuen Meister VfL Wolfsburg den zweiten Platz und somit die direkte Qualifikation für die Champions League der Folgesaison sichern. Im DFB-Pokal war man zuvor schon im Viertelfinale gegen Bayer Leverkusen ausgeschieden. In der Champions League konnte man sich im Achtelfinal-Hinspiel bei Sporting Lissabon mit 5:0 durchsetzen und zog nach einem 7:1 im Rückspiel in das Viertelfinale ein; das Gesamtergebnis von 12:1 gegen Sporting bedeutete Champions-League-Rekord. Im Viertelfinale erlebte man jedoch vier Tage nach einem 1:5 in der Bundesliga beim VfL Wolfsburg das von vielen Fans[16] und Medien befürchtete Hinspiel-Debakel beim FC Barcelona: Nach einer 4:0-Pausenführung im Camp Nou schalteten die zuvor schon kaum geforderten Katalanen noch etwas zurück, führten eine ersatzgeschwächte (ohne Lahm, Lucio, van Buyten und Klose) und katastrophal spielende Bayern-Mannschaft aber weiter vor, ohne ihre großen Chancen in weitere Tore umzumünzen. Nach einem 1:1 im von beiden Mannschaften, besonders aber von Barcelona, nicht mit letztem Einsatz geführtem Rückspiel war die Europapokalsaison für den FC Bayern beendet.+Kurz nach der Winterpause gab Willy Sagnol auf Grund andauernder Beschwerden im Knie sein Karriereende bekannt. Bis März 2009 hatte der von Los Angeles Galaxy ausgeliehene US-Amerikaner Landon Donovan ein etwas glückloses Gastspiel in München.+Den Verein verließen zum Saisonende Lukas Podolski zum 1. FC Köln, Zé Roberto zum HSV und Lúcio zu Inter Mailand. Der vom AC Mailand ausgeliehene Massimo Oddo wurde nicht übernommen.+Saison 2009/10 [Bearbeiten]+Am 1. Juli 2009 übernahm Louis van Gaal, der in der Vorsaison den AZ Alkmaar zur Niederländischen Fußballmeisterschaft führte, den Posten als Chef-Trainer des FC Bayern.+Zugänge zur Saison 2009/10 waren Anatolij Tymoschtschuk von Zenit St. Petersburg, Alexander Baumjohann von Borussia Mönchengladbach, Ivica Olić vom Hamburger SV, Edson Braafheid von Twente Enschede.[17], Danijel Pranjić vom SC Heerenveen[18] und Mario Gómez vom VfB Stuttgart. Letzterer ist mit einer Ablösesumme von 30 Millionen Euro der teuerste Transfer der Bundesligageschichte.[19] Zudem kehrte Andreas Görlitz, der an den Karlsruher SC ausgeliehen war, zum FC Bayern zurück. Daneben rückten aus der zweiten Mannschaft Thomas Müller und Holger Badstuber in den Profikader auf. Am 28. August 2009 wurde schließlich der holländische Nationalspieler Arjen Robben von Real Madrid verpflichtet.[20]+Am Beginn der Saison versuchte van Gaal nochmals, Michael Rensing als Stammtorwart zu installieren. Allerdings konnte dieser abermals nicht überzeugen, so dass er am fünften Spieltag seinen Stammplatz wieder an Hans Jörg Butt abtreten musste. Das erste Saison-Drittel verlief wenig erfolgreich für den FC Bayern. In der Bundesliga rutschte man zwischenzeitlich bis auf Rang 14 ab und auch das Weiterkommen in der Champions League war gefährdet. Im letzten Spiel der Champions-League-Gruppenphase besiegten die Bayern schließlich am 8. Dezember 2009 Juventus Turin auswärts mit 4:1, wodurch sie doch noch die Endrunde der Champions League erreichen konnten. Daneben gelang es dem FC Bayern in der Bundesliga, bis Mitte Februar 2010 neun Spiele hintereinander zu gewinnen und damit den Rückstand auf den Spitzenreiter Bayer Leverkusen, der zwischenzeitlich acht Punkte betragen hatte, auszugleichen. Am 24. Spieltag übernahmen die Bayern schließlich die Tabellenführung in der Bundesliga, die sie bis Saisonende nur noch einmal abgaben. Am letzten Spieltag wurde durch einen 3:1-Sieg bei Hertha BSC die 22. Deutsche Meisterschaft perfekt gemacht. Zudem gewann man das Finale des DFB-Pokals gegen Werder Bremen mit 4:0 und konnte somit den 15. Pokalsieg, gleichzeitig das achte Double, verbuchen.+Spieldaten des Endspiels um den DFB-Pokal 2010+Mit dem Einzug ins Finale der Champions League eröffnete sich die Chance für die Bayern, als erste deutsche Mannschaft das Triple aus Meisterschaft, nationalem sowie internationalem Pokal zu gewinnen. Allerdings verlor man am 22. Mai 2010 im Estadio Santiago Bernabéu in Madrid gegen Inter Mailand mit 0:2 und verpasste damit den historischen Triumph.++Zu Beginn der Saison 2010/2011 konnte der Verein mit einem 2:0 gegen Schalke 04 den von der DFL wieder eingeführten Supercup gewinnen. In der Champions League erreichten die Münchner das Achtelfinale, wo sie gegen Inter Mailand nach einem 1:0-Auswärtssieg durch eine 2:3-Heimniederlage ausschieden. Im DFB-Pokal schieden sie im Halbfinale nach einer 0:1-Heimniederlage gegen Schalke aus.+Am 7. März 2011 wurde vom FC Bayern bekanntgegeben, dass der Vertrag mit Trainer Louis van Gaal am Saisonende zum 30. Juni 2011 vorzeitig und einvernehmlich aufgelöst werden wird. Grund hierfür war laut Pressemitteilung die unterschiedliche Auffassung über die strategische Ausrichtung des Klubs. Nachfolger wurde Jupp Heynckes, der einen Zweijahresvertrag erhielt.[21] Am 10. April 2011 gab der Verein aufgrund der weiteren sportlichen Talfahrt die sofortige Beurlaubung Louis van Gaals bekannt und ernannte den bisherigen Co-Trainer Andries Jonker zum Cheftrainer bis zum Saisonende.[22]+Nach 5 Spielen und 13 von 15 möglichen Punkten unter Jonker schloss die Mannschaft die Saison 2010/2011 als Dritter ab und sicherte sich damit die Teilnahme an der Qualifikation zur Champions League.+In der Bundesligasaison 2011/12 musste man sich erneut Borussia Dortmund geschlagen geben, schaffte mit dem zweiten Platz aber die direkte Champions-League-Qualifikation. Zudem wurde das Pokalfinale am 12. Mai 2012 in Berlin erreicht, in dem man mit 2:5 wieder Borussia Dortmund unterlegen war.+In der Champions League-Qualifikation besiegte man den FC Zürich mit 2:0 und 1:0 und erreichte somit die Gruppenphase. In den Duellen gegen den FC Villarreal, Manchester City und die SSC Neapel gelang es den Roten, bereits nach dem fünften Spieltag als Gruppensieger festzustehen.[23] Über den FC Basel, Olympique Marseille und Real Madrid zog man in das Finale der Champions League ein und verlor am 19. Mai 2012 gegen Chelsea London im eigenen Stadion nach Verlängerung (1:1) im Elfmeterschießen 3:4.+Mit dem jeweils zweiten Platz in Champions League, Meisterschaft und DFB-Pokal ging 2012 als ein Annus horribilis verpasster Chancen in die Vereinsgeschichte ein. +Die erste Mannschaft spielt seit 1965 in der Bundesliga. Der FC Bayern München ist der erfolgreichste deutsche Fußball-Club und deutscher Rekordmeister. Für 21 Meisterschaften seit Einführung der Bundesliga 1963 darf er vier Meistersterne auf dem Trikot tragen. Der FC Bayern ist der erste Verein, dem es gelang, das Double zu verteidigen. Der FC Bayern München ist neben Borussia Dortmund, Borussia Mönchengladbach und dem Hamburger SV der vierte Verein, der seinen Titel in der Fußball-Bundesliga verteidigen konnte. Mit 592 Spieltagen als Tabellenführer belegt der Verein den 1. Platz in der ewigen Liste der Tabellenführer. Neben Ajax Amsterdam und Juventus Turin gelang es dem FC Bayern, alle Europapokale sowie den Weltpokal zu gewinnen. Neben Bayern München gelang es bisher nur Real Madrid und Ajax Amsterdam, den Europapokal der Landesmeister dreimal in Folge zu gewinnen. Deswegen erlaubt es die UEFA unter anderem dem FC Bayern, ein Logo mit dem Champions-League-Pokal zu tragen, in dem zusätzlich die Anzahl aller gewonnenen Europapokale der Landesmeister (4) eingetragen ist. Unter den Vereinspokalen fehlt einzig der europäische Supercup, der bisher noch von keiner deutschen Mannschaft gewonnen wurde.++Die zweite Mannschaft (bis 2005: FC Bayern München Amateure, seitdem offiziell: FC Bayern München II) ist ebenfalls eine Profimannschaft und spielt seit 2011 in der viertklassigen Regionalliga Süd. Von 1973 bis 2011 spielte die Mannschaft stets drittklassig. Betreut wird das Team derzeit von Andries Jonker als Trainer sowie Gerd Müller und Rainer Ulrich als Co-Trainern, Torwarttrainer ist Walter Junghans.+1983 und 1987 erreichten die Bayern-Amateure jeweils das Endspiel um die Deutsche Amateurmeisterschaft. Bei der Einführung der Regionalligen als dritthöchste Spielklasse 1994 war man direkt für die Regionalliga Süd qualifiziert und spielte in dieser Liga bis 2008, als durch einen achten Platz die Qualifikation für die neugegründete 3. Liga gelang, deren Premierensaison man 2008/09 als Fünfter beendete. In der Saison 2003/04 gewannen die Bayern-Amateure mit Spielern wie Zvjezdan Misimović, Piotr Trochowski und Paolo Guerrero die Meisterschaft in der Regionalliga Süd. Für den DFB-Pokal waren die Bayern-Amateure mehrmals qualifiziert, erreichten in der Saison 1993/94 das Achtelfinale sowie 1994/95 und 2004/05 sogar das Viertelfinale, wobei u. a. die Bundesligisten Werder Bremen, VfB Stuttgart, 1. FC Köln und Borussia Mönchengladbach besiegt wurden.+Immer wieder schafften Spieler der zweiten Mannschaft den Sprung in den Kader der Profimannschaft und wurden später Stammspieler, so u. a. Markus Babbel, Philipp Lahm, Owen Hargreaves, Bastian Schweinsteiger oder in jüngerer Zeit Holger Badstuber und Thomas Müller.+In den Anfangsjahren des Vereins wechselten die Spielstätten recht häufig. Das erste Spiel der Vereinsgeschichte fand auf dem städtischen Spielplatz an der Schyrenstraße statt. Der 1. Münchner FC wurde damals mit 5:2 bezwungen. 1901 bis 1907 spielte man dann in Schwabing an der Clemensstraße, um dann an die Leopoldstraße zu wechseln. Da immer mehr Zuschauer zu den Heimspielen des Vereins kamen, wechselte man ab 1920 erneut den Platz, ohne für eine längere Zeit eine feste Heimstätte zu haben. Für 47 Jahre fanden die „Roten“ dann ab 1925 im Grünwalder Stadion ihr festes Zuhause, wobei man bis zum Ende des Zweiten Weltkriegs Untermieter des TSV 1860 München war. Der TSV musste später aus finanziellen Gründen das Stadion an die Stadt München verkaufen. Bayerns Zuschauerrekord im Grünwalder Stadion beläuft sich auf mehr als 50.000 während der Saison 1961/62 gegen den 1. FC Nürnberg. Mit Beginn der Bundesliga waren dann nur noch 44.000 Zuschauer zugelassen.++Nach Fertigstellung des Olympiastadions München für die Olympischen Sommerspiele 1972 zogen die Bayern dorthin um. Das erste Spiel der Bayern fand am letzten Spieltag der Saison 1971/72 statt. FC Schalke 04 hieß der Gegner und wurde vor 79.000 Zuschauern mit 5:1 geschlagen. Nach dem Spiel feierte der Verein seine erste von vielen Deutschen Meisterschaften im Olympiastadion. Durch eine Reduzierung der Stehplätze und kleinere Anpassungen im Stadion sank die offizielle Stadionkapazität schrittweise auf 69.200 Zuschauer bei nationalen Spielen und 59.000 bei internationalen Spielen. Aus Komfortgründen gab der Verein rund 6.000 Plätze, die keine gute Sicht auf das Spielfeld boten, nicht für den Verkauf frei und ließ zu Bundesliga-Spielen nur 63.000 Zuschauer ins Stadion. Ab 1995, ein Jahr nach dem Wiederaufstieg des TSV 1860 München in die Bundesliga trug auch der Stadtrivale seine Heimspiele im Olympiastadion aus, wobei die Löwen bei Spitzenspielen die zulässige Höchstgrenze von 69.200 Zuschauern nutzten.+Das Olympiastadion wurde mit der Zeit immer stärker als nicht mehr zeitgemäß für Fußballspiele auf Spitzenniveau kritisiert. Es gab keine VIP-Logen, das Stadion war nur zu einer Seite hin überdacht und in der weiten und offenen Anlage wollte keine rechte „Fußball-Stimmung“ aufkommen. Auch die vorhandene Tartanbahn und die dadurch bedingte große Entfernung zwischen Zuschauern und Spielgeschehen war Fans und Verantwortlichen ein Dorn im Auge. Zudem kam es bisweilen zu Terminkonflikten, wenn andere Veranstaltungen, wie z.B. Leichtathletikwettbewerbe oder Rockkonzerte im Stadion stattfinden sollten. Viele derartige Veranstaltungen wurden wegen der Beschwerden des FC Bayern als Hauptnutzer, (und mit ca. 5 Millionen DM jährlich größten Mietzahlers) an andere Orte verlegt. Prominentestes „Opfer“ war die alljährliche Rockveranstaltung Rock im Park, die schließlich von München nach Nürnberg verlegt wurde. Der Verein machte sich daher schon länger Gedanken über ein eigenes Stadion in München. Doch über Jahre hinweg fand man keinen geeigneten Platz und auch die Stadt als Eigentümerin der olympischen Spielstätte sträubte sich gegen derartige Pläne, da die Mietzahlungen des FC Bayern eine lukrative Einnahmequelle darstellten, die man nicht verlieren wollte. Als sich Deutschland für die Fußball-Weltmeisterschaft 2006 bewarb, kam das Thema Stadion erneut auf den Tisch, denn mit dem veralteten Olympiastadion wäre München als Spielort für das Turnier undenkbar gewesen. Da es hieß, dass es nirgendwo einen geeigneten Platz für einen Neubau in München geben würde, dachte man zunächst darüber nach, das Olympiastadion aufwendig zu renovieren und grundlegend umzubauen. Auch ein Abriss und Neubau unter dem denkmalgeschützten Zeltdach wurde durchgespielt. All diese Pläne scheiterten letzten Endes aber am Veto des Architekten Günter Behnisch. Um die örtliche Politik unter Zugzwang zu setzen, spekulierte der Verein daraufhin eine Zeitlang öffentlich darüber, das neue Stadion außerhalb der Stadtgrenzen, beispielsweise in Garching oder Poing zu errichten, womit der Stadt München etliches an Steuereinnahmen und Prestige verlorengegangen wäre.++Wollte München also WM-Spielort werden, musste eine Lösung gefunden werden. Verschiedene Standorte wurden auf ihre Tauglichkeit hin geprüft und man einigte sich letzten Endes auf Fröttmaning am nördlichen Ende der Stadt als Standort für die neue Allianz Arena. Nach zähem Ringen wurde in der Kompromisslösung festgezurrt, dass der FC Bayern und 1860 München die neue Arena gemeinsam errichten und nutzen sollten, wobei jegliche Nutzung außerhalb von Fußball ausgeschlossen wurde, um dem Olympiastadion eine gewisse Grundauslastung bei Veranstaltungen zu sichern. Auch dieser Kompromiss wurde von der Öffentlichkeit kontrovers aufgenommen, sodass es sogar zu einer Volksabstimmung über den Stadionneubau kam, die mit etwa 2/3 der Stimmen zu Gunsten des Neubaus ausfiel. Die beiden Vereine trugen die Kosten für den Stadionbau, während die Stadt München und das Land Bayern für die Kosten der Infrastruktur aufkommen sollten. Zu Beginn waren die FC Bayern München AG und die TSV München von 1860 GmbH & Co. KGaA zu je 50 % an der Stadiongesellschaft, der die Arena gehört und sie betreibt, beteiligt. Beide Vereine müssen zur Nutzung der Arena entsprechende Mietentgelte entrichten, woraus die Stadion GmbH wiederum den Kredit, der den Bau finanzierte, bedient. Als die Löwen jedoch erneut in finanzielle Nöte gerieten, verkauften sie ihren 50-Prozent-Anteil an den Mitgesellschafter. Auch eine zunächst ausgehandelte Rückkaufoption wurde inzwischen an die Bayern verkauft. Somit steht das Stadion unter der alleinigen Kontrolle des FC Bayern München.+Baulich ist das Stadion in drei Ränge unterteilt. Dabei besteht die Haupttribüne mit den Ein- und Ausgängen größtenteils aus VIP-Plätzen und sogenannten Business-Seats. Die Fankurven des FC Bayern befinden sich jeweils hinter den Toren. Die Sitzschalen des Stadions sind in Grau, da wohl weder Rot noch Blau dem einen oder anderen der beiden Vereine zuzumuten gewesen wäre. Dies hat allerdings den Nachteil, dass das Stadion auf Grund des vielen Graus recht kühl wirkt. Während der Heimspiele des FCB leuchtet das Stadion außen in Rot. Mehrfarbige Beleuchtungen sind zwar möglich, wurden aber nachträglich polizeilich untersagt, da die Farbwechsel zu erhöhten Unfallzahlen auf der nahen Autobahn A9 geführt hatten.+Das Stadion fasste anfangs 66.000 Zuschauer. Durch eine Neuanordnung der Sitzreihen und den Umbau einiger überbreiter Business-Seats zu normalen Sitzplätzen wurde die Kapazität wenige Monate später auf 69.001 Zuschauer erhöht. Prinzipiell ist eine weitere Aufstockung bis auf über 80.000 Plätze ohne tiefgreifende Baumaßnahmen möglich, der Verein verzichtet aber darauf, vor allem aus Komfortgründen für die Zuschauer.++Das Trainingsgelände des FC Bayern befindet sich in München-Giesing an der Säbener Straße 51. Es gilt als eines der modernsten Trainingsgelände in Europa. Vielfach wird behauptet, das Gelände befände sich im Stadtteil Harlaching, der jedoch wenige Meter weiter südlich beginnt.+Bereits seit 1949 nutzen die Bayern das Gelände an der Säbener Straße, der ehemaligen Bezirkssportanlage Harlaching. 1970 begann der Bau der neuen Geschäftsstelle und des Trainingsgeländes unter Präsident Neudecker. Am 17. Mai 1971 war die Anlage bezugsfertig. Zum ersten Mal in der Geschichte des Vereins waren Geschäftsstelle und Trainingsgelände vereint. Bereits 1979 wurde das Gelände erweitert, worauf Ende der 80er Jahre ein weiterer Ausbau folgte, um neue Gebäude für den Amateur- und Profibereich zu schaffen. Im Jahr 2000 gab es einen Brand im Profitrakt, wobei ein erheblicher Schaden an den Umkleidekabinen, in der medizinischen Abteilung und in der Sauna entstand. 2008 wurde ein neues Servicezentrum fertiggestellt mit einem neuen Fan-Shop auf einer 250 m² großen Fläche, zudem entstand eine Tiefgarage. Das neue Gebäude ist 95 Meter lang, 16 Meter breit und ca. 10 Meter hoch. Die Tiefgarage fasst 270 Stellplätze. Direkt neben dem neuen Gebäude entstand ein neuer Rasenplatz mit mehreren Sitzreihen auf einer Seite, auf dem in der Saison 2008/09 die Heimspiele der B-Jugend-Mannschaften ausgetragen wurden. Zudem wurde ein neuer Kunstrasenplatz mit zwei Kleinfeldern für die E- und F-Jugend angelegt. Des Weiteren wurde das alte Klubrestaurant in eine Kantine für die Vereinsangestellten umgewandelt. Waren früher alle Trainingseinheiten öffentlich, hat sich in jüngerer Zeit der allgemeine Trend durchgesetzt, meist nur noch einmal wöchentlich ein öffentliches Training stattfinden zu lassen. Insgesamt gibt es auf dem Gelände fünf Rasenplätze, zwei Kunstrasenplätze und einen Beachvolleyballplatz.+Nur durch einen Parkplatz und einen Fußweg vom Bayern-Gelände getrennt befindet sich das neue Sportgelände der Sportfreunde München. Durch die Erweiterungsmaßnahmen des FC Bayern musste das alte Gelände der Sportfreunde weichen und wurde um einige Meter nach Süden versetzt. Ein Stück weiter westlich, getrennt durch ein Wohnviertel, befindet sich an der Grünwalder Straße das Trainingsgelände des Erzrivalen TSV 1860 München.+Der FC Bayern München gliedert sich in die FC Bayern München AG und den FC Bayern München e. V. Auf einer außerordentlichen Mitgliederversammlung des Vereins am 14. Februar 2002 wurde die Ausgliederung der Fußballprofiabteilung in die FC Bayern München AG beschlossen. Vorstandsvorsitzender der AG ist Karl-Heinz Rummenigge, während Uli Hoeneß Präsident des FC Bayern München e. V. und Aufsichtsratsvorsitzender der AG ist. Zum e. V. gehören folgende Sportabteilungen: Fußball (Männer: Fußball-Bundesliga, Regionalliga Süd; Frauen: Fußball-Bundesliga der Frauen), Basketball (Männer: Basketball-Bundesliga), Handball, Schach (Männer: Bundesliga, Frauen: 2. Bundesliga), Sportkegeln, Tischtennis und Turnen.++Die Beziehung zwischen dem FC Bayern München und dem Sportartikelhersteller Adidas kann als recht außergewöhnlich bezeichnet werden. Seit 1965 ist Adidas ununterbrochen Ausrüster des Vereins. Von 2002 bis 2010 hielt Adidas einen 10-Prozent-Anteil an der FC Bayern München AG, der für 77 Millionen Euro erworben wurde.[27] Zwischen März 2010 und Juni 2011 erwarb jedoch die Audi AG in drei Schritten Aktien im Wert von 90 Mio. Euro. Dies war verbunden mit einer Kapitalerhöhung von 2,5 Mio. auf 27,5 Mio. Euro.[28] Nach dieser Kapitalerhöhung halten der FC Bayern München e. V. 81,82 Prozent sowie Adidas und Audi je 9,09 Prozent der Aktien an der AG.+Mit Herbert Hainer stellt Adidas den stellvertretenden Aufsichtsratsvorsitzenden der AG.[29] Bis 2007 durfte auch kein Spieler des FC Bayern eine andere Schuhmarke tragen als Adidas, selbst wenn der Spieler einen Vertrag mit einem anderen Ausrüster als Adidas hatte. Erst mit dem Wechsel von Miroslav Klose zu Bayern München änderte sich dies.++Kein anderer Verein Deutschlands hat so viele registrierte Anhänger wie der Rekordmeister. 2952 Fanklubs mit 204.235 Fanklub-Mitgliedern sind beim FC Bayern offiziell registriert (Stand: 18. November 2011).[32] In ganz Deutschland, aber auch weltweit gibt es organisierte Bayern-Fans. Zu den bekanntesten offiziellen Fanclubs gehören die „Red Munichs 89“, die „Red Sharks“ und die „Die 13 Höslwanger“. In den 1970er Jahren gab es mit der „Südkurve 73 und den „Red Angels zwei führende Gruppen beim FC Bayern. 1986 entstand in München die erste reine Hooligangruppe, die so genannte „Service Crew Munich (SCM). Mitte der 1990er Jahre entwickelte sich dann die Ultra-Bewegung. Als erste Gruppe sind hier die „Munichmaniacs 1996 zu erwähnen. Seit 2002 gibt es eine übergreifende Ultra-Gruppe, die Schickeria München. Diese ist aber kein offizieller Fanclub. Als Dachorganisation für Fans und Fanclubs gibt es den Club Nr. 12 mit aktuell über 1400 Mitgliedern.[33] Früher gab es ein Fanheim auf einem alten Bahngelände im Stadtteil Laim, das aber einem Wohngebiet weichen musste. Was die Zahl der nicht organisierten Fans und Anhänger weltweit anbelangt, gehört der FC Bayern München auch international zu den größten Vereinen. Fanbeauftragter ist mit Andreas Brück ein langjähriger Fan aus der Südkurve.+Jahrelang kämpften die Bayern-Fans und Fanclubs um ein neues, reines Fußballstadion, allein schon wegen der zu erwartenden besseren Stimmung. Tatsächlich zeigte sich jedoch nach dem Einzug in die Allianz Arena, dass die Stimmung im Stadion teilweise schlechter ist als im alten Olympiastadion mit Laufbahn und führte in der Vergangenheit zu sehr kontroversen Diskussionen zwischen Vereinsführung und aktiven Fans. Dies mag zum einen an dem so genannten Operettenpublikum liegen, zum anderen aber auch an der Aufteilung und Bauweise der Allianz Arena. So wurden die Fans aus der Südkurve des Olympiastadions im neuen Stadion auf Süd- und Nordkurve aufgeteilt. Im Unterrang der Südkurve befinden sich weniger Stehplätze als in der Südkurve des Olympiastadions, so gibt es zu Bundesligaspielen dort lediglich 6800 Stehplätze.+Zu den Heimspielen der zweiten Mannschaft im Stadion an der Grünwalder Straße finden sich auf der Gegengeraden meist zwischen 50 und 300 aktive Fans ein. Das Stadion wird von ihnen als „Hermann-Gerland-Kampfbahn“ bezeichnet, ein Zeichen der Anerkennung der Arbeit von Hermann Gerland als langjährigem Trainer der Mannschaft. Die seit 2005 vom DFB praktizierte Sprachregelung mit dem Namenszusatz „II“ statt „Amateure“ wird von den Fans nicht akzeptiert.++Das aktuelle offizielle Vereinslied ist „Stern des Südens“, komponiert von Willy Astor und gesungen von Claus Lessmann, dem Leadsänger der Hardrockband Bonfire. Davor war jahrelang das Lied „Forever Number One“ die Hymne des Vereins. Das Lied „Stern des Südens“ befindet sich auf der CD „Heimspiel“ der FC Bayern Fans United und wurde auch als Single veröffentlicht. Die beiden offiziellen Lieder wurden jedoch von der Fanszene wenig akzeptiert, inoffizielle Hymne ist das Lied „Mir san die Bayern“.+Bekannt ist ebenfalls der alte Schlager von Franz Beckenbauer „Gute Freunde kann niemand trennen“. Angestimmt werden nahezu alle Lieder im Unterrang der Südkurve und hier sowohl von der Schickeria München[34] als auch von einem Trompeter und einer Reihe älterer Fans. Auch in der Nordkurve befinden sich aktive Fans, während sich die Zuschauer in den Sitzplatzbereichen meist passiv verhalten.+Überregional haben sich über die Jahre hinweg mehrere Rivalitäten herausgebildet. Meistens entstand so eine Rivalität mit einem Verein, mit dem die Bayern über einen gewissen Zeitraum hinweg um die Meisterschaft rangen. So waren dies Borussia Mönchengladbach in den 1970ern und Borussia Dortmund in den 1990er Jahren. Zudem gibt es noch die Rivalität zum 1. FC Kaiserslautern und die Nord-Süd-Gipfel gegen den Hamburger SV und Werder Bremen.
+ benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txt view
@@ -0,0 +1,699 @@+मधुशाला+मृदु भावों के अंगूरों की आज बना लाया हाला,+प्रियतम, अपने ही हाथों से आज पिलाऊँगा प्याला,+पहले भोग लगा लूँ तेरा फिर प्रसाद जग पाएगा,+सबसे पहले तेरा स्वागत करती मेरी मधुशाला।।१। ++प्यास तुझे तो, विश्व तपाकर पूर्ण निकालूँगा हाला,+एक पाँव से साकी बनकर नाचूँगा लेकर प्याला,+जीवन की मधुता तो तेरे ऊपर कब का वार चुका,+आज निछावर कर दूँगा मैं तुझ पर जग की मधुशाला।।२।++प्रियतम, तू मेरी हाला है, मैं तेरा प्यासा प्याला,+अपने को मुझमें भरकर तू बनता है पीनेवाला,+मैं तुझको छक छलका करता, मस्त मुझे पी तू होता,+एक दूसरे की हम दोनों आज परस्पर मधुशाला।।३।++भावुकता अंगूर लता से खींच कल्पना की हाला,+कवि साकी बनकर आया है भरकर कविता का प्याला,+कभी न कण-भर खाली होगा लाख पिएँ, दो लाख पिएँ!+पाठकगण हैं पीनेवाले, पुस्तक मेरी मधुशाला।।४।++मधुर भावनाओं की सुमधुर नित्य बनाता हूँ हाला,+भरता हूँ इस मधु से अपने अंतर का प्यासा प्याला,+उठा कल्पना के हाथों से स्वयं उसे पी जाता हूँ,+अपने ही में हूँ मैं साकी, पीनेवाला, मधुशाला।।५।++मदिरालय जाने को घर से चलता है पीनेवला,+'किस पथ से जाऊँ?' असमंजस में है वह भोलाभाला,+अलग-अलग पथ बतलाते सब पर मैं यह बतलाता हूँ -+'राह पकड़ तू एक चला चल, पा जाएगा मधुशाला।'। ६।++चलने ही चलने में कितना जीवन, हाय, बिता डाला!+'दूर अभी है', पर, कहता है हर पथ बतलानेवाला,+हिम्मत है न बढूँ आगे को साहस है न फिरुँ पीछे,+किंकर्तव्यविमूढ़ मुझे कर दूर खड़ी है मधुशाला।।७।++मुख से तू अविरत कहता जा मधु, मदिरा, मादक हाला,+हाथों में अनुभव करता जा एक ललित कल्पित प्याला,+ध्यान किए जा मन में सुमधुर सुखकर, सुंदर साकी का,+और बढ़ा चल, पथिक, न तुझको दूर लगेगी मधुशाला।।८।++मदिरा पीने की अभिलाषा ही बन जाए जब हाला,+अधरों की आतुरता में ही जब आभासित हो प्याला,+बने ध्यान ही करते-करते जब साकी साकार, सखे,+रहे न हाला, प्याला, साकी, तुझे मिलेगी मधुशाला।।९।++सुन, कलकल़ , छलछल़ मधुघट से गिरती प्यालों में हाला,+सुन, रूनझुन रूनझुन चल वितरण करती मधु साकीबाला,+बस आ पहुंचे, दुर नहीं कुछ, चार कदम अब चलना है,+चहक रहे, सुन, पीनेवाले, महक रही, ले, मधुशाला।।१०।++जलतरंग बजता, जब चुंबन करता प्याले को प्याला,+वीणा झंकृत होती, चलती जब रूनझुन साकीबाला,+डाँट डपट मधुविक्रेता की ध्वनित पखावज करती है,+मधुरव से मधु की मादकता और बढ़ाती मधुशाला।।११।++मेंहदी रंजित मृदुल हथेली पर माणिक मधु का प्याला,+अंगूरी अवगुंठन डाले स्वर्ण वर्ण साकीबाला,+पाग बैंजनी, जामा नीला डाट डटे पीनेवाले,+इन्द्रधनुष से होड़ लगाती आज रंगीली मधुशाला।।१२।++हाथों में आने से पहले नाज़ दिखाएगा प्याला,+अधरों पर आने से पहले अदा दिखाएगी हाला,+बहुतेरे इनकार करेगा साकी आने से पहले,+पथिक, न घबरा जाना, पहले मान करेगी मधुशाला।।१३।++लाल सुरा की धार लपट सी कह न इसे देना ज्वाला,+फेनिल मदिरा है, मत इसको कह देना उर का छाला,+दर्द नशा है इस मदिरा का विगत स्मृतियाँ साकी हैं,+पीड़ा में आनंद जिसे हो, आए मेरी मधुशाला।।१४।++जगती की शीतल हाला सी पथिक, नहीं मेरी हाला,+जगती के ठंडे प्याले सा पथिक, नहीं मेरा प्याला,+ज्वाल सुरा जलते प्याले में दग्ध हृदय की कविता है,+जलने से भयभीत न जो हो, आए मेरी मधुशाला।।१५।++बहती हाला देखी, देखो लपट उठाती अब हाला,+देखो प्याला अब छूते ही होंठ जला देनेवाला,+'होंठ नहीं, सब देह दहे, पर पीने को दो बूंद मिले'+ऐसे मधु के दीवानों को आज बुलाती मधुशाला।।१६।++धर्मग्रन्थ सब जला चुकी है, जिसके अंतर की ज्वाला,+मंदिर, मसजिद, गिरिजे, सब को तोड़ चुका जो मतवाला,+पंडित, मोमिन, पादिरयों के फंदों को जो काट चुका,+कर सकती है आज उसी का स्वागत मेरी मधुशाला।।१७।++लालायित अधरों से जिसने, हाय, नहीं चूमी हाला,+हर्ष-विकंपित कर से जिसने, हा, न छुआ मधु का प्याला,+हाथ पकड़ लज्जित साकी को पास नहीं जिसने खींचा,+व्यर्थ सुखा डाली जीवन की उसने मधुमय मधुशाला।।१८।++बने पुजारी प्रेमी साकी, गंगाजल पावन हाला,+रहे फेरता अविरत गति से मधु के प्यालों की माला'+'और लिये जा, और पीये जा', इसी मंत्र का जाप करे'+मैं शिव की प्रतिमा बन बैठूं, मंदिर हो यह मधुशाला।।१९।++बजी न मंदिर में घड़ियाली, चढ़ी न प्रतिमा पर माला,+बैठा अपने भवन मुअज्ज़िन देकर मस्जिद में ताला,+लुटे ख़जाने नरपितयों के गिरीं गढ़ों की दीवारें,+रहें मुबारक पीनेवाले, खुली रहे यह मधुशाला।।२०।++बड़े बड़े परिवार मिटें यों, एक न हो रोनेवाला,+हो जाएँ सुनसान महल वे, जहाँ थिरकतीं सुरबाला,+राज्य उलट जाएँ, भूपों की भाग्य सुलक्ष्मी सो जाए,+जमे रहेंगे पीनेवाले, जगा करेगी मधुशाला।।२१।++सब मिट जाएँ, बना रहेगा सुन्दर साकी, यम काला,+सूखें सब रस, बने रहेंगे, किन्तु, हलाहल औ' हाला,+धूमधाम औ' चहल पहल के स्थान सभी सुनसान बनें,+जगा करेगा अविरत मरघट, जगा करेगी मधुशाला।।२२।++भुरा सदा कहलायेगा जग में बाँका, मदचंचल प्याला,+छैल छबीला, रसिया साकी, अलबेला पीनेवाला,+पटे कहाँ से, मधु औ' जग की जोड़ी ठीक नहीं,+जग जर्जर प्रतिदन, प्रतिक्षण, पर नित्य नवेली मधुशाला।।२३।++बिना पिये जो मधुशाला को बुरा कहे, वह मतवाला,+पी लेने पर तो उसके मुह पर पड़ जाएगा ताला,+दास द्रोहियों दोनों में है जीत सुरा की, प्याले की,+विश्वविजयिनी बनकर जग में आई मेरी मधुशाला।।२४।++हरा भरा रहता मदिरालय, जग पर पड़ जाए पाला,+वहाँ मुहर्रम का तम छाए, यहाँ होलिका की ज्वाला,+स्वर्ग लोक से सीधी उतरी वसुधा पर, दुख क्या जाने,+पढ़े मर्सिया दुनिया सारी, ईद मनाती मधुशाला।।२५।++एक बरस में, एक बार ही जगती होली की ज्वाला,+एक बार ही लगती बाज़ी, जलती दीपों की माला,+दुनियावालों, किन्तु, किसी दिन आ मदिरालय में देखो,+दिन को होली, रात दिवाली, रोज़ मनाती मधुशाला।।२६।++नहीं जानता कौन, मनुज आया बनकर पीनेवाला,+कौन अपिरिचत उस साकी से, जिसने दूध पिला पाला,+जीवन पाकर मानव पीकर मस्त रहे, इस कारण ही,+जग में आकर सबसे पहले पाई उसने मधुशाला।।२७।++बनी रहें अंगूर लताएँ जिनसे मिलती है हाला,+बनी रहे वह मिटटी जिससे बनता है मधु का प्याला,+बनी रहे वह मदिर पिपासा तृप्त न जो होना जाने,+बनें रहें ये पीने वाले, बनी रहे यह मधुशाला।।२८।++सकुशल समझो मुझको, सकुशल रहती यदि साकीबाला,+मंगल और अमंगल समझे मस्ती में क्या मतवाला,+मित्रों, मेरी क्षेम न पूछो आकर, पर मधुशाला की,+कहा करो 'जय राम' न मिलकर, कहा करो 'जय मधुशाला'।।२९।++सूर्य बने मधु का विक्रेता, सिंधु बने घट, जल, हाला,+बादल बन-बन आए साकी, भूमि बने मधु का प्याला,+झड़ी लगाकर बरसे मदिरा रिमझिम, रिमझिम, रिमझिम कर,+बेलि, विटप, तृण बन मैं पीऊँ, वर्षा ऋतु हो मधुशाला।।३०।++तारक मणियों से सज्जित नभ बन जाए मधु का प्याला,+सीधा करके भर दी जाए उसमें सागरजल हाला,+मत्त समीरण साकी बनकर अधरों पर छलका जाए,+फैले हों जो सागर तट से विश्व बने यह मधुशाला।।३१।++अधरों पर हो कोई भी रस जिहवा पर लगती हाला,+भाजन हो कोई हाथों में लगता रक्खा है प्याला,+हर सूरत साकी की सूरत में परिवर्तित हो जाती,+आँखों के आगे हो कुछ भी, आँखों में है मधुशाला।।३२।++पौधे आज बने हैं साकी ले ले फूलों का प्याला,+भरी हुई है जिसके अंदर पिरमल-मधु-सुरिभत हाला,+माँग माँगकर भ्रमरों के दल रस की मदिरा पीते हैं,+झूम झपक मद-झंपित होते, उपवन क्या है मधुशाला!।३३।++प्रति रसाल तरू साकी सा है, प्रति मंजरिका है प्याला,+छलक रही है जिसके बाहर मादक सौरभ की हाला,+छक जिसको मतवाली कोयल कूक रही डाली डाली+हर मधुऋतु में अमराई में जग उठती है मधुशाला।।३४।++मंद झकोरों के प्यालों में मधुऋतु सौरभ की हाला+भर भरकर है अनिल पिलाता बनकर मधु-मद-मतवाला,+हरे हरे नव पल्लव, तरूगण, नूतन डालें, वल्लरियाँ,+छक छक, झुक झुक झूम रही हैं, मधुबन में है मधुशाला।।३५।++साकी बन आती है प्रातः जब अरुणा ऊषा बाला,+तारक-मणि-मंडित चादर दे मोल धरा लेती हाला,+अगणित कर-किरणों से जिसको पी, खग पागल हो गाते,+प्रति प्रभात में पूर्ण प्रकृति में मुखिरत होती मधुशाला।।३६।++उतर नशा जब उसका जाता, आती है संध्या बाला,+बड़ी पुरानी, बड़ी नशीली नित्य ढला जाती हाला,+जीवन के संताप शोक सब इसको पीकर मिट जाते+सुरा-सुप्त होते मद-लोभी जागृत रहती मधुशाला।।३७।++अंधकार है मधुविक्रेता, सुन्दर साकी शशिबाला+किरण किरण में जो छलकाती जाम जुम्हाई का हाला,+पीकर जिसको चेतनता खो लेने लगते हैं झपकी+तारकदल से पीनेवाले, रात नहीं है, मधुशाला।।३८।++किसी ओर मैं आँखें फेरूँ, दिखलाई देती हाला+किसी ओर मैं आँखें फेरूँ, दिखलाई देता प्याला,+किसी ओर मैं देखूं, मुझको दिखलाई देता साकी+किसी ओर देखूं, दिखलाई पड़ती मुझको मधुशाला।।३९।++साकी बन मुरली आई साथ लिए कर में प्याला,+जिनमें वह छलकाती लाई अधर-सुधा-रस की हाला,+योगिराज कर संगत उसकी नटवर नागर कहलाए,+देखो कैसों-कैसों को है नाच नचाती मधुशाला।।४०।++वादक बन मधु का विक्रेता लाया सुर-सुमधुर-हाला,+रागिनियाँ बन साकी आई भरकर तारों का प्याला,+विक्रेता के संकेतों पर दौड़ लयों, आलापों में,+पान कराती श्रोतागण को, झंकृत वीणा मधुशाला।।४१।++चित्रकार बन साकी आता लेकर तूली का प्याला,+जिसमें भरकर पान कराता वह बहु रस-रंगी हाला,+मन के चित्र जिसे पी-पीकर रंग-बिरंगे हो जाते,+चित्रपटी पर नाच रही है एक मनोहर मधुशाला।।४२।++घन श्यामल अंगूर लता से खिंच खिंच यह आती हाला,+अरूण-कमल-कोमल कलियों की प्याली, फूलों का प्याला,+लोल हिलोरें साकी बन बन माणिक मधु से भर जातीं,+हंस मत्त होते पी पीकर मानसरोवर मधुशाला।।४३।++हिम श्रेणी अंगूर लता-सी फैली, हिम जल है हाला,+चंचल नदियाँ साकी बनकर, भरकर लहरों का प्याला,+कोमल कूर-करों में अपने छलकाती निशिदिन चलतीं,+पीकर खेत खड़े लहराते, भारत पावन मधुशाला।।४४।++धीर सुतों के हृदय रक्त की आज बना रक्तिम हाला,+वीर सुतों के वर शीशों का हाथों में लेकर प्याला,+अति उदार दानी साकी है आज बनी भारतमाता,+स्वतंत्रता है तृषित कालिका बलिवेदी है मधुशाला।।४५।++दुतकारा मस्जिद ने मुझको कहकर है पीनेवाला,+ठुकराया ठाकुरद्वारे ने देख हथेली पर प्याला,+कहाँ ठिकाना मिलता जग में भला अभागे काफिर को?+शरणस्थल बनकर न मुझे यदि अपना लेती मधुशाला।।४६।++पथिक बना मैं घूम रहा हूँ, सभी जगह मिलती हाला,+सभी जगह मिल जाता साकी, सभी जगह मिलता प्याला,+मुझे ठहरने का, हे मित्रों, कष्ट नहीं कुछ भी होता,+मिले न मंदिर, मिले न मस्जिद, मिल जाती है मधुशाला।।४७।++सजें न मस्जिद और नमाज़ी कहता है अल्लाताला,+सजधजकर, पर, साकी आता, बन ठनकर, पीनेवाला,+शेख, कहाँ तुलना हो सकती मस्जिद की मदिरालय से+चिर विधवा है मस्जिद तेरी, सदा सुहागिन मधुशाला।।४८।++बजी नफ़ीरी और नमाज़ी भूल गया अल्लाताला,+गाज गिरी, पर ध्यान सुरा में मग्न रहा पीनेवाला,+शेख, बुरा मत मानो इसको, साफ़ कहूँ तो मस्जिद को+अभी युगों तक सिखलाएगी ध्यान लगाना मधुशाला!।४९।++मुसलमान औ' हिन्दू है दो, एक, मगर, उनका प्याला,+एक, मगर, उनका मदिरालय, एक, मगर, उनकी हाला,+दोनों रहते एक न जब तक मस्जिद मन्दिर में जाते,+बैर बढ़ाते मस्जिद मन्दिर मेल कराती मधुशाला!।५०।++कोई भी हो शेख नमाज़ी या पंडित जपता माला,+बैर भाव चाहे जितना हो मदिरा से रखनेवाला,+एक बार बस मधुशाला के आगे से होकर निकले,+देखूँ कैसे थाम न लेती दामन उसका मधुशाला!।५१।++और रसों में स्वाद तभी तक, दूर जभी तक है हाला,+इतरा लें सब पात्र न जब तक, आगे आता है प्याला,+कर लें पूजा शेख, पुजारी तब तक मस्जिद मन्दिर में+घूँघट का पट खोल न जब तक झाँक रही है मधुशाला।।५२।++आज करे परहेज़ जगत, पर, कल पीनी होगी हाला,+आज करे इन्कार जगत पर कल पीना होगा प्याला,+होने दो पैदा मद का महमूद जगत में कोई, फिर+जहाँ अभी हैं मन्दिर मस्जिद वहाँ बनेगी मधुशाला।।५३।++यज्ञ अग्नि सी धधक रही है मधु की भटठी की ज्वाला,+ऋषि सा ध्यान लगा बैठा है हर मदिरा पीने वाला,+मुनि कन्याओं सी मधुघट ले फिरतीं साकीबालाएँ,+किसी तपोवन से क्या कम है मेरी पावन मधुशाला।।५४।++सोम सुरा पुरखे पीते थे, हम कहते उसको हाला,+द्रोणकलश जिसको कहते थे, आज वही मधुघट आला,+वेदिवहित यह रस्म न छोड़ो वेदों के ठेकेदारों,+युग युग से है पुजती आई नई नहीं है मधुशाला।।५५।++वही वारूणी जो थी सागर मथकर निकली अब हाला,+रंभा की संतान जगत में कहलाती 'साकीबाला',+देव अदेव जिसे ले आए, संत महंत मिटा देंगे!+किसमें कितना दम खम, इसको खूब समझती मधुशाला।।५६।++कभी न सुन पड़ता, 'इसने, हा, छू दी मेरी हाला',+कभी न कोई कहता, 'उसने जूठा कर डाला प्याला',+सभी जाति के लोग यहाँ पर साथ बैठकर पीते हैं,+सौ सुधारकों का करती है काम अकेले मधुशाला।।५७।++श्रम, संकट, संताप, सभी तुम भूला करते पी हाला,+सबक बड़ा तुम सीख चुके यदि सीखा रहना मतवाला,+व्यर्थ बने जाते हो हिरजन, तुम तो मधुजन ही अच्छे,+ठुकराते हैं मंदिरवाले, पलक बिछाती मधुशाला।।५८।++एक तरह से सबका स्वागत करती है साकीबाला,+अज्ञ विज्ञ में है क्या अंतर हो जाने पर मतवाला,+रंक राव में भेद हुआ है कभी नहीं मदिरालय में,+साम्यवाद की प्रथम प्रचारक है यह मेरी मधुशाला।।५९।++बार बार मैंने आगे बढ़ आज नहीं माँगी हाला,+समझ न लेना इससे मुझको साधारण पीने वाला,+हो तो लेने दो ऐ साकी दूर प्रथम संकोचों को,+मेरे ही स्वर से फिर सारी गूँज उठेगी मधुशाला।।६०।++कल? कल पर विश्वास किया कब करता है पीनेवाला+हो सकते कल कर जड़ जिनसे फिर फिर आज उठा प्याला,+आज हाथ में था, वह खोया, कल का कौन भरोसा है,+कल की हो न मुझे मधुशाला काल कुटिल की मधुशाला।।६१।++आज मिला अवसर, तब फिर क्यों मैं न छकूँ जी-भर हाला+आज मिला मौका, तब फिर क्यों ढाल न लूँ जी-भर प्याला,+छेड़छाड़ अपने साकी से आज न क्यों जी-भर कर लूँ,+एक बार ही तो मिलनी है जीवन की यह मधुशाला।।६२।++आज सजीव बना लो, प्रेयसी, अपने अधरों का प्याला,+भर लो, भर लो, भर लो इसमें, यौवन मधुरस की हाला,+और लगा मेरे होठों से भूल हटाना तुम जाओ,+अथक बनू मैं पीनेवाला, खुले प्रणय की मधुशाला।।६३।++सुमुखी तुम्हारा, सुन्दर मुख ही, मुझको कन्चन का प्याला+छलक रही है जिसमें माणिक रूप मधुर मादक हाला,+मैं ही साकी बनता, मैं ही पीने वाला बनता हूँ+जहाँ कहीं मिल बैठे हम तुम़ वहीं गयी हो मधुशाला।।६४।++दो दिन ही मधु मुझे पिलाकर ऊब उठी साकीबाला,+भरकर अब खिसका देती है वह मेरे आगे प्याला,+नाज़, अदा, अंदाजों से अब, हाय पिलाना दूर हुआ,+अब तो कर देती है केवल फ़र्ज़ - अदाई मधुशाला।।६५।++छोटे-से जीवन में कितना प्यार करुँ, पी लूँ हाला,+आने के ही साथ जगत में कहलाया 'जानेवाला',+स्वागत के ही साथ विदा की होती देखी तैयारी,+बंद लगी होने खुलते ही मेरी जीवन-मधुशाला।।६६।++क्या पीना, निर्द्वन्द न जब तक ढाला प्यालों पर प्याला,+क्या जीना, निश्चिंत न जब तक साथ रहे साकीबाला,+खोने का भय, हाय, लगा है पाने के सुख के पीछे,+मिलने का आनंद न देती मिलकर के भी मधुशाला।।६७।++मुझे पिलाने को लाए हो इतनी थोड़ी-सी हाला! +मुझे दिखाने को लाए हो एक यही छिछला प्याला!+इतनी पी जीने से अच्छा सागर की ले प्यास मरुँ,+सिंधु-तृषा दी किसने रचकर बिंदु-बराबर मधुशाला।।६८।++क्या कहता है, रह न गई अब तेरे भाजन में हाला,+क्या कहता है, अब न चलेगी मादक प्यालों की माला,+थोड़ी पीकर प्यास बढ़ी तो शेष नहीं कुछ पीने को,+प्यास बुझाने को बुलवाकर प्यास बढ़ाती मधुशाला।।६९।++लिखी भाग्य में जितनी बस उतनी ही पाएगा हाला,+लिखा भाग्य में जैसा बस वैसा ही पाएगा प्याला,+लाख पटक तू हाथ पाँव, पर इससे कब कुछ होने का,+लिखी भाग्य में जो तेरे बस वही मिलेगी मधुशाला।।७०।++कर ले, कर ले कंजूसी तू मुझको देने में हाला,+दे ले, दे ले तू मुझको बस यह टूटा फूटा प्याला,+मैं तो सब्र इसी पर करता, तू पीछे पछताएगी,+जब न रहूँगा मैं, तब मेरी याद करेगी मधुशाला।।७१।++ध्यान मान का, अपमानों का छोड़ दिया जब पी हाला,+गौरव भूला, आया कर में जब से मिट्टी का प्याला,+साकी की अंदाज़ भरी झिड़की में क्या अपमान धरा,+दुनिया भर की ठोकर खाकर पाई मैंने मधुशाला।।७२।++क्षीण, क्षुद्र, क्षणभंगुर, दुर्बल मानव मिटटी का प्याला,+भरी हुई है जिसके अंदर कटु-मधु जीवन की हाला,+मृत्यु बनी है निर्दय साकी अपने शत-शत कर फैला,+काल प्रबल है पीनेवाला, संसृति है यह मधुशाला।।७३।++प्याले सा गढ़ हमें किसी ने भर दी जीवन की हाला,+नशा न भाया, ढाला हमने ले लेकर मधु का प्याला,+जब जीवन का दर्द उभरता उसे दबाते प्याले से,+जगती के पहले साकी से जूझ रही है मधुशाला।।७४।++अपने अंगूरों से तन में हमने भर ली है हाला,+क्या कहते हो, शेख, नरक में हमें तपाएगी ज्वाला,+तब तो मदिरा खूब खिंचेगी और पिएगा भी कोई,+हमें नमक की ज्वाला में भी दीख पड़ेगी मधुशाला।।७५।++यम आएगा लेने जब, तब खूब चलूँगा पी हाला,+पीड़ा, संकट, कष्ट नरक के क्या समझेगा मतवाला,+क्रूर, कठोर, कुटिल, कुविचारी, अन्यायी यमराजों के+डंडों की जब मार पड़ेगी, आड़ करेगी मधुशाला।।७६।++यदि इन अधरों से दो बातें प्रेम भरी करती हाला,+यदि इन खाली हाथों का जी पल भर बहलाता प्याला,+हानि बता, जग, तेरी क्या है, व्यर्थ मुझे बदनाम न कर,+मेरे टूटे दिल का है बस एक खिलौना मधुशाला।।७७।++याद न आए दुखमय जीवन इससे पी लेता हाला,+जग चिंताओं से रहने को मुक्त, उठा लेता प्याला,+शौक, साध के और स्वाद के हेतु पिया जग करता है,+पर मै वह रोगी हूँ जिसकी एक दवा है मधुशाला।।७८।++गिरती जाती है दिन प्रतिदन प्रणयनी प्राणों की हाला+भग्न हुआ जाता दिन प्रतिदन सुभगे मेरा तन प्याला,+रूठ रहा है मुझसे रूपसी, दिन दिन यौवन का साकी+सूख रही है दिन दिन सुन्दरी, मेरी जीवन मधुशाला।।७९।++यम आयेगा साकी बनकर साथ लिए काली हाला,+पी न होश में फिर आएगा सुरा-विसुध यह मतवाला,+यह अंतिम बेहोशी, अंतिम साकी, अंतिम प्याला है,+पथिक, प्यार से पीना इसको फिर न मिलेगी मधुशाला।८०।++ढलक रही है तन के घट से, संगिनी जब जीवन हाला+पत्र गरल का ले जब अंतिम साकी है आनेवाला,+हाथ स्पर्श भूले प्याले का, स्वाद सुरा जीव्हा भूले+कानो में तुम कहती रहना, मधु का प्याला मधुशाला।।८१।++मेरे अधरों पर हो अंतिम वस्तु न तुलसीदल प्याला+मेरी जीव्हा पर हो अंतिम वस्तु न गंगाजल हाला,+मेरे शव के पीछे चलने वालों याद इसे रखना+राम नाम है सत्य न कहना, कहना सच्ची मधुशाला।।८२।++मेरे शव पर वह रोये, हो जिसके आंसू में हाला+आह भरे वो, जो हो सुरिभत मदिरा पी कर मतवाला,+दे मुझको वो कान्धा जिनके पग मद डगमग होते हों+और जलूं उस ठौर जहां पर कभी रही हो मधुशाला।।८३।++और चिता पर जाये उंढेला पात्र न घ्रित का, पर प्याला+कंठ बंधे अंगूर लता में मध्य न जल हो, पर हाला,+प्राण प्रिये यदि श्राध करो तुम मेरा तो ऐसे करना+पीने वालों को बुलवा कऱ खुलवा देना मधुशाला।।८४।++नाम अगर कोई पूछे तो, कहना बस पीनेवाला+काम ढालना, और ढालना सबको मदिरा का प्याला,+जाति प्रिये, पूछे यदि कोई कह देना दीवानों की +धर्म बताना प्यालों की ले माला जपना मधुशाला।।८५।++ज्ञात हुआ यम आने को है ले अपनी काली हाला,+पंडित अपनी पोथी भूला, साधू भूल गया माला,+और पुजारी भूला पूजा, ज्ञान सभी ज्ञानी भूला,+किन्तु न भूला मरकर के भी पीनेवाला मधुशाला।।८६।++यम ले चलता है मुझको तो, चलने दे लेकर हाला,+चलने दे साकी को मेरे साथ लिए कर में प्याला,+स्वर्ग, नरक या जहाँ कहीं भी तेरा जी हो लेकर चल,+ठौर सभी हैं एक तरह के साथ रहे यदि मधुशाला।।८७।++पाप अगर पीना, समदोषी तो तीनों - साकी बाला,+नित्य पिलानेवाला प्याला, पी जानेवाली हाला,+साथ इन्हें भी ले चल मेरे न्याय यही बतलाता है,+कैद जहाँ मैं हूँ, की जाए कैद वहीं पर मधुशाला।।८८।++शांत सकी हो अब तक, साकी, पीकर किस उर की ज्वाला,+'और, और' की रटन लगाता जाता हर पीनेवाला,+कितनी इच्छाएँ हर जानेवाला छोड़ यहाँ जाता!+कितने अरमानों की बनकर कब्र खड़ी है मधुशाला।।८९।++जो हाला मैं चाह रहा था, वह न मिली मुझको हाला,+जो प्याला मैं माँग रहा था, वह न मिला मुझको प्याला,+जिस साकी के पीछे मैं था दीवाना, न मिला साकी,+जिसके पीछे था मैं पागल, हा न मिली वह मधुशाला!।९०।++देख रहा हूँ अपने आगे कब से माणिक-सी हाला,+देख रहा हूँ अपने आगे कब से कंचन का प्याला,+'बस अब पाया!'- कह-कह कब से दौड़ रहा इसके पीछे,+किंतु रही है दूर क्षितिज-सी मुझसे मेरी मधुशाला।।९१।++कभी निराशा का तम घिरता, छिप जाता मधु का प्याला,+छिप जाती मदिरा की आभा, छिप जाती साकीबाला,+कभी उजाला आशा करके प्याला फिर चमका जाती,+आँख मिचौली खेल रही है मुझसे मेरी मधुशाला।।९२।++'आ आगे' कहकर कर पीछे कर लेती साकीबाला,+होंठ लगाने को कहकर हर बार हटा लेती प्याला,+नहीं मुझे मालूम कहाँ तक यह मुझको ले जाएगी,+बढ़ा बढ़ाकर मुझको आगे, पीछे हटती मधुशाला।।९३।++हाथों में आने-आने में, हाय, फिसल जाता प्याला,+अधरों पर आने-आने में हाय, ढुलक जाती हाला,+दुनियावालो, आकर मेरी किस्मत की ख़ूबी देखो,+रह-रह जाती है बस मुझको मिलते-मिलते मधुशाला।।९४।++प्राप्य नही है तो, हो जाती लुप्त नहीं फिर क्यों हाला,+प्राप्य नही है तो, हो जाता लुप्त नहीं फिर क्यों प्याला,+दूर न इतनी हिम्मत हारुँ, पास न इतनी पा जाऊँ,+व्यर्थ मुझे दौड़ाती मरु में मृगजल बनकर मधुशाला।।९५।++मिले न, पर, ललचा ललचा क्यों आकुल करती है हाला,+मिले न, पर, तरसा तरसाकर क्यों तड़पाता है प्याला,+हाय, नियति की विषम लेखनी मस्तक पर यह खोद गई+'दूर रहेगी मधु की धारा, पास रहेगी मधुशाला!'।९६।++मदिरालय में कब से बैठा, पी न सका अब तक हाला,+यत्न सहित भरता हूँ, कोई किंतु उलट देता प्याला,+मानव-बल के आगे निर्बल भाग्य, सुना विद्यालय में,+'भाग्य प्रबल, मानव निर्बल' का पाठ पढ़ाती मधुशाला।।९७।++किस्मत में था खाली खप्पर, खोज रहा था मैं प्याला,+ढूँढ़ रहा था मैं मृगनयनी, किस्मत में थी मृगछाला,+किसने अपना भाग्य समझने में मुझसा धोखा खाया,+किस्मत में था अवघट मरघट, ढूँढ़ रहा था मधुशाला।।९८।++उस प्याले से प्यार मुझे जो दूर हथेली से प्याला,+उस हाला से चाव मुझे जो दूर अधर से है हाला,+प्यार नहीं पा जाने में है, पाने के अरमानों में!+पा जाता तब, हाय, न इतनी प्यारी लगती मधुशाला।।९९।++साकी के पास है तनिक सी श्री, सुख, संपित की हाला,+सब जग है पीने को आतुर ले ले किस्मत का प्याला,+रेल ठेल कुछ आगे बढ़ते, बहुतेरे दबकर मरते,+जीवन का संघर्ष नहीं है, भीड़ भरी है मधुशाला।।१००।++साकी, जब है पास तुम्हारे इतनी थोड़ी सी हाला,+क्यों पीने की अभिलषा से, करते सबको मतवाला,+हम पिस पिसकर मरते हैं, तुम छिप छिपकर मुसकाते हो,+हाय, हमारी पीड़ा से है क्रीड़ा करती मधुशाला।।१०१।++साकी, मर खपकर यदि कोई आगे कर पाया प्याला,+पी पाया केवल दो बूंदों से न अधिक तेरी हाला,+जीवन भर का, हाय, पिरश्रम लूट लिया दो बूंदों ने,+भोले मानव को ठगने के हेतु बनी है मधुशाला।।१०२।++जिसने मुझको प्यासा रक्खा बनी रहे वह भी हाला,+जिसने जीवन भर दौड़ाया बना रहे वह भी प्याला,+मतवालों की जिह्वा से हैं कभी निकलते शाप नहीं,+दुखी बनाया जिसने मुझको सुखी रहे वह मधुशाला!।१०३।++नहीं चाहता, आगे बढ़कर छीनूँ औरों की हाला,+नहीं चाहता, धक्के देकर, छीनूँ औरों का प्याला,+साकी, मेरी ओर न देखो मुझको तनिक मलाल नहीं,+इतना ही क्या कम आँखों से देख रहा हूँ मधुशाला।।१०४।++मद, मदिरा, मधु, हाला सुन-सुन कर ही जब हूँ मतवाला,+क्या गति होगी अधरों के जब नीचे आएगा प्याला,+साकी, मेरे पास न आना मैं पागल हो जाऊँगा,+प्यासा ही मैं मस्त, मुबारक हो तुमको ही मधुशाला।।१०५।++क्या मुझको आवश्यकता है साकी से माँगूँ हाला,+क्या मुझको आवश्यकता है साकी से चाहूँ प्याला,+पीकर मदिरा मस्त हुआ तो प्यार किया क्या मदिरा से!+मैं तो पागल हो उठता हूँ सुन लेता यदि मधुशाला।।१०६।++देने को जो मुझे कहा था दे न सकी मुझको हाला,+देने को जो मुझे कहा था दे न सका मुझको प्याला,+समझ मनुज की दुर्बलता मैं कहा नहीं कुछ भी करता,+किन्तु स्वयं ही देख मुझे अब शरमा जाती मधुशाला।।१०७।++एक समय संतुष्ट बहुत था पा मैं थोड़ी-सी हाला,+भोला-सा था मेरा साकी, छोटा-सा मेरा प्याला,+छोटे-से इस जग की मेरे स्वर्ग बलाएँ लेता था,+विस्तृत जग में, हाय, गई खो मेरी नन्ही मधुशाला!।१०८।++बहुतेरे मदिरालय देखे, बहुतेरी देखी हाला,+भाँति भाँति का आया मेरे हाथों में मधु का प्याला,+एक एक से बढ़कर, सुन्दर साकी ने सत्कार किया,+जँची न आँखों में, पर, कोई पहली जैसी मधुशाला।।१०९।++एक समय छलका करती थी मेरे अधरों पर हाला,+एक समय झूमा करता था मेरे हाथों पर प्याला,+एक समय पीनेवाले, साकी आलिंगन करते थे,+आज बनी हूँ निर्जन मरघट, एक समय थी मधुशाला।।११०।++जला हृदय की भट्टी खींची मैंने आँसू की हाला,+छलछल छलका करता इससे पल पल पलकों का प्याला,+आँखें आज बनी हैं साकी, गाल गुलाबी पी होते,+कहो न विरही मुझको, मैं हूँ चलती फिरती मधुशाला!।१११।++कितनी जल्दी रंग बदलती है अपना चंचल हाला,+कितनी जल्दी घिसने लगता हाथों में आकर प्याला,+कितनी जल्दी साकी का आकर्षण घटने लगता है,+प्रात नहीं थी वैसी, जैसी रात लगी थी मधुशाला।।११२।++बूँद बूँद के हेतु कभी तुझको तरसाएगी हाला,+कभी हाथ से छिन जाएगा तेरा यह मादक प्याला,+पीनेवाले, साकी की मीठी बातों में मत आना,+मेरे भी गुण यों ही गाती एक दिवस थी मधुशाला।।११३।++छोड़ा मैंने पथ मतों को तब कहलाया मतवाला,+चली सुरा मेरा पग धोने तोड़ा जब मैंने प्याला,+अब मानी मधुशाला मेरे पीछे पीछे फिरती है,+क्या कारण? अब छोड़ दिया है मैंने जाना मधुशाला।।११४।++यह न समझना, पिया हलाहल मैंने, जब न मिली हाला,+तब मैंने खप्पर अपनाया ले सकता था जब प्याला,+जले हृदय को और जलाना सूझा, मैंने मरघट को+अपनाया जब इन चरणों में लोट रही थी मधुशाला।।११५।++कितनी आई और गई पी इस मदिरालय में हाला,+टूट चुकी अब तक कितने ही मादक प्यालों की माला,+कितने साकी अपना अपना काम खतम कर दूर गए,+कितने पीनेवाले आए, किन्तु वही है मधुशाला।।११६।++कितने होठों को रक्खेगी याद भला मादक हाला,+कितने हाथों को रक्खेगा याद भला पागल प्याला,+कितनी शक्लों को रक्खेगा याद भला भोला साकी,+कितने पीनेवालों में है एक अकेली मधुशाला।।११७।++दर दर घूम रहा था जब मैं चिल्लाता - हाला! हाला!+मुझे न मिलता था मदिरालय, मुझे न मिलता था प्याला,+मिलन हुआ, पर नहीं मिलनसुख लिखा हुआ था किस्मत में,+मैं अब जमकर बैठ गया हूँ, घूम रही है मधुशाला।।११८।++मैं मदिरालय के अंदर हूँ, मेरे हाथों में प्याला,+प्याले में मदिरालय बिंबित करनेवाली है हाला,+इस उधेड़-बुन में ही मेरा सारा जीवन बीत गया -+मैं मधुशाला के अंदर या मेरे अंदर मधुशाला!।११९।++किसे नहीं पीने से नाता, किसे नहीं भाता प्याला,+इस जगती के मदिरालय में तरह-तरह की है हाला,+अपनी-अपनी इच्छा के अनुसार सभी पी मदमाते,+एक सभी का मादक साकी, एक सभी की मधुशाला।।१२०।++वह हाला, कर शांत सके जो मेरे अंतर की ज्वाला, +जिसमें मैं बिंबित-प्रतिबिंबित प्रतिपल, वह मेरा प्याला,+मधुशाला वह नहीं जहाँ पर मदिरा बेची जाती है,+भेंट जहाँ मस्ती की मिलती मेरी तो वह मधुशाला।।१२१।++मतवालापन हाला से ले मैंने तज दी है हाला,+पागलपन लेकर प्याले से, मैंने त्याग दिया प्याला,+साकी से मिल, साकी में मिल अपनापन मैं भूल गया,+मिल मधुशाला की मधुता में भूल गया मैं मधुशाला।।१२२।++मदिरालय के द्वार ठोंकता किस्मत का छूंछा प्याला,+गहरी, ठंडी सांसें भर भर कहता था हर मतवाला,+कितनी थोड़ी सी यौवन की हाला, हा, मैं पी पाया!+बंद हो गई कितनी जल्दी मेरी जीवन मधुशाला।।१२३।++कहाँ गया वह स्वर्गिक साकी, कहाँ गयी सुरिभत हाला,+कहाँ गया स्वपिनल मदिरालय, कहाँ गया स्वर्णिम प्याला!+पीनेवालों ने मदिरा का मूल्य, हाय, कब पहचाना?+फूट चुका जब मधु का प्याला, टूट चुकी जब मधुशाला।।१२४।++अपने युग में सबको अनुपम ज्ञात हुई अपनी हाला, +अपने युग में सबको अदभुत ज्ञात हुआ अपना प्याला,+फिर भी वृद्धों से जब पूछा एक यही उत्तर पाया -+अब न रहे वे पीनेवाले, अब न रही वह मधुशाला!।१२५।++'मय' को करके शुद्ध दिया अब नाम गया उसको, 'हाला'+'मीना' को 'मधुपात्र' दिया 'सागर' को नाम गया 'प्याला',+क्यों न मौलवी चौंकें, बिचकें तिलक-त्रिपुंडी पंडित जी+'मय-महिफल' अब अपना ली है मैंने करके 'मधुशाला'।।१२६।++कितने मर्म जता जाती है बार-बार आकर हाला,+कितने भेद बता जाता है बार-बार आकर प्याला,+कितने अर्थों को संकेतों से बतला जाता साकी,+फिर भी पीनेवालों को है एक पहेली मधुशाला।।१२७।++जितनी दिल की गहराई हो उतना गहरा है प्याला,+जितनी मन की मादकता हो उतनी मादक है हाला,+जितनी उर की भावुकता हो उतना सुन्दर साकी है,+जितना ही जो रिसक, उसे है उतनी रसमय मधुशाला।।१२८।++जिन अधरों को छुए, बना दे मस्त उन्हें मेरी हाला,+जिस कर को छू दे, कर दे विक्षिप्त उसे मेरा प्याला,+आँख चार हों जिसकी मेरे साकी से दीवाना हो,+पागल बनकर नाचे वह जो आए मेरी मधुशाला।।१२९।++हर जिव्हा पर देखी जाएगी मेरी मादक हाला+हर कर में देखा जाएगा मेरे साकी का प्याला+हर घर में चर्चा अब होगी मेरे मधुविक्रेता की+हर आंगन में गमक उठेगी मेरी सुरिभत मधुशाला।।१३०।++मेरी हाला में सबने पाई अपनी-अपनी हाला,+मेरे प्याले में सबने पाया अपना-अपना प्याला,+मेरे साकी में सबने अपना प्यारा साकी देखा,+जिसकी जैसी रुचि थी उसने वैसी देखी मधुशाला।।१३१।++यह मदिरालय के आँसू हैं, नहीं-नहीं मादक हाला,+यह मदिरालय की आँखें हैं, नहीं-नहीं मधु का प्याला,+किसी समय की सुखदस्मृति है साकी बनकर नाच रही,+नहीं-नहीं कवि का हृदयांगण, यह विरहाकुल मधुशाला।।१३२। ++कुचल हसरतें कितनी अपनी, हाय, बना पाया हाला,+कितने अरमानों को करके ख़ाक बना पाया प्याला!+पी पीनेवाले चल देंगे, हाय, न कोई जानेगा,+कितने मन के महल ढहे तब खड़ी हुई यह मधुशाला!।१३३।++विश्व तुम्हारे विषमय जीवन में ला पाएगी हाला+यदि थोड़ी-सी भी यह मेरी मदमाती साकीबाला,+शून्य तुम्हारी घड़ियाँ कुछ भी यदि यह गुंजित कर पाई,+जन्म सफल समझेगी जग में अपना मेरी मधुशाला।।१३४।++बड़े-बड़े नाज़ों से मैंने पाली है साकीबाला,+कलित कल्पना का ही इसने सदा उठाया है प्याला,+मान-दुलारों से ही रखना इस मेरी सुकुमारी को,+विश्व, तुम्हारे हाथों में अब सौंप रहा हूँ मधुशाला।।१३५।++पिरिशष्ट से++स्वयं नहीं पीता, औरों को, किन्तु पिला देता हाला,+स्वयं नहीं छूता, औरों को, पर पकड़ा देता प्याला,+पर उपदेश कुशल बहुतेरों से मैंने यह सीखा है,+स्वयं नहीं जाता, औरों को पहुंचा देता मधुशाला।++मैं कायस्थ कुलोदभव मेरे पुरखों ने इतना ढ़ाला,+मेरे तन के लोहू में है पचहत्तर प्रतिशत हाला,+पुश्तैनी अधिकार मुझे है मदिरालय के आँगन पर,+मेरे दादों परदादों के हाथ बिकी थी मधुशाला।++बहुतों के सिर चार दिनों तक चढ़कर उतर गई हाला,+बहुतों के हाथों में दो दिन छलक झलक रीता प्याला,+पर बढ़ती तासीर सुरा की साथ समय के, इससे ही+और पुरानी होकर मेरी और नशीली मधुशाला।++पितृ पक्ष में पुत्र उठाना अर्ध्य न कर में, पर प्याला+बैठ कहीं पर जाना, गंगा सागर में भरकर हाला+किसी जगह की मिटटी भीगे, तृप्ति मुझे मिल जाएगी+तर्पण अर्पण करना मुझको, पढ़ पढ़ कर के मधुशाला।++- बच्चन
+ benchmark/Streamly/Benchmark/Unicode/data/English.txt view
@@ -0,0 +1,58 @@+Origins[edit]+The standard Italian language has a poetic and literary origin in the twelfth century, and the modern standard of the language was largely shaped by relatively recent events. However, Italian as a language used in the Italian Peninsula has a longer history. In fact the earliest surviving texts that can definitely be called Italian (or more accurately, vernacular, as distinct from its predecessor Vulgar Latin) are legal formulae known as the Placiti Cassinesi from the Province of Benevento that date from 960–963, although the Veronese Riddle contains a late form of Vulgar Latin that can be seen as a very early Italian dialect.[13] What would come to be thought of as Italian was first formalized in the early fourteenth century through the works of Tuscan writer Dante Alighieri, written in his native Florentine. Dante's epic poems, known collectively as the Commedia, to which another Tuscan poet Giovanni Boccaccio later affixed the title Divina, were read throughout Italy and his written dialect became the "canonical standard" that all educated Italians could understand. Dante is still credited with standardizing the Italian language, and thus the dialect of Florence became the basis for what would become the official language of Italy.++Italian often was an official language of the various Italian states predating unification, slowly usurping Latin, even when ruled by foreign powers (such as the Spanish in the Kingdom of Naples, or the Austrians in the Kingdom of Lombardy-Venetia), even though the masses spoke primarily vernacular languages and dialects. Italian was also one of the many recognised languages in the Austro-Hungarian Empire.++Italy has always had a distinctive dialect for each city, because the cities, until recently, were thought of as city-states. Those dialects now have considerable variety. As Tuscan-derived Italian came to be used throughout Italy, features of local speech were naturally adopted, producing various versions of Regional Italian. The most characteristic differences, for instance, between Roman Italian and Milanese Italian are the gemination of initial consonants and the pronunciation of stressed "e", and of "s" in some cases: e.g. va bene "all right": is pronounced [va ˈbːɛne] by a Roman (and by any standard-speaker), [va ˈbene] by a Milanese (and by any speaker whose native dialect lies to the north of La Spezia–Rimini Line); a casa "at home" is [a ˈkːasa] for Roman and standard, [a ˈkaza] for Milanese and generally northern.++In contrast to the Northern Italian language, southern Italian dialects and languages were largely untouched by the Franco-Occitan influences introduced to Italy, mainly by bards from France, during the Middle Ages but, after the Norman conquest of southern Italy, Sicily became the first Italian land to adopt Occitan lyric moods (and words) in poetry. Even in the case of Northern Italian language, however, scholars are careful not to overstate the effects of outsiders on the natural indigenous developments of the languages.++The economic might and relatively advanced development of Tuscany at the time (Late Middle Ages) gave its dialect weight, though the Venetian language remained widespread in medieval Italian commercial life, and Ligurian (or Genoese) remained in use in maritime trade alongside the Mediterranean. The increasing political and cultural relevance of Florence during the periods of the rise of Medici's bank, Humanism, and the Renaissance made its dialect, or rather a refined version of it, a standard in the arts.++Renaissance[edit]+Main article: Italian Renaissance+Starting with the Renaissance, Italian became the language used in the courts of every state in the peninsula. The rediscovery of Dante's De vulgari eloquentia and a renewed interest in linguistics in the sixteenth century, sparked a debate that raged throughout Italy concerning the criteria that should govern the establishment of a modern Italian literary and spoken language. Scholars divided into three factions:++The purists, headed by Venetian Pietro Bembo (who, in his Gli Asolani, claimed the language might be based only on the great literary classics, such as Petrarch and some part of Boccaccio). The purists thought the Divine Comedy not dignified enough, because it used elements from non-lyric registers of the language.+Niccolò Machiavelli and other Florentines preferred the version spoken by ordinary people in their own times.+The courtiers, like Baldassare Castiglione and Gian Giorgio Trissino, insisted that each local vernacular contribute to the new standard.+A fourth faction claimed the best Italian was the one that the papal court adopted, which was a mix of Florentine and the dialect of Rome. Eventually, Bembo's ideas prevailed, and the foundation of the Accademia della Crusca in Florence (1582–1583), the official legislative body of the Italian language led to publication of Agnolo Monosini's Latin tome Floris italicae linguae libri novem in 1604 followed by the first Italian dictionary in 1612.++Modern era[edit]+An important event that helped the diffusion of Italian was the conquest and occupation of Italy by Napoleon in the early nineteenth century (who was himself of Italian-Corsican descent). This conquest propelled the unification of Italy some decades after, and pushed the Italian language into a lingua franca used not only among clerks, nobility and functionaries in the Italian courts but also in the bourgeoisie.++Contemporary times[edit]+Italian literature's first modern novel, I Promessi Sposi (The Betrothed), by Alessandro Manzoni, further defined the standard by "rinsing" his Milanese "in the waters of the Arno" (Florence's river), as he states in the Preface to his 1840 edition.++After unification a huge number of civil servants and soldiers recruited from all over the country introduced many more words and idioms from their home languages ("ciao" is derived from Venetian word "s-cia[v]o" (slave), "panettone" comes from Lombard word "panatton" etc.). Only 2.5% of Italy’s population could speak the Italian standardized language properly when the nation unified in 1861.[14]++Classification[edit]+Italian is a Romance language, and is therefore a descendant of Vulgar Latin. Standard Italian is based on Tuscan, especially its Florentine dialect, and is therefore an Italo-Dalmatian language, to which Sicilian and the extinct Dalmatian also belong, among a few others.++Unlike most other Romance languages, Italian retains Latin's contrast between short and long consonants. As in most Romance languages, stress is distinctive. In particular, among the Romance languages, Italian is the closest to Latin in terms of vocabulary.[12] Lexical similarity is 89% with French, 88% with Catalan, 85% with Sardinian, 82% with Spanish and Portuguese, 78% with Rhaeto-Romance, and 77% with Romanian.[6][15]++Geographic distribution[edit]++The geographic distribution of the Italian language in the world: large Italian-speaking communities are shown in green; light blue indicates areas where the Italian language was used officially during the Italian colonial period.++Use of the Italian language in Europe++Use of the Italian language in Europe and former use in Africa+Europe[edit]+Italian is the official language of Italy and San Marino and is spoken fluently by the majority of the countries' populations. Italian is official, together with French, German and Romansch in Switzerland, with most of the 0.5 million speakers concentrated in the south of the country, in the cantons of Ticino and southern Graubünden (predominately in Italian Girgioni). Italian is the third most spoken language in Switzerland (after German and French), and its use has modestly declined since the 1970s.[16] Italian is also used in administration and official documents in Vatican City.[17]++Italian is widely spoken in Malta, where nearly two-thirds of the population can speak it fluently, making it the most spoken non-official language in Europe in 2005.[18] Italian served as Malta's official language until 1934, while it is also recognized as an official language in Istria County, Croatia and Slovenian Istria, where there are significant and historic Italian populations.[citation needed]++It is used as the official language of the Sovereign Military Order of Malta, a Roman Catholic chivalric order which, while not a nation per se, is still recognized as a sovereign subject of international law.++Italian is also spoken by a minority in Monaco and France (especially in the southeast of the country and Corsica).[19][20] Small Italian-speaking minorities can also be found in Albania and Montenegro.[citation needed]++Africa[edit]+Due to heavy Italian influence during the Italian colonial period, Italian is still widely understood in the countries of Libya and Eritrea.[6] Although it was the primary language since colonial rule, Italian greatly declined under the rule of Muammar Gaddafi, who expelled the Italian Libyan population and made Arabic the sole official language of the country.[21] Nevertheless, Italian remains an important language in the education and economic sectors in Libya. In Eritrea, Italian is a principal language in commerce and the capital city Asmara still has an Italian-language school.[22] Italian was also introduced to Somalia through colonialism and was the sole official language of administration and education during the colonial period but declined after government, educational and economic infrastructure was destroyed in the Somali Civil War. Italian remains spoken as a second language by the elderly and the educated and is also used in the new Federal Government of Somalia.[23][24]++Italian was also used in administration in Ethiopia when the country was briefly occupied by Italy from 1936 to 1941.++Immigrant communities[edit]+Although over 17 million Americans are of Italian descent, only a little over one million people in the United States speak Italian at home.[25] Nevertheless, an Italian language media market does exist in the country.[26]++In Canada, Italian is the second most spoken non-official language when Chinese languages are not combined, with over 660,000 speakers (or abou
+ benchmark/Streamly/Benchmark/Unicode/data/Japanese.txt view
@@ -0,0 +1,855 @@+私は、その男の写真を三葉、見たことがある。+　一葉は、その男の、幼年時代、とでも言うべきであろうか、十歳前後かと推定される頃の写真であって、その子供が大勢の女のひとに取りかこまれ、（それは、その子供の姉たち、妹たち、それから、従姉妹《いとこ》たちかと想像される）庭園の池のほとりに、荒い縞の袴《はかま》をはいて立ち、首を三十度ほど左に傾け、醜く笑っている写真である。醜く？　けれども、鈍い人たち（つまり、美醜などに関心を持たぬ人たち）は、面白くも何とも無いような顔をして、+「可愛い坊ちゃんですね」+　といい加減なお世辞を言っても、まんざら空《から》お世辞に聞えないくらいの、謂《い》わば通俗の「可愛らしさ」みたいな影もその子供の笑顔に無いわけではないのだが、しかし、いささかでも、美醜に就いての訓練を経て来たひとなら、ひとめ見てすぐ、+「なんて、いやな子供だ」+　と頗《すこぶ》る不快そうに呟《つぶや》き、毛虫でも払いのける時のような手つきで、その写真をほうり投げるかも知れない。+　まったく、その子供の笑顔は、よく見れば見るほど、何とも知れず、イヤな薄気味悪いものが感ぜられて来る。どだい、それは、笑顔でない。この子は、少しも笑ってはいないのだ。その証拠には、この子は、両方のこぶしを固く握って立っている。人間は、こぶしを固く握りながら笑えるものでは無いのである。猿だ。猿の笑顔だ。ただ、顔に醜い皺《しわ》を寄せているだけなのである。「皺くちゃ坊ちゃん」とでも言いたくなるくらいの、まことに奇妙な、そうして、どこかけがらわしく、へんにひとをムカムカさせる表情の写真であった。私はこれまで、こんな不思議な表情の子供を見た事が、いちども無かった。+　第二葉の写真の顔は、これはまた、びっくりするくらいひどく変貌《へんぼう》していた。学生の姿である。高等学校時代の写真か、大学時代の写真か、はっきりしないけれども、とにかく、おそろしく美貌の学生である。しかし、これもまた、不思議にも、生きている人間の感じはしなかった。学生服を着て、胸のポケットから白いハンケチを覗《のぞ》かせ、籐椅子《とういす》に腰かけて足を組み、そうして、やはり、笑っている。こんどの笑顔は、皺くちゃの猿の笑いでなく、かなり巧みな微笑になってはいるが、しかし、人間の笑いと、どこやら違う。血の重さ、とでも言おうか、生命《いのち》の渋さ、とでも言おうか、そのような充実感は少しも無く、それこそ、鳥のようではなく、羽毛のように軽く、ただ白紙一枚、そうして、笑っている。つまり、一から十まで造り物の感じなのである。キザと言っても足りない。軽薄と言っても足りない。ニヤケと言っても足りない。おしゃれと言っても、もちろん足りない。しかも、よく見ていると、やはりこの美貌の学生にも、どこか怪談じみた気味悪いものが感ぜられて来るのである。私はこれまで、こんな不思議な美貌の青年を見た事が、いちども無かった。+　もう一葉の写真は、最も奇怪なものである。まるでもう、としの頃がわからない。頭はいくぶん白髪のようである。それが、ひどく汚い部屋（部屋の壁が三箇所ほど崩れ落ちているのが、その写真にハッキリ写っている）の片隅で、小さい火鉢に両手をかざし、こんどは笑っていない。どんな表情も無い。謂わば、坐って火鉢に両手をかざしながら、自然に死んでいるような、まことにいまわしい、不吉なにおいのする写真であった。奇怪なのは、それだけでない。その写真には、わりに顔が大きく写っていたので、私は、つくづくその顔の構造を調べる事が出来たのであるが、額は平凡、額の皺も平凡、眉も平凡、眼も平凡、鼻も口も顎《あご》も、ああ、この顔には表情が無いばかりか、印象さえ無い。特徴が無いのだ。たとえば、私がこの写真を見て、眼をつぶる。既に私はこの顔を忘れている。部屋の壁や、小さい火鉢は思い出す事が出来るけれども、その部屋の主人公の顔の印象は、すっと霧消して、どうしても、何としても思い出せない。画にならない顔である。漫画にも何もならない顔である。眼をひらく。あ、こんな顔だったのか、思い出した、というようなよろこびさえ無い。極端な言い方をすれば、眼をひらいてその写真を再び見ても、思い出せない。そうして、ただもう不愉快、イライラして、つい眼をそむけたくなる。+　所謂《いわゆる》「死相」というものにだって、もっと何か表情なり印象なりがあるものだろうに、人間のからだに駄馬の首でもくっつけたなら、こんな感じのものになるであろうか、とにかく、どこという事なく、見る者をして、ぞっとさせ、いやな気持にさせるのだ。私はこれまで、こんな不思議な男の顔を見た事が、やはり、いちども無かった。+［＃改頁］++++［＃３字下げ］第一の手記［＃「第一の手記」は大見出し］+++　恥の多い生涯を送って来ました。+　自分には、人間の生活というものが、見当つかないのです。自分は東北の田舎に生れましたので、汽車をはじめて見たのは、よほど大きくなってからでした。自分は停車場のブリッジを、上って、降りて、そうしてそれが線路をまたぎ越えるために造られたものだという事には全然気づかず、ただそれは停車場の構内を外国の遊戯場みたいに、複雑に楽しく、ハイカラにするためにのみ、設備せられてあるものだとばかり思っていました。しかも、かなり永い間そう思っていたのです。ブリッジの上ったり降りたりは、自分にはむしろ、ずいぶん垢抜《あかぬ》けのした遊戯で、それは鉄道のサーヴィスの中でも、最も気のきいたサーヴィスの一つだと思っていたのですが、のちにそれはただ旅客が線路をまたぎ越えるための頗る実利的な階段に過ぎないのを発見して、にわかに興が覚めました。+　また、自分は子供の頃、絵本で地下鉄道というものを見て、これもやはり、実利的な必要から案出せられたものではなく、地上の車に乗るよりは、地下の車に乗ったほうが風がわりで面白い遊びだから、とばかり思っていました。+　自分は子供の頃から病弱で、よく寝込みましたが、寝ながら、敷布、枕のカヴァ、掛蒲団のカヴァを、つくづく、つまらない装飾だと思い、それが案外に実用品だった事を、二十歳ちかくになってわかって、人間のつましさに暗然とし、悲しい思いをしました。+　また、自分は、空腹という事を知りませんでした。いや、それは、自分が衣食住に困らない家に育ったという意味ではなく、そんな馬鹿な意味ではなく、自分には「空腹」という感覚はどんなものだか、さっぱりわからなかったのです。へんな言いかたですが、おなかが空いていても、自分でそれに気がつかないのです。小学校、中学校、自分が学校から帰って来ると、周囲の人たちが、それ、おなかが空いたろう、自分たちにも覚えがある、学校から帰って来た時の空腹は全くひどいからな、甘納豆はどう？　カステラも、パンもあるよ、などと言って騒ぎますので、自分は持ち前のおべっか精神を発揮して、おなかが空いた、と呟いて、甘納豆を十粒ばかり口にほうり込むのですが、空腹感とは、どんなものだか、ちっともわかっていやしなかったのです。+　自分だって、それは勿論《もちろん》、大いにものを食べますが、しかし、空腹感から、ものを食べた記憶は、ほとんどありません。めずらしいと思われたものを食べます。豪華と思われたものを食べます。また、よそへ行って出されたものも、無理をしてまで、たいてい食べます。そうして、子供の頃の自分にとって、最も苦痛な時刻は、実に、自分の家の食事の時間でした。+　自分の田舎の家では、十人くらいの家族全部、めいめいのお膳《ぜん》を二列に向い合せに並べて、末っ子の自分は、もちろん一ばん下の座でしたが、その食事の部屋は薄暗く、昼ごはんの時など、十幾人の家族が、ただ黙々としてめしを食っている有様には、自分はいつも肌寒い思いをしました。それに田舎の昔｜気質《かたぎ》の家でしたので、おかずも、たいていきまっていて、めずらしいもの、豪華なもの、そんなものは望むべくもなかったので、いよいよ自分は食事の時刻を恐怖しました。自分はその薄暗い部屋の末席に、寒さにがたがた震える思いで口にごはんを少量ずつ運び、押し込み、人間は、どうして一日に三度々々ごはんを食べるのだろう、実にみな厳粛な顔をして食べている、これも一種の儀式のようなもので、家族が日に三度々々、時刻をきめて薄暗い一部屋に集り、お膳を順序正しく並べ、食べたくなくても無言でごはんを噛《か》みながら、うつむき、家中にうごめいている霊たちに祈るためのものかも知れない、とさえ考えた事があるくらいでした。+　めしを食べなければ死ぬ、という言葉は、自分の耳には、ただイヤなおどかしとしか聞えませんでした。その迷信は、（いまでも自分には、何だか迷信のように思われてならないのですが）しかし、いつも自分に不安と恐怖を与えました。人間は、めしを食べなければ死ぬから、そのために働いて、めしを食べなければならぬ、という言葉ほど自分にとって難解で晦渋《かいじゅう》で、そうして脅迫めいた響きを感じさせる言葉は、無かったのです。+　つまり自分には、人間の営みというものが未《いま》だに何もわかっていない、という事になりそうです。自分の幸福の観念と、世のすべての人たちの幸福の観念とが、まるで食いちがっているような不安、自分はその不安のために夜々、転輾《てんてん》し、呻吟《しんぎん》し、発狂しかけた事さえあります。自分は、いったい幸福なのでしょうか。自分は小さい時から、実にしばしば、仕合せ者だと人に言われて来ましたが、自分ではいつも地獄の思いで、かえって、自分を仕合せ者だと言ったひとたちのほうが、比較にも何もならぬくらいずっとずっと安楽なように自分には見えるのです。+　自分には、禍《わざわ》いのかたまりが十個あって、その中の一個でも、隣人が脊負《せお》ったら、その一個だけでも充分に隣人の生命取りになるのではあるまいかと、思った事さえありました。+　つまり、わからないのです。隣人の苦しみの性質、程度が、まるで見当つかないのです。プラクテカルな苦しみ、ただ、めしを食えたらそれで解決できる苦しみ、しかし、それこそ最も強い痛苦で、自分の例の十個の禍いなど、吹っ飛んでしまう程の、凄惨《せいさん》な阿鼻地獄なのかも知れない、それは、わからない、しかし、それにしては、よく自殺もせず、発狂もせず、政党を論じ、絶望せず、屈せず生活のたたかいを続けて行ける、苦しくないんじゃないか？　エゴイストになりきって、しかもそれを当然の事と確信し、いちども自分を疑った事が無いんじゃないか？　それなら、楽だ、しかし、人間というものは、皆そんなもので、またそれで満点なのではないかしら、わからない、……夜はぐっすり眠り、朝は爽快《そうかい》なのかしら、どんな夢を見ているのだろう、道を歩きながら何を考えているのだろう、金？　まさか、それだけでも無いだろう、人間は、めしを食うために生きているのだ、という説は聞いた事があるような気がするけれども、金のために生きている、という言葉は、耳にした事が無い、いや、しかし、ことに依ると、……いや、それもわからない、……考えれば考えるほど、自分には、わからなくなり、自分ひとり全く変っているような、不安と恐怖に襲われるばかりなのです。自分は隣人と、ほとんど会話が出来ません。何を、どう言ったらいいのか、わからないのです。+　そこで考え出したのは、道化でした。+　それは、自分の、人間に対する最後の求愛でした。自分は、人間を極度に恐れていながら、それでいて、人間を、どうしても思い切れなかったらしいのです。そうして自分は、この道化の一線でわずかに人間につながる事が出来たのでした。おもてでは、絶えず笑顔をつくりながらも、内心は必死の、それこそ千番に一番の兼ね合いとでもいうべき危機一髪の、油汗流してのサーヴィスでした。+　自分は子供の頃から、自分の家族の者たちに対してさえ、彼等がどんなに苦しく、またどんな事を考えて生きているのか、まるでちっとも見当つかず、ただおそろしく、その気まずさに堪える事が出来ず、既に道化の上手になっていました。つまり、自分は、いつのまにやら、一言も本当の事を言わない子になっていたのです。+　その頃の、家族たちと一緒にうつした写真などを見ると、他の者たちは皆まじめな顔をしているのに、自分ひとり、必ず奇妙に顔をゆがめて笑っているのです。これもまた、自分の幼く悲しい道化の一種でした。+　また自分は、肉親たちに何か言われて、口応《くちごた》えした事はいちども有りませんでした。そのわずかなおこごとは、自分には霹靂《へきれき》の如く強く感ぜられ、狂うみたいになり、口応えどころか、そのおこごとこそ、謂わば万世一系の人間の「真理」とかいうものに違いない、自分にはその真理を行う力が無いのだから、もはや人間と一緒に住めないのではないかしら、と思い込んでしまうのでした。だから自分には、言い争いも自己弁解も出来ないのでした。人から悪く言われると、いかにも、もっとも、自分がひどい思い違いをしているような気がして来て、いつもその攻撃を黙して受け、内心、狂うほどの恐怖を感じました。+　それは誰でも、人から非難せられたり、怒られたりしていい気持がするものでは無いかも知れませんが、自分は怒っている人間の顔に、獅子《しし》よりも鰐《わに》よりも竜よりも、もっとおそろしい動物の本性を見るのです。ふだんは、その本性をかくしているようですけれども、何かの機会に、たとえば、牛が草原でおっとりした形で寝ていて、突如、尻尾《しっぽ》でピシッと腹の虻《あぶ》を打ち殺すみたいに、不意に人間のおそろしい正体を、怒りに依って暴露する様子を見て、自分はいつも髪の逆立つほどの戦慄《せんりつ》を覚え、この本性もまた人間の生きて行く資格の一つなのかも知れないと思えば、ほとんど自分に絶望を感じるのでした。+　人間に対して、いつも恐怖に震いおののき、また、人間としての自分の言動に、みじんも自信を持てず、そうして自分ひとりの懊悩《おうのう》は胸の中の小箱に秘め、その憂鬱、ナアヴァスネスを、ひたかくしに隠して、ひたすら無邪気の楽天性を装い、自分はお道化たお変人として、次第に完成されて行きました。+　何でもいいから、笑わせておればいいのだ、そうすると、人間たちは、自分が彼等の所謂「生活」の外にいても、あまりそれを気にしないのではないかしら、とにかく、彼等人間たちの目障りになってはいけない、自分は無だ、風だ、空《そら》だ、というような思いばかりが募り、自分はお道化に依って家族を笑わせ、また、家族よりも、もっと不可解でおそろしい下男や下女にまで、必死のお道化のサーヴィスをしたのです。+　自分は夏に、浴衣の下に赤い毛糸のセエターを着て廊下を歩き、家中の者を笑わせました。めったに笑わない長兄も、それを見て噴き出し、+「それあ、葉ちゃん、似合わない」+　と、可愛くてたまらないような口調で言いました。なに、自分だって、真夏に毛糸のセエターを着て歩くほど、いくら何でも、そんな、暑さ寒さを知らぬお変人ではありません。姉の脚絆《レギンス》を両腕にはめて、浴衣の袖口から覗かせ、以《もっ》てセエターを着ているように見せかけていたのです。+　自分の父は、東京に用事の多いひとでしたので、上野の桜木町に別荘を持っていて、月の大半は東京のその別荘で暮していました。そうして帰る時には家族の者たち、また親戚《しんせき》の者たちにまで、実におびただしくお土産を買って来るのが、まあ、父の趣味みたいなものでした。+　いつかの父の上京の前夜、父は子供たちを客間に集め、こんど帰る時には、どんなお土産がいいか、一人々々に笑いながら尋ね、それに対する子供たちの答をいちいち手帖《てちょう》に書きとめるのでした。父が、こんなに子供たちと親しくするのは、めずらしい事でした。+「葉蔵は？」+　と聞かれて、自分は、口ごもってしまいました。+　何が欲しいと聞かれると、とたんに、何も欲しくなくなるのでした。どうでもいい、どうせ自分を楽しくさせてくれるものなんか無いんだという思いが、ちらと動くのです。と、同時に、人から与えられるものを、どんなに自分の好みに合わなくても、それを拒む事も出来ませんでした。イヤな事を、イヤと言えず、また、好きな事も、おずおずと盗むように、極めてにがく味《あじわ》い、そうして言い知れぬ恐怖感にもだえるのでした。つまり、自分には、二者選一の力さえ無かったのです。これが、後年に到り、いよいよ自分の所謂「恥の多い生涯」の、重大な原因ともなる性癖の一つだったように思われます。+　自分が黙って、もじもじしているので、父はちょっと不機嫌な顔になり、+「やはり、本か。浅草の仲店にお正月の獅子舞いのお獅子、子供がかぶって遊ぶのには手頃な大きさのが売っていたけど、欲しくないか」+　欲しくないか、と言われると、もうダメなんです。お道化た返事も何も出来やしないんです。お道化役者は、完全に落第でした。+「本が、いいでしょう」+　長兄は、まじめな顔をして言いました。+「そうか」+　父は、興覚め顔に手帖に書きとめもせず、パチと手帖を閉じました。+　何という失敗、自分は父を怒らせた、父の復讐《ふくしゅう》は、きっと、おそるべきものに違いない、いまのうちに何とかして取りかえしのつかぬものか、とその夜、蒲団の中でがたがた震えながら考え、そっと起きて客間に行き、父が先刻、手帖をしまい込んだ筈の机の引き出しをあけて、手帖を取り上げ、パラパラめくって、お土産の注文記入の個所を見つけ、手帖の鉛筆をなめて、シシマイ、と書いて寝ました。自分はその獅子舞いのお獅子を、ちっとも欲しくは無かったのです。かえって、本のほうがいいくらいでした。けれども、自分は、父がそのお獅子を自分に買って与えたいのだという事に気がつき、父のその意向に迎合して、父の機嫌を直したいばかりに、深夜、客間に忍び込むという冒険を、敢えておかしたのでした。+　そうして、この自分の非常の手段は、果して思いどおりの大成功を以て報いられました。やがて、父は東京から帰って来て、母に大声で言っているのを、自分は子供部屋で聞いていました。+「仲店のおもちゃ屋で、この手帖を開いてみたら、これ、ここに、シシマイ、と書いてある。これは、私の字ではない。はてな？　と首をかしげて、思い当りました。これは、葉蔵のいたずらですよ。あいつは、私が聞いた時には、にやにやして黙っていたが、あとで、どうしてもお獅子が欲しくてたまらなくなったんだね。何せ、どうも、あれは、変った坊主ですからね。知らん振りして、ちゃんと書いている。そんなに欲しかったのなら、そう言えばよいのに。私は、おもちゃ屋の店先で笑いましたよ。葉蔵を早くここへ呼びなさい」+　また一方、自分は、下男や下女たちを洋室に集めて、下男のひとりに滅茶苦茶《めちゃくちゃ》にピアノのキイをたたかせ、（田舎ではありましたが、その家には、たいていのものが、そろっていました）自分はその出鱈目《でたらめ》の曲に合せて、インデヤンの踊りを踊って見せて、皆を大笑いさせました。次兄は、フラッシュを焚《た》いて、自分のインデヤン踊りを撮影して、その写真が出来たのを見ると、自分の腰布（それは更紗《さらさ》の風呂敷でした）の合せ目から、小さいおチンポが見えていたので、これがまた家中の大笑いでした。自分にとって、これまた意外の成功というべきものだったかも知れません。+　自分は毎月、新刊の少年雑誌を十冊以上も、とっていて、またその他《ほか》にも、さまざまの本を東京から取り寄せて黙って読んでいましたので、メチャラクチャラ博士だの、また、ナンジャモンジャ博士などとは、たいへんな馴染《なじみ》で、また、怪談、講談、落語、江戸｜小咄《こばなし》などの類にも、かなり通じていましたから、剽軽《ひょうきん》な事をまじめな顔をして言って、家の者たちを笑わせるのには事を欠きませんでした。+　しかし、嗚呼《ああ》、学校！+　自分は、そこでは、尊敬されかけていたのです。尊敬されるという観念もまた、甚《はなは》だ自分を、おびえさせました。ほとんど完全に近く人をだまして、そうして、或るひとりの全知全能の者に見破られ、木っ葉みじんにやられて、死ぬる以上の赤恥をかかせられる、それが、「尊敬される」という状態の自分の定義でありました。人間をだまして、「尊敬され」ても、誰かひとりが知っている、そうして、人間たちも、やがて、そのひとりから教えられて、だまされた事に気づいた時、その時の人間たちの怒り、復讐は、いったい、まあ、どんなでしょうか。想像してさえ、身の毛がよだつ心地がするのです。+　自分は、金持ちの家に生れたという事よりも、俗にいう「できる」事に依って、学校中の尊敬を得そうになりました。自分は、子供の頃から病弱で、よく一つき二つき、また一学年ちかくも寝込んで学校を休んだ事さえあったのですが、それでも、病み上りのからだで人力車に乗って学校へ行き、学年末の試験を受けてみると、クラスの誰よりも所謂「できて」いるようでした。からだ具合いのよい時でも、自分は、さっぱり勉強せず、学校へ行っても授業時間に漫画などを書き、休憩時間にはそれをクラスの者たちに説明して聞かせて、笑わせてやりました。また、綴り方には、滑稽噺《こっけいばなし》ばかり書き、先生から注意されても、しかし、自分は、やめませんでした。先生は、実はこっそり自分のその滑稽噺を楽しみにしている事を自分は、知っていたからでした。或る日、自分は、れいに依って、自分が母に連れられて上京の途中の汽車で、おしっこを客車の通路にある痰壺《たんつぼ》にしてしまった失敗談（しかし、その上京の時に、自分は痰壺と知らずにしたのではありませんでした。子供の無邪気をてらって、わざと、そうしたのでした）を、ことさらに悲しそうな筆致で書いて提出し、先生は、きっと笑うという自信がありましたので、職員室に引き揚げて行く先生のあとを、そっとつけて行きましたら、先生は、教室を出るとすぐ、自分のその綴り方を、他のクラスの者たちの綴り方の中から選び出し、廊下を歩きながら読みはじめて、クスクス笑い、やがて職員室にはいって読み終えたのか、顔を真赤にして大声を挙げて笑い、他の先生に、さっそくそれを読ませているのを見とどけ、自分は、たいへん満足でした。+　お茶目。+　自分は、所謂お茶目に見られる事に成功しました。尊敬される事から、のがれる事に成功しました。通信簿は全学科とも十点でしたが、操行というものだけは、七点だったり、六点だったりして、それもまた家中の大笑いの種でした。+　けれども自分の本性は、そんなお茶目さんなどとは、凡《およ》そ対蹠《たいせき》的なものでした。その頃、既に自分は、女中や下男から、哀《かな》しい事を教えられ、犯されていました。幼少の者に対して、そのような事を行うのは、人間の行い得る犯罪の中で最も醜悪で下等で、残酷な犯罪だと、自分はいまでは思っています。しかし、自分は、忍びました。これでまた一つ、人間の特質を見たというような気持さえして、そうして、力無く笑っていました。もし自分に、本当の事を言う習慣がついていたなら、悪びれず、彼等の犯罪を父や母に訴える事が出来たのかも知れませんが、しかし、自分は、その父や母をも全部は理解する事が出来なかったのです。人間に訴える、自分は、その手段には少しも期待できませんでした。父に訴えても、母に訴えても、お巡《まわ》りに訴えても、政府に訴えても、結局は世渡りに強い人の、世間に通りのいい言いぶんに言いまくられるだけの事では無いかしら。+　必ず片手落のあるのが、わかり切っている、所詮《しょせん》、人間に訴えるのは無駄である、自分はやはり、本当の事は何も言わず、忍んで、そうしてお道化をつづけているより他、無い気持なのでした。+　なんだ、人間への不信を言っているのか？　へえ？　お前はいつクリスチャンになったんだい、と嘲笑《ちょうしょう》する人も或いはあるかも知れませんが、しかし、人間への不信は、必ずしもすぐに宗教の道に通じているとは限らないと、自分には思われるのですけど。現にその嘲笑する人をも含めて、人間は、お互いの不信の中で［＃「お互いの不信の中で」に傍点］、エホバも何も念頭に置かず、平気で生きているではありませんか。やはり、自分の幼少の頃の事でありましたが、父の属していた或る政党の有名人が、この町に演説に来て、自分は下男たちに連れられて劇場に聞きに行きました。満員で、そうして、この町の特に父と親しくしている人たちの顔は皆、見えて、大いに拍手などしていました。演説がすんで、聴衆は雪の夜道を三々五々かたまって家路に就き、クソミソに今夜の演説会の悪口を言っているのでした。中には、父と特に親しい人の声もまじっていました。父の開会の辞も下手、れいの有名人の演説も何が何やら、わけがわからぬ、とその所謂父の「同志たち」が怒声に似た口調で言っているのです。そうしてそのひとたちは、自分の家に立ち寄って客間に上り込み、今夜の演説会は大成功だったと、しんから嬉しそうな顔をして父に言っていました。下男たちまで、今夜の演説会はどうだったと母に聞かれ、とても面白かった、と言ってけろりとしているのです。演説会ほど面白くないものはない、と帰る途々《みちみち》、下男たちが嘆き合っていたのです。+　しかし、こんなのは、ほんのささやかな一例に過ぎません。互いにあざむき合って、しかもいずれも不思議に何の傷もつかず、あざむき合っている事にさえ気がついていないみたいな、実にあざやかな、それこそ清く明るくほがらかな不信の例が、人間の生活に充満しているように思われます。けれども、自分には、あざむき合っているという事には、さして特別の興味もありません。自分だって、お道化に依って、朝から晩まで人間をあざむいているのです。自分は、修身教科書的な正義とか何とかいう道徳には、あまり関心を持てないのです。自分には、あざむき合っていながら、清く明るく朗らかに［＃「清く明るく朗らかに」に傍点］生きている、或いは生き得る自信を持っているみたいな人間が難解なのです。人間は、ついに自分にその妙諦《みょうてい》を教えてはくれませんでした。それさえわかったら、自分は、人間をこんなに恐怖し、また、必死のサーヴィスなどしなくて、すんだのでしょう。人間の生活と対立してしまって、夜々の地獄のこれほどの苦しみを嘗《な》めずにすんだのでしょう。つまり、自分が下男下女たちの憎むべきあの犯罪をさえ、誰にも訴えなかったのは、人間への不信からではなく、また勿論クリスト主義のためでもなく、人間が、葉蔵という自分に対して信用の殻を固く閉じていたからだったと思います。父母でさえ、自分にとって難解なものを、時折、見せる事があったのですから。+　そうして、その、誰にも訴えない、自分の孤独の匂いが、多くの女性に、本能に依って嗅《か》ぎ当てられ、後年さまざま、自分がつけ込まれる誘因の一つになったような気もするのです。+　つまり、自分は、女性にとって、恋の秘密を守れる男であったというわけなのでした。+［＃改頁］++++［＃３字下げ］第二の手記［＃「第二の手記」は大見出し］+++　海の、波打際、といってもいいくらいに海にちかい岸辺に、真黒い樹肌の山桜の、かなり大きいのが二十本以上も立ちならび、新学年がはじまると、山桜は、褐色のねばっこいような嫩葉《わかば》と共に、青い海を背景にして、その絢爛《けんらん》たる花をひらき、やがて、花吹雪の時には、花びらがおびただしく海に散り込み、海面を鏤《ちりば》めて漂い、波に乗せられ再び波打際に打ちかえされる、その桜の砂浜が、そのまま校庭として使用せられている東北の或る中学校に、自分は受験勉強もろくにしなかったのに、どうやら無事に入学できました。そうして、その中学の制帽の徽章《きしょう》にも、制服のボタンにも、桜の花が図案化せられて咲いていました。+　その中学校のすぐ近くに、自分の家と遠い親戚に当る者の家がありましたので、その理由もあって、父がその海と桜の中学校を自分に選んでくれたのでした。自分は、その家にあずけられ、何せ学校のすぐ近くなので、朝礼の鐘の鳴るのを聞いてから、走って登校するというような、かなり怠惰な中学生でしたが、それでも、れいのお道化に依って、日一日とクラスの人気を得ていました。+　生れてはじめて、謂わば他郷へ出たわけなのですが、自分には、その他郷のほうが、自分の生れ故郷よりも、ずっと気楽な場所のように思われました。それは、自分のお道化もその頃にはいよいよぴったり身について来て、人をあざむくのに以前ほどの苦労を必要としなくなっていたからである、と解説してもいいでしょうが、しかし、それよりも、肉親と他人、故郷と他郷、そこには抜くべからざる演技の難易の差が、どのような天才にとっても、たとい神の子のイエスにとっても、存在しているものなのではないでしょうか。俳優にとって、最も演じにくい場所は、故郷の劇場であって、しかも六親｜眷属《けんぞく》全部そろって坐っている一部屋の中に在っては、いかな名優も演技どころでは無くなるのではないでしょうか。けれども自分は演じて来ました。しかも、それが、かなりの成功を収めたのです。それほどの曲者《くせもの》が、他郷に出て、万が一にも演じ損ねるなどという事は無いわけでした。+　自分の人間恐怖は、それは以前にまさるとも劣らぬくらい烈しく胸の底で蠕動《ぜんどう》していましたが、しかし、演技は実にのびのびとして来て、教室にあっては、いつもクラスの者たちを笑わせ、教師も、このクラスは大庭さえいないと、とてもいいクラスなんだが、と言葉では嘆じながら、手で口を覆って笑っていました。自分は、あの雷の如き蛮声を張り上げる配属将校をさえ、実に容易に噴き出させる事が出来たのです。+　もはや、自分の正体を完全に隠蔽《いんぺい》し得たのではあるまいか、とほっとしかけた矢先に、自分は実に意外にも背後から突き刺されました。それは、背後から突き刺す男のごたぶんにもれず、クラスで最も貧弱な肉体をして、顔も青ぶくれで、そうしてたしかに父兄のお古と思われる袖が聖徳太子の袖みたいに長すぎる上衣《うわぎ》を着て、学課は少しも出来ず、教練や体操はいつも見学という白痴に似た生徒でした。自分もさすがに、その生徒にさえ警戒する必要は認めていなかったのでした。+　その日、体操の時間に、その生徒（姓はいま記憶していませんが、名は竹一といったかと覚えています）その竹一は、れいに依って見学、自分たちは鉄棒の練習をさせられていました。自分は、わざと出来るだけ厳粛な顔をして、鉄棒めがけて、えいっと叫んで飛び、そのまま幅飛びのように前方へ飛んでしまって、砂地にドスンと尻餅をつきました。すべて、計画的な失敗でした。果して皆の大笑いになり、自分も苦笑しながら起き上ってズボンの砂を払っていると、いつそこへ来ていたのか、竹一が自分の背中をつつき、低い声でこう囁《ささや》きました。+「ワザ。ワザ」+　自分は震撼《しんかん》しました。ワザと失敗したという事を、人もあろうに、竹一に見破られるとは全く思いも掛けない事でした。自分は、世界が一瞬にして地獄の業火に包まれて燃え上るのを眼前に見るような心地がして、わあっ！　と叫んで発狂しそうな気配を必死の力で抑えました。+　それからの日々の、自分の不安と恐怖。+　表面は相変らず哀しいお道化を演じて皆を笑わせていましたが、ふっと思わず重苦しい溜息《ためいき》が出て、何をしたってすべて竹一に木っ葉みじんに見破られていて、そうしてあれは、そのうちにきっと誰かれとなく、それを言いふらして歩くに違いないのだ、と考えると、額にじっとり油汗がわいて来て、狂人みたいに妙な眼つきで、あたりをキョロキョロむなしく見廻したりしました。できる事なら、朝、昼、晩、四六時中、竹一の傍《そば》から離れず彼が秘密を口走らないように監視していたい気持でした。そうして、自分が、彼にまつわりついている間に、自分のお道化は、所謂「ワザ」では無くて、ほんものであったというよう思い込ませるようにあらゆる努力を払い、あわよくば、彼と無二の親友になってしまいたいものだ、もし、その事が皆、不可能なら、もはや、彼の死を祈るより他は無い、とさえ思いつめました。しかし、さすがに、彼を殺そうという気だけは起りませんでした。自分は、これまでの生涯に於《お》いて、人に殺されたいと願望した事は幾度となくありましたが、人を殺したいと思った事は、いちどもありませんでした。それは、おそるべき相手に、かえって幸福を与えるだけの事だと考えていたからです。+　自分は、彼を手なずけるため、まず、顔に偽クリスチャンのような「優しい」媚笑《びしょう》を湛《たた》え、首を三十度くらい左に曲げて、彼の小さい肩を軽く抱き、そうして猫撫《ねこな》で声に似た甘ったるい声で、彼を自分の寄宿している家に遊びに来るようしばしば誘いましたが、彼は、いつも、ぼんやりした眼つきをして、黙っていました。しかし、自分は、或る日の放課後、たしか初夏の頃の事でした、夕立ちが白く降って、生徒たちは帰宅に困っていたようでしたが、自分は家がすぐ近くなので平気で外へ飛び出そうとして、ふと下駄箱のかげに、竹一がしょんぼり立っているのを見つけ、行こう、傘を貸してあげる、と言い、臆する竹一の手を引っぱって、一緒に夕立ちの中を走り、家に着いて、二人の上衣を小母さんに乾かしてもらうようにたのみ、竹一を二階の自分の部屋に誘い込むのに成功しました。+　その家には、五十すぎの小母さんと、三十くらいの、眼鏡をかけて、病身らしい背の高い姉娘（この娘は、いちどよそへお嫁に行って、それからまた、家へ帰っているひとでした。自分は、このひとを、ここの家のひとたちにならって、アネサと呼んでいました）それと、最近女学校を卒業したばかりらしい、セッちゃんという姉に似ず背が低く丸顔の妹娘と、三人だけの家族で、下の店には、文房具やら運動用具を少々並べていましたが、主な収入は、なくなった主人が建てて残して行った五六棟の長屋の家賃のようでした。+「耳が痛い」+　竹一は、立ったままでそう言いました。+「雨に濡れたら、痛くなったよ」+　自分が、見てみると、両方の耳が、ひどい耳だれでした。膿《うみ》が、いまにも耳殻の外に流れ出ようとしていました。+「これは、いけない。痛いだろう」+　と自分は大袈裟《おおげさ》におどろいて見せて、+「雨の中を、引っぱり出したりして、ごめんね」+　と女の言葉みたいな言葉を遣って「優しく」謝り、それから、下へ行って綿とアルコールをもらって来て、竹一を自分の膝《ひざ》を枕にして寝かせ、念入りに耳の掃除をしてやりました。竹一も、さすがに、これが偽善の悪計であることには気附かなかったようで、+「お前は、きっと、女に惚《ほ》れられるよ」+　と自分の膝枕で寝ながら、無智なお世辞を言ったくらいでした。+　しかしこれは、おそらく、あの竹一も意識しなかったほどの、おそろしい悪魔の予言のようなものだったという事を、自分は後年に到って思い知りました。惚れると言い、惚れられると言い、その言葉はひどく下品で、ふざけて、いかにも、やにさがったものの感じで、どんなに所謂「厳粛」の場であっても、そこへこの言葉が一言でもひょいと顔を出すと、みるみる憂鬱の伽藍《がらん》が崩壊し、ただのっぺらぼうになってしまうような心地がするものですけれども、惚れられるつらさ、などという俗語でなく、愛せられる不安、とでもいう文学語を用いると、あながち憂鬱の伽藍をぶちこわす事にはならないようですから、奇妙なものだと思います。+　竹一が、自分に耳だれの膿の仕末をしてもらって、お前は惚れられるという馬鹿なお世辞を言い、自分はその時、ただ顔を赤らめて笑って、何も答えませんでしたけれども、しかし、実は、幽《かす》かに思い当るところもあったのでした。でも、「惚れられる」というような野卑な言葉に依って生じるやにさがった雰囲気《ふんいき》に対して、そう言われると、思い当るところもある、などと書くのは、ほとんど落語の若旦那のせりふにさえならぬくらい、おろかしい感懐を示すようなもので、まさか、自分は、そんなふざけた、やにさがった気持で、「思い当るところもあった」わけでは無いのです。+　自分には、人間の女性のほうが、男性よりもさらに数倍難解でした。自分の家族は、女性のほうが男性よりも数が多く、また親戚にも、女の子がたくさんあり、またれいの「犯罪」の女中などもいまして、自分は幼い時から、女とばかり遊んで育ったといっても過言ではないと思っていますが、それは、また、しかし、実に、薄氷を踏む思いで、その女のひとたちと附合って来たのです。ほとんど、まるで見当が、つかないのです。五里霧中で、そうして時たま、虎の尾を踏む失敗をして、ひどい痛手を負い、それがまた、男性から受ける笞《むち》とちがって、内出血みたいに極度に不快に内攻して、なかなか治癒《ちゆ》し難い傷でした。+　女は引き寄せて、つっ放す、或いはまた、女は、人のいるところでは自分をさげすみ、邪慳《じゃけん》にし、誰もいなくなると、ひしと抱きしめる、女は死んだように深く眠る、女は眠るために生きているのではないかしら、その他、女に就いてのさまざまの観察を、すでに自分は、幼年時代から得ていたのですが、同じ人類のようでありながら、男とはまた、全く異った生きもののような感じで、そうしてまた、この不可解で油断のならぬ生きものは、奇妙に自分をかまうのでした。「惚れられる」なんていう言葉も、また「好かれる」という言葉も、自分の場合にはちっとも、ふさわしくなく、「かまわれる」とでも言ったほうが、まだしも実状の説明に適しているかも知れません。+　女は、男よりも更に、道化には、くつろぐようでした。自分がお道化を演じ、男はさすがにいつまでもゲラゲラ笑ってもいませんし、それに自分も男のひとに対し、調子に乗ってあまりお道化を演じすぎると失敗するという事を知っていましたので、必ず適当のところで切り上げるように心掛けていましたが、女は適度という事を知らず、いつまでもいつまでも、自分にお道化を要求し、自分はその限りないアンコールに応じて、へとへとになるのでした。実に、よく笑うのです。いったいに、女は、男よりも快楽をよけいに頬張る事が出来るようです。+　自分が中学時代に世話になったその家の姉娘も、妹娘も、ひまさえあれば、二階の自分の部屋にやって来て、自分はその度毎に飛び上らんばかりにぎょっとして、そうして、ひたすらおびえ、+「御勉強？」+「いいえ」+　と微笑して本を閉じ、+「きょうね、学校でね、コンボウという地理の先生がね」+　とするする口から流れ出るものは、心にも無い滑稽噺でした。+「葉ちゃん、眼鏡をかけてごらん」+　或る晩、妹娘のセッちゃんが、アネサと一緒に自分の部屋へ遊びに来て、さんざん自分にお道化を演じさせた揚句の果に、そんな事を言い出しました。+「なぜ？」+「いいから、かけてごらん。アネサの眼鏡を借りなさい」+　いつでも、こんな乱暴な命令口調で言うのでした。道化師は、素直にアネサの眼鏡をかけました。とたんに、二人の娘は、笑いころげました。+「そっくり。ロイドに、そっくり」+　当時、ハロルド・ロイドとかいう外国の映画の喜劇役者が、日本で人気がありました。+　自分は立って片手を挙げ、+「諸君」+　と言い、+「このたび、日本のファンの皆様がたに、……」+　と一場の挨拶を試み、さらに大笑いさせて、それから、ロイドの映画がそのまちの劇場に来るたび毎に見に行って、ひそかに彼の表情などを研究しました。+　また、或る秋の夜、自分が寝ながら本を読んでいると、アネサが鳥のように素早く部屋へはいって来て、いきなり自分の掛蒲団の上に倒れて泣き、+「葉ちゃんが、あたしを助けてくれるのだわね。そうだわね。こんな家、一緒に出てしまったほうがいいのだわ。助けてね。助けて」+　などと、はげしい事を口走っては、また泣くのでした。けれども、自分には、女から、こんな態度を見せつけられるのは、これが最初ではありませんでしたので、アネサの過激な言葉にも、さして驚かず、かえってその陳腐、無内容に興が覚めた心地で、そっと蒲団から脱け出し、机の上の柿をむいて、その一きれをアネサに手渡してやりました。すると、アネサは、しゃくり上げながらその柿を食べ、+「何か面白い本が無い？　貸してよ」+　と言いました。+　自分は漱石の「吾輩は猫である」という本を、本棚から選んであげました。+「ごちそうさま」+　アネサは、恥ずかしそうに笑って部屋から出て行きましたが、このアネサに限らず、いったい女は、どんな気持で生きているのかを考える事は、自分にとって、蚯蚓《みみず》の思いをさぐるよりも、ややこしく、わずらわしく、薄気味の悪いものに感ぜられていました。ただ、自分は、女があんなに急に泣き出したりした場合、何か甘いものを手渡してやると、それを食べて機嫌を直すという事だけは、幼い時から、自分の経験に依って知っていました。+　また、妹娘のセッちゃんは、その友だちまで自分の部屋に連れて来て、自分がれいに依って公平に皆を笑わせ、友だちが帰ると、セッちゃんは、必ずその友だちの悪口を言うのでした。あのひとは不良少女だから、気をつけるように、ときまって言うのでした。そんなら、わざわざ連れて来なければ、よいのに、おかげで自分の部屋の来客の、ほとんど全部が女、という事になってしまいました。+　しかし、それは、竹一のお世辞の「惚れられる」事の実現では未だ決して無かったのでした。つまり、自分は、日本の東北のハロルド・ロイドに過ぎなかったのです。竹一の無智なお世辞が、いまわしい予言として、なまなまと生きて来て、不吉な形貌を呈するようになったのは、更にそれから、数年経った後の事でありました。+　竹一は、また、自分にもう一つ、重大な贈り物をしていました。+「お化けの絵だよ」+　いつか竹一が、自分の二階へ遊びに来た時、ご持参の、一枚の原色版の口絵を得意そうに自分に見せて、そう説明しました。+　おや？　と思いました。その瞬間、自分の落ち行く道が決定せられたように、後年に到って、そんな気がしてなりません。自分は、知っていました。それは、ゴッホの例の自画像に過ぎないのを知っていました。自分たちの少年の頃には、日本ではフランスの所謂印象派の画が大流行していて、洋画鑑賞の第一歩を、たいていこのあたりからはじめたもので、ゴッホ、ゴーギャン、セザンヌ、ルナアルなどというひとの絵は、田舎の中学生でも、たいていその写真版を見て知っていたのでした。自分なども、ゴッホの原色版をかなりたくさん見て、タッチの面白さ、色彩の鮮やかさに興趣を覚えてはいたのですが、しかし、お化けの絵、だとは、いちども考えた事が無かったのでした。+「では、こんなのは、どうかしら。やっぱり、お化けかしら」+　自分は本棚から、モジリアニの画集を出し、焼けた赤銅のような肌の、れいの裸婦の像を竹一に見せました。+「すげえなあ」+　竹一は眼を丸くして感嘆しました。+「地獄の馬みたい」+「やっぱり、お化けかね」+「おれも、こんなお化けの絵がかきたいよ」+　あまりに人間を恐怖している人たちは、かえって、もっともっと、おそろしい妖怪《ようかい》を確実にこの眼で見たいと願望するに到る心理、神経質な、ものにおびえ易い人ほど、暴風雨の更に強からん事を祈る心理、ああ、この一群の画家たちは、人間という化け物に傷《いた》めつけられ、おびやかされた揚句の果、ついに幻影を信じ、白昼の自然の中に、ありありと妖怪を見たのだ、しかも彼等は、それを道化などでごまかさず、見えたままの表現に努力したのだ、竹一の言うように、敢然と「お化けの絵」をかいてしまったのだ、ここに将来の自分の、仲間がいる、と自分は、涙が出たほどに興奮し、+「僕も画くよ。お化けの絵を画くよ。地獄の馬を、画くよ」+　と、なぜだか、ひどく声をひそめて、竹一に言ったのでした。+　自分は、小学校の頃から、絵はかくのも、見るのも好きでした。けれども、自分のかいた絵は、自分の綴り方ほどには、周囲の評判が、よくありませんでした。自分は、どだい人間の言葉を一向に信用していませんでしたので、綴り方などは、自分にとって、ただお道化の御挨拶みたいなもので、小学校、中学校、と続いて先生たちを狂喜させて来ましたが、しかし、自分では、さっぱり面白くなく、絵だけは、（漫画などは別ですけれども）その対象の表現に、幼い我流ながら、多少の苦心を払っていました。学校の図画のお手本はつまらないし、先生の絵は下手くそだし、自分は、全く出鱈目にさまざまの表現法を自分で工夫して試みなければならないのでした。中学校へはいって、自分は油絵の道具も一｜揃《そろ》い持っていましたが、しかし、そのタッチの手本を、印象派の画風に求めても、自分の画いたものは、まるで千代紙細工のようにのっぺりして、ものになりそうもありませんでした。けれども自分は、竹一の言葉に依って、自分のそれまでの絵画に対する心構えが、まるで間違っていた事に気が附きました。美しいと感じたものを、そのまま美しく表現しようと努力する甘さ、おろかしさ。マイスターたちは、何でも無いものを、主観に依って美しく創造し、或いは醜いものに嘔吐《おうと》をもよおしながらも、それに対する興味を隠さず、表現のよろこびにひたっている、つまり、人の思惑に少しもたよっていないらしいという、画法のプリミチヴな虎の巻を、竹一から、さずけられて、れいの女の来客たちには隠して、少しずつ、自画像の制作に取りかかってみました。+　自分でも、ぎょっとしたほど、陰惨な絵が出来上りました。しかし、これこそ胸底にひた隠しに隠している自分の正体なのだ、おもては陽気に笑い、また人を笑わせているけれども、実は、こんな陰鬱な心を自分は持っているのだ、仕方が無い、とひそかに肯定し、けれどもその絵は、竹一以外の人には、さすがに誰にも見せませんでした。自分のお道化の底の陰惨を見破られ、急にケチくさく警戒せられるのもいやでしたし、また、これを自分の正体とも気づかず、やっぱり新趣向のお道化と見なされ、大笑いの種にせられるかも知れぬという懸念もあり、それは何よりもつらい事でしたので、その絵はすぐに押入れの奥深くしまい込みました。+　また、学校の図画の時間にも、自分はあの「お化け式手法」は秘めて、いままでどおりの美しいものを美しく画く式の凡庸なタッチで画いていました。+　自分は竹一にだけは、前から自分の傷み易い神経を平気で見せていましたし、こんどの自画像も安心して竹一に見せ、たいへんほめられ、さらに二枚三枚と、お化けの絵を画きつづけ、竹一からもう一つの、+「お前は、偉い絵画きになる」+　という予言を得たのでした。+　惚れられるという予言と、偉い絵画きになるという予言と、この二つの予言を馬鹿の竹一に依って額に刻印せられて、やがて、自分は東京へ出て来ました。+　自分は、美術学校にはいりたかったのですが、父は、前から自分を高等学校にいれて、末は官吏にするつもりで、自分にもそれを言い渡してあったので、口応え一つ出来ないたちの自分は、ぼんやりそれに従ったのでした。四年から受けて見よ、と言われたので、自分も桜と海の中学はもういい加減あきていましたし、五年に進級せず、四年修了のままで、東京の高等学校に受験して合格し、すぐに寮生活にはいりましたが、その不潔と粗暴に辟易《へきえき》して、道化どころではなく、医師に肺浸潤の診断書を書いてもらい、寮から出て、上野桜木町の父の別荘に移りました。自分には、団体生活というものが、どうしても出来ません。それにまた、青春の感激だとか、若人の誇りだとかいう言葉は、聞いて寒気がして来て、とても、あの、ハイスクール・スピリットとかいうものには、ついて行けなかったのです。教室も寮も、ゆがめられた性慾の、はきだめみたいな気さえして、自分の完璧《かんぺき》に近いお道化も、そこでは何の役にも立ちませんでした。+　父は議会の無い時は、月に一週間か二週間しかその家に滞在していませんでしたので、父の留守の時は、かなり広いその家に、別荘番の老夫婦と自分と三人だけで、自分は、ちょいちょい学校を休んで、さりとて東京見物などをする気も起らず（自分はとうとう、明治神宮も、楠正成《くすのきまさしげ》の銅像も、泉岳寺の四十七士の墓も見ずに終りそうです）家で一日中、本を読んだり、絵をかいたりしていました。父が上京して来ると、自分は、毎朝そそくさと登校するのでしたが、しかし、本郷千駄木町の洋画家、安田新太郎氏の画塾に行き、三時間も四時間も、デッサンの練習をしている事もあったのです。高等学校の寮から脱けたら、学校の授業に出ても、自分はまるで聴講生みたいな特別の位置にいるような、それは自分のひがみかも知れなかったのですが、何とも自分自身で白々しい気持がして来て、いっそう学校へ行くのが、おっくうになったのでした。自分には、小学校、中学校、高等学校を通じて、ついに愛校心というものが理解できずに終りました。校歌などというものも、いちども覚えようとした事がありません。+　自分は、やがて画塾で、或る画学生から、酒と煙草と淫売婦《いんばいふ》と質屋と左翼思想とを知らされました。妙な取合せでしたが、しかし、それは事実でした。+　その画学生は、堀木正雄といって、東京の下町に生れ、自分より六つ年長者で、私立の美術学校を卒業して、家にアトリエが無いので、この画塾に通い、洋画の勉強をつづけているのだそうです。+「五円、貸してくれないか」+　お互いただ顔を見知っているだけで、それまで一言も話合った事が無かったのです。自分は、へどもどして五円差し出しました。+「よし、飲もう。おれが、お前におごるんだ。よかチゴじゃのう」+　自分は拒否し切れず、その画塾の近くの、蓬莱《ほうらい》町のカフエに引っぱって行かれたのが、彼との交友のはじまりでした。+「前から、お前に眼をつけていたんだ。それそれ、そのはにかむような微笑、それが見込みのある芸術家特有の表情なんだ。お近づきのしるしに、乾杯！　キヌさん、こいつは美男子だろう？　惚れちゃいけないぜ。こいつが塾へ来たおかげで、残念ながらおれは、第二番の美男子という事になった」+　堀木は、色が浅黒く端正な顔をしていて、画学生には珍らしく、ちゃんとした脊広《せびろ》を着て、ネクタイの好みも地味で、そうして頭髪もポマードをつけてまん中からぺったりとわけていました。+　自分は馴れぬ場所でもあり、ただもうおそろしく、腕を組んだりほどいたりして、それこそ、はにかむような微笑ばかりしていましたが、ビイルを二、三杯飲んでいるうちに、妙に解放せられたような軽さを感じて来たのです。+「僕は、美術学校にはいろうと思っていたんですけど、……」+「いや、つまらん。あんなところは、つまらん。学校は、つまらん。われらの教師は、自然の中にあり！　自然に対するパアトス！」+　しかし、自分は、彼の言う事に一向に敬意を感じませんでした。馬鹿なひとだ、絵も下手にちがいない、しかし、遊ぶのには、いい相手かも知れないと考えました。つまり、自分はその時、生れてはじめて、ほんものの都会の与太者を見たのでした。それは、自分と形は違っていても、やはり、この世の人間の営みから完全に遊離してしまって、戸迷いしている点に於いてだけは、たしかに同類なのでした。そうして、彼はそのお道化を意識せずに行い、しかも、そのお道化の悲惨に全く気がついていないのが、自分と本質的に異色のところでした。+　ただ遊ぶだけだ、遊びの相手として附合っているだけだ、とつねに彼を軽蔑《けいべつ》し、時には彼との交友を恥ずかしくさえ思いながら、彼と連れ立って歩いているうちに、結局、自分は、この男にさえ打ち破られました。+　しかし、はじめは、この男を好人物、まれに見る好人物とばかり思い込み、さすが人間恐怖の自分も全く油断をして、東京のよい案内者が出来た、くらいに思っていました。自分は、実は、ひとりでは、電車に乗ると車掌がおそろしく、歌舞伎座へはいりたくても、あの正面玄関の緋《ひ》の絨緞《じゅうたん》が敷かれてある階段の両側に並んで立っている案内嬢たちがおそろしく、レストランへはいると、自分の背後にひっそり立って、皿のあくのを待っている給仕のボーイがおそろしく、殊にも勘定を払う時、ああ、ぎごちない自分の手つき、自分は買い物をしてお金を手渡す時には、吝嗇《りんしょく》ゆえでなく、あまりの緊張、あまりの恥ずかしさ、あまりの不安、恐怖に、くらくら目まいして、世界が真暗になり、ほとんど半狂乱の気持になってしまって、値切るどころか、お釣を受け取るのを忘れるばかりでなく、買った品物を持ち帰るのを忘れた事さえ、しばしばあったほどなので、とても、ひとりで東京のまちを歩けず、それで仕方なく、一日一ぱい家の中で、ごろごろしていたという内情もあったのでした。+　それが、堀木に財布を渡して一緒に歩くと、堀木は大いに値切って、しかも遊び上手というのか、わずかなお金で最大の効果のあるような支払い振りを発揮し、また、高い円タクは敬遠して、電車、バス、ポンポン蒸気など、それぞれ利用し分けて、最短時間で目的地へ着くという手腕をも示し、淫売婦のところから朝帰る途中には、何々という料亭に立ち寄って朝風呂へはいり、湯豆腐で軽くお酒を飲むのが、安い割に、ぜいたくな気分になれるものだと実地教育をしてくれたり、その他、屋台の牛めし焼とりの安価にして滋養に富むものたる事を説き、酔いの早く発するのは、電気ブランの右に出るものはないと保証し、とにかくその勘定に就いては自分に、一つも不安、恐怖を覚えさせた事がありませんでした。+　さらにまた、堀木と附合って救われるのは、堀木が聞き手の思惑などをてんで無視して、その所謂｜情熱《パトス》の噴出するがままに、（或いは、情熱とは、相手の立場を無視する事かも知れませんが）四六時中、くだらないおしゃべりを続け、あの、二人で歩いて疲れ、気まずい沈黙におちいる危懼《きく》が、全く無いという事でした。人に接し、あのおそろしい沈黙がその場にあらわれる事を警戒して、もともと口の重い自分が、ここを先途《せんど》と必死のお道化を言って来たものですが、いまこの堀木の馬鹿が、意識せずに、そのお道化役をみずからすすんでやってくれているので、自分は、返事もろくにせずに、ただ聞き流し、時折、まさか、などと言って笑っておれば、いいのでした。+　酒、煙草、淫売婦、それは皆、人間恐怖を、たとい一時でも、まぎらす事の出来るずいぶんよい手段である事が、やがて自分にもわかって来ました。それらの手段を求めるためには、自分の持ち物全部を売却しても悔いない気持さえ、抱くようになりました。+　自分には、淫売婦というものが、人間でも、女性でもない、白痴か狂人のように見え、そのふところの中で、自分はかえって全く安心して、ぐっすり眠る事が出来ました。みんな、哀しいくらい、実にみじんも慾というものが無いのでした。そうして、自分に、同類の親和感とでもいったようなものを覚えるのか、自分は、いつも、その淫売婦たちから、窮屈でない程度の自然の好意を示されました。何の打算も無い好意、押し売りでは無い好意、二度と来ないかも知れぬひとへの好意、自分には、その白痴か狂人の淫売婦たちに、マリヤの円光を現実に見た夜もあったのです。+　しかし、自分は、人間への恐怖からのがれ、幽かな一夜の休養を求めるために、そこへ行き、それこそ自分と「同類」の淫売婦たちと遊んでいるうちに、いつのまにやら無意識の、或るいまわしい雰囲気を身辺にいつもただよわせるようになった様子で、これは自分にも全く思い設けなかった所謂「おまけの附録」でしたが、次第にその「附録」が、鮮明に表面に浮き上って来て、堀木にそれを指摘せられ、愕然《がくぜん》として、そうして、いやな気が致しました。はたから見て、俗な言い方をすれば、自分は、淫売婦に依って女の修行をして、しかも、最近めっきり腕をあげ、女の修行は、淫売婦に依るのが一ばん厳しく、またそれだけに効果のあがるものだそうで、既に自分には、あの、「女達者」という匂いがつきまとい、女性は、（淫売婦に限らず）本能に依ってそれを嗅ぎ当て寄り添って来る、そのような、卑猥《ひわい》で不名誉な雰囲気を、「おまけの附録」としてもらって、そうしてそのほうが、自分の休養などよりも、ひどく目立ってしまっているらしいのでした。+　堀木はそれを半分はお世辞で言ったのでしょうが、しかし、自分にも、重苦しく思い当る事があり、たとえば、喫茶店の女から稚拙な手紙をもらった覚えもあるし、桜木町の家の隣りの将軍のはたちくらいの娘が、毎朝、自分の登校の時刻には、用も無さそうなのに、ご自分の家の門を薄化粧して出たりはいったりしていたし、牛肉を食いに行くと、自分が黙っていても、そこの女中が、……また、いつも買いつけの煙草屋の娘から手渡された煙草の箱の中に、……また、歌舞伎を見に行って隣りの席のひとに、……また、深夜の市電で自分が酔って眠っていて、……また、思いがけなく故郷の親戚の娘から、思いつめたような手紙が来て、……また、誰かわからぬ娘が、自分の留守中にお手製らしい人形を、……自分が極度に消極的なので、いずれも、それっきりの話で、ただ断片、それ以上の進展は一つもありませんでしたが、何か女に夢を見させる雰囲気が、自分のどこかにつきまとっている事は、それは、のろけだの何だのといういい加減な冗談でなく、否定できないのでありました。自分は、それを堀木ごとき者に指摘せられ、屈辱に似た苦《にが》さを感ずると共に、淫売婦と遊ぶ事にも、にわかに興が覚めました。+　堀木は、また、その見栄坊《みえぼう》のモダニティから、（堀木の場合、それ以外の理由は、自分には今もって考えられませんのですが）或る日、自分を共産主義の読書会とかいう（Ｒ・Ｓとかいっていたか、記憶がはっきり致しません）そんな、秘密の研究会に連れて行きました。堀木などという人物にとっては、共産主義の秘密会合も、れいの「東京案内」の一つくらいのものだったのかも知れません。自分は所謂「同志」に紹介せられ、パンフレットを一部買わされ、そうして上座のひどい醜い顔の青年から、マルクス経済学の講義を受けました。しかし、自分には、それはわかり切っている事のように思われました。それは、そうに違いないだろうけれども、人間の心には、もっとわけのわからない、おそろしいものがある。慾、と言っても、言いたりない、ヴァニティ、と言っても、言いたりない、色と慾、とこう二つ並べても、言いたりない、何だか自分にもわからぬが、人間の世の底に、経済だけでない、へんに怪談じみたものがあるような気がして、その怪談におびえ切っている自分には、所謂唯物論を、水の低きに流れるように自然に肯定しながらも、しかし、それに依って、人間に対する恐怖から解放せられ、青葉に向って眼をひらき、希望のよろこびを感ずるなどという事は出来ないのでした。けれども、自分は、いちども欠席せずに、そのＲ・Ｓ（と言ったかと思いますが、間違っているかも知れません）なるものに出席し、「同志」たちが、いやに一大事の如く、こわばった顔をして、一プラス一は二、というような、ほとんど初等の算術めいた理論の研究にふけっているのが滑稽に見えてたまらず、れいの自分のお道化で、会合をくつろがせる事に努め、そのためか、次第に研究会の窮屈な気配もほぐれ、自分はその会合に無くてかなわぬ人気者という形にさえなって来たようでした。この、単純そうな人たちは、自分の事を、やはりこの人たちと同じ様に単純で、そうして、楽天的なおどけ者の「同志」くらいに考えていたかも知れませんが、もし、そうだったら、自分は、この人たちを一から十まで、あざむいていたわけです。自分は、同志では無かったんです。けれども、その会合に、いつも欠かさず出席して、皆にお道化のサーヴィスをして来ました。+　好きだったからなのです。自分には、その人たちが、気にいっていたからなのです。しかし、それは必ずしも、マルクスに依って結ばれた親愛感では無かったのです。+　非合法。自分には、それが幽かに楽しかったのです。むしろ、居心地がよかったのです。世の中の合法というもののほうが、かえっておそろしく、（それには、底知れず強いものが予感せられます）そのからくりが不可解で、とてもその窓の無い、底冷えのする部屋には坐っておられず、外は非合法の海であっても、それに飛び込んで泳いで、やがて死に到るほうが、自分には、いっそ気楽のようでした。+　日蔭者《ひかげもの》、という言葉があります。人間の世に於いて、みじめな、敗者、悪徳者を指差していう言葉のようですが、自分は、自分を生れた時からの日蔭者［＃「生れた時からの日蔭者」に傍点］のような気がしていて、世間から、あれは日蔭者だと指差されている程のひとと逢うと、自分は、必ず、優しい心になるのです。そうして、その自分の「優しい心」は、自身でうっとりするくらい優しい心でした。+　また、犯人意識、という言葉もあります。自分は、この人間の世の中に於いて、一生その意識に苦しめられながらも、しかし、それは自分の糟糠《そうこう》の妻の如き好｜伴侶《はんりょ》で、そいつと二人きりで侘《わ》びしく遊びたわむれているというのも、自分の生きている姿勢の一つだったかも知れないし、また、俗に、脛《すね》に傷持つ身、という言葉もあるようですが、その傷は、自分の赤ん坊の時から、自然に片方の脛にあらわれて、長ずるに及んで治癒するどころか、いよいよ深くなるばかりで、骨にまで達し、夜々の痛苦は千変万化の地獄とは言いながら、しかし、（これは、たいへん奇妙な言い方ですけど）その傷は、次第に自分の血肉よりも［＃「血肉よりも」に傍点］親しくなり、その傷の痛みは、すなわち傷の生きている感情、または愛情の囁《ささや》きのようにさえ思われる、そんな男にとって、れいの地下運動のグルウプの雰囲気が、へんに安心で、居心地がよく、つまり、その運動の本来の目的よりも、その運動の肌が、自分に合った感じなのでした。堀木の場合は、ただもう阿呆のひやかしで、いちど自分を紹介しにその会合へ行ったきりで、マルキシストは、生産面の研究と同時に、消費面の視察も必要だなどと下手な洒落《しゃれ》を言って、その会合には寄りつかず、とかく自分を、その消費面の視察のほうにばかり誘いたがるのでした。思えば、当時は、さまざまの型のマルキシストがいたものです。堀木のように、虚栄のモダニティから、それを自称する者もあり、また自分のように、ただ非合法の匂いが気にいって、そこに坐り込んでいる者もあり、もしもこれらの実体が、マルキシズムの真の信奉者に見破られたら、堀木も自分も、烈火の如く怒られ、卑劣なる裏切者として、たちどころに追い払われた事でしょう。しかし、自分も、また、堀木でさえも、なかなか除名の処分に遭わず、殊にも自分は、その非合法の世界に於いては、合法の紳士たちの世界に於けるよりも、かえってのびのびと、所謂「健康」に振舞う事が出来ましたので、見込みのある「同志」として、噴き出したくなるほど過度に秘密めかした、さまざまの用事をたのまれるほどになったのです。また、事実、自分は、そんな用事をいちども断ったことは無く、平気でなんでも引受け、へんにぎくしゃくして、犬（同志は、ポリスをそう呼んでいました）にあやしまれ不審｜訊問《じんもん》などを受けてしくじるような事も無かったし、笑いながら、また、ひとを笑わせながら、そのあぶない（その運動の連中は、一大事の如く緊張し、探偵小説の下手な真似みたいな事までして、極度の警戒を用い、そうして自分にたのむ仕事は、まことに、あっけにとられるくらい、つまらないものでしたが、それでも、彼等は、その用事を、さかんに、あぶながって力んでいるのでした）と、彼等の称する仕事を、とにかく正確にやってのけていました。自分のその当時の気持としては、党員になって捕えられ、たとい終身、刑務所で暮すようになったとしても、平気だったのです。世の中の人間の「実生活」というものを恐怖しながら、毎夜の不眠の地獄で呻《うめ》いているよりは、いっそ牢屋《ろうや》のほうが、楽かも知れないとさえ考えていました。+　父は、桜木町の別荘では、来客やら外出やら、同じ家にいても、三日も四日も自分と顔を合せる事が無いほどでしたが、しかし、どうにも、父がけむったく、おそろしく、この家を出て、どこか下宿でも、と考えながらもそれを言い出せずにいた矢先に、父がその家を売払うつもりらしいという事を別荘番の老爺《ろうや》から聞きました。+　父の議員の任期もそろそろ満期に近づき、いろいろ理由のあった事に違いありませんが、もうこれきり選挙に出る意志も無い様子で、それに、故郷に一棟、隠居所など建てたりして、東京に未練も無いらしく、たかが、高等学校の一生徒に過ぎない自分のために、邸宅と召使いを提供して置くのも、むだな事だとでも考えたのか、（父の心もまた、世間の人たちの気持ちと同様に、自分にはよくわかりません）とにかく、その家は、間も無く人手にわたり、自分は、本郷森川町の仙遊館という古い下宿の、薄暗い部屋に引越して、そうして、たちまち金に困りました。+　それまで、父から月々、きまった額の小遣いを手渡され、それはもう、二、三日で無くなっても、しかし、煙草も、酒も、チイズも、くだものも、いつでも家にあったし、本や文房具やその他、服装に関するものなど一切、いつでも、近所の店から所謂「ツケ」で求められたし、堀木におそばか天丼などをごちそうしても、父のひいきの町内の店だったら、自分は黙ってその店を出てもかまわなかったのでした。+　それが急に、下宿のひとり住いになり、何もかも、月々の定額の送金で間に合わせなければならなくなって、自分は、まごつきました。送金は、やはり、二、三日で消えてしまい、自分は慄然《りつぜん》とし、心細さのために狂うようになり、父、兄、姉などへ交互にお金を頼む電報と、イサイフミの手紙（その手紙に於いて訴えている事情は、ことごとく、お道化の虚構でした。人にものを頼むのに、まず、その人を笑わせるのが上策と考えていたのです）を連発する一方、また、堀木に教えられ、せっせと質屋がよいをはじめ、それでも、いつもお金に不自由をしていました。+　所詮、自分には、何の縁故も無い下宿に、ひとりで「生活」して行く能力が無かったのです。自分は、下宿のその部屋に、ひとりでじっとしているのが、おそろしく、いまにも誰かに襲われ、一撃せられるような気がして来て、街に飛び出しては、れいの運動の手伝いをしたり、或いは堀木と一緒に安い酒を飲み廻ったりして、ほとんど学業も、また画の勉強も放棄し、高等学校へ入学して、二年目の十一月、自分より年上の有夫の婦人と情死事件などを起し、自分の身の上は、一変しました。+　学校は欠席するし、学科の勉強も、すこしもしなかったのに、それでも、妙に試験の答案に要領のいいところがあるようで、どうやらそれまでは、故郷の肉親をあざむき通して来たのですが、しかし、もうそろそろ、出席日数の不足など、学校のほうから内密に故郷の父へ報告が行っているらしく、父の代理として長兄が、いかめしい文章の長い手紙を、自分に寄こすようになっていたのでした。けれども、それよりも、自分の直接の苦痛は、金の無い事と、それから、れいの運動の用事が、とても遊び半分の気持では出来ないくらい、はげしく、いそがしくなって来た事でした。中央地区と言ったか、何地区と言ったか、とにかく本郷、小石川、下谷、神田、あの辺の学校全部の、マルクス学生の行動隊々長というものに、自分はなっていたのでした。武装｜蜂起《ほうき》、と聞き、小さいナイフを買い（いま思えば、それは鉛筆をけずるにも足りない、きゃしゃなナイフでした）それを、レンコオトのポケットにいれ、あちこち飛び廻って、所謂《いわゆる》「聯絡《れんらく》」をつけるのでした。お酒を飲んで、ぐっすり眠りたい、しかし、お金がありません。しかも、Ｐ（党の事を、そういう隠語で呼んでいたと記憶していますが、或いは、違っているかも知れません）のほうからは、次々と息をつくひまも無いくらい、用事の依頼がまいります。自分の病弱のからだでは、とても勤まりそうも無くなりました。もともと、非合法の興味だけから、そのグルウプの手伝いをしていたのですし、こんなに、それこそ冗談から駒が出たように、いやにいそがしくなって来ると、自分は、ひそかにＰのひとたちに、それはお門《かど》ちがいでしょう、あなたたちの直系のものたちにやらせたらどうですか、というようないまいましい感を抱くのを禁ずる事が出来ず、逃げました。逃げて、さすがに、いい気持はせず、死ぬ事にしました。+　その頃、自分に特別の好意を寄せている女が、三人いました。ひとりは、自分の下宿している仙遊館の娘でした。この娘は、自分がれいの運動の手伝いでへとへとになって帰り、ごはんも食べずに寝てしまってから、必ず用箋《ようせん》と万年筆を持って自分の部屋にやって来て、+「ごめんなさい。下では、妹や弟がうるさくて、ゆっくり手紙も書けないのです」+　と言って、何やら自分の机に向って一時間以上も書いているのです。+　自分もまた、知らん振りをして寝ておればいいのに、いかにもその娘が何か自分に言ってもらいたげの様子なので、れいの受け身の奉仕の精神を発揮して、実に一言も口をききたくない気持なのだけれども、くたくたに疲れ切っているからだに、ウムと気合いをかけて腹這《はらば》いになり、煙草を吸い、+「女から来たラヴ・レターで、風呂をわかしてはいった男があるそうですよ」+「あら、いやだ。あなたでしょう？」+「ミルクをわかして飲んだ事はあるんです」+「光栄だわ、飲んでよ」+　早くこのひと、帰らねえかなあ、手紙だなんて、見えすいているのに。へへののもへじでも書いているのに違いないんです。+「見せてよ」+　と死んでも見たくない思いでそう言えば、あら、いやよ、あら、いやよ、と言って、そのうれしがる事、ひどくみっともなく、興が覚めるばかりなのです。そこで自分は、用事でも言いつけてやれ、と思うんです。+「すまないけどね、電車通りの薬屋に行って、カルモチンを買って来てくれない？　あんまり疲れすぎて、顔がほてって、かえって眠れないんだ。すまないね。お金は、……」+「いいわよ、お金なんか」+　よろこんで立ちます。用を言いつけるというのは、決して女をしょげさせる事ではなく、かえって女は、男に用事をたのまれると喜ぶものだという事も、自分はちゃんと知っているのでした。+　もうひとりは、女子高等師範の文科生の所謂「同志」でした。このひととは、れいの運動の用事で、いやでも毎日、顔を合せなければならなかったのです。打ち合せがすんでからも、その女は、いつまでも自分について歩いて、そうして、やたらに自分に、ものを買ってくれるのでした。+「私を本当の姉だと思っていてくれていいわ」+　そのキザに身震いしながら、自分は、+「そのつもりでいるんです」+　と、愁《うれ》えを含んだ微笑の表情を作って答えます。とにかく、怒らせては、こわい、何とかして、ごまかさなければならぬ、という思い一つのために、自分はいよいよその醜い、いやな女に奉仕をして、そうして、ものを買ってもらっては、（その買い物は、実に趣味の悪い品ばかりで、自分はたいてい、すぐにそれを、焼きとり屋の親爺《おやじ》などにやってしまいました）うれしそうな顔をして、冗談を言っては笑わせ、或る夏の夜、どうしても離れないので、街の暗いところで、そのひとに帰ってもらいたいばかりに、キスをしてやりましたら、あさましく狂乱の如く興奮し、自動車を呼んで、そのひとたちの運動のために秘密に借りてあるらしいビルの事務所みたいな狭い洋室に連れて行き、朝まで大騒ぎという事になり、とんでもない姉だ、と自分はひそかに苦笑しました。+　下宿屋の娘と言い、またこの「同志」と言い、どうしたって毎日、顔を合せなければならぬ具合になっていますので、これまでの、さまざまの女のひとのように、うまく避けられず、つい、ずるずるに、れいの不安の心から、この二人のご機嫌をただ懸命に取り結び、もはや自分は、金縛り同様の形になっていました。+　同じ頃また自分は、銀座の或る大カフエの女給から、思いがけぬ恩を受け、たったいちど逢っただけなのに、それでも、その恩にこだわり、やはり身動き出来ないほどの、心配やら、空《そら》おそろしさを感じていたのでした。その頃になると、自分も、敢えて堀木の案内に頼らずとも、ひとりで電車にも乗れるし、また、歌舞伎座にも行けるし、または、絣《かすり》の着物を着て、カフエにだってはいれるくらいの、多少の図々しさを装えるようになっていたのです。心では、相変らず、人間の自信と暴力とを怪しみ、恐れ、悩みながら、うわべだけは、少しずつ、他人と真顔の挨拶、いや、ちがう、自分はやはり敗北のお道化の苦しい笑いを伴わずには、挨拶できないたちなのですが、とにかく、無我夢中のへどもどの挨拶でも、どうやら出来るくらいの「伎倆《ぎりょう》」を、れいの運動で走り廻ったおかげ？　または、女の？　または、酒？　けれども、おもに金銭の不自由のおかげで修得しかけていたのです。どこにいても、おそろしく、かえって大カフエでたくさんの酔客または女給、ボーイたちにもまれ、まぎれ込む事が出来たら、自分のこの絶えず追われているような心も落ちつくのではなかろうか、と十円持って、銀座のその大カフエに、ひとりではいって、笑いながら相手の女給に、+「十円しか無いんだからね、そのつもりで」+　と言いました。+「心配要りません」+　どこかに関西の訛《なま》りがありました。そうして、その一言が、奇妙に自分の、震えおののいている心をしずめてくれました。いいえ、お金の心配が要らなくなったからではありません、そのひとの傍にいる事に心配が要らないような気がしたのです。+　自分は、お酒を飲みました。そのひとに安心しているので、かえってお道化など演じる気持も起らず、自分の地金《じがね》の無口で陰惨なところを隠さず見せて、黙ってお酒を飲みました。+「こんなの、おすきか？」+　女は、さまざまの料理を自分の前に並べました。自分は首を振りました。+「お酒だけか？　うちも飲もう」+　秋の、寒い夜でした。自分は、ツネ子（といったと覚えていますが、記憶が薄れ、たしかではありません。情死の相手の名前をさえ忘れているような自分なのです）に言いつけられたとおりに、銀座裏の、或る屋台のお鮨《すし》やで、少しもおいしくない鮨を食べながら、（そのひとの名前は忘れても、その時の鮨のまずさだけは、どうした事か、はっきり記憶に残っています。そうして、青大将の顔に似た顔つきの、丸坊主のおやじが、首を振り振り、いかにも上手みたいにごまかしながら鮨を握っている様も、眼前に見るように鮮明に思い出され、後年、電車などで、はて見た顔だ、といろいろ考え、なんだ、あの時の鮨やの親爺に似ているんだ、と気が附き苦笑した事も再三あったほどでした。あのひとの名前も、また、顔かたちさえ記憶から遠ざかっている現在なお、あの鮨やの親爺の顔だけは絵にかけるほど正確に覚えているとは、よっぽどあの時の鮨がまずく、自分に寒さと苦痛を与えたものと思われます。もともと、自分は、うまい鮨を食わせる店というところに、ひとに連れられて行って食っても、うまいと思った事は、いちどもありませんでした。大き過ぎるのです。親指くらいの大きさにキチッと握れないものかしら、といつも考えていました）そのひとを、待っていました。+　本所の大工さんの二階を、そのひとが借りていました。自分は、その二階で、日頃の自分の陰鬱な心を少しもかくさず、ひどい歯痛に襲われてでもいるように、片手で頬をおさえながら、お茶を飲みました。そうして、自分のそんな姿態が、かえって、そのひとには、気にいったようでした。そのひとも、身のまわりに冷たい木枯しが吹いて、落葉だけが舞い狂い、完全に孤立している感じの女でした。+　一緒にやすみながらそのひとは、自分より二つ年上であること、故郷は広島、あたしには主人があるのよ、広島で床屋さんをしていたの、昨年の春、一緒に東京へ家出して逃げて来たのだけれども、主人は、東京で、まともな仕事をせずそのうちに詐欺罪に問われ、刑務所にいるのよ、あたしは毎日、何やらかやら差し入れしに、刑務所へかよっていたのだけれども、あすから、やめます、などと物語るのでしたが、自分は、どういうものか、女の身の上｜噺《ばなし》というものには、少しも興味を持てないたちで、それは女の語り方の下手なせいか、つまり、話の重点の置き方を間違っているせいなのか、とにかく、自分には、つねに、馬耳東風なのでありました。+　侘びしい。+　自分には、女の千万言の身の上噺よりも、その一言の呟《つぶや》きのほうに、共感をそそられるに違いないと期待していても、この世の中の女から、ついにいちども自分は、その言葉を聞いた事がないのを、奇怪とも不思議とも感じております。けれども、そのひとは、言葉で「侘びしい」とは言いませんでしたが、無言のひどい侘びしさを、からだの外郭に、一寸くらいの幅の気流みたいに持っていて、そのひとに寄り添うと、こちらのからだもその気流に包まれ、自分の持っている多少トゲトゲした陰鬱の気流と程よく溶け合い、「水底の岩に落ち附く枯葉」のように、わが身は、恐怖からも不安からも、離れる事が出来るのでした。+　あの白痴の淫売婦たちのふところの中で、安心してぐっすり眠る思いとは、また、全く異って、（だいいち、あのプロステチュウトたちは、陽気でした）その詐欺罪の犯人の妻と過した一夜は、自分にとって、幸福な（こんな大それた言葉を、なんの躊躇《ちゅうちょ》も無く、肯定して使用する事は、自分のこの全手記に於いて、再び無いつもりです）解放せられた夜でした。+　しかし、ただ一夜でした。朝、眼が覚めて、はね起き、自分はもとの軽薄な、装えるお道化者になっていました。弱虫は、幸福をさえおそれるものです。綿で怪我をするんです。幸福に傷つけられる事もあるんです。傷つけられないうちに、早く、このまま、わかれたいとあせり、れいのお道化の煙幕を張りめぐらすのでした。+「金の切れめが縁の切れめ、ってのはね、あれはね、解釈が逆なんだ。金が無くなると女にふられるって意味、じゃあ無いんだ。男に金が無くなると、男は、ただおのずから意気｜銷沈《しょうちん》して、ダメになり、笑う声にも力が無く、そうして、妙にひがんだりなんかしてね、ついには破れかぶれになり、男のほうから女を振る、半狂乱になって振って振って振り抜くという意味なんだね、金沢大辞林という本に依ればね、可哀そうに。僕にも、その気持わかるがね」+　たしか、そんなふうの馬鹿げた事を言って、ツネ子を噴き出させたような記憶があります。長居は無用、おそれありと、顔も洗わずに素早く引上げたのですが、その時の自分の、「金の切れめが縁の切れめ」という出鱈目《でたらめ》の放言が、のちに到って、意外のひっかかりを生じたのです。+　それから、ひとつき、自分は、その夜の恩人とは逢いませんでした。別れて、日が経つにつれて、よろこびは薄れ、かりそめの恩を受けた事がかえってそらおそろしく、自分勝手にひどい束縛を感じて来て、あのカフエのお勘定を、あの時、全部ツネ子の負担にさせてしまったという俗事さえ、次第に気になりはじめて、ツネ子もやはり、下宿の娘や、あの女子高等師範と同じく、自分を脅迫するだけの女のように思われ、遠く離れていながらも、絶えずツネ子におびえていて、その上に自分は、一緒に休んだ事のある女に、また逢うと、その時にいきなり何か烈火の如く怒られそうな気がしてたまらず、逢うのに頗《すこぶ》るおっくうがる性質でしたので、いよいよ、銀座は敬遠の形でしたが、しかし、そのおっくうがるという性質は、決して自分の狡猾《こうかつ》さではなく、女性というものは、休んでからの事と、朝、起きてからの事との間に、一つの、塵《ちり》ほどの、つながりをも持たせず、完全の忘却の如く、見事に二つの世界を切断させて生きているという不思議な現象を、まだよく呑みこんでいなかったからなのでした。+　十一月の末、自分は、堀木と神田の屋台で安酒を飲み、この悪友は、その屋台を出てからも、さらにどこかで飲もうと主張し、もう自分たちにはお金が無いのに、それでも、飲もう、飲もうよ、とねばるのです。その時、自分は、酔って大胆になっているからでもありましたが、+「よし、そんなら、夢の国に連れて行く。おどろくな、酒池肉林という、……」+「カフエか？」+「そう」+「行こう！」+　というような事になって二人、市電に乗り、堀木は、はしゃいで、+「おれは、今夜は、女に飢え渇いているんだ。女給にキスしてもいいか」+　自分は、堀木がそんな酔態を演じる事を、あまり好んでいないのでした。堀木も、それを知っているので、自分にそんな念を押すのでした。+「いいか。キスするぜ。おれの傍に坐った女給に、きっとキスして見せる。いいか」+「かまわんだろう」+「ありがたい！　おれは女に飢え渇いているんだ」+　銀座四丁目で降りて、その所謂酒池肉林の大カフエに、ツネ子をたのみの綱としてほとんど無一文ではいり、あいているボックスに堀木と向い合って腰をおろしたとたんに、ツネ子ともう一人の女給が走り寄って来て、そのもう一人の女給が自分の傍に、そうしてツネ子は、堀木の傍に、ドサンと腰かけたので、自分は、ハッとしました。ツネ子は、いまにキスされる。+　惜しいという気持ではありませんでした。自分には、もともと所有慾というものは薄く、また、たまに幽かに惜しむ気持はあっても、その所有権を敢然と主張し、人と争うほどの気力が無いのでした。のちに、自分は、自分の内縁の妻が犯されるのを、黙って見ていた事さえあったほどなのです。+　自分は、人間のいざこざに出来るだけ触りたくないのでした。その渦に巻き込まれるのが、おそろしいのでした。ツネ子と自分とは、一夜だけの間柄です。ツネ子は、自分のものではありません。惜しい、など思い上った慾は、自分に持てる筈はありません。けれども、自分は、ハッとしました。+　自分の眼の前で、堀木の猛烈なキスを受ける、そのツネ子の身の上を、ふびんに思ったからでした。堀木によごされたツネ子は、自分とわかれなければならなくなるだろう、しかも自分にも、ツネ子を引き留める程のポジティヴな熱は無い、ああ、もう、これでおしまいなのだ、とツネ子の不幸に一瞬ハッとしたものの、すぐに自分は水のように素直にあきらめ、堀木とツネ子の顔を見較べ、にやにやと笑いました。+　しかし、事態は、実に思いがけなく、もっと悪く展開せられました。+「やめた！」+　と堀木は、口をゆがめて言い、+「さすがのおれも、こんな貧乏くさい女には、……」+　閉口し切ったように、腕組みしてツネ子をじろじろ眺め、苦笑するのでした。+「お酒を。お金は無い」+　自分は、小声でツネ子に言いました。それこそ、浴びるほど飲んでみたい気持でした。所謂俗物の眼から見ると、ツネ子は酔漢のキスにも価いしない、ただ、みすぼらしい、貧乏くさい女だったのでした。案外とも、意外とも、自分には霹靂《へきれき》に撃ちくだかれた思いでした。自分は、これまで例の無かったほど、いくらでも、いくらでも、お酒を飲み、ぐらぐら酔って、ツネ子と顔を見合せ、哀《かな》しく微笑《ほほえ》み合い、いかにもそう言われてみると、こいつはへんに疲れて貧乏くさいだけの女だな、と思うと同時に、金の無い者どうしの親和（貧富の不和は、陳腐のようでも、やはりドラマの永遠のテーマの一つだと自分は今では思っていますが）そいつが、その親和感が、胸に込み上げて来て、ツネ子がいとしく、生れてこの時はじめて、われから積極的に、微弱ながら恋の心の動くのを自覚しました。吐きました。前後不覚になりました。お酒を飲んで、こんなに我を失うほど酔ったのも、その時がはじめてでした。+　眼が覚めたら、枕もとにツネ子が坐っていました。本所の大工さんの二階の部屋に寝ていたのでした。+「金の切れめが縁の切れめ、なんておっしゃって、冗談かと思うていたら、本気か。来てくれないのだもの。ややこしい切れめやな。うちが、かせいであげても、だめか」+「だめ」+　それから、女も休んで、夜明けがた、女の口から「死」という言葉がはじめて出て、女も人間としての営みに疲れ切っていたようでしたし、また、自分も、世の中への恐怖、わずらわしさ、金、れいの運動、女、学業、考えると、とてもこの上こらえて生きて行けそうもなく、そのひとの提案に気軽に同意しました。+　けれども、その時にはまだ、実感としての「死のう」という覚悟は、出来ていなかったのです。どこかに「遊び」がひそんでいました。+　その日の午前、二人は浅草の六区をさまよっていました。喫茶店にはいり、牛乳を飲みました。+「あなた、払うて置いて」+　自分は立って、袂《たもと》からがま口を出し、ひらくと、銅銭が三枚、羞恥《しゅうち》よりも凄惨《せいさん》の思いに襲われ、たちまち脳裡《のうり》に浮ぶものは、仙遊館の自分の部屋、制服と蒲団だけが残されてあるきりで、あとはもう、質草になりそうなものの一つも無い荒涼たる部屋、他には自分のいま着て歩いている絣の着物と、マント、これが自分の現実なのだ、生きて行けない、とはっきり思い知りました。+　自分がまごついているので、女も立って、自分のがま口をのぞいて、+「あら、たったそれだけ？」+　無心の声でしたが、これがまた、じんと骨身にこたえるほどに痛かったのです。はじめて自分が、恋したひとの声だけに、痛かったのです。それだけも、これだけもない、銅銭三枚は、どだいお金でありません。それは、自分が未《いま》だかつて味わった事の無い奇妙な屈辱でした。とても生きておられない屈辱でした。所詮《しょせん》その頃の自分は、まだお金持ちの坊ちゃんという種属から脱し切っていなかったのでしょう。その時、自分は、みずからすすんでも死のうと、実感として［＃「実感として」に傍点］決意したのです。+　その夜、自分たちは、鎌倉の海に飛び込みました。女は、この帯はお店のお友達から借りている帯やから、と言って、帯をほどき、畳んで岩の上に置き、自分もマントを脱ぎ、同じ所に置いて、一緒に入水《じゅすい》しました。+　女のひとは、死にました。そうして、自分だけ助かりました。+　自分が高等学校の生徒ではあり、また父の名にもいくらか、所謂ニュウス・ヴァリュがあったのか、新聞にもかなり大きな問題として取り上げられたようでした。+　自分は海辺の病院に収容せられ、故郷から親戚《しんせき》の者がひとり駈けつけ、さまざまの始末をしてくれて、そうして、くにの父をはじめ一家中が激怒しているから、これっきり生家とは義絶になるかも知れぬ、と自分に申し渡して帰りました。けれども自分は、そんな事より、死んだツネ子が恋いしく、めそめそ泣いてばかりいました。本当に、いままでのひとの中で、あの貧乏くさいツネ子だけを、すきだったのですから。+　下宿の娘から、短歌を五十も書きつらねた長い手紙が来ました。「生きくれよ」というへんな言葉ではじまる短歌ばかり、五十でした。また、自分の病室に、看護婦たちが陽気に笑いながら遊びに来て、自分の手をきゅっと握って帰る看護婦もいました。+　自分の左肺に故障のあるのを、その病院で発見せられ、これがたいへん自分に好都合な事になり、やがて自分が自殺｜幇助《ほうじょ》罪という罪名で病院から警察に連れて行かれましたが、警察では、自分を病人あつかいにしてくれて、特に保護室に収容しました。+　深夜、保護室の隣りの宿直室で、寝ずの番をしていた年寄りのお巡《まわ》りが、間のドアをそっとあけ、+「おい！」+　と自分に声をかけ、+「寒いだろう。こっちへ来て、あたれ」+　と言いました。+　自分は、わざとしおしおと宿直室にはいって行き、椅子に腰かけて火鉢にあたりました。+「やはり、死んだ女が恋いしいだろう」+「はい」+　ことさらに、消え入るような細い声で返事しました。+「そこが、やはり人情というものだ」+　彼は次第に、大きく構えて来ました。+「はじめ、女と関係を結んだのは、どこだ」+　ほとんど裁判官の如く、もったいぶって尋ねるのでした。彼は、自分を子供とあなどり、秋の夜のつれづれに、あたかも彼自身が取調べの主任でもあるかのように装い、自分から猥談《わいだん》めいた述懐を引き出そうという魂胆のようでした。自分は素早くそれを察し、噴き出したいのを怺《こら》えるのに骨を折りました。そんなお巡りの「非公式な訊問」には、いっさい答を拒否してもかまわないのだという事は、自分も知っていましたが、しかし、秋の夜ながに興を添えるため、自分は、あくまでも神妙に、そのお巡りこそ取調べの主任であって、刑罰の軽重の決定もそのお巡りの思召《おぼしめ》し一つに在るのだ、という事を固く信じて疑わないような所謂誠意をおもてにあらわし、彼の助平の好奇心を、やや満足させる程度のいい加減な「陳述」をするのでした。+「うん、それでだいたいわかった。何でも正直に答えると、わしらのほうでも、そこは手心を加える」+「ありがとうございます。よろしくお願いいたします」+　ほとんど入神の演技でした。そうして、自分のためには、何も、一つも、とくにならない力演なのです。+　夜が明けて、自分は署長に呼び出されました。こんどは、本式の取調べなのです。+　ドアをあけて、署長室にはいったとたんに、+「おう、いい男だ。これあ、お前が悪いんじゃない。こんな、いい男に産んだお前のおふくろが悪いんだ」+　色の浅黒い、大学出みたいな感じのまだ若い署長でした。いきなりそう言われて自分は、自分の顔の半面にべったり赤痣《あかあざ》でもあるような、みにくい不具者のような、みじめな気がしました。+　この柔道か剣道の選手のような署長の取調べは、実にあっさりしていて、あの深夜の老巡査のひそかな、執拗《しつよう》きわまる好色の「取調べ」とは、雲泥の差がありました。訊問がすんで、署長は、検事局に送る書類をしたためながら、+「からだを丈夫にしなけれゃ、いかんね。血痰《けったん》が出ているようじゃないか」+　と言いました。+　その朝、へんに咳《せき》が出て、自分は咳の出るたびに、ハンケチで口を覆っていたのですが、そのハンケチに赤い霰《あられ》が降ったみたいに血がついていたのです。けれども、それは、喉《のど》から出た血ではなく、昨夜、耳の下に出来た小さいおできをいじって、そのおできから出た血なのでした。しかし、自分は、それを言い明さないほうが、便宜な事もあるような気がふっとしたものですから、ただ、+「はい」+　と、伏眼になり、殊勝げに答えて置きました。+　署長は書類を書き終えて、+「起訴になるかどうか、それは検事殿がきめることだが、お前の身元引受人に、電報か電話で、きょう横浜の検事局に来てもらうように、たのんだほうがいいな。誰か、あるだろう、お前の保護者とか保証人とかいうものが」+　父の東京の別荘に出入りしていた書画｜骨董《こっとう》商の渋田という、自分たちと同郷人で、父のたいこ持ちみたいな役も勤めていたずんぐりした独身の四十男が、自分の学校の保証人になっているのを、自分は思い出しました。その男の顔が、殊に眼つきが、ヒラメに似ているというので、父はいつもその男をヒラメと呼び、自分も、そう呼びなれていました。+　自分は警察の電話帳を借りて、ヒラメの家の電話番号を捜し、見つかったので、ヒラメに電話して、横浜の検事局に来てくれるように頼みましたら、ヒラメは人が変ったみたいな威張った口調で、それでも、とにかく引受けてくれました。+「おい、その電話機、すぐ消毒したほうがいいぜ。何せ、血痰が出ているんだから」+　自分が、また保護室に引き上げてから、お巡りたちにそう言いつけている署長の大きな声が、保護室に坐っている自分の耳にまで、とどきました。+　お昼すぎ、自分は、細い麻繩で胴を縛られ、それはマントで隠すことを許されましたが、その麻繩の端を若いお巡りが、しっかり握っていて、二人一緒に電車で横浜に向いました。+　けれども、自分には少しの不安も無く、あの警察の保護室も、老巡査もなつかしく、嗚呼《ああ》、自分はどうしてこうなのでしょう、罪人として縛られると、かえってほっとして、そうしてゆったり落ちついて、その時の追憶を、いま書くに当っても、本当にのびのびした楽しい気持になるのです。+　しかし、その時期のなつかしい［＃「なつかしい」に傍点］思い出の中にも、たった一つ、冷汗三斗の、生涯わすれられぬ悲惨なしくじりがあったのです。自分は、検事局の薄暗い一室で、検事の簡単な取調べを受けました。検事は四十歳前後の物静かな、（もし自分が美貌だったとしても、それは謂《い》わば邪淫の美貌だったに違いありませんが、その検事の顔は、正しい美貌、とでも言いたいような、聡明な静謐《せいひつ》の気配を持っていました）コセコセしない人柄のようでしたので、自分も全く警戒せず、ぼんやり陳述していたのですが、突然、れいの咳が出て来て、自分は袂からハンケチを出し、ふとその血を見て、この咳もまた何かの役に立つかも知れぬとあさましい駈引きの心を起し、ゴホン、ゴホンと二つばかり、おまけの贋《にせ》の咳を大袈裟《おおげさ》に附け加えて、ハンケチで口を覆ったまま検事の顔をちらと見た、間一髪、+「ほんとうかい？」+　ものしずかな微笑でした。冷汗三斗、いいえ、いま思い出しても、きりきり舞いをしたくなります。中学時代に、あの馬鹿の竹一から、ワザ、ワザ、と言われて脊中《せなか》を突かれ、地獄に蹴落《けおと》された、その時の思い以上と言っても、決して過言では無い気持です。あれと、これと、二つ、自分の生涯に於ける演技の大失敗の記録です。検事のあんな物静かな侮蔑《ぶべつ》に遭うよりは、いっそ自分は十年の刑を言い渡されたほうが、ましだったと思う事さえ、時たまある程なのです。+　自分は起訴猶予になりました。けれども一向にうれしくなく、世にもみじめな気持で、検事局の控室のベンチに腰かけ、引取り人のヒラメが来るのを待っていました。+　背後の高い窓から夕焼けの空が見え、鴎《かもめ》が、「女」という字みたいな形で飛んでいました。+［＃改頁］++++［＃３字下げ］第三の手記［＃「第三の手記」は大見出し］+++［＃５字下げ］一［＃「一」は中見出し］++　竹一の予言の、一つは当り、一つは、はずれました。惚《ほ》れられるという、名誉で無い予言のほうは、あたりましたが、きっと偉い絵画きになるという、祝福の予言は、はずれました。+　自分は、わずかに、粗悪な雑誌の、無名の下手な漫画家になる事が出来ただけでした。+　鎌倉の事件のために、高等学校からは追放せられ、自分は、ヒラメの家の二階の、三畳の部屋で寝起きして、故郷からは月々、極めて小額の金が、それも直接に自分宛ではなく、ヒラメのところにひそかに送られて来ている様子でしたが、（しかも、それは故郷の兄たちが、父にかくして送ってくれているという形式になっていたようでした）それっきり、あとは故郷とのつながりを全然、断ち切られてしまい、そうして、ヒラメはいつも不機嫌、自分があいそ笑いをしても、笑わず、人間というものはこんなにも簡単に、それこそ手のひらをかえすが如くに変化できるものかと、あさましく、いや、むしろ滑稽に思われるくらいの、ひどい変り様で、+「出ちゃいけませんよ。とにかく、出ないで下さいよ」+　そればかり自分に言っているのでした。+　ヒラメは、自分に自殺のおそれありと、にらんでいるらしく、つまり、女の後を追ってまた海へ飛び込んだりする危険があると見てとっているらしく、自分の外出を固く禁じているのでした。けれども、酒も飲めないし、煙草も吸えないし、ただ、朝から晩まで二階の三畳のこたつにもぐって、古雑誌なんか読んで阿呆同然のくらしをしている自分には、自殺の気力さえ失われていました。+　ヒラメの家は、大久保の医専の近くにあり、書画骨董商、青竜園、だなどと看板の文字だけは相当に気張っていても、一棟二戸の、その一戸で、店の間口も狭く、店内はホコリだらけで、いい加減なガラクタばかり並べ、（もっとも、ヒラメはその店のガラクタにたよって商売しているわけではなく、こっちの所謂旦那の秘蔵のものを、あっちの所謂旦那にその所有権をゆずる場合などに活躍して、お金をもうけているらしいのです）店に坐っている事は殆ど無く、たいてい朝から、むずかしそうな顔をしてそそくさと出かけ、留守は十七、八の小僧ひとり、これが自分の見張り番というわけで、ひまさえあれば近所の子供たちと外でキャッチボールなどしていても、二階の居候をまるで馬鹿か気違いくらいに思っているらしく、大人《おとな》の説教くさい事まで自分に言い聞かせ、自分は、ひとと言い争いの出来ない質《たち》なので、疲れたような、また、感心したような顔をしてそれに耳を傾け、服従しているのでした。この小僧は渋田のかくし子で、それでもへんな事情があって、渋田は所謂親子の名乗りをせず、また渋田がずっと独身なのも、何やらその辺に理由があっての事らしく、自分も以前、自分の家の者たちからそれに就いての噂《うわさ》を、ちょっと聞いたような気もするのですが、自分は、どうも他人の身の上には、あまり興味を持てないほうなので、深い事は何も知りません。しかし、その小僧の眼つきにも、妙に魚の眼を聯想《れんそう》させるところがありましたから、或いは、本当にヒラメのかくし子、……でも、それならば、二人は実に淋しい親子でした。夜おそく、二階の自分には内緒で、二人でおそばなどを取寄せて無言で食べている事がありました。+　ヒラメの家では食事はいつもその小僧がつくり、二階のやっかい者の食事だけは別にお膳《ぜん》に載せて小僧が三度々々二階に持ち運んで来てくれて、ヒラメと小僧は、階段の下のじめじめした四畳半で何やら、カチャカチャ皿小鉢の触れ合う音をさせながら、いそがしげに食事しているのでした。+　三月末の或る夕方、ヒラメは思わぬもうけ口にでもありついたのか、または何か他に策略でもあったのか、（その二つの推察が、ともに当っていたとしても、おそらくは、さらにまたいくつかの、自分などにはとても推察のとどかないこまかい原因もあったのでしょうが）自分を階下の珍らしくお銚子《ちょうし》など附いている食卓に招いて、ヒラメならぬマグロの刺身に、ごちそうの主人《あるじ》みずから感服し、賞讃《しょうさん》し、ぼんやりしている居候にも少しくお酒をすすめ、+「どうするつもりなんです、いったい、これから」+　自分はそれに答えず、卓上の皿から畳鰯《たたみいわし》をつまみ上げ、その小魚たちの銀の眼玉を眺めていたら、酔いがほのぼの発して来て、遊び廻っていた頃がなつかしく、堀木でさえなつかしく、つくづく「自由」が欲しくなり、ふっと、かぼそく泣きそうになりました。+　自分がこの家へ来てからは、道化を演ずる張合いさえ無く、ただもうヒラメと小僧の蔑視の中に身を横たえ、ヒラメのほうでもまた、自分と打ち解けた長噺をするのを避けている様子でしたし、自分もそのヒラメを追いかけて何かを訴える気などは起らず、ほとんど自分は、間抜けづらの居候になり切っていたのです。+「起訴猶予というのは、前科何犯とか、そんなものには、ならない模様です。だから、まあ、あなたの心掛け一つで、更生が出来るわけです。あなたが、もし、改心して、あなたのほうから、真面目に私に相談を持ちかけてくれたら、私も考えてみます」+　ヒラメの話方には、いや、世の中の全部の人の話方には、このようにややこしく、どこか朦朧《もうろう》として、逃腰とでもいったみたいな微妙な複雑さがあり、そのほとんど無益と思われるくらいの厳重な警戒と、無数といっていいくらいの小うるさい駈引とには、いつも自分は当惑し、どうでもいいやという気分になって、お道化で茶化したり、または無言の首肯で一さいおまかせという、謂わば敗北の態度をとってしまうのでした。+　この時もヒラメが、自分に向って、だいたい次のように簡単に報告すれば、それですむ事だったのを自分は後年に到って知り、ヒラメの不必要な用心、いや、世の中の人たちの不可解な見栄、おていさいに、何とも陰鬱な思いをしました。+　ヒラメは、その時、ただこう言えばよかったのでした。+「官立でも私立でも、とにかく四月から、どこかの学校へはいりなさい。あなたの生活費は、学校へはいると、くにから、もっと充分に送って来る事になっているのです。」+　ずっと後になってわかったのですが、事実は、そのようになっていたのでした。そうして、自分もその言いつけに従ったでしょう。それなのに、ヒラメのいやに用心深く持って廻った言い方のために、妙にこじれ、自分の生きて行く方向もまるで変ってしまったのです。+「真面目に私に相談を持ちかけてくれる気持が無ければ、仕様がないですが」+「どんな相談？」+　自分には、本当に何も見当がつかなかったのです。+「それは、あなたの胸にある事でしょう？」+「たとえば？」+「たとえばって、あなた自身、これからどうする気なんです」+「働いたほうが、いいんですか？」+「いや、あなたの気持は、いったいどうなんです」+「だって、学校へはいるといったって、……」+「そりゃ、お金が要ります。しかし、問題は、お金でない。あなたの気持です」+　お金は、くにから来る事になっているんだから、となぜ一こと、言わなかったのでしょう。その一言に依って、自分の気持も、きまった筈なのに、自分には、ただ五里霧中でした。+「どうですか？　何か、将来の希望、とでもいったものが、あるんですか？　いったい、どうも、ひとをひとり世話しているというのは、どれだけむずかしいものだか、世話されているひとには、わかりますまい」+「すみません」+「そりゃ実に、心配なものです。私も、いったんあなたの世話を引受けた以上、あなたにも、生半可《なまはんか》な気持でいてもらいたくないのです。立派に更生の道をたどる、という覚悟のほどを見せてもらいたいのです。たとえば、あなたの将来の方針、それに就いてあなたのほうから私に、まじめに相談を持ちかけて来たなら、私もその相談には応ずるつもりでいます。それは、どうせこんな、貧乏なヒラメの援助なのですから、以前のようなぜいたくを望んだら、あてがはずれます。しかし、あなたの気持がしっかりしていて、将来の方針をはっきり打ち樹《た》て、そうして私に相談をしてくれたら、私は、たといわずかずつでも、あなたの更生のために、お手伝いしようとさえ思っているんです。わかりますか？　私の気持が。いったい、あなたは、これから、どうするつもりでいるのです」+「ここの二階に、置いてもらえなかったら、働いて、……」+「本気で、そんな事を言っているのですか？　いまのこの世の中に、たとい帝国大学校を出たって、……」+「いいえ、サラリイマンになるんでは無いんです」+「それじゃ、何です」+「画家です」+　思い切って、それを言いました。+「へええ？」+　自分は、その時の、頸《くび》をちぢめて笑ったヒラメの顔の、いかにもずるそうな影を忘れる事が出来ません。軽蔑の影にも似て、それとも違い、世の中を海にたとえると、その海の千尋《ちひろ》の深さの箇所に、そんな奇妙な影がたゆとうていそうで、何か、おとなの生活の奥底をチラと覗《のぞ》かせたような笑いでした。+　そんな事では話にも何もならぬ、ちっとも気持がしっかりしていない、考えなさい、今夜一晩まじめに考えてみなさい、と言われ、自分は追われるように二階に上って、寝ても、別に何の考えも浮びませんでした。そうして、あけがたになり、ヒラメの家から逃げました。+　夕方、間違いなく帰ります。左記の友人の許《もと》へ、将来の方針に就いて相談に行って来るのですから、御心配無く。ほんとうに。+　と、用箋に鉛筆で大きく書き、それから、浅草の堀木正雄の住所姓名を記して、こっそり、ヒラメの家を出ました。+　ヒラメに説教せられたのが、くやしくて逃げたわけではありませんでした。まさしく自分は、ヒラメの言うとおり、気持のしっかりしていない男で、将来の方針も何も自分にはまるで見当がつかず、この上、ヒラメの家のやっかいになっているのは、ヒラメにも気の毒ですし、そのうちに、もし万一、自分にも発奮の気持が起り、志を立てたところで、その更生資金をあの貧乏なヒラメから月々援助せられるのかと思うと、とても心苦しくて、いたたまらない気持になったからでした。+　しかし、自分は、所謂「将来の方針」を、堀木ごときに、相談に行こうなどと本気に思って、ヒラメの家を出たのでは無かったのでした。それは、ただ、わずかでも、つかのまでも、ヒラメに安心させて置きたくて、（その間に自分が、少しでも遠くへ逃げのびていたいという探偵小説的な策略から、そんな置手紙を書いた、というよりは、いや、そんな気持も幽《かす》かにあったに違いないのですが、それよりも、やはり自分は、いきなりヒラメにショックを与え、彼を混乱当惑させてしまうのが、おそろしかったばかりに、とでも言ったほうが、いくらか正確かも知れません。どうせ、ばれるにきまっているのに、そのとおりに言うのが、おそろしくて、必ず何かしら飾りをつけるのが、自分の哀しい性癖の一つで、それは世間の人が「嘘つき」と呼んで卑しめている性格に似ていながら、しかし、自分は自分に利益をもたらそうとしてその飾りつけを行った事はほとんど無く、ただ雰囲気《ふんいき》の興覚めた一変が、窒息するくらいにおそろしくて、後で自分に不利益になるという事がわかっていても、れいの自分の「必死の奉仕」それはたといゆがめられ微弱で、馬鹿らしいものであろうと、その奉仕の気持から、つい一言の飾りつけをしてしまうという場合が多かったような気もするのですが、しかし、この習性もまた、世間の所謂「正直者」たちから、大いに乗ぜられるところとなりました）その時、ふっと、記憶の底から浮んで来たままに堀木の住所と姓名を、用箋の端にしたためたまでの事だったのです。+　自分はヒラメの家を出て、新宿まで歩き、懐中の本を売り、そうして、やっぱり途方にくれてしまいました。自分は、皆にあいそがいいかわりに、「友情」というものを、いちども実感した事が無く、堀木のような遊び友達は別として、いっさいの附き合いは、ただ苦痛を覚えるばかりで、その苦痛をもみほぐそうとして懸命にお道化を演じて、かえって、へとへとになり、わずかに知合っているひとの顔を、それに似た顔をさえ、往来などで見掛けても、ぎょっとして、一瞬、めまいするほどの不快な戦慄に襲われる有様で、人に好かれる事は知っていても、人を愛する能力に於《お》いては欠けているところがあるようでした。（もっとも、自分は、世の中の人間にだって、果して、「愛」の能力があるのかどうか、たいへん疑問に思っています）そのような自分に、所謂「親友」など出来る筈は無く、そのうえ自分には、「訪問《ヴィジット》」の能力さえ無かったのです。他人の家の門は、自分にとって、あの神曲の地獄の門以上に薄気味わるく、その門の奥には、おそろしい竜みたいな生臭い奇獣がうごめいている気配を、誇張でなしに、実感せられていたのです。+　誰とも、附き合いが無い。どこへも、訪ねて行けない。+　堀木。+　それこそ、冗談から駒が出た形でした。あの置手紙に、書いたとおりに、自分は浅草の堀木をたずねて行く事にしたのです。自分はこれまで、自分のほうから堀木の家をたずねて行った事は、いちども無く、たいてい電報で堀木を自分のほうに呼び寄せていたのですが、いまはその電報料さえ心細く、それに落ちぶれた身のひがみから、電報を打っただけでは、堀木は、来てくれぬかも知れぬと考えて、何よりも自分に苦手の「訪問」を決意し、溜息《ためいき》をついて市電に乗り、自分にとって、この世の中でたった一つの頼みの綱は、あの堀木なのか、と思い知ったら、何か脊筋《せすじ》の寒くなるような凄《すさま》じい気配に襲われました。+　堀木は、在宅でした。汚い露路の奥の、二階家で、堀木は二階のたった一部屋の六畳を使い、下では、堀木の老父母と、それから若い職人と三人、下駄の鼻緒を縫ったり叩いたりして製造しているのでした。+　堀木は、その日、彼の都会人としての新しい一面を自分に見せてくれました。それは、俗にいうチャッカリ性でした。田舎者の自分が、愕然《がくぜん》と眼をみはったくらいの、冷たく、ずるいエゴイズムでした。自分のように、ただ、とめどなく流れるたちの男では無かったのです。+「お前には、全く呆《あき》れた。親爺さんから、お許しが出たかね。まだかい」+　逃げて来た、とは、言えませんでした。+　自分は、れいに依って、ごまかしました。いまに、すぐ、堀木に気附かれるに違いないのに、ごまかしました。+「それは、どうにかなるさ」+「おい、笑いごとじゃ無いぜ。忠告するけど、馬鹿もこのへんでやめるんだな。おれは、きょうは、用事があるんだがね。この頃、ばかにいそがしいんだ」+「用事って、どんな？」+「おい、おい、座蒲団の糸を切らないでくれよ」+　自分は話をしながら、自分の敷いている座蒲団の綴糸《とじいと》というのか、くくり紐《ひも》というのか、あの総《ふさ》のような四隅の糸の一つを無意識に指先でもてあそび、ぐいと引っぱったりなどしていたのでした。堀木は、堀木の家の品物なら、座蒲団の糸一本でも惜しいらしく、恥じる色も無く、それこそ、眼に角《かど》を立てて、自分をとがめるのでした。考えてみると、堀木は、これまで自分との附合いに於いて何一つ失ってはいなかったのです。+　堀木の老母が、おしるこを二つお盆に載せて持って来ました。+「あ、これは」+　と堀木は、しんからの孝行息子のように、老母に向って恐縮し、言葉づかいも不自然なくらい丁寧に、+「すみません、おしるこですか。豪気だなあ。こんな心配は、要らなかったんですよ。用事で、すぐ外出しなけれゃいけないんですから。いいえ、でも、せっかくの御自慢のおしるこを、もったいない。いただきます。お前も一つ、どうだい。おふくろが、わざわざ作ってくれたんだ。ああ、こいつあ、うめえや。豪気だなあ」+　と、まんざら芝居でも無いみたいに、ひどく喜び、おいしそうに食べるのです。自分もそれを啜《すす》りましたが、お湯のにおいがして、そうして、お餅をたべたら、それはお餅でなく、自分にはわからないものでした。決して、その貧しさを軽蔑したのではありません。（自分は、その時それを、不味《まず》いとは思いませんでしたし、また、老母の心づくしも身にしみました。自分には、貧しさへの恐怖感はあっても、軽蔑感は、無いつもりでいます）あのおしること、それから、そのおしるこを喜ぶ堀木に依って、自分は、都会人のつましい本性、また、内と外をちゃんと区別していとなんでいる東京の人の家庭の実体を見せつけられ、内も外も変りなく、ただのべつ幕無しに人間の生活から逃げ廻ってばかりいる薄馬鹿の自分ひとりだけ完全に取残され、堀木にさえ見捨てられたような気配に、狼狽《ろうばい》し、おしるこのはげた塗箸《ぬりばし》をあつかいながら、たまらなく侘《わ》びしい思いをしたという事を、記して置きたいだけなのです。+「わるいけど、おれは、きょうは用事があるんでね」+　堀木は立って、上衣を着ながらそう言い、+「失敬するぜ、わるいけど」+　その時、堀木に女の訪問者があり、自分の身の上も急転しました。+　堀木は、にわかに活気づいて、+「や、すみません。いまね、あなたのほうへお伺いしようと思っていたのですがね、このひとが突然やって来て、いや、かまわないんです。さあ、どうぞ」+　よほど、あわてているらしく、自分が自分の敷いている座蒲団をはずして裏がえしにして差し出したのを引ったくって、また裏がえしにして、その女のひとにすすめました。部屋には、堀木の座蒲団の他には、客座蒲団がたった一枚しか無かったのです。+　女のひとは痩《や》せて、脊の高いひとでした。その座蒲団は傍にのけて、入口ちかくの片隅に坐りました。+　自分は、ぼんやり二人の会話を聞いていました。女は雑誌社のひとのようで、堀木にカットだか、何だかをかねて頼んでいたらしく、それを受取りに来たみたいな具合いでした。+「いそぎますので」+「出来ています。もうとっくに出来ています。これです、どうぞ」+　電報が来ました。+　堀木が、それを読み、上機嫌のその顔がみるみる険悪になり、+「ちぇっ！　お前、こりゃ、どうしたんだい」+　ヒラメからの電報でした。+「とにかく、すぐに帰ってくれ。おれが、お前を送りとどけるといいんだろうが、おれにはいま、そんなひまは、無えや。家出していながら、その、のんきそうな面《つら》ったら」+「お宅は、どちらなのですか？」+「大久保です」+　ふいと答えてしまいました。+「そんなら、社の近くですから」+　女は、甲州の生れで二十八歳でした。五つになる女児と、高円寺のアパートに住んでいました。夫と死別して、三年になると言っていました。+「あなたは、ずいぶん苦労して育って来たみたいなひとね。よく気がきくわ。可哀そうに」+　はじめて、男めかけみたいな生活をしました。シヅ子（というのが、その女記者の名前でした）が新宿の雑誌社に勤めに出たあとは、自分とそれからシゲ子という五つの女児と二人、おとなしくお留守番という事になりました。それまでは、母の留守には、シゲ子はアパートの管理人の部屋で遊んでいたようでしたが、「気のきく」おじさんが遊び相手として現われたので、大いに御機嫌がいい様子でした。+　一週間ほど、ぼんやり、自分はそこにいました。アパートの窓のすぐ近くの電線に、奴凧《やっこだこ》が一つひっからまっていて、春のほこり風に吹かれ、破られ、それでもなかなか、しつっこく電線にからみついて離れず、何やら首肯《うなず》いたりなんかしているので、自分はそれを見る度毎に苦笑し、赤面し、夢にさえ見て、うなされました。+「お金が、ほしいな」+「……いくら位？」+「たくさん。……金の切れ目が、縁の切れ目、って、本当の事だよ」+「ばからしい。そんな、古くさい、……」+「そう？　しかし、君には、わからないんだ。このままでは、僕は、逃げる事になるかも知れない」+「いったい、どっちが貧乏なのよ。そうして、どっちが逃げるのよ。へんねえ」+「自分でかせいで、そのお金で、お酒、いや、煙草を買いたい。絵だって僕は、堀木なんかより、ずっと上手なつもりなんだ」+　このような時、自分の脳裡におのずから浮びあがって来るものは、あの中学時代に画いた竹一の所謂「お化け」の、数枚の自画像でした。失われた傑作。それは、たびたびの引越しの間に、失われてしまっていたのですが、あれだけは、たしかに優れている絵だったような気がするのです。その後、さまざま画いてみても、その思い出の中の逸品には、遠く遠く及ばず、自分はいつも、胸がからっぽになるような、だるい喪失感になやまされ続けて来たのでした。+　飲み残した一杯のアブサン。+　自分は、その永遠に償い難いような喪失感を、こっそりそう形容していました。絵の話が出ると、自分の眼前に、その飲み残した一杯のアブサンがちらついて来て、ああ、あの絵をこのひとに見せてやりたい、そうして、自分の画才を信じさせたい、という焦燥《しょうそう》にもだえるのでした。+「ふふ、どうだか。あなたは、まじめな顔をして冗談を言うから可愛い」+　冗談ではないのだ、本当なんだ、ああ、あの絵を見せてやりたい、と空転の煩悶《はんもん》をして、ふいと気をかえ、あきらめて、+「漫画さ。すくなくとも、漫画なら、堀木よりは、うまいつもりだ」+　その、ごまかしの道化の言葉のほうが、かえってまじめに信ぜられました。+「そうね。私も、実は感心していたの。シゲ子にいつもかいてやっている漫画、つい私まで噴き出してしまう。やってみたら、どう？　私の社の編輯長《へんしゅうちょう》に、たのんでみてあげてもいいわ」+　その社では、子供相手のあまり名前を知られていない月刊の雑誌を発行していたのでした。+　……あなたを見ると、たいていの女のひとは、何かしてあげたくて、たまらなくなる。……いつも、おどおどしていて、それでいて、滑稽家なんだもの。……時たま、ひとりで、ひどく沈んでいるけれども、そのさまが、いっそう女のひとの心を、かゆがらせる。+　シヅ子に、そのほかさまざまの事を言われて、おだてられても、それが即《すなわ》ち男めかけのけがらわしい特質なのだ、と思えば、それこそいよいよ「沈む」ばかりで、一向に元気が出ず、女よりは金、とにかくシヅ子からのがれて自活したいとひそかに念じ、工夫しているものの、かえってだんだんシヅ子にたよらなければならぬ破目になって、家出の後仕末やら何やら、ほとんど全部、この男まさりの甲州女の世話を受け、いっそう自分は、シヅ子に対し、所謂「おどおど」しなければならぬ結果になったのでした。+　シヅ子の取計らいで、ヒラメ、堀木、それにシヅ子、三人の会談が成立して、自分は、故郷から全く絶縁せられ、そうしてシヅ子と「天下晴れて」同棲《どうせい》という事になり、これまた、シヅ子の奔走のおかげで自分の漫画も案外お金になって、自分はそのお金で、お酒も、煙草も買いましたが、自分の心細さ、うっとうしさは、いよいよつのるばかりなのでした。それこそ「沈み」に「沈み」切って、シヅ子の雑誌の毎月の連載漫画「キンタさんとオタさんの冒険」を画いていると、ふいと故郷の家が思い出され、あまりの侘びしさに、ペンが動かなくなり、うつむいて涙をこぼした事もありました。+　そういう時の自分にとって、幽かな救いは、シゲ子でした。シゲ子は、その頃になって自分の事を、何もこだわらずに「お父ちゃん」と呼んでいました。+「お父ちゃん。お祈りをすると、神様が、何でも下さるって、ほんとう？」+　自分こそ、そのお祈りをしたいと思いました。+　ああ、われに冷き意志を与え給え。われに、「人間」の本質を知らしめ給え。人が人を押しのけても、罪ならずや。われに、怒りのマスクを与え給え。+「うん、そう。シゲちゃんには何でも下さるだろうけれども、お父ちゃんには、駄目かも知れない」+　自分は神にさえ、おびえていました。神の愛は信ぜられず、神の罰だけを信じているのでした。信仰。それは、ただ神の笞《むち》を受けるために、うなだれて審判の台に向う事のような気がしているのでした。地獄は信ぜられても、天国の存在は、どうしても信ぜられなかったのです。+「どうして、ダメなの？」+「親の言いつけに、そむいたから」+「そう？　お父ちゃんはとてもいいひとだって、みんな言うけどな」+　それは、だましているからだ、このアパートの人たち皆に、自分が好意を示されているのは、自分も知っている、しかし、自分は、どれほど皆を恐怖しているか、恐怖すればするほど好かれ、そうして、こちらは好かれると好かれるほど恐怖し、皆から離れて行かねばならぬ、この不幸な病癖を、シゲ子に説明して聞かせるのは、至難の事でした。+「シゲちゃんは、いったい、神様に何をおねだりしたいの？」+　自分は、何気無さそうに話頭を転じました。+「シゲ子はね、シゲ子の本当のお父ちゃんがほしいの」+　ぎょっとして、くらくら目まいしました。敵。自分がシゲ子の敵なのか、シゲ子が自分の敵なのか、とにかく、ここにも自分をおびやかすおそろしい大人がいたのだ、他人、不可解な他人、秘密だらけの他人、シゲ子の顔が、にわかにそのように見えて来ました。+　シゲ子だけは、と思っていたのに、やはり、この者も、あの「不意に虻《あぶ》を叩き殺す牛のしっぽ」を持っていたのでした。自分は、それ以来、シゲ子にさえおどおどしなければならなくなりました。+「色魔《しきま》！　いるかい？」+　堀木が、また自分のところへたずねて来るようになっていたのです。あの家出の日に、あれほど自分を淋しくさせた男なのに、それでも自分は拒否できず、幽かに笑って迎えるのでした。+「お前の漫画は、なかなか人気が出ているそうじゃないか。アマチュアには、こわいもの知らずの糞度胸《くそどきょう》があるからかなわねえ。しかし、油断するなよ。デッサンが、ちっともなってやしないんだから」+　お師匠みたいな態度をさえ示すのです。自分のあの「お化け」の絵を、こいつに見せたら、どんな顔をするだろう、とれいの空転の身悶《みもだ》えをしながら、+「それを言ってくれるな。ぎゃっという悲鳴が出る」+　堀木は、いよいよ得意そうに、+「世渡りの才能だけでは、いつかは、ボロが出るからな」+　世渡りの才能。……自分には、ほんとうに苦笑の他はありませんでした。自分に、世渡りの才能！　しかし、自分のように人間をおそれ、避け、ごまかしているのは、れいの俗諺《ぞくげん》の「さわらぬ神にたたりなし」とかいう怜悧《れいり》狡猾《こうかつ》の処生訓を遵奉しているのと、同じ形だ、という事になるのでしょうか。ああ、人間は、お互い何も相手をわからない、まるっきり間違って見ていながら、無二の親友のつもりでいて、一生、それに気附かず、相手が死ねば、泣いて弔詞なんかを読んでいるのではないでしょうか。+　堀木は、何せ、（それはシヅ子に押してたのまれてしぶしぶ引受けたに違いないのですが）自分の家出の後仕末に立ち合ったひとなので、まるでもう、自分の更生の大恩人か、月下氷人のように振舞い、もっともらしい顔をして自分にお説教めいた事を言ったり、また、深夜、酔っぱらって訪問して泊ったり、また、五円（きまって五円でした）借りて行ったりするのでした。+「しかし、お前の、女道楽もこのへんでよすんだね。これ以上は、世間が、ゆるさないからな」+　世間とは、いったい、何の事でしょう。人間の複数でしょうか。どこに、その世間というものの実体があるのでしょう。けれども、何しろ、強く、きびしく、こわいもの、とばかり思ってこれまで生きて来たのですが、しかし、堀木にそう言われて、ふと、+「世間というのは、君じゃないか」+　という言葉が、舌の先まで出かかって、堀木を怒らせるのがイヤで、ひっこめました。+（それは世間が、ゆるさない）+（世間じゃない。あなたが、ゆるさないのでしょう？）+（そんな事をすると、世間からひどいめに逢うぞ）+（世間じゃない。あなたでしょう？）+（いまに世間から葬られる）+（世間じゃない。葬むるのは、あなたでしょう？）+　汝《なんじ》は、汝個人のおそろしさ、怪奇、悪辣《あくらつ》、古狸《ふるだぬき》性、妖婆《ようば》性を知れ！　などと、さまざまの言葉が胸中に去来したのですが、自分は、ただ顔の汗をハンケチで拭いて、+「冷汗《ひやあせ》、冷汗」+　と言って笑っただけでした。+　けれども、その時以来、自分は、（世間とは個人じゃないか）という、思想めいたものを持つようになったのです。+　そうして、世間というものは、個人ではなかろうかと思いはじめてから、自分は、いままでよりは多少、自分の意志で動く事が出来るようになりました。シヅ子の言葉を借りて言えば、自分は少しわがままになり、おどおどしなくなりました。また、堀木の言葉を借りて言えば、へんにケチになりました。また、シゲ子の言葉を借りて言えば、あまりシゲ子を可愛がらなくなりました。+　無口で、笑わず、毎日々々、シゲ子のおもりをしながら、「キンタさんとオタさんの冒険」やら、またノンキなトウサンの歴然たる亜流の「ノンキ和尚《おしょう》」やら、また、「セッカチピンチャン」という自分ながらわけのわからぬヤケクソの題の連載漫画やらを、各社の御注文（ぽつりぽつり、シヅ子の社の他からも注文が来るようになっていましたが、すべてそれは、シヅ子の社よりも、もっと下品な謂わば三流出版社からの注文ばかりでした）に応じ、実に実に陰鬱な気持で、のろのろと、（自分の画の運筆は、非常におそいほうでした）いまはただ、酒代がほしいばかりに画いて、そうして、シヅ子が社から帰るとそれと交代にぷいと外へ出て、高円寺の駅近くの屋台やスタンド・バアで安くて強い酒を飲み、少し陽気になってアパートへ帰り、+「見れば見るほど、へんな顔をしているねえ、お前は。ノンキ和尚の顔は、実は、お前の寝顔からヒントを得たのだ」+「あなたの寝顔だって、ずいぶんお老けになりましてよ。四十男みたい」+「お前のせいだ。吸い取られたんだ。水の流れと、人の身はあサ。何をくよくよ川端やなあぎいサ」+「騒がないで、早くおやすみなさいよ。それとも、ごはんをあがりますか？」+　落ちついていて、まるで相手にしません。+「酒なら飲むがね。水の流れと、人の身はあサ。人の流れと、いや、水の流れえと、水の身はあサ」+　唄いながら、シヅ子に衣服をぬがせられ、シヅ子の胸に自分の額を押しつけて眠ってしまう、それが自分の日常でした。++［＃ここから２字下げ］+してその翌日《あくるひ》も同じ事を繰返して、+昨日《きのう》に異《かわ》らぬ慣例《しきたり》に従えばよい。+即ち荒っぽい大きな歓楽《よろこび》を避《よ》けてさえいれば、+自然また大きな悲哀《かなしみ》もやって来《こ》ないのだ。+ゆくてを塞《ふさ》ぐ邪魔な石を+蟾蜍《ひきがえる》は廻って通る。+［＃ここで字下げ終わり］++　上田敏訳のギイ・シャルル・クロオとかいうひとの、こんな詩句を見つけた時、自分はひとりで顔を燃えるくらいに赤くしました。+　蟾蜍。+（それが、自分だ。世間がゆるすも、ゆるさぬもない。葬むるも、葬むらぬもない。自分は、犬よりも猫よりも劣等な動物なのだ。蟾蜍。のそのそ動いているだけだ）+　自分の飲酒は、次第に量がふえて来ました。高円寺駅附近だけでなく、新宿、銀座のほうにまで出かけて飲み、外泊する事さえあり、ただもう「慣例《しきたり》」に従わぬよう、バアで無頼漢の振りをしたり、片端からキスしたり、つまり、また、あの情死以前の、いや、あの頃よりさらに荒《すさ》んで野卑な酒飲みになり、金に窮して、シヅ子の衣類を持ち出すほどになりました。+　ここへ来て、あの破れた奴凧に苦笑してから一年以上経って、葉桜の頃、自分は、またもシヅ子の帯やら襦袢《じゅばん》やらをこっそり持ち出して質屋に行き、お金を作って銀座で飲み、二晩つづけて外泊して、三日目の晩、さすがに具合い悪い思いで、無意識に足音をしのばせて、アパートのシヅ子の部屋の前まで来ると、中から、シヅ子とシゲ子の会話が聞えます。+「なぜ、お酒を飲むの？」+「お父ちゃんはね、お酒を好きで飲んでいるのでは、ないんですよ。あんまりいいひとだから、だから、……」+「いいひとは、お酒を飲むの？」+「そうでもないけど、……」+「お父ちゃんは、きっと、びっくりするわね」+「おきらいかも知れない。ほら、ほら、箱から飛び出した」+「セッカチピンチャンみたいね」+「そうねえ」+　シヅ子の、しんから幸福そうな低い笑い声が聞えました。+　自分が、ドアを細くあけて中をのぞいて見ますと、白兎の子でした。ぴょんぴょん部屋中を、はね廻り、親子はそれを追っていました。+（幸福なんだ、この人たちは。自分という馬鹿者が、この二人のあいだにはいって、いまに二人を滅茶苦茶にするのだ。つつましい幸福。いい親子。幸福を、ああ、もし神様が、自分のような者の祈りでも聞いてくれるなら、いちどだけ、生涯にいちどだけでいい、祈る）+　自分は、そこにうずくまって合掌したい気持でした。そっと、ドアを閉め、自分は、また銀座に行き、それっきり、そのアパートには帰りませんでした。+　そうして、京橋のすぐ近くのスタンド・バアの二階に自分は、またも男めかけの形で、寝そべる事になりました。+　世間。どうやら自分にも、それがぼんやりわかりかけて来たような気がしていました。個人と個人の争いで、しかも、その場の争いで、しかも、その場で勝てばいいのだ、人間は決して人間に服従しない［＃「人間は決して人間に服従しない」に傍点］、奴隷でさえ奴隷らしい卑屈なシッペがえしをするものだ、だから、人間にはその場の一本勝負にたよる他、生き伸びる工夫がつかぬのだ、大義名分らしいものを称《とな》えていながら、努力の目標は必ず個人、個人を乗り越えてまた個人、世間の難解は、個人の難解、大洋《オーシャン》は世間でなくて、個人なのだ、と世の中という大海の幻影におびえる事から、多少解放せられて、以前ほど、あれこれと際限の無い心遣いする事なく、謂わば差し当っての必要に応じて、いくぶん図々しく振舞う事を覚えて来たのです。+　高円寺のアパートを捨て、京橋のスタンド・バアのマダムに、+「わかれて来た」+　それだけ言って、それで充分、つまり一本勝負はきまって、その夜から、自分は乱暴にもそこの二階に泊り込む事になったのですが、しかし、おそろしい筈の「世間」は、自分に何の危害も加えませんでしたし、また自分も「世間」に対して何の弁明もしませんでした。マダムが、その気だったら、それですべてがいいのでした。+　自分は、その店のお客のようでもあり、亭主のようでもあり、走り使いのようでもあり、親戚の者のようでもあり、はたから見て甚《はなは》だ得態《えたい》の知れない存在だった筈なのに、「世間」は少しもあやしまず、そうしてその店の常連たちも、自分を、葉ちゃん、葉ちゃんと呼んで、ひどく優しく扱い、そうしてお酒を飲ませてくれるのでした。+　自分は世の中に対して、次第に用心しなくなりました。世の中というところは、そんなに、おそろしいところでは無い、と思うようになりました。つまり、これまでの自分の恐怖感は、春の風には百日咳《ひゃくにちぜき》の黴菌《ばいきん》が何十万、銭湯には、目のつぶれる黴菌が何十万、床屋には禿頭《とくとう》病の黴菌が何十万、省線の吊皮《つりかわ》には疥癬《かいせん》の虫がうようよ、または、おさしみ、牛豚肉の生焼けには、さなだ虫の幼虫やら、ジストマやら、何やらの卵などが必ずひそんでいて、また、はだしで歩くと足の裏からガラスの小さい破片がはいって、その破片が体内を駈けめぐり眼玉を突いて失明させる事もあるとかいう謂わば「科学の迷信」におびやかされていたようなものなのでした。それは、たしかに何十万もの黴菌の浮び泳ぎうごめいているのは、「科学的」にも、正確な事でしょう。と同時に、その存在を完全に黙殺さえすれば、それは自分とみじんのつながりも無くなってたちまち消え失せる「科学の幽霊」に過ぎないのだという事をも、自分は知るようになったのです。お弁当箱に食べ残しのごはん三粒、千万人が一日に三粒ずつ食べ残しても既にそれは、米何俵をむだに捨てた事になる、とか、或いは、一日に鼻紙一枚の節約を千万人が行うならば、どれだけのパルプが浮くか、などという「科学的統計」に、自分は、どれだけおびやかされ、ごはんを一粒でも食べ残す度毎に、また鼻をかむ度毎に、山ほどの米、山ほどのパルプを空費するような錯覚に悩み、自分がいま重大な罪を犯しているみたいな暗い気持になったものですが、しかし、それこそ「科学の嘘」「統計の嘘」「数学の嘘」で、三粒のごはんは集められるものでなく、掛算割算の応用問題としても、まことに原始的で低能なテーマで、電気のついてない暗いお便所の、あの穴に人は何度にいちど片脚を踏みはずして落下させるか、または、省線電車の出入口と、プラットホームの縁《へり》とのあの隙間に、乗客の何人中の何人が足を落とし込むか、そんなプロバビリティを計算するのと同じ程度にばからしく、それは如何《いか》にも有り得る事のようでもありながら、お便所の穴をまたぎそこねて怪我をしたという例は、少しも聞かないし、そんな仮説を「科学的事実」として教え込まれ、それを全く現実として受取り、恐怖していた昨日までの自分をいとおしく思い、笑いたく思ったくらいに、自分は、世の中というものの実体を少しずつ知って来たというわけなのでした。+　そうは言っても、やはり人間というものが、まだまだ、自分にはおそろしく、店のお客と逢うのにも、お酒をコップで一杯ぐいと飲んでからでなければいけませんでした。こわいもの見たさ。自分は、毎晩、それでもお店に出て、子供が、実は少しこわがっている小動物などを、かえって強くぎゅっと握ってしまうみたいに、店のお客に向って酔ってつたない芸術論を吹きかけるようにさえなりました。+　漫画家。ああ、しかし、自分は、大きな歓楽《よろこび》も、また、大きな悲哀《かなしみ》もない無名の漫画家。いかに大きな悲哀《かなしみ》があとでやって来てもいい、荒っぽい大きな歓楽《よろこび》が欲しいと内心あせってはいても、自分の現在のよろこびたるや、お客とむだ事を言い合い、お客の酒を飲む事だけでした。+　京橋へ来て、こういうくだらない生活を既に一年ちかく続け、自分の漫画も、子供相手の雑誌だけでなく、駅売りの粗悪で卑猥《ひわい》な雑誌などにも載るようになり、自分は、上司幾太（情死、生きた）という、ふざけ切った匿名で、汚いはだかの絵など画き、それにたいていルバイヤットの詩句を插入《そうにゅう》しました。++［＃ここから２字下げ］+無駄な御祈りなんか止《よ》せったら+涙を誘うものなんか　かなぐりすてろ+まア一杯いこう　好いことばかり思出して+よけいな心づかいなんか忘れっちまいな++不安や恐怖もて人を脅やかす奴輩《やから》は+自《みずから》の作りし大それた罪に怯《おび》え+死にしものの復讐《ふくしゅう》に備えんと+自《みずから》の頭にたえず計いを為《な》す++よべ　酒充ちて我ハートは喜びに充ち+けさ　さめて只《ただ》に荒涼+いぶかし　一夜《ひとよ》さの中+様変りたる此《この》気分よ++祟《たた》りなんて思うこと止《や》めてくれ+遠くから響く太鼓のように+何がなしそいつは不安だ+屁《へ》ひったこと迄《まで》一々罪に勘定されたら助からんわい++正義は人生の指針たりとや？+さらば血に塗られたる戦場に+暗殺者の切尖《きっさき》に+何の正義か宿れるや？++いずこに指導原理ありや？+いかなる叡智《えいち》の光ありや？+美《うる》わしくも怖《おそろ》しきは浮世なれ+かよわき人の子は背負切れぬ荷をば負わされ++どうにもできない情慾の種子を植えつけられた許《ばか》りに+善だ悪だ罪だ罰だと呪《のろ》わるるばかり+どうにもできない只まごつくばかり+抑え摧《くだ》く力も意志も授けられぬ許りに++どこをどう彷徨《うろつき》まわってたんだい+ナニ批判　検討　再認識？+ヘッ　空《むな》しき夢を　ありもしない幻を+エヘッ　酒を忘れたんで　みんな虚仮《こけ》の思案さ++どうだ　此｜涯《はて》もない大空を御覧よ+此中にポッチリ浮んだ点じゃい+此地球が何んで自転するのか分るもんか+自転　公転　反転も勝手ですわい++至る処《ところ》に　至高の力を感じ+あらゆる国にあらゆる民族に+同一の人間性を発見する+我は異端者なりとかや++みんな聖経をよみ違えてんのよ+でなきゃ常識も智慧《ちえ》もないのよ+生身《いきみ》の喜びを禁じたり　酒を止めたり+いいわ　ムスタッファ　わたしそんなの　大嫌い+［＃ここで字下げ終わり］++　けれども、その頃、自分に酒を止めよ、とすすめる処女がいました。+「いけないわ、毎日、お昼から、酔っていらっしゃる」+　バアの向いの、小さい煙草屋の十七、八の娘でした。ヨシちゃんと言い、色の白い、八重歯のある子でした。自分が、煙草を買いに行くたびに、笑って忠告するのでした。+「なぜ、いけないんだ。どうして悪いんだ。あるだけの酒をのんで、人の子よ、憎悪を消せ消せ消せ、ってね、むかしペルシャのね、まあよそう、悲しみ疲れたるハートに希望を持ち来すは、ただ微醺《びくん》をもたらす玉杯なれ、ってね。わかるかい」+「わからない」+「この野郎。キスしてやるぞ」+「してよ」+　ちっとも悪びれず下唇を突き出すのです。+「馬鹿野郎。貞操観念、……」+　しかし、ヨシちゃんの表情には、あきらかに誰にも汚されていない処女のにおいがしていました。+　としが明けて厳寒の夜、自分は酔って煙草を買いに出て、その煙草屋の前のマンホールに落ちて、ヨシちゃん、たすけてくれえ、と叫び、ヨシちゃんに引き上げられ、右腕の傷の手当を、ヨシちゃんにしてもらい、その時ヨシちゃんは、しみじみ、+「飲みすぎますわよ」+　と笑わずに言いました。+　自分は死ぬのは平気なんだけど、怪我をして出血してそうして不具者などになるのは、まっぴらごめんのほうですので、ヨシちゃんに腕の傷の手当をしてもらいながら、酒も、もういい加減によそうかしら、と思ったのです。+「やめる。あしたから、一滴も飲まない」+「ほんとう？」+「きっと、やめる。やめたら、ヨシちゃん、僕のお嫁になってくれるかい？」+　しかし、お嫁の件は冗談でした。+「モチよ」+　モチとは、「勿論」の略語でした。モボだの、モガだの、その頃いろんな略語がはやっていました。+「ようし。ゲンマンしよう。きっとやめる」+　そうして翌《あく》る日、自分は、やはり昼から飲みました。+　夕方、ふらふら外へ出て、ヨシちゃんの店の前に立ち、+「ヨシちゃん、ごめんね。飲んじゃった」+「あら、いやだ。酔った振りなんかして」+　ハッとしました。酔いもさめた気持でした。+「いや、本当なんだ。本当に飲んだのだよ。酔った振りなんかしてるんじゃない」+「からかわないでよ。ひとがわるい」+　てんで疑おうとしないのです。+「見ればわかりそうなものだ。きょうも、お昼から飲んだのだ。ゆるしてね」+「お芝居が、うまいのねえ」+「芝居じゃあないよ、馬鹿野郎。キスしてやるぞ」+「してよ」+「いや、僕には資格が無い。お嫁にもらうのもあきらめなくちゃならん。顔を見なさい、赤いだろう？　飲んだのだよ」+「それあ、夕陽が当っているからよ。かつごうたって、だめよ。きのう約束したんですもの。飲む筈が無いじゃないの。ゲンマンしたんですもの。飲んだなんて、ウソ、ウソ、ウソ」+　薄暗い店の中に坐って微笑しているヨシちゃんの白い顔、ああ、よごれを知らぬヴァジニティは尊いものだ、自分は今まで、自分よりも若い処女と寝た事がない、結婚しよう、どんな大きな悲哀《かなしみ》がそのために後からやって来てもよい、荒っぽいほどの大きな歓楽《よろこび》を、生涯にいちどでいい、処女性の美しさとは、それは馬鹿な詩人の甘い感傷の幻に過ぎぬと思っていたけれども、やはりこの世の中に生きて在るものだ、結婚して春になったら二人で自転車で青葉の滝を見に行こう、と、その場で決意し、所謂「一本勝負」で、その花を盗むのにためらう事をしませんでした。+　そうして自分たちは、やがて結婚して、それに依って得た歓楽《よろこび》は、必ずしも大きくはありませんでしたが、その後に来た悲哀《かなしみ》は、凄惨《せいさん》と言っても足りないくらい、実に想像を絶して、大きくやって来ました。自分にとって、「世の中」は、やはり底知れず、おそろしいところでした。決して、そんな一本勝負などで、何から何まできまってしまうような、なまやさしいところでも無かったのでした。+++［＃５字下げ］二［＃「二」は中見出し］++　堀木と自分。+　互いに軽蔑《けいべつ》しながら附き合い、そうして互いに自《みずか》らをくだらなくして行く、それがこの世の所謂「交友」というものの姿だとするなら、自分と堀木との間柄も、まさしく「交友」に違いありませんでした。+　自分があの京橋のスタンド・バアのマダムの義侠心《ぎきょうしん》にすがり、（女のひとの義侠心なんて、言葉の奇妙な遣い方ですが、しかし、自分の経験に依ると、少くとも都会の［＃「都会の」に傍点］男女の場合、男よりも女のほうが、その、義侠心とでもいうべきものをたっぷりと持っていました。男はたいてい、おっかなびっくりで、おていさいばかり飾り、そうして、ケチでした）あの煙草屋のヨシ子を内縁の妻にする事が出来て、そうして築地《つきじ》、隅田川の近く、木造の二階建ての小さいアパートの階下の一室を借り、ふたりで住み、酒は止めて、そろそろ自分の定った職業になりかけて来た漫画の仕事に精を出し、夕食後は二人で映画を見に出かけ、帰りには、喫茶店などにはいり、また、花の鉢を買ったりして、いや、それよりも自分をしんから信頼してくれているこの小さい花嫁の言葉を聞き、動作を見ているのが楽しく、これは自分もひょっとしたら、いまにだんだん人間らしいものになる事が出来て、悲惨な死に方などせずにすむのではなかろうかという甘い思いを幽かに胸にあたためはじめていた矢先に、堀木がまた自分の眼前に現われました。+「よう！　色魔。おや？　これでも、いくらか分別くさい顔になりやがった。きょうは、高円寺女史からのお使者なんだがね」+　と言いかけて、急に声をひそめ、お勝手でお茶の仕度をしているヨシ子のほうを顎《あご》でしゃくって、大丈夫かい？　とたずねますので、+「かまわない。何を言ってもいい」+　と自分は落ちついて答えました。+　じっさい、ヨシ子は、信頼の天才と言いたいくらい、京橋のバアのマダムとの間はもとより、自分が鎌倉で起した事件を知らせてやっても、ツネ子との間を疑わず、それは自分が嘘がうまいからというわけでは無く、時には、あからさまな言い方をする事さえあったのに、ヨシ子には、それがみな冗談としか聞きとれぬ様子でした。+「相変らず、しょっていやがる。なに、たいした事じゃないがね、たまには、高円寺のほうへも遊びに来てくれっていう御伝言さ」+　忘れかけると、怪鳥が羽ばたいてやって来て、記憶の傷口をその嘴《くちばし》で突き破ります。たちまち過去の恥と罪の記憶が、ありありと眼前に展開せられ、わあっと叫びたいほどの恐怖で、坐っておられなくなるのです。+「飲もうか」+　と自分。+「よし」+　と堀木。+　自分と堀木。形は、ふたり似ていました。そっくりの人間のような気がする事もありました。もちろんそれは、安い酒をあちこち飲み歩いている時だけの事でしたが、とにかく、ふたり顔を合せると、みるみる同じ形の同じ毛並の犬に変り降雪のちまたを駈けめぐるという具合いになるのでした。+　その日以来、自分たちは再び旧交をあたためたという形になり、京橋のあの小さいバアにも一緒に行き、そうして、とうとう、高円寺のシヅ子のアパートにもその泥酔の二匹の犬が訪問し、宿泊して帰るなどという事にさえなってしまったのです。+　忘れも、しません。むし暑い夏の夜でした。堀木は日暮頃、よれよれの浴衣を着て築地の自分のアパートにやって来て、きょう或る必要があって夏服を質入したが、その質入が老母に知れるとまことに具合いが悪い、すぐ受け出したいから、とにかく金を貸してくれ、という事でした。あいにく自分のところにも、お金が無かったので、例に依って、ヨシ子に言いつけ、ヨシ子の衣類を質屋に持って行かせてお金を作り、堀木に貸しても、まだ少し余るのでその残金でヨシ子に焼酎《しょうちゅう》を買わせ、アパートの屋上に行き、隅田川から時たま幽かに吹いて来るどぶ臭い風を受けて、まことに薄汚い納涼の宴を張りました。+　自分たちはその時、喜劇名詞、悲劇名詞の当てっこをはじめました。これは、自分の発明した遊戯で、名詞には、すべて男性名詞、女性名詞、中性名詞などの別があるけれども、それと同時に、喜劇名詞、悲劇名詞の区別があって然るべきだ、たとえば、汽船と汽車はいずれも悲劇名詞で、市電とバスは、いずれも喜劇名詞、なぜそうなのか、それのわからぬ者は芸術を談ずるに足らん、喜劇に一個でも悲劇名詞をさしはさんでいる劇作家は、既にそれだけで落第、悲劇の場合もまた然り、といったようなわけなのでした。+「いいかい？　煙草は？」+　と自分が問います。+「トラ。（悲劇《トラジディ》の略）」+　と堀木が言下に答えます。+「薬は？」+「粉薬かい？　丸薬かい？」+「注射」+「トラ」+「そうかな？　ホルモン注射もあるしねえ」+「いや、断然トラだ。針が第一、お前、立派なトラじゃないか」+「よし、負けて置こう。しかし、君、薬や医者はね、あれで案外、コメ（喜劇《コメディ》の略）なんだぜ。死は？」+「コメ。牧師も和尚《おしょう》も然りじゃね」+「大出来。そうして、生はトラだなあ」+「ちがう。それも、コメ」+「いや、それでは、何でもかでも皆コメになってしまう。ではね、もう一つおたずねするが、漫画家は？　よもや、コメとは言えませんでしょう？」+「トラ、トラ。大悲劇名詞！」+「なんだ、大トラは君のほうだぜ」+　こんな、下手な駄洒落《だじゃれ》みたいな事になってしまっては、つまらないのですけど、しかし自分たちはその遊戯を、世界のサロンにも嘗《か》つて存しなかった頗《すこぶ》る気のきいたものだと得意がっていたのでした。+　またもう一つ、これに似た遊戯を当時、自分は発明していました。それは、対義語《アントニム》の当てっこでした。黒のアント（対義語《アントニム》の略）は、白。けれども、白のアントは、赤。赤のアントは、黒。+「花のアントは？」+　と自分が問うと、堀木は口を曲げて考え、+「ええっと、花月という料理屋があったから、月だ」+「いや、それはアントになっていない。むしろ、同義語《シノニム》だ。星と菫《すみれ》だって、シノニムじゃないか。アントでない」+「わかった、それはね、蜂《はち》だ」+「ハチ？」+「牡丹《ぼたん》に、……蟻《あり》か？」+「なあんだ、それは画題《モチイフ》だ。ごまかしちゃいけない」+「わかった！　花にむら雲、……」+「月にむら雲だろう」+「そう、そう。花に風。風だ。花のアントは、風」+「まずいなあ、それは浪花節《なにわぶし》の文句じゃないか。おさとが知れるぜ」+「いや、琵琶《びわ》だ」+「なおいけない。花のアントはね、……およそこの世で最も花らしくないもの、それをこそ挙げるべきだ」+「だから、その、……待てよ、なあんだ、女か」+「ついでに、女のシノニムは？」+「臓物」+「君は、どうも、詩《ポエジイ》を知らんね。それじゃあ、臓物のアントは？」+「牛乳」+「これは、ちょっとうまいな。その調子でもう一つ。恥。オントのアント」+「恥知らずさ。流行漫画家上司幾太」+「堀木正雄は？」+　この辺から二人だんだん笑えなくなって、焼酎の酔い特有の、あのガラスの破片が頭に充満しているような、陰鬱な気分になって来たのでした。+「生意気言うな。おれはまだお前のように、繩目の恥辱など受けた事が無えんだ」+　ぎょっとしました。堀木は内心、自分を、真人間あつかいにしていなかったのだ、自分をただ、死にぞこないの、恥知らずの、阿呆のばけものの、謂《い》わば「生ける屍《しかばね》」としか解してくれず、そうして、彼の快楽のために、自分を利用できるところだけは利用する、それっきりの「交友」だったのだ、と思ったら、さすがにいい気持はしませんでしたが、しかしまた、堀木が自分をそのように見ているのも、もっともな話で、自分は昔から、人間の資格の無いみたいな子供だったのだ、やっぱり堀木にさえ軽蔑せられて至当なのかも知れない、と考え直し、+「罪。罪のアントニムは、何だろう。これは、むずかしいぞ」+　と何気無さそうな表情を装って、言うのでした。+「法律さ」+　堀木が平然とそう答えましたので、自分は堀木の顔を見直しました。近くのビルの明滅するネオンサインの赤い光を受けて、堀木の顔は、鬼刑事の如く威厳ありげに見えました。自分は、つくづく呆《あき》れかえり、+「罪ってのは、君、そんなものじゃないだろう」+　罪の対義語が、法律とは！　しかし、世間の人たちは、みんなそれくらいに簡単に考えて、澄まして暮しているのかも知れません。刑事のいないところにこそ罪がうごめいている、と。+「それじゃあ、なんだい、神か？　お前には、どこかヤソ坊主くさいところがあるからな。いや味だぜ」+「まあそんなに、軽く片づけるなよ。も少し、二人で考えて見よう。これはでも、面白いテーマじゃないか。このテーマに対する答一つで、そのひとの全部がわかるような気がするのだ」+「まさか。……罪のアントは、善さ。善良なる市民。つまり、おれみたいなものさ」+「冗談は、よそうよ。しかし、善は悪のアントだ。罪のアントではない」+「悪と罪とは違うのかい？」+「違う、と思う。善悪の概念は人間が作ったものだ。人間が勝手に作った道徳の言葉だ」+「うるせえなあ。それじゃ、やっぱり、神だろう。神、神。なんでも、神にして置けば間違いない。腹がへったなあ」+「いま、したでヨシ子がそら豆を煮ている」+「ありがてえ。好物だ」+　両手を頭のうしろに組んで、仰向《あおむけ》にごろりと寝ました。+「君には、罪というものが、まるで興味ないらしいね」+「そりゃそうさ、お前のように、罪人では無いんだから。おれは道楽はしても、女を死なせたり、女から金を巻き上げたりなんかはしねえよ」+　死なせたのではない、巻き上げたのではない、と心の何処《どこ》かで幽かな、けれども必死の抗議の声が起っても、しかし、また、いや自分が悪いのだとすぐに思いかえしてしまうこの習癖。+　自分には、どうしても、正面切っての議論が出来ません。焼酎の陰鬱な酔いのために刻一刻、気持が険しくなって来るのを懸命に抑えて、ほとんど独りごとのようにして言いました。+「しかし、牢屋《ろうや》にいれられる事だけが罪じゃないんだ。罪のアントがわかれば、罪の実体もつかめるような気がするんだけど、……神、……救い、……愛、……光、……しかし、神にはサタンというアントがあるし、救いのアントは苦悩だろうし、愛には憎しみ、光には闇というアントがあり、善には悪、罪と祈り、罪と悔い、罪と告白、罪と、……嗚呼《ああ》、みんなシノニムだ、罪の対語は何だ」+「ツミの対語は、ミツさ。蜜《みつ》の如く甘しだ。腹がへったなあ。何か食うものを持って来いよ」+「君が持って来たらいいじゃないか！」+　ほとんど生れてはじめてと言っていいくらいの、烈しい怒りの声が出ました。+「ようし、それじゃ、したへ行って、ヨシちゃんと二人で罪を犯して来よう。議論より実地検分。罪のアントは、蜜豆、いや、そら豆か」+　ほとんど、ろれつの廻らぬくらいに酔っているのでした。+「勝手にしろ。どこかへ行っちまえ！」+「罪と空腹、空腹とそら豆、いや、これはシノニムか」+　出鱈目《でたらめ》を言いながら起き上ります。+　罪と罰。ドストイエフスキイ。ちらとそれが、頭脳の片隅をかすめて通り、はっと思いました。もしも、あのドスト氏が、罪と罰をシノニムと考えず、アントニムとして置き並べたものとしたら？　罪と罰、絶対に相通ぜざるもの、氷炭｜相容《あいい》れざるもの。罪と罰をアントとして考えたドストの青みどろ、腐った池、乱麻の奥底の、……ああ、わかりかけた、いや、まだ、……などと頭脳に走馬燈がくるくる廻っていた時に、+「おい！　とんだ、そら豆だ。来い！」+　堀木の声も顔色も変っています。堀木は、たったいまふらふら起きてしたへ行った、かと思うとまた引返して来たのです。+「なんだ」+　異様に殺気立ち、ふたり、屋上から二階へ降り、二階から、さらに階下の自分の部屋へ降りる階段の中途で堀木は立ち止り、+「見ろ！」+　と小声で言って指差します。+　自分の部屋の上の小窓があいていて、そこから部屋の中が見えます。電気がついたままで、二匹の動物がいました。+　自分は、ぐらぐら目まいしながら、これもまた人間の姿だ、これもまた人間の姿だ、おどろく事は無い、など劇《はげ》しい呼吸と共に胸の中で呟《つぶや》き、ヨシ子を助ける事も忘れ、階段に立ちつくしていました。+　堀木は、大きい咳《せき》ばらいをしました。自分は、ひとり逃げるようにまた屋上に駈け上り、寝ころび、雨を含んだ夏の夜空を仰ぎ、そのとき自分を襲った感情は、怒りでも無く、嫌悪でも無く、また、悲しみでも無く、もの凄《すさ》まじい恐怖でした。それも、墓地の幽霊などに対する恐怖ではなく、神社の杉木立で白衣の御神体に逢った時に感ずるかも知れないような、四の五の言わさぬ古代の荒々しい恐怖感でした。自分の若白髪は、その夜からはじまり、いよいよ、すべてに自信を失い、いよいよ、ひとを底知れず疑い、この世の営みに対する一さいの期待、よろこび、共鳴などから永遠にはなれるようになりました。実に、それは自分の生涯に於いて、決定的な事件でした。自分は、まっこうから眉間《みけん》を割られ、そうしてそれ以来その傷は、どんな人間にでも接近する毎に痛むのでした。+「同情はするが、しかし、お前もこれで、少しは思い知ったろう。もう、おれは、二度とここへは来ないよ。まるで、地獄だ。……でも、ヨシちゃんは、ゆるしてやれ。お前だって、どうせ、ろくな奴じゃないんだから。失敬するぜ」+　気まずい場所に、永くとどまっているほど間《ま》の抜けた堀木ではありませんでした。+　自分は起き上って、ひとりで焼酎を飲み、それから、おいおい声を放って泣きました。いくらでも、いくらでも泣けるのでした。+　いつのまにか、背後に、ヨシ子が、そら豆を山盛りにしたお皿を持ってぼんやり立っていました。+「なんにも、しないからって言って、……」+「いい。何も言うな。お前は、ひとを疑う事を知らなかったんだ。お坐り。豆を食べよう」+　並んで坐って豆を食べました。嗚呼、信頼は罪なりや？　相手の男は、自分に漫画をかかせては、わずかなお金をもったい振って置いて行く三十歳前後の無学な小男の商人なのでした。+　さすがにその商人は、その後やっては来ませんでしたが、自分には、どうしてだか、その商人に対する憎悪よりも、さいしょに見つけたすぐその時に大きい咳ばらいも何もせず、そのまま自分に知らせにまた屋上に引返して来た堀木に対する憎しみと怒りが、眠られぬ夜などにむらむら起って呻《うめ》きました。+　ゆるすも、ゆるさぬもありません。ヨシ子は信頼の天才なのです。ひとを疑う事を知らなかったのです。しかし、それゆえの悲惨。+　神に問う。信頼は罪なりや。+　ヨシ子が汚されたという事よりも、ヨシ子の信頼が汚されたという事が、自分にとってそののち永く、生きておられないほどの苦悩の種になりました。自分のような、いやらしくおどおどして、ひとの顔いろばかり伺い、人を信じる能力が、ひび割れてしまっているものにとって、ヨシ子の無垢《むく》の信頼心は、それこそ青葉の滝のようにすがすがしく思われていたのです。それが一夜で、黄色い汚水に変ってしまいました。見よ、ヨシ子は、その夜から自分の一顰《いっぴん》一笑にさえ気を遣うようになりました。+「おい」+　と呼ぶと、ぴくっとして、もう眼のやり場に困っている様子です。どんなに自分が笑わせようとして、お道化を言っても、おろおろし、びくびくし、やたらに自分に敬語を遣うようになりました。+　果して、無垢の信頼心は、罪の原泉なりや。+　自分は、人妻の犯された物語の本を、いろいろ捜して読んでみました。けれども、ヨシ子ほど悲惨な犯され方をしている女は、ひとりも無いと思いました。どだい、これは、てんで物語にも何もなりません。あの小男の商人と、ヨシ子とのあいだに、少しでも恋に似た感情でもあったなら、自分の気持もかえってたすかるかも知れませんが、ただ、夏の一夜、ヨシ子が信頼して、そうして、それっきり、しかもそのために自分の眉間は、まっこうから割られ声が嗄れて若白髪がはじまり、ヨシ子は一生おろおろしなければならなくなったのです。たいていの物語は、その妻の「行為」を夫が許すかどうか、そこに重点を置いていたようでしたが、それは自分にとっては、そんなに苦しい大問題では無いように思われました。許す、許さぬ、そのような権利を留保している夫こそ幸いなる哉《かな》、とても許す事が出来ぬと思ったなら、何もそんなに大騒ぎせずとも、さっさと妻を離縁して、新しい妻を迎えたらどうだろう、それが出来なかったら、所謂《いわゆる》「許して」我慢するさ、いずれにしても夫の気持一つで四方八方がまるく収るだろうに、という気さえするのでした。つまり、そのような事件は、たしかに夫にとって大いなるショックであっても、しかし、それは「ショック」であって、いつまでも尽きること無く打ち返し打ち寄せる波と違い、権利のある夫の怒りでもってどうにでも処理できるトラブルのように自分には思われたのでした。けれども、自分たちの場合、夫に何の権利も無く、考えると何もかも自分がわるいような気がして来て、怒るどころか、おこごと一つも言えず、また、その妻は、その所有している稀《まれ》な美質に依って犯されたのです。しかも、その美質は、夫のかねてあこがれの、無垢の信頼心というたまらなく可憐《かれん》なものなのでした。+　無垢の信頼心は、罪なりや。+　唯一のたのみの美質にさえ、疑惑を抱き、自分は、もはや何もかも、わけがわからなくなり、おもむくところは、ただアルコールだけになりました。自分の顔の表情は極度にいやしくなり、朝から焼酎を飲み、歯がぼろぼろに欠けて、漫画もほとんど猥画《わいが》に近いものを画くようになりました。いいえ、はっきり言います。自分はその頃から、春画のコピイをして密売しました。焼酎を買うお金がほしかったのです。いつも自分から視線をはずしておろおろしているヨシ子を見ると、こいつは全く警戒を知らぬ女だったから、あの商人といちどだけでは無かったのではなかろうか、また、堀木は？　いや、或いは自分の知らない人とも？　と疑惑は疑惑を生み、さりとて思い切ってそれを問い正す勇気も無く、れいの不安と恐怖にのたうち廻る思いで、ただ焼酎を飲んで酔っては、わずかに卑屈な誘導｜訊問《じんもん》みたいなものをおっかなびっくり試み、内心おろかしく一喜一憂し、うわべは、やたらにお道化て、そうして、それから、ヨシ子にいまわしい地獄の愛撫《あいぶ》を加え、泥のように眠りこけるのでした。+　その年の暮、自分は夜おそく泥酔して帰宅し、砂糖水を飲みたく、ヨシ子は眠っているようでしたから、自分でお勝手に行き砂糖壺を捜し出し、ふたを開けてみたら砂糖は何もはいってなくて、黒く細長い紙の小箱がはいっていました。何気なく手に取り、その箱にはられてあるレッテルを見て愕然《がくぜん》としました。そのレッテルは、爪で半分以上も掻《か》きはがされていましたが、洋字の部分が残っていて、それにはっきり書かれていました。ＤＩＡＬ。+　ジアール。自分はその頃もっぱら焼酎で、催眠剤を用いてはいませんでしたが、しかし、不眠は自分の持病のようなものでしたから、たいていの催眠剤にはお馴染《なじ》みでした。ジアールのこの箱一つは、たしかに致死量以上の筈でした。まだ箱の封を切ってはいませんでしたが、しかし、いつかは、やる気で［＃「やる気で」に傍点］こんなところに、しかもレッテルを掻きはがしたりなどして隠していたのに違いありません。可哀想に、あの子にはレッテルの洋字が読めないので、爪で半分掻きはがして、これで大丈夫と思っていたのでしょう。（お前に罪は無い）+　自分は、音を立てないようにそっとコップに水を満たし、それから、ゆっくり箱の封を切って、全部、一気に口の中にほうり、コップの水を落ちついて飲みほし、電燈を消してそのまま寝ました。+　三昼夜、自分は死んだようになっていたそうです。医者は過失と見なして、警察にとどけるのを猶予してくれたそうです。覚醒《かくせい》しかけて、一ばんさきに呟いたうわごとは、うちへ帰る、という言葉だったそうです。うちとは、どこの事を差して言ったのか、当の自分にも、よくわかりませんが、とにかく、そう言って、ひどく泣いたそうです。+　次第に霧がはれて、見ると、枕元にヒラメが、ひどく不機嫌な顔をして坐っていました。+「このまえも、年の暮の事でしてね、お互いもう、目が廻るくらいいそがしいのに、いつも、年の暮をねらって、こんな事をやられたひには、こっちの命がたまらない」+　ヒラメの話の聞き手になっているのは、京橋のバアのマダムでした。+「マダム」+　と自分は呼びました。+「うん、何？　気がついた？」+　マダムは笑い顔を自分の顔の上にかぶせるようにして言いました。+　自分は、ぽろぽろ涙を流し、+「ヨシ子とわかれさせて」+　自分でも思いがけなかった言葉が出ました。+　マダムは身を起し、幽かな溜息をもらしました。+　それから自分は、これもまた実に思いがけない滑稽とも阿呆らしいとも、形容に苦しむほどの失言をしました。+「僕は、女のいないところに行くんだ」+　うわっはっは、とまず、ヒラメが大声を挙げて笑い、マダムもクスクス笑い出し、自分も涙を流しながら赤面の態《てい》になり、苦笑しました。+「うん、そのほうがいい」+　とヒラメは、いつまでもだらし無く笑いながら、+「女のいないところに行ったほうがよい。女がいると、どうもいけない。女のいないところとは、いい思いつきです」+　女のいないところ。しかし、この自分の阿呆くさいうわごとは、のちに到って、非常に陰惨に実現せられました。+　ヨシ子は、何か、自分がヨシ子の身代りになって毒を飲んだとでも思い込んでいるらしく、以前よりも尚《なお》いっそう、自分に対して、おろおろして、自分が何を言っても笑わず、そうしてろくに口もきけないような有様なので、自分もアパートの部屋の中にいるのが、うっとうしく、つい外へ出て、相変らず安い酒をあおる事になるのでした。しかし、あのジアールの一件以来、自分のからだがめっきり痩《や》せ細って、手足がだるく、漫画の仕事も怠けがちになり、ヒラメがあの時、見舞いとして置いて行ったお金（ヒラメはそれを、渋田の志です、と言っていかにもご自身から出たお金のようにして差出しましたが、これも故郷の兄たちからのお金のようでした。自分もその頃には、ヒラメの家から逃げ出したあの時とちがって、ヒラメのそんなもったい振った芝居を、おぼろげながら見抜く事が出来るようになっていましたので、こちらもずるく、全く気づかぬ振りをして、神妙にそのお金のお礼をヒラメに向って申し上げたのでしたが、しかし、ヒラメたちが、なぜ、そんなややこしいカラクリをやらかすのか、わかるような、わからないような、どうしても自分には、へんな気がしてなりませんでした）そのお金で、思い切ってひとりで南伊豆の温泉に行ってみたりなどしましたが、とてもそんな悠長な温泉めぐりなど出来る柄《がら》ではなく、ヨシ子を思えば侘《わ》びしさ限りなく、宿の部屋から山を眺めるなどの落ちついた心境には甚だ遠く、ドテラにも着換えず、お湯にもはいらず、外へ飛び出しては薄汚い茶店みたいなところに飛び込んで、焼酎を、それこそ浴びるほど飲んで、からだ具合いを一そう悪くして帰京しただけの事でした。+　東京に大雪の降った夜でした。自分は酔って銀座裏を、ここはお国を何百里、ここはお国を何百里、と小声で繰り返し繰り返し呟くように歌いながら、なおも降りつもる雪を靴先で蹴散《けち》らして歩いて、突然、吐きました。それは自分の最初の喀血《かっけつ》でした。雪の上に、大きい日の丸の旗が出来ました。自分は、しばらくしゃがんで、それから、よごれていない個所の雪を両手で掬《すく》い取って、顔を洗いながら泣きました。+　こうこは、どうこの細道じゃ？+　こうこは、どうこの細道じゃ？+　哀れな童女の歌声が、幻聴のように、かすかに遠くから聞えます。不幸。この世には、さまざまの不幸な人が、いや、不幸な人ばかり、と言っても過言ではないでしょうが、しかし、その人たちの不幸は、所謂世間に対して堂々と抗議が出来、また「世間」もその人たちの抗議を容易に理解し同情します。しかし、自分の不幸は、すべて自分の罪悪からなので、誰にも抗議の仕様が無いし、また口ごもりながら一言でも抗議めいた事を言いかけると、ヒラメならずとも世間の人たち全部、よくもまあそんな口がきけたものだと呆《あき》れかえるに違いないし、自分はいったい俗にいう「わがままもの」なのか、またはその反対に、気が弱すぎるのか、自分でもわけがわからないけれども、とにかく罪悪のかたまりらしいので、どこまでも自《おのずか》らどんどん不幸になるばかりで、防ぎ止める具体策など無いのです。+　自分は立って、取り敢えず何か適当な薬をと思い、近くの薬屋にはいって、そこの奥さんと顔を見合せ、瞬間、奥さんは、フラッシュを浴びたみたいに首をあげ眼を見はり、棒立ちになりました。しかし、その見はった眼には、驚愕の色も嫌悪の色も無く、ほとんど救いを求めるような、慕うような色があらわれているのでした。ああ、このひとも、きっと不幸な人なのだ、不幸な人は、ひとの不幸にも敏感なものなのだから、と思った時、ふと、その奥さんが松葉杖《まつばづえ》をついて危かしく立っているのに気がつきました。駈け寄りたい思いを抑えて、なおもその奥さんと顔を見合せているうちに涙が出て来ました。すると、奥さんの大きい眼からも、涙がぽろぽろとあふれて出ました。+　それっきり、一言も口をきかずに、自分はその薬屋から出て、よろめいてアパートに帰り、ヨシ子に塩水を作らせて飲み、黙って寝て、翌る日も、風邪気味だと嘘をついて一日一ぱい寝て、夜、自分の秘密の喀血がどうにも不安でたまらず、起きて、あの薬屋に行き、こんどは笑いながら、奥さんに、実に素直に今迄のからだ具合いを告白し、相談しました。+「お酒をおよしにならなければ」+　自分たちは、肉身のようでした。+「アル中になっているかも知れないんです。いまでも飲みたい」+「いけません。私の主人も、テーベのくせに、菌を酒で殺すんだなんて言って、酒びたりになって、自分から寿命をちぢめました」+「不安でいけないんです。こわくて、とても、だめなんです」+「お薬を差し上げます。お酒だけは、およしなさい」+　奥さん（未亡人で、男の子がひとり、それは千葉だかどこだかの医大にはいって、間もなく父と同じ病いにかかり、休学入院中で、家には中風の舅《しゅうと》が寝ていて、奥さん自身は五歳の折、小児｜痲痺《まひ》で片方の脚が全然だめなのでした）は、松葉杖をコトコトと突きながら、自分のためにあっちの棚、こっちの引出し、いろいろと薬品を取そろえてくれるのでした。+　これは、造血剤。+　これは、ヴィタミンの注射液。注射器は、これ。+　これは、カルシウムの錠剤。胃腸をこわさないように、ジアスターゼ。+　これは、何。これは、何、と五、六種の薬品の説明を愛情こめてしてくれたのですが、しかし、この不幸な奥さんの愛情もまた、自分にとって深すぎました。最後に奥さんが、これは、どうしても、なんとしてもお酒を飲みたくて、たまらなくなった時のお薬、と言って素早く紙に包んだ小箱。+　モルヒネの注射液でした。+　酒よりは、害にならぬと奥さんも言い、自分もそれを信じて、また一つには、酒の酔いもさすがに不潔に感ぜられて来た矢先でもあったし、久し振りにアルコールというサタンからのがれる事の出来る喜びもあり、何の躊躇《ちゅうちょ》も無く、自分は自分の腕に、そのモルヒネを注射しました。不安も、焦燥《しょうそう》も、はにかみも、綺麗《きれい》に除去せられ、自分は甚だ陽気な能弁家になるのでした。そうして、その注射をすると自分は、からだの衰弱も忘れて、漫画の仕事に精が出て、自分で画きながら噴き出してしまうほど珍妙な趣向が生れるのでした。+　一日一本のつもりが、二本になり、四本になった頃には、自分はもうそれが無ければ、仕事が出来ないようになっていました。+「いけませんよ、中毒になったら、そりゃもう、たいへんです」+　薬屋の奥さんにそう言われると、自分はもう可成りの中毒患者になってしまったような気がして来て、（自分は、ひとの暗示に実にもろくひっかかるたちなのです。このお金は使っちゃいけないよ、と言っても、お前の事だものなあ、なんて言われると、何だか使わないと悪いような、期待にそむくような、へんな錯覚が起って、必ずすぐにそのお金を使ってしまうのでした）その中毒の不安のため、かえって薬品をたくさん求めるようになったのでした。+「たのむ！　もう一箱。勘定は月末にきっと払いますから」+「勘定なんて、いつでもかまいませんけど、警察のほうが、うるさいのでねえ」+　ああ、いつでも自分の周囲には、何やら、濁って暗く、うさん臭い日蔭者の気配がつきまとうのです。+「そこを何とか、ごまかして、たのむよ、奥さん。キスしてあげよう」+　奥さんは、顔を赤らめます。+　自分は、いよいよつけ込み、+「薬が無いと仕事がちっとも、はかどらないんだよ。僕には、あれは強精剤みたいなものなんだ」+「それじゃ、いっそ、ホルモン注射がいいでしょう」+「ばかにしちゃいけません。お酒か、そうでなければ、あの薬か、どっちかで無ければ仕事が出来ないんだ」+「お酒は、いけません」+「そうでしょう？　僕はね、あの薬を使うようになってから、お酒は一滴も飲まなかった。おかげで、からだの調子が、とてもいいんだ。僕だって、いつまでも、下手くそな漫画などをかいているつもりは無い、これから、酒をやめて、からだを直して、勉強して、きっと偉い絵画きになって見せる。いまが大事なところなんだ。だからさ、ね、おねがい。キスしてあげようか」+　奥さんは笑い出し、+「困るわねえ。中毒になっても知りませんよ」+　コトコトと松葉杖の音をさせて、その薬品を棚から取り出し、+「一箱は、あげられませんよ。すぐ使ってしまうのだもの。半分ね」+「ケチだなあ、まあ、仕方が無いや」+　家へ帰って、すぐに一本、注射をします。+「痛くないんですか？」+　ヨシ子は、おどおど自分にたずねます。+「それあ痛いさ。でも、仕事の能率をあげるためには、いやでもこれをやらなければいけないんだ。僕はこの頃、とても元気だろう？　さあ、仕事だ。仕事、仕事」+　とはしゃぐのです。+　深夜、薬屋の戸をたたいた事もありました。寝巻姿で、コトコト松葉杖をついて出て来た奥さんに、いきなり抱きついてキスして、泣く真似をしました。+　奥さんは、黙って自分に一箱、手渡しました。+　薬品もまた、焼酎同様、いや、それ以上に、いまわしく不潔なものだと、つくづく思い知った時には、既に自分は完全な中毒患者になっていました。真に、恥知らずの極《きわみ》でした。自分はその薬品を得たいばかりに、またも春画のコピイをはじめ、そうして、あの薬屋の不具の奥さんと文字どおりの醜関係をさえ結びました。+　死にたい、いっそ、死にたい、もう取返しがつかないんだ、どんな事をしても、何をしても、駄目になるだけなんだ、恥の上塗りをするだけなんだ、自転車で青葉の滝など、自分には望むべくも無いんだ、ただけがらわしい罪にあさましい罪が重なり、苦悩が増大し強烈になるだけなんだ、死にたい、死ななければならぬ、生きているのが罪の種なのだ、などと思いつめても、やっぱり、アパートと薬屋の間を半狂乱の姿で往復しているばかりなのでした。+　いくら仕事をしても、薬の使用量もしたがってふえているので、薬代の借りがおそろしいほどの額にのぼり、奥さんは、自分の顔を見ると涙を浮べ、自分も涙を流しました。+　地獄。+　この地獄からのがれるための最後の手段、これが失敗したら、あとはもう首をくくるばかりだ、という神の存在を賭《か》けるほどの決意を以《もっ》て、自分は、故郷の父あてに長い手紙を書いて、自分の実情一さいを（女の事は、さすがに書けませんでしたが）告白する事にしました。+　しかし、結果は一そう悪く、待てど暮せど何の返事も無く、自分はその焦燥と不安のために、かえって薬の量をふやしてしまいました。+　今夜、十本、一気に注射し、そうして大川に飛び込もうと、ひそかに覚悟を極めたその日の午後、ヒラメが、悪魔の勘で嗅《か》ぎつけたみたいに、堀木を連れてあらわれました。+「お前は、喀血したんだってな」+　堀木は、自分の前にあぐらをかいてそう言い、いままで見た事も無いくらいに優しく微笑《ほほえ》みました。その優しい微笑が、ありがたくて、うれしくて、自分はつい顔をそむけて涙を流しました。そうして彼のその優しい微笑一つで、自分は完全に打ち破られ、葬り去られてしまったのです。+　自分は自動車に乗せられました。とにかく入院しなければならぬ、あとは自分たちにまかせなさい、とヒラメも、しんみりした口調で、（それは慈悲深いとでも形容したいほど、もの静かな口調でした）自分にすすめ、自分は意志も判断も何も無い者の如く、ただメソメソ泣きながら唯々諾々と二人の言いつけに従うのでした。ヨシ子もいれて四人、自分たちは、ずいぶん永いこと自動車にゆられ、あたりが薄暗くなった頃、森の中の大きい病院の、玄関に到着しました。+　サナトリアムとばかり思っていました。+　自分は若い医師のいやに物やわらかな、鄭重《ていちょう》な診察を受け、それから医師は、+「まあ、しばらくここで静養するんですね」+　と、まるで、はにかむように微笑して言い、ヒラメと堀木とヨシ子は、自分ひとりを置いて帰ることになりましたが、ヨシ子は着換の衣類をいれてある風呂敷包を自分に手渡し、それから黙って帯の間から注射器と使い残りのあの薬品を差し出しました。やはり、強精剤だとばかり思っていたのでしょうか。+「いや、もう要らない」+　実に、珍らしい事でした。すすめられて、それを拒否したのは、自分のそれまでの生涯に於いて、その時ただ一度、といっても過言でないくらいなのです。自分の不幸は、拒否の能力の無い者の不幸でした。すすめられて拒否すると、相手の心にも自分の心にも、永遠に修繕し得ない白々しいひび割れが出来るような恐怖におびやかされているのでした。けれども、自分はその時、あれほど半狂乱になって求めていたモルヒネを、実に自然に拒否しました。ヨシ子の謂わば「神の如き無智」に撃たれたのでしょうか。自分は、あの瞬間、すでに中毒でなくなっていたのではないでしょうか。+　けれども、自分はそれからすぐに、あのはにかむような微笑をする若い医師に案内せられ、或る病棟にいれられて、ガチャンと鍵《かぎ》をおろされました。脳病院でした。+　女のいないところへ行くという、あのジアールを飲んだ時の自分の愚かなうわごとが、まことに奇妙に実現せられたわけでした。その病棟には、男の狂人ばかりで、看護人も男でしたし、女はひとりもいませんでした。+　いまはもう自分は、罪人どころではなく、狂人でした。いいえ、断じて自分は狂ってなどいなかったのです。一瞬間といえども、狂った事は無いんです。けれども、ああ、狂人は、たいてい自分の事をそう言うものだそうです。つまり、この病院にいれられた者は気違い、いれられなかった者は、ノーマルという事になるようです。+　神に問う。無抵抗は罪なりや？+　堀木のあの不思議な美しい微笑に自分は泣き、判断も抵抗も忘れて自動車に乗り、そうしてここに連れて来られて、狂人という事になりました。いまに、ここから出ても、自分はやっぱり狂人、いや、癈人《はいじん》という刻印を額に打たれる事でしょう。+　人間、失格。+　もはや、自分は、完全に、人間で無くなりました。+　ここへ来たのは初夏の頃で、鉄の格子の窓から病院の庭の小さい池に紅《あか》い睡蓮の花が咲いているのが見えましたが、それから三つき経ち、庭にコスモスが咲きはじめ、思いがけなく故郷の長兄が、ヒラメを連れて自分を引き取りにやって来て、父が先月末に胃潰瘍《いかいよう》でなくなったこと、自分たちはもうお前の過去は問わぬ、生活の心配もかけないつもり、何もしなくていい、その代り、いろいろ未練もあるだろうがすぐに東京から離れて、田舎で療養生活をはじめてくれ、お前が東京でしでかした事の後仕末は、だいたい渋田がやってくれた筈だから、それは気にしないでいい、とれいの生真面目な緊張したような口調で言うのでした。+　故郷の山河が眼前に見えるような気がして来て、自分は幽かにうなずきました。+　まさに癈人。+　父が死んだ事を知ってから、自分はいよいよ腑抜《ふぬ》けたようになりました。父が、もういない、自分の胸中から一刻も離れなかったあの懐しくおそろしい存在が、もういない、自分の苦悩の壺がからっぽになったような気がしました。自分の苦悩の壺がやけに重かったのも、あの父のせいだったのではなかろうかとさえ思われました。まるで、張合いが抜けました。苦悩する能力をさえ失いました。+　長兄は自分に対する約束を正確に実行してくれました。自分の生れて育った町から汽車で四、五時間、南下したところに、東北には珍らしいほど暖かい海辺の温泉地があって、その村はずれの、間数は五つもあるのですが、かなり古い家らしく壁は剥《は》げ落ち、柱は虫に食われ、ほとんど修理の仕様も無いほどの茅屋《ぼうおく》を買いとって自分に与え、六十に近いひどい赤毛の醜い女中をひとり附けてくれました。+　それから三年と少し経ち、自分はその間にそのテツという老女中に数度へんな犯され方をして、時たま夫婦｜喧嘩《げんか》みたいな事をはじめ、胸の病気のほうは一進一退、痩せたりふとったり、血痰《けったん》が出たり、きのう、テツにカルモチンを買っておいで、と言って、村の薬屋にお使いにやったら、いつもの箱と違う形の箱のカルモチンを買って来て、べつに自分も気にとめず、寝る前に十錠のんでも一向に眠くならないので、おかしいなと思っているうちに、おなかの具合がへんになり急いで便所へ行ったら猛烈な下痢で、しかも、それから引続き三度も便所にかよったのでした。不審に堪えず、薬の箱をよく見ると、それはヘノモチンという下剤でした。+　自分は仰向けに寝て、おなかに湯たんぽを載せながら、テツにこごとを言ってやろうと思いました。+「これは、お前、カルモチンじゃない。ヘノモチン、という」+　と言いかけて、うふふふと笑ってしまいました。「癈人」は、どうやらこれは、喜劇名詞のようです。眠ろうとして下剤を飲み、しかも、その下剤の名前は、ヘノモチン。+　いまは自分には、幸福も不幸もありません。+　ただ、一さいは過ぎて行きます。+　自分がいままで阿鼻叫喚で生きて来た所謂「人間」の世界に於いて、たった一つ、真理［＃「真理」に傍点］らしく思われたのは、それだけでした。+　ただ、一さいは過ぎて行きます。+　自分はことし、二十七になります。白髪がめっきりふえたので、たいていの人から、四十以上に見られます。+［＃改頁］++++［＃３字下げ］あとがき［＃「あとがき」は大見出し］+++　この手記を書き綴った狂人を、私は、直接には知らない。けれども、この手記に出て来る京橋のスタンド・バアのマダムともおぼしき人物を、私はちょっと知っているのである。小柄で、顔色のよくない、眼が細く吊《つ》り上っていて、鼻の高い、美人というよりは、美青年といったほうがいいくらいの固い感じのひとであった。この手記には、どうやら、昭和五、六、七年、あの頃の東京の風景がおもに写されているように思われるが、私が、その京橋のスタンド・バアに、友人に連れられて二、三度、立ち寄り、ハイボールなど飲んだのは、れいの日本の「軍部」がそろそろ露骨にあばれはじめた昭和十年前後の事であったから、この手記を書いた男には、おめにかかる事が出来なかったわけである。+　然るに、ことしの二月、私は千葉県船橋市に疎開している或る友人をたずねた。その友人は、私の大学時代の謂わば学友で、いまは某女子大の講師をしているのであるが、実は私はこの友人に私の身内の者の縁談を依頼していたので、その用事もあり、かたがた何か新鮮な海産物でも仕入れて私の家の者たちに食わせてやろうと思い、リュックサックを背負って船橋市へ出かけて行ったのである。+　船橋市は、泥海に臨んだかなり大きいまちであった。新住民たるその友人の家は、その土地の人に所番地を告げてたずねても、なかなかわからないのである。寒い上に、リュックサックを背負った肩が痛くなり、私はレコードの提琴の音にひかれて、或る喫茶店のドアを押した。+　そこのマダムに見覚えがあり、たずねてみたら、まさに、十年前のあの京橋の小さいバアのマダムであった。マダムも、私をすぐに思い出してくれた様子で、互いに大袈裟《おおげさ》に驚き、笑い、それからこんな時のおきまりの、れいの、空襲で焼け出されたお互いの経験を問われもせぬのに、いかにも自慢らしく語り合い、+「あなたは、しかし、かわらない」+「いいえ、もうお婆さん。からだが、がたぴしです。あなたこそ、お若いわ」+「とんでもない、子供がもう三人もあるんだよ。きょうはそいつらのために買い出し」+　などと、これもまた久し振りで逢った者同志のおきまりの挨拶を交し、それから、二人に共通の知人のその後の消息をたずね合ったりして、そのうちに、ふとマダムは口調を改め、あなたは葉ちゃんを知っていたかしら、と言う。それは知らない、と答えると、マダムは、奥へ行って、三冊のノートブックと、三葉の写真を持って来て私に手渡し、+「何か、小説の材料になるかも知れませんわ」+　と言った。+　私は、ひとから押しつけられた材料でものを書けないたちなので、すぐにその場でかえそうかと思ったが、（三葉の写真、その奇怪さに就いては、はしがきにも書いて置いた）その写真に心をひかれ、とにかくノートをあずかる事にして、帰りにはまたここへ立ち寄りますが、何町何番地の何さん、女子大の先生をしているひとの家をご存じないか、と尋ねると、やはり新住民同志、知っていた。時たま、この喫茶店にもお見えになるという。すぐ近所であった。+　その夜、友人とわずかなお酒を汲《く》み交し、泊めてもらう事にして、私は朝まで一睡もせずに、れいのノートに読みふけった。+　その手記に書かれてあるのは、昔の話ではあったが、しかし、現代の人たちが読んでも、かなりの興味を持つに違いない。下手に私の筆を加えるよりは、これはこのまま、どこかの雑誌社にたのんで発表してもらったほうが、なお、有意義な事のように思われた。+　子供たちへの土産の海産物は、干物《ひもの》だけ。私は、リュックサックを背負って友人の許《もと》を辞し、れいの喫茶店に立ち寄り、+「きのうは、どうも。ところで、……」+　とすぐに切り出し、+「このノートは、しばらく貸していただけませんか」+「ええ、どうぞ」+「このひとは、まだ生きているのですか？」+「さあ、それが、さっぱりわからないんです。十年ほど前に、京橋のお店あてに、そのノートと写真の小包が送られて来て、差し出し人は葉ちゃんにきまっているのですが、その小包には、葉ちゃんの住所も、名前さえも書いていなかったんです。空襲の時、ほかのものにまぎれて、これも不思議にたすかって、私はこないだはじめて、全部読んでみて、……」+「泣きましたか？」+「いいえ、泣くというより、……だめね、人間も、ああなっては、もう駄目ね」+「それから十年、とすると、もう亡くなっているかも知れないね。これは、あなたへのお礼のつもりで送ってよこしたのでしょう。多少、誇張して書いているようなところもあるけど、しかし、あなたも、相当ひどい被害をこうむったようですね。もし、これが全部事実だったら、そうして僕がこのひとの友人だったら、やっぱり脳病院に連れて行きたくなったかも知れない」+「あのひとのお父さんが悪いのですよ」+　何気なさそうに、そう言った。+「私たちの知っている葉ちゃんは、とても素直で、よく気がきいて、あれでお酒さえ飲まなければ、いいえ、飲んでも、……神様みたいないい子でした」
+ benchmark/Streamly/Benchmark/Unicode/data/Korean.txt view
@@ -0,0 +1,493 @@+야구+위키백과, 우리 모두의 백과사전. + 이동: 둘러보기, 찾기 ++야구+일리노이 주 시카고의 리글리 필드 경기 장면+최고 기구	국제 야구 연맹+별칭	하드볼+기원	18세기 중반 잉글랜드 (초기 형태)+ 1846년 6월 19일 미국+뉴저지 주 호보컨 (공식 경기)+특징+팀 인원수	9명+분류	실외, 필드, 구기+장비	야구공, 야구 방망이, 글러브+경기장	야구장+올림픽	1992년~2008년+ 야구 경기+야구(野球, baseball)는 각각 아홉 또는 열 명으로 구성된 두 팀이 방망이와 공을 사용해 겨루는 구기 종목이다. 야구의 목표는 공을 방망이(배트)로 맞추어, 한 변이 27.432 미터(90 피트)인 정사각형의 각 꼭지점에 놓여 있는 루(壘, Base)를 밟은 뒤 마지막으로 본루(本壘, Home Plate)를 밟아서 득점하는 것이다.[1] [2]공격 팀은 아홉 타자가 순서대로 나와서 수비 팀의 투수가 던지는 공을 쳐서 다이아몬드의 각 루를 밟은 뒤 홈에 들어와야 하며, 동시에 수비 팀은 공격 팀의 타자들이나 주자들을 여러 가지 방법을 통해 아웃시켜서 공격 팀이 득점을 못 하도록 막아야 한다. 공격 팀의 타자들은 동료가 안타(간혹 2루타, 3루타를 치는 경우가 있으며 외야 펜스를 넘기거나 아웃 당하기 전에 홈으로 돌아오면 홈런이 된다)를 쳤을 경우 원하는 루에 멈춰서거나 홈으로 들어와 득점할 수 있다. 공격 팀이 아웃 세 번을 기록할 경우 수비 팀은 공격 팀으로, 공격 팀은 수비 팀으로 바뀐다. 이 세 번의 아웃을 이닝(Inning, 회)이라고 부르며, 프로 게임에서 한 경기는 아홉 개의 이닝으로 구성된다. 마지막 이닝이 끝날 때 더 많은 득점을 한 팀이 이기게 된다. 공격과 수비가 완전히 분리된 스포츠이다.+프로 야구, 아마추어 야구, 청소년 야구는 북아메리카, 중앙아메리카, 남아메리카, 카리브 제도의 여러 국가들, 동아시아, 동남아시아 국가들에서 인기가 있다. 야구의 근대적인 틀은 19세기 북아메리카에서 만들어졌다. 역사학자들은 야구의 원형은 북미 대륙에 건너 온 영국, 아일랜드 이민자들이 가지고 들어 온, 크리켓이나 라운더스와 같이 공과 방망이를 사용하는 구기 경기에서 시작되었다는 데 의견을 함께한다. 19세기 후반 야구는 미국의 국기(國技)로 널리 인정받게 되었다.목차  [숨기기] +1 야구의 명칭+2 야구의 역사 +2.1 야구의 기원+2.2 미국에서의 발전+2.3 세계의 야구 +2.3.1 한국+3 야구 규칙과 경기 진행 +3.1 경기 용구+3.2 포지션+3.3 아웃+3.4 진루+4 야구의 인원 +4.1 선수 명단+4.2 그 외+5 야구의 기본기와 전술 +5.1 기본기+5.2 전술+6 야구의 고유한 스타일 +6.1 시간적 요소+6.2 개인과 팀+7 경기장+8 기록+9 야구 단체 및 주요 대회 +9.1 국제 야구 단체+9.2 야구 대회+9.3 야구 리그+10 같이 보기+11 참고 문헌+12 주석+13 바깥 고리++[편집]+야구의 명칭+ + 주만 가나에++야구의 명칭의 유래는 1894년 일본 제일고등중학교(현 도쿄 대학 교양학부)에서 재학중이던 주만 가나에가 'baseball'을 일본어 '野球(や-きゅう)'로 번역한 것이 대한민국으로 들어와 사용되고 있는 것이다. 그 외에도 일본의 문학가 마사오카 시키가 '배터(batter)', '러너(runner)', '베이스 온 볼스(base on balls)', '스트레이트(straight)', '쇼트스톱(shortstop)' 등의 미국식 야구용어를 '타자', '주자', '사구 (四球)대한민국에선 사구 대신 볼넷으로 사용)', '직구'(대한민국에서는 포심 속구, 투심, 컷 패스트볼로 부름.) '유격수'로 번역한 것이 대한민국에 들어와 쓰이고 있다.[3] 때때로 야구를 비슷한 경기인 소프트볼(softball)에 대비하여 하드볼(hardball)로 부르기도 한다.+[편집]+야구의 역사+ 이 부분의 본문은 야구의 역사입니다.+[편집]+야구의 기원++야구의 기원은 확실하게 짚어내기가 힘들다. 1344년에 출간된 프랑스의 한 책에 성직자들이 야구와 흡사한 라 술(La soule)이라는 게임을 즐기는 모습을 담은 삽화가 실려있다.[4] 원래 야구는 미국의 애브너 더블데이라는 군인 출신의 인물이 1839년에 쿠퍼스타운에서 창안했다고 알려졌다. 하지만 그가 직접 야구를 창안했다는 구체적인 증거가 없으며, 광산 기술자 출신의 애브너 그레이브스의 증언이 있었으나 별로 신뢰하기 어렵기 때문에 야구는 유럽에서 미국으로 전해진 것으로 추측된다.[5]++방망이와 공을 이용한 경기는 이미 오래 전부터 리디아인, 페르시아인, 인도인, 이집트인, 그리스인, 로마인 등에 의해 의식이나 오락으로 행해졌다. 이런 경기들은 정해진 규칙없이 여러 지역에서 행해졌다. 이런 여러가지 배트와 공을 이용하는 경기를 통해서 야구는 두드러진 발전을 할 수 있었다. 이런 발전을 통해서 1774년에 독일에서 프리드리히 구츠무츠가 존 뉴베리에서 출간한 《작고 귀여운 포켓북》(A Little Pretty Pocket-book)이라는 시집에서는 최초로 'Base-ball'이라는 단어가 들어가기도 했다.[6]++방망이와 공을 이용해 하는 경기는 영국에서 여러 가지 종류로 발전하는데, 영국 동남부에서는 크리켓으로, 남서부에서는 원홀 캣(또는 원 오캣)의 이름으로 발전했으며, 야구와 흡사한 경기인 라운더스도 있었다. 이런 종류의 경기들은 아메리카 대륙으로 옮겨와 두가지 형태로 진화했는데, 뉴욕 주변에서 행해진 타운볼은 각각 9명의 선수로 이루어진 두 팀이 하는 경기로 정비되었다.+ + 알렉산더 카트라이트++루셔스 애덤스등은 야구의 기본적인 규칙을 확립했다. 특히 1845년에는, 미국 뉴욕의 알렉산더 카트라이트가 니커보커 규칙을 만들었으며, 이 규칙은 오늘날 현대 야구의 규칙으로 진화하게 된다.[7] 그는 또한 라운더스에서 사용되었던 말랑말랑한 공을 더 작지만 딱딱한 공으로 교체했다.[8] 1953년 6월 3일, 미국 의회는 공식적으로 카트라이트가 근대 야구의 발명가임을 인정했다.++카트라이트가 소속된 구단인 뉴욕 니커보커스 팀이 1845년에 경기를 했다는 기록이 있기는 하지만, 미국의 역사상 공식적인 첫 경기로 현재 알려지고 있는 것은 1846년 6월 19일 뉴저지 주의 '호보켄'에서,[9] '뉴욕 나인'[10]이 '니커보커스' 팀을 4이닝 동안 23 대 1로 이긴 경기이다.[11]+[편집]+미국에서의 발전++1860년대 이미 미국에서는 야구가 대중적인 스포츠로 자리 잡았으며 선수들은 연봉을 받고 생활하는 프로 선수였으나 아마추어 선수처럼 생활해야 했다. 아마추어 시대는 1871년 3월 17일, 전미프로야구선수협회가 창설됨으로써 그 막을 내렸다. 1869년, 최초의 프로 야구 팀 신시내티 레드 스타킹스(Cincinnati Red Stockings)가 창단 되었으며 1875년에는 내셔널 리그(연봉 상한제 있음)가 창설되었다. 1882년에는 아메리칸 어소시에이션(American Association)이 창설되었고 1901년에는 이를 전신으로 하는 아메리칸 리그(연봉이 무제한임)가 창설되어 양대 리그체제를 갖추게 되었다. 1903년에는 양 리그의 우승 팀간의 승자를 겨루는 월드 시리즈(여기에서 월드(World)는 "월드신문사"의 이름으로써 신문사에서 스폰서를 해주기 때문에 월드시리즈라는 이름이 쓰인다고 한다)가 처음으로 치러졌으며, 1933년에는 올스타전이 처음으로 치러졌다.[12]++이후 많은 제도의 발전이 있었다. 브랜치 리키는 1920년에 대규모의 팜 시스템(Farm System)을 도입했다[13] 1975년에는 커드 플러드 등 여러 선수들의 희생으로 자유 계약 제도가 도입 되었다. 1980년에는 선수협 위원들이 구단주를 상대로 고소를 함으로써 연봉 상한선이 폐지되는 등 선수들의 권익이 향상되었다.[14]+ + 재키 로빈슨++메이저 리그 야구에서는 1947년 이전까지 흑인이 선수로 활동하지 못했다. 그 대신 흑인들은 1920년에 설립된 니그로 리그에서 선수로 뛰었고, 1924년에는 최초의 니그로 월드 시리즈가 치러졌다. 메이저 리그 야구에서 흑인이 최초로 선수로 뛴 것은 1947년으로, 재키 로빈슨은 로스앤젤레스 다저스에 입단해 10년간 팀에 몸담았으며, 1962년에는 명예의 전당에 헌액된 최초의 흑인이 되었다.[15]++투수는 1960년대에서 1970년대 초반까지 경기에서 타석에 섰다. 1970년대 초반, 지명타자(designated hitter, DH) 규칙이 제안되었으며,[16] 아메리칸 리그에서는 1973년 이 규칙이 적용되기 시작해 투수가 타석에 서지 않게 되었고 지명타자는 타석에만 서면서 수비는 하지 않았다. 내셔널 리그에서는 지금도 투수가 타석에 선다.++메이저 리그 야구는 1980년대 초반까지 불법이었던 약물 복용이 흔했고, 이 시기가 되어서야 알려졌다. 또한 여러 선수들이 약물로 인해 사망했다. 1990년대 초반부터는 선수들이 근육강화제를 사용했으며, 이 때문에 2005년 3월 17일, 미국 의회는 스테로이드 사용에 관한 청문회가 열렸다. 이 때문에 메이저 리그 야구는 2006년부터 약물 복용이 처음 발각 되었을 때에는 50경기, 두 번째에는 100경기, 세 번째로 발각이 되면 영구 제명이 된다는 '삼진 아웃' 제도를 적용하기 시작했다.[17]++메이저 리그 야구는 점점 미국 전역으로 확대 되었는데, 팀이 미국 동부에서 서부로 많이 옮겨갔으며, 캐나다에서도 1969년 몬트리올 엑스포스(현 워싱턴 내셔널스)가, 1977년 토론토 블루제이스가 리그에 참가했다.[18] 현재는 내셔널 리그 16팀, 아메리칸 리그 14팀으로 팀 수 (목표는 모든 리그 16팀씩 32팀)가 유지가 되고 있으며, 경기 수는 한 시즌 당 162경기로 치러진다.+[편집]+세계의 야구+ + 야구의 픽토그램.++야구는 미국의 대표적인 스포츠 중 하나며, 다른 여러 나라에서도 팬들의 지지에 기반한 야구 체계가 갖추어져 있다. 캐나다 야구의 역사는 미국과 밀접하게 관련이 있는데, 1877년 프로리그와 국제 협회에서 두 나라로 이루어진 특색있는 팀을 만들기도 했었다.++세계적으로 미국과 캐나다가 아닌 다른 공식적 첫 야구 리그는 쿠바의 야구 리그이다. 쿠바는 오랜 전통을 유지하며 1930년대 후반부터 국제 경기에서 막강한 전력을 자랑하는 팀이라는 명예를 얻게 된다.++쿠바의 야구 리그가 만들어진 후 프로 리그가 생긴 국가는 다음과 같다. 제1차 세계 대전 후에 프로 리그가 만들어진 국가는 1922년 네덜란드, 1934년 오스트레일리아, 1936년 일본, 1938년 푸에르토 리코이며, 제2차 세계대전 이후에 프로 리그가 만들어진 국가는 1948년 이탈리아, 많은 라틴 아메리카의 나라들 중 가장 두드러진 나라, 1945년 베네수엘라, 1945년 멕시코, 1951년 도미니카 공화국과 1982년 대한민국, 1990년 타이완, 2003년 중국 순으로 만들어졌다. 2009년 현재, 국제 야구 연맹에는 현재 117개국이 가입했다.[19]++현재 야구는 미국, 일본, 대한민국 의 국가에서 가장 인기있는 스포츠 중 하나이다. MLB의 겨울 리그 프로그램으로 푸에르토 리코, 베네수엘라, 도미니카 공화국, 오스트레일리아에 겨울 리그가 존재하고, 멕시코는 MLB 하위 Triple-A 에서 리그 참여를 하고있다. MLB 는 푸에르토 리코, 베네수엘라, 도미니카 공화국,멕시코 가 참여하는 캐러비언 시리즈를 4년에 한번씩 개최하고 있다. 또한 이탈리아, 네덜란드, 중국, 타이완, 니카라과 에도 대회가 존재한다.++공식적 첫 야구 리그 였던 쿠바의 야구 리그는 1961년 쿠바 혁명으로 폐지 되었다. 자세한 내용은 하위항목 야구 리그 참조.++한편 2005년 7월 싱가포르에서 열린 2012년 하계 올림픽에 관한 117번째 회의에서 야구, 소프트볼 종목 삭제에 관한 투표가 진행되어 2012년 하계 올림픽에서 야구, 소프트볼 종목을 제외시키기로 결정했다. 이는 메이저 리거들이 출전하지 않기 때문이다.[20]. 또한 2009년 8월 회의에서 2016년 하계 올림픽 에도 야구 종목을 제외하기로 결정했다. 이 회의에서는 빅스타 선수가 참여하는 8팀, 짧은 5일 간의 경기 방식으로 바꾸라고 요구했다.[21]+[편집]+한국++한국에 야구가 처음 들어온 것은 1905년으로, 당시 선교사로 온 미국인 질레트(P. L. Gillett)가 황성기독교청년회 회원들에게 야구를 가르친 것이 그 시초이다. 1906년 2월 11일 훈련원 터에서 YMCA팀 대 덕어(독일어)학교팀 사이에 최초의 야구경기가 열렸다. 《황성신문》1909년 3월 21일자엔 이러한 〈야구단 운동가〉라는 노래가 소개돼 있을 정도로 야구는 큰 인기를 누렸다: "무쇠 골격 돌 근육 소년 남아야/애국의 정신을 분발하여라/다달았네 다달았네 우리나라에/소년의 활동 시대 다달았네 /(후렴) 만인 대적(對敵) 연습하여 후일 전공 세우세/절세 영웅 대사업이 우리 목적이 아닌가" [22]+[편집]+야구 규칙과 경기 진행+ + 야구 경기장의 구조+ 이 부분의 본문은 야구 규칙입니다.++야구 경기는 두 팀이 서로 겨루는데, 경기가 진행되는 동안에 두 팀은 공격과 수비를 번갈아 가면서 진행한다. 그리고 공격 팀이 공격을 진행하면서 세 번의 아웃을 기록하면 공격 팀은 수비 팀으로, 수비 팀은 공격 팀으로 바뀐다. 그리고 이 세 번의 아웃을 이닝(inning, 회)이라고 하며, 일반적인 경기는 9이닝으로 구성되어 진행된다. 그리고 한 이닝은 초(初, 선공)와 말(末, 후공)로 구성된다. 그리고 한 이닝에 두 팀은 공격과 수비를 번갈아 가면서 경기를 진행하는데, 한 팀, 주로 홈팀이 말에 공격하며, 다른 한 팀, 주로 원정팀이 초에 공격한다. 야구 경기의 목표는 경기를 치르면서 상대 팀보다 더 많은 점수(득점)를 얻어 승리하는 것이다. 공격하는 팀의 선수들은 사각형 형태의 내야 다이아몬드 꼭지점에 있는 네 개의 베이스를 돌면 득점을 할 수 있다. 타자는 홈플레이트에서 타격을 하며 누상에 출루하고서는 반드시 시계반대방향으로 1루, 2루, 3루, 그리고 홈플레이트를 거쳐야 하며, 홈을 밟으면 득점이 된다. 반면 필드에서 수비를 보는 다른 팀은 아웃을 잡고 공격 팀이 점수를 내는 것을 막아야 한다. 아웃을 잡힌 선수는 배팅 오더에 따라 자신의 차례가 돌아올 때까지 공격을 할 수 없다. 세 개의 아웃카운트가 채워지면, 양 팀은 공격과 수비 역할을 교대하는 공수교대를 하며, 경기는 초에서 말로, 말에서 초로 바뀌게 된다. 9이닝동안 경기가 진행되다가 9회가 다 끝나도 점수가 같을 경우에는 연장전을 치뤄 승부를 낸다. 어린이 야구에서는 9이닝보다 적은 이닝으로 경기가 이루어지는게 보통이다.[23]+[편집]+경기 용구+ 이 부분의 본문은 야구의 경기 용구입니다.++야구를 하기 위해서 기본적으로 필요한 것은 방망이, 야구공, 글러브, 야구 경기를 치를 수 있는 경기장이 필요하다.+방망이는 공격을 할 때 필요한 도구로, 보통 알루미늄이나 목재로 만든다. 배트는 길고 딱딱한 나무 막대기이고, 손잡이 부분을 제외하고 지름은 약 2인치(5 센티미터)이다. 손잡이 부분은 지름이 약 1인치(2.5 센티미터)이다.+야구공은 한 주먹 정도의 크기이고 빨간색 실이 들어간 흰색(다른 색일 수도 있다) 공이다. 소프트볼의 경우, 보통 주먹 두 개 정도 크기의 흰색 줄무늬가 있는 흰색이나 노랑색 공을 사용한다.+글러브 또는 미트는 수비할 때 필요한 도구로, 가죽으로 만들어졌으며, 선수의 손에 착용한다. 글러브의 모양은 사용하는 선수의 포지션에 따라 조금씩 다르다.+야구의 경기장은 선수의 나이, 능력에 따라서 크기가 달라진다. 하지만 모든 야구장은 다이아몬드와 모서리, 베이스(루) + 야구공+가 있으며, 같은 방식의 경기를 진행한다. 경기장은 크게 내야와 외야로 구별된다.  + 야구공+[편집]+포지션+ 이 부분의 본문은 야구의 포지션입니다.+ + 야구의 포지션++이닝에서, 수비를 할 때 9명의 수비수들은 각자의 수비 위치에 선다. 다이아몬드의 중심의 투수판에 서 있는 선수를 투수라고 하며, 그리고 홈 플레이트 뒤에 앉아 있는 선수를 포수라고 하는데 이 둘을 배터리라고 부른다. 나머지 수비수들은 야수라고 부르는데 야수는 위치에 따라 내야수와 외야수로 분류되며 내야 안에 있는 4명의 수비수들을 내야수라고 한다. 내야수 중 3명은 1, 2, 3루에 서 있는데 이들은 각각 1루수, 2루수, 3루수라고 말하며 각 루와 그 주변을 수비하는 역할을 한다. 나머지 한명은 유격수로, 2루와 3루 사이의 서면서 그 사이를 수비한다. 그리고 나머지 3명의 선수는 외야에 서는데, 이들을 외야수라고 하며, 위치에 따라 좌익수(왼쪽), 중견수(가운데), 우익수(오른쪽)로 구분해서 부른다.++지명타자는 공격만 하고 수비는 하지 않는데, 이는 투수를 보호하기 위해 고안된 규칙으로 지명타자는 투수 대신 공격을 한다.++경기에서 홈플레이트 옆에 있는 타석에 서 공격을 하려는 선수를 '타자'라고 부르며, 타자는 배트를 잡고 있으며, 투수가 투수판에서 홈플레이트 쪽으로 공을 던지면 타자는 배트로 공을 쳐서 점수를 내려고 한다. 타자가 공을 치고 난 후에 타자는 배트를 놓고 1루를 향해 달려간다. 그리고 상황에 따라 2, 3루, 홈까지 갈 수 있다. 아웃이 된 경우에는 덕아웃으로 돌아간다.++투수는 타자가 베이스에 나가지 못하게 막기 위해 투수판에서 공을 던지는데, 공을 어디에 던지느냐에 따라 '스트라이크'(strike)와 '볼'(ball)로 구별된다. 타자는 스트라이크가 3개가 되면 아웃되지만, 볼이 4개가 되면 1루로 나갈 수 있다.++스트라이크를 던지는 방법은 다음과 같다.+투수가 공을 던졌는데 스트라이크 존(strike zone)을 통과한 경우.+타자가 공을 보고 방망이를 휘둘렀으나 맞지 않은 경우.(헛스윙)+타자가 공을 쳤으나 파울 라인이나 파울 폴(foul pole)을 기준으로 필드 바깥쪽으로 공이 날아간 경우. 이 경우를 파울(foul) 이라고 한다. 하지만 2 스트라이크 상태에서 파울이 된 경우에는 스트라이크가 추가되지 않는다.+[편집]+아웃+타자가 친 공이 노바운드(친 공이 땅에 떨어지지 않는상태)로 야수들의 글러브나 미트에 들어간 경우.+스트라이크를 3번 허용한 경우(스윙이나 그냥 보거만 있거나 스트라이크 존 안에서 몸에 맞거나).+2스트라이크 상황에서 번트가 파울이 된 경우(스리번트 아웃).+타자가 친 공을 야수가 잡은 후 타자가 1루에 닿기 전에 1루수에게 던진 후 잡은 경우.+타자가 친 공을 야수가 잡은 후 타자가 1루에 닿기 전에 1루수에게 던진 후 잡은 공으로 타자를 태그 하는 경우.+타자가 친 공을 야수가 잡은 후 주자를 태그한 경우.+타자가 친 공을 야수가 잡은 후 주자가 진루할 루로 가서 포스아웃 하는 경우 +(단, 포스아웃 당할 주자의 원래의 루로 다음 주자 혹은 타자가 주루해야 하는 경우.).+타자가 친 공에 주자가 맞은 경우.+타자가 2루타 이상의 장타를 쳤는데 베이스를 밟지 않고 진루한 때 수비측이 그에 대해 어필(항의)을 한 경우(누의 공과).+2스트라이크 상황에서 타자가 공에 맞았지만 배트를 휘두른 경우.+타자가 친 공을 노바운드로 야수가 잡은 후, 주자가 원래의 루에 귀루하여 터치하지 않고 진루했을 때 주자나 베이스를 공으로 터치한 경우 +(이 경우 포스아웃이 아닌 어필아웃이다).+타자가 친 공이 야수가 충분히 노바운드로 잡을 수 있다고 판단한 경우에 관중들이 공을 잡은 경우.+노아웃이나 1아웃 주자 1,2루나 만루일때, 타자가 친 공이 내야수들이 충분히 잡을 수 있는 내야안의 경우라 판단 될 경우 (인필드 플라이).+타자가 공을 쳤고 수비수가 충분히 잡을 수 있는데 주자 혹은 타자가 쳐서 수비방해한 경우.+타순이 엉켜서 상대편이 어필한 경우.(예를들어 3번타자가 나와야 할 때 4번타자가 나와서 타격을 해서 안타 등이 나왔는데 어필하면 3번타자는 아웃이고 4번타자는 다시 쳐야 한다.)+2스트라이크 이후에 투수가 던진 공이 스트라이크 선언되거나 타자가 헛스윙을 하였는데 포수가 노바운드로 잡지 못하여 공을 타자에게 태그하거나 타자가 1루 베이스를 밟기 전에 1루에 던진 경우. (스트라이크 아웃 낫아웃)+노아웃 혹은 1아웃에서 1루 주자가 있을때 제3스트라이크가 선언되었으면 스트라이크 아웃 낫아웃이 적용되지 않고 그대로 스트라이크 아웃이 된다.+주자가 선행주자를 추월한 경우+주자나 타자가 태그를 피하기 위해 루와 루사이를 연결하는 가상의 직선에서 91.4cm 이상 떨어져 주루했을때 (타구를 처리하는 야수를 피해 달린것은 상관없다.) (스리피트라인 아웃)+2스트라이크 상황에서 주자가 번트를 시도하여 친공이 파울라인밖으로 나갈경우+[편집]+진루++타자 또는 주자가 자신의 다음 베이스(타자의 경우에는 1루) 또는 그 이상에서 세이프되는 것을 진루라고 한다.+안타 : 히트(Hit)라고도 한다. 인플레이 상황에서 타구가 수비수가 잡을 수 없는 곳으로 갔을 때 안타라고 하며, 잡을 수 있는 공을 놓칠 때는 실책이라고 한다. 타자가 친 공이 땅바닥에 튀기지 않고 담장을 넘어가면 전광판에 안타라고 표시되지만, 주로 홈런이라고 하며, 모든 루를 돌아 홈플레이트를 밟고 득점할 수 있다.+볼넷 : 몸쪽에서 나간 공(볼)이 4개일 경우 진루하는 것을 말한다.+야수 선택 (필더스 초이스) : 야수의 기술적 실책이 아니라 두뇌적 실책에 의해서 주자가 진루하는 경우이다. 평범한 땅볼이 된 공을 잡은 야수가 1루에 타자 주자를 아웃시키는 대신, 선행주자를 아웃시키려고 다른 루에 송구하여 타자 주자가 1개 또는 그이상을 진루한 경우에 타자에게 주어지는 기록을 말한다.+실책 : 에러(Error)라고도 한다. 수비수가 잡아서 타자를 아웃을 시킬 수 있는 타구를 놓칠 때 쓰이는 말이다. 폭투, 도루 견제 때는 실책으로 인정하지 않는다. 2 스트라이크에서 헛스윙 삼진이 될 때, 그 공을 포수가 놓쳐서 그 사이에 타자가 1루에 무사히 갈 때는 스트라이크아웃 낫아웃이라고 한다.+몸에 맞은 볼 (힛바이피치드볼) : 타자의 몸에 공이 맞았을 때 1루로 진출할 수 있다.(스윙을 하지 않았을 경우) 정식 명칭은 '몸에 맞은 볼'이나 '힛바이피치드볼'이지만 보통 '데드볼'이라고 부른다.+[편집]+야구의 인원+[편집]+선수 명단+ +구원 투수가 몸을 풀고 있으며, 투수 코치가 그들을 살펴보고 있다.++최대 선수 명단 수는 리그 또는 수준에 따라 다르다. 메이저 리그 야구 팀은 선수 명단을 25명으로 유지하고 있다.+8명의 포지션 선수(position players)는 포수, 4명의 내야수, 3명의 외야수로 구성 된다.+5명의 선발 투수(starting pitchers)는 선발 로테이션을 구성한다.(6인도 있다.)+6명의 구원 투수(relief pitcher)에는 마무리 투수가 포함되며, 팀의 불펜을 구성한다.+1명의 백업 포수+2명의 백업 내야수+2명의 백업 외야수+1명의 지명타자, 또는 2번째의 백업 포수, 또는 7번째 구원 투수(seventh reliever)+[편집]+그 외++팀의 감독 또는 수석 코치는 선수 명단, 타순, 선발 투수를 정하고, 특히 구원 투수의 경기 중의 등판 시점과 같은 선수교체 등과 같은 팀의 중요한 전술을 구상한다. 감독은 2명 또는 그 이상의 코치들의 도움을 받는다. 코치들은 타격 코치, 야수 코치, 투수 코치, 트레이닝 코치로 전문적인 책임을 가지고 있다. 대부분의 경기에선 팀이 공격을 할 때 1루 코치와 3루 코치가 경기장에 서 있는데 그들은 파울선의 밖에 정해진 장소에 서서 경기 중에 주자의 방향에 조언하고 경기 중단시에 감독의 지시를 타자와 주자에게 전달한다.[24]+ 이 부분의 본문은 야구 심판입니다.+ + 야구의 주심++야구 경기에서 심판은 4명인데, 주심, 1루심, 2루심, 3루심으로 구성되어 있다. 먼저 주심은 포수 뒤에 서 있는데, 스트라이크 존을 통해서 스트라이크와 볼을 판정한다. 주심은 본루에서 아웃인지 세이프인지 판단하기도 한다. 그리고 나머지 1루심, 2루심, 3루심은 루 근처에서 서 있으며, 아웃인지 세이프인지 판정한다. 또한 타자가 하프 스윙 시에 주심이 스트라이크를 선고하지 않았을 경우에는 감독 또는 포수는 누심에게 조언을 받을 것을 요청할 수 있다. 좌우측 선심이 없는 경우 1, 3루심은 타자가 친 공이 외야에서 파울인지 아닌지 판단하기도 한다. 보크나 타임의 선언은 4심이 모두 동등한 권한을 갖는다.++메이저리그 야구에서는 보통 4명의 심판을 두는데, 올스타전이나 포스트 시즌 경기와 같이 중요한 시합의 경우 좌측 선심과 우측 선심을 추가하여 6명의 심판을 둔다. 그리고 2008년 8월부터는 비디오 판독제를 도입하기로 했다.[25]+[편집]+야구의 기본기와 전술+[편집]+기본기++야구는 기본적으로 야구공을 통해 이루어지는 경기인데, 공을 처리하는 것은 투구, 타격, 주루, 포구, 생각과 같은 동작으로 이루어진다.[26] 이에 따른 신체의 동작도 손(어깨), 발(다리), 눈, 입, 귀, 머리를 통해서 행해진다.[26] 손과 발은 투구, 타격, 주루, 포구에 필요한 수단이며, 눈은 잘볼 수 있는 수단이다.[26] 또한 야구는 단체스포츠이기 때문에 서로의 기분을 이해하고 동료의 플레이가 쉽게 되도록 서로 협조하는 팀워크가 필요하다.[27]++투구는 투수가 투수판을 밟고 타자에게 공을 던지는 행위를 뜻한다.[28] 투수는 좋은 투구를 위해서는 스피드와 제구가 좋은 공을 던져야 하고, 기본적인 속구 이외에도 커브, 포크볼과 같은 변화구를 던질줄 알아야 한다.[29] 또한 투수는 일반적인 와인드업 포지션과 주자 견제를 위한 세트 포지션을 사용한다.[28]++타격은 타자가 투수가 던진 공을 쳐내는 행위를 뜻한다. 스윙의 각도에 따라서 다운 스윙, 레벨 스윙, 어퍼 스윙으로 나뉜다.[28] 다운 스윙은 위에서 밑으로 내려치는 타법이며,[30] 레벨 스윙은 수평으로 휘두르는 타법으로 가장 이상적이며,[31] 어퍼 스윙은 밑에서 위로 올려치는 타법으로 가장 비효율적이다.[31]++주루는 루 상에 나간 주자의 플레이를 말한다. 일반적으로, 주루는 득점을 위해 홈으로 들어오기 위한 하나의 전략이다. 주루를 위해서는 주루 감각과 도루, 투수의 견제시 대비가 중요하다.+[편집]+전술++야구 경기에서 팀은 승리하기 위해서 여러가지 전술을 사용한다. 예컨대, 일반적으로 우타자는 좌완 투수에게 강하며, 좌타자는 우완 투수에게 강하다.[32] 만약 상대 팀의 선발 투수가 좌완 투수일 때, 보통 좌타자 대신 우타자를 많이 기용하며, 좌타자는 기용되지 않거나 하위타선에 배치된다. 이런 점 때문에 우완 투수일 때는 좌타석, 좌완 투수일 때는 우타석에 서서 양손을 사용하는 스위치 히터가 생겨났다.[33]+ + 타자가 번트를 시도하고 있다.++희생 번트는 루 상에 나가 있는 주자의 진루를 목표로 하는 전술으로, 주로 아웃 카운트가 유리한 무사 1루, 무사 2루, 무사 1·2루일 때 시도한다.[34] 스퀴즈 플레이는 주자가 3루에 있을 때, 번트를 대서 3루 주자가 득점하기 위한 전술이다.[35] 희생 플라이(일명 태그업)은 주자가 3루에 있을 때, 타자가 뜬공을 쳐 내면, 야수가 뜬공을 잡았을 때 3루주자는 득점하는 전술이다.[36] 도루는 투수가 투구를 하는 사이에 주자가 다음 루로 가려고 시도하는 것으로, 주로 발이 빠른 주자가 시도한다. 히트 앤 런(Hit and run)은 투수가 투구를 하는 사이 주자는 다음 루로 주루하며, 타자는 투수가 던진 공을 무조건 쳐서 최대한 많이 진루하려는 것이다. 런 앤 히트(Run and hit)는 투수가 투구를 하는 사이 주자가 다음 루로 주루하는 것은 같지만, 타자는 투수가 던진 공을 원하면 타격하는 전술이다. 런 앤 히트 작전이 시도됐을 때 타자가 타격하지 않았을 경우 주자의 도루 시도가 된다.++고의사구는 경기의 승부처(클러치)일 때, 잘 치는 타자가 나왔을 경우 그 타자를 볼넷으로 거르고 다음 타자와 상대해 더 큰 실점을 막으려는 전술이다. 루 상에 발이 빠르고 도루 가능성이 높은 주자가 나가있을 경우에는 투수가 포수에게 공을 하나 완전히 빼서 투구를 하는데, 도루를 대비해 주자를 견제하기 위한 것이다. 투수가 투구 전 또는 포수가 투구 후에 주자를 견제하기 위해서 주자가 있는 루의 야수에게 견제구를 던지기도 한다. 주자가 3루에 있을 때 내야 땅볼을 홈에 송구하기 위해서, 또는 타자가 번트한 공을 효율적으로 처리하기 위해서 야수들이 홈플레이트 쪽으로 이동해 수비를 한다.[37] 수비 위치는 타자의 타격 성향의 따라서 이동될 수 있다. 타자가 장타를 쳤을 때, 외야수는 잡은 공을 베이스에 있는 야수에게 송구하지 않고 보통 2루수 또는 유격수에게 송구를 하는데, 이를 중계 플레이라고 하며, 주자의 득점이나 진루를 방지하는 플레이이다.++전술의 지시는 보통 감독, 코칭스태프, 또는 선수간의 사인으로 전달되는데, 대부분 손짓으로 이루어진다. 사인의 종류에는 플래시 사인, 블록 사인, 키 사인 등이 있다.[38] 메이저 리그 야구에서는 9이닝을 기준으로 한 경기에 오가는 사인이 평균 1000여건 정도이다.[39]++경기는 모두 전술대로 진행하는 것은 아니며, 선수가 혼자서 독단적으로 플레이하는 경우도 있다. 예를 들어, 발이 빠른 주자들은 덕아웃 에서의 사인 지시 없이 자신의 판단으로 도루를 시도하는데, 이를 '그린라이트'(green light)라고 한다.[40]+[편집]+야구의 고유한 스타일++야구는 미국의 스포츠 중에서 여러가지 면에서 독특한 특징을 갖는 스포츠이다. 이러한 독특함이 오랜기간 지속해 올 수 있었던 매력이자 미국인의 정신에 강한 연대감을 갖게 하는 큰 요인이다. 또한 많은 미국인들은 야구가 기술과 타이밍 그리고 열정, 전략의 최상의 조합이라고 생각한다. 철학자였던 모리스 라파엘 코언은 야구를 국민적 종교라고 묘사하기도 했다.[41] 이 점에서, 야구는 그의 사촌격인 크리켓과 유사한데, 많은 영연방 국가에서 크리켓과 그것과 관련된 문화는 미국 문화에서의 야구의 역할과 비슷한 지위와 영향력을 가진다.+[편집]+시간적 요소++농구, 아이스하키, 미식축구, 그리고 축구는 모두 경기 시간이 정해져 있고, 보통 상대 팀에 직접적으로 저항해서 경쟁하는 것보다 정해져 있는 시간에서 공격에서 많은 시간을 차지한 팀에 의해 끝난다. 이와 반대로 야구는 경기 시간이 정해져 있지 않다. 팀은 마지막 타자가 나가기 전까지는 이길 수 없고 반격은 시간 제한을 받지 않는다. 비록 단체 종목과 반대되는 개인 종목들 중에서 경기 시간제한이 없어서 미국의 전문직들에게 인기가 많은 다른 스포츠로는 테니스와 골프가 있다.++최근 수십 년간, 관찰자들은 매년 야구 경기를 하는 데에 걸리는 시간이 꾸준히 증가한 것에 대한 정당성을 들어 프로 야구의 게임 길이를 비판해 왔다. 20세기에 들어서면서 게임 시간은 전형적으로 1시간 반 정도였다(1시간 반으로 정해졌다). 1920년대에는 평균 2시간 미만으로 변한 것이 1960년대에는 결국 2시간 38분으로 늘어났다.[42] 1975년에는 평균 2시간 25분으로 줄어 들었지만,[43] 21세기에 들어서면서 2003년 시즌 종료 직후 조사한 결과 평균 2시간 46분대가 되는 것으로 밝혀져 경기 시간이 더욱 길어지게 된 것으로 판명되었다.[42]++경기 시간이 늘어나는 것은 하프 이닝(half inning; 공수교대시간) 사이의 TV 광고, 늘어나는 반칙과 투구 인터벌, 그리고 느린 경기 흐름 때문이었다. 결국 메이저 리그는 하프 이닝 사이의 쉬는 시간의 최대 시간을 정하는 반면 심판이 더욱 엄격하게 스트라이크 존과 시간 규칙을 선수들이 지키게 강요하도록 교육했다.[42] [43] 2008년, 일본의 프로 야구는 2007년부터 과거 10년간의 평균 경기 시간이었던 3시간 18분의 6%(교토 의정서의 온실가스 배출량 감축 목표에서 따온 것이다)인 12분 줄이는 것을 목표로 삼았다.[44]++이러한 제한 시간이 없는 특징 때문에 야구계 일각에서는 승부가 연장으로 이어질 시에 빠르게 승부를 낼 수 있는 규칙으로서 이른바 승부치기를 도입하는 것이 논의되고 있기도 하다. 실제 베이징 올림픽에서는 승부치기 제도가 실시된 바 있으나, 승부치기 제도가 일반적인 것은 아니며 전 세계 거의 대부분의 프로 야구 리그에서는 아직 승부치기 제도를 도입하지 않고 있다.++공식적인 규칙에 명기되어 있기는 하지만 루(Base) 상에 주자가 없을 경우 투수는 12초 안에 투구해야 하며 이를 어길 시 그 투구는 '볼(Ball)'로 판정이 된다는 경기 촉진룰의 적용은 매우 드물고 아주 만약의 상황에만 시행 된다. 그러나 2010년도 프로야구에서는 이 12초룰을 적용키로 하여 투수에 유리한 룰이 아니냐며 타자들이 반발하고 있는 추세다. 심판은 또한 주자가 있을 경우에도 투수의 투구 지연 행위를 볼(Ball)로 판정할 수 있는 권리도 가지고 있는데 이 규칙 또한 매우 드물고 만약의 상황에만 시행된다. 공식 규칙 중에는 또한 주심이 타자에게 타격행위가 끝나지 않았을 경우 타자석을 벗어나지 않도록 요청할 수 있는 규칙이 있다. 그 이외의 다른 규칙으로는 '규칙위반을 하는지 주시하라'가 있다.+[편집]+개인과 팀++야구는 근본적으로 팀 스포츠이다. 명예의 전당에 들어갈 정도로 훌륭한 실력을 가졌으며 높은 연봉을 받는 두, 세 명 정도의 선수를 보유할 정도로 재정이 좋은 지역 연고 구단이라 하더라도 기량이 우수한 선수들이 반드시 성공을 기대할 수는 없으며, 여전히 선수 개인들은 강한 압박과 시험에 놓이게 된다. 투수는 반드시 훌륭한 투구를 해야하며 만약 그렇지 못할 경우 시합에 질 위험이 크고, 타자는 극히 짧은 순간에 어떤 구질인지, 스윙을 해야 할지, 말아야 할지를 결정해야 한다. 감독과 코치가 어떤 작전을 수행할지를 선수들에게 사인을 줄 수는 있지만, 그 어느 누구도 투수가 투구하는 것을, 타자가 타격하는 것을 도와 줄 수는 없다. 타자가 직선타구를 치게 되면, 최종 수비자인 외야수들은 볼을 잡아야 할지, 바운드 볼로 처리해야 할지를 혼자서 결정한다. 야구의 역사에서는 영웅적 대접을 받는 선수와 비난을 받는 선수들이 많다 - 시합의 승부처(클러치)에서 한 선수가 적시 안타를 치거나 또는 공을 잡아 플라이 아웃 시킬 수도 있지만, 또는 그 반대로 예상치 못한 삼진 아웃을 당하거나 수비에서 실책을 해서 모두에게 뚜렷이 각인되는 결과를 낳았다.++또한 야구에서 모든 선수들이 주자로 뛸 수 있으며 이 때문에 야구에서는 단거리 달리기가 매우 중요하다. 굳이 주자가 아니더라도 포수를 제외한 모든 포지션에서 뛰어난 단거리 달리기 능력이 요구된다. 단거리를 빠른 속도로 달리는 능력이야말로 야구의 기본기이다.+[편집]+경기장+ 이 부분의 본문은 야구장입니다.+ +리글리 필드의 득점판. 2005년 7월 27일, 시카고 컵스 - 플로리다 말린스의 경기.++야구 규칙에 따르면 경기장에 대한 규정은 다음과 같다.[1][45]+본루에서 1루, 1루에서 2루, 2루에서 3루, 3루에서 본루까지의 거리는 각각 27.432m(90피트)이다. 내야의 중앙 부근에 본루로부터 25.4cm(10인치)의 높이가 되도록 흙을 쌓아 올려 그곳에 투수판을 놓고 투수판 앞 15.2cm(6인치)되는 지점으로부터 본루를 향해 182.8cm(6피트)되는 지점까지, 경사도는 12:1이여야한다. 본루로부터 백 스톱까지의 거리 및 루선으로부터 파울지역에 있는 펜스, 스탠드 또는 플레이에 방해가 되는 시설까지의 거리는 18.288m(60피트) 이상이 되어야 한다. 내야는 한 변이 27.432m(90피트)인 정사각형이고 외야는 1루선과 3루선을 연장한 파울 라인 사이의 지역이다. 본루부터 페어지역에 있는 펜스, 스탠드 또는 플레이에 방해가 되는 시설까지의 거리는 76.199m(250피트) 이상이어야 한다. 경계선을 포함한 내야 및 외야는 페어지역이고 다른 지역은 파울지역이다. +1958년 6월 1일 이후 프로야구를 위해 건설하는 경기장은 본부로부터 좌우의 펜스, 스탠드 또는 좌우의 페어지역 위에 있는 플레이에 방해가 되는 시설까지의 거리는 99.058m(325피트) 이상, 중견의 펜스까지의 거리는 121.918m(400피트) 이상이여야한다.+본루는 오각형의 흰색 고무판으로 표시한다. 이 오각형을 만들 때에는 먼저 한 변이 43.2cm(17인치)인 정사각형을 그려, 이 중 한 변을 골라 이에 이웃한 양쪽의 변을 21.6cm(8½인치)로 줄인다. 이 변에서 밑변의 중심으로 각 30.5cm(12인치)의 변을 2개 만든다. 30.5cm(12인치)의 두 변이 만나는 곳을 1루선과 3루선의 교차점에 두고, 43.2cm(17인치)의 변을 투수판 쪽으로 해서 그 표면이 지면과 수평이 되도록 고정시킨다.+1루, 2루, 3루는 흰색 캔버스 백으로 표시하고 땅에 올바르게 고정시킨다. 1루와 3루의 캔버스 백은 완전히 내야 안쪽으로 들어가게 설치하고, 2루의 캔버스 백은 2루지점에 그 중심이 놓이도록 설치한다. 캔버스 백은 그 속에 부드러운 재료를 넣어서 만들고 그 크기는 38.1cm(15인치) 평방, 두께는 7.6cm(3인치)에서 12.7cm(5인치)까지 허용된다.+투수판은 가로 61cm(24인치), 세로 15.2cm(6인치)의 직사각형 흰색 고무 평판으로 만든다. 투수판은 그 앞쪽면 중앙으로부터 본루까지의 거리가 18.44m(60피트 6인치)가 되게 한다.+본거지 구단은 1루선과 3루선으로부터 적어도 7.62m(25피트) 떨어진 곳에 본거지 구단 및 방문 구단용으로 각 1개씩의 선수용 벤치를 설치하여야 하며, 이 벤치는 양 옆과 뒷 쪽을 둘러싸고 지붕을 씌워야 한다.+[편집]+기록+ 이 부분의 본문은 야구의 기록입니다.++많은 스포츠 중에서 혹은 그보다 휠씬 더, 야구에서의 기록은 대단히 중요한 의미를 갖는다. 야구 기록은 미국 프로 야구인 메이저 리그의 태동과 함께 유지되어 왔으며 생각컨대 이전보다 더 일반적인 것이 되었다. 단장, 스카우터, 감독 그리고 선수들은 자신이 속한 팀의 승리를 위한 다양한 전략선택에 도움을 주기 위해 기록을 연구한다.++야구에서의 기록은 여러 가지 이유로 다른 스포츠들보다 더 중요한 의미를 갖는 가장 중요한 이유는 다른 운동 경기들에서의 플레이는 유동적이고 다양한 결과를 보여주지만, 야구에서의 플레이는 제한된 결과만을 갖기 때문이다.++모든 세대의 야구팬은 다음과 같은 전통적인 야구 기록에 대해 알고 있으며 또한 그 내용에 관해 의견을 교환한다.+'타수'(打數, At-bats, AB)는 타자가 타석에서 타격행위를 완료한 총 횟수를 의미한다. 타수에는 타자가 타격행위를 완료하지 않은 타석은 제외하는데 볼넷과 몸에 맞는 볼이 그러한 경우이다.+타자의 '타율'(打率, Batting Average, AVG)은 '안타'의 수를 '타수'로 나눈 값이다.[46] 이것은 타자의 타격능력을 보여주는 가장 기본적인 통계수치이다.+투수의 '평균자책점'(Earned Run Average, ERA, 일본 야구에서는 '방어율'(防禦率)이란 용어를 사용)은 투수가 투구한 총 이닝과 허용한 자책점을 평균적으로 환산하여 9 이닝당 자책점(투구와 관련없는 수비행위로 인한 실점은 제외)으로 보여주는 통계수치이다. 약어로는 'ERA'로 표기한다.+투수의 '이닝'(Inning, IP(Inning Pitched))은 투구행동의 기본단위이다. 보통 양팀의 공수교대를 1이닝으로 표현하기도 하지만, 투수가 얼마나 던졌는지를 가늠하는 것도 이닝이다. 투구수와는 상관없이 1-아웃카운트를 잡았을 경우 ⅓(0.1)이닝 2-아웃카운트를 잡았을 경우 ⅔(0.2)이닝이라 표현, 3명의 타자를 아웃시키면 1이닝으로 표현된다. (또는 0.3, 0.7, 1로 표현) 연속성은 상관이 없이 기록된다. 투구에 의한 아웃이 아니라, 견제사에 의한 아웃도 인정되므로 투구수 없이 이닝을 기록할 수도 있다. 이것은 주로 투수의 내구력과, 지구력에 대한 척도가 되곤 한다.+'도루'(Stolen Bases, SB)는 투수의 투구행동시 다음 루로의 진루를 하는 행위이다. 얼마나 빠른지에 대한 수치적인 기준이 되며, 도루가 많을수록 공격의 효율성이 좋아진다.+세이버매트릭스(Sabermetrics)++미국 야구 연구 협회(The Society for American Baseball Research, SABR)는 야구 선수의 성과와 팀 기여도를 보다 더 잘 측정하고 상대적 가치에 관한 좀 더 추상적인 질문에 대한 답을 제공하기 위해 혁신적인 통계 수치를 개발해왔다('세이버매트릭스'란 용어는 학문의 분야와 고안된 특정 통계수치를 의미한다).++몇몇 세이버매트릭스 신봉자들이 야구계의 주류로 편입함에 따라 '세이버매트릭스'의 통계기록은 일반적으로 사용되기 시작했으며, 내용은 다음과 같다.+'OPS'(출루율과 장타율을 합한 것)는 타율보다 타자들의 성과를 더 잘 측정한다고 세이버매트릭스를 믿는 사람들이 말하는 다소 복잡한 공식이다. 타자의 '출루율 : (안타 + 볼넷 + 사구) / (타수+볼넷 +사구 + 희생플라이)'[46] 과 '장타율 : 총루타수 / 타수'[47]를 더한 값이다.[48]+'WHIP'(투구이닝 당 허용한 볼넷과 안타의 합)[49]은 투수의 능력을 잘 보여주는 통계수치이다.+특정 상황에 따른 통계기록++특정 상황에서 좀 더 세밀한 통계수치는 더욱 중요해진다. 예를 들어, 좌완 투수의 공을 잘 치는 타자의 경우 감독은 왼손 투수를 상대하기 위해 그 선수에게 좀 더 많은 기회를 줄 것이다. 득점상황에서 더 잘 치는 타자들이 나왔을 경우 상대팀 감독은 득점권 타율이 낮은 타자와 승부하기 위해 그 타자를 고의사구로 내보내려고 할 것이다.++다른 통계 기록들도 있는데 위에서 언급한 통계수치들보다 덜 중요할지도 모른다. 타자의 경우 타수, 안타수, 장타수 그리고 타점이고 투수의 경우는 투구 이닝수, 9이닝 당 삼진수, 볼넷, 투구 수 등이다.+[편집]+야구 단체 및 주요 대회+[편집]+국제 야구 단체+ +국제 야구 연맹에 가입된 국가.++국제 야구 연맹은 1938년에 설립되었으며, 117개국이 가맹하고 있다.[19] 그리고 대륙별로도 연맹이 조직되어 있어 있으며, 다음과 같이 소속되어 있다.++     아프리카 야구·소프트볼 협회(ABSA) - 16개국++     팬아메리칸 야구 연맹(COPABE, 스페인어: Confederación Panamericana de Béisbol) - 26개국++     아시아 야구 연맹 (BFA) - 20개국++     유럽 야구 연맹 (CEB, 프랑스어: Confédération Européenne de Baseball) - 40개국++     오세아니아 야구 연맹 (BCO) - 15개국+[편집]+야구 대회++세계의 주요 야구 대회에는 야구 월드컵, 대륙간컵 등이 있다. 하지만 이런 대회들은 아마추어 선수들만 참가하고 메이저 리그 야구 선수는 참여하지 않는다. 올림픽 야구 또한 메이저 리그 야구 선수들은 참여하지 않는데, 이 때문에 2012년 하계 올림픽에서 야구와 소프트볼이 제외된 이유가 되기도 한다. 유니버시아드 야구, 세계 청소년 야구 선수권 대회, 유스 베이스볼 월드 챔피언십은 대학, 청소년을 위한 대회이다. 여자 야구 대회로는 여자 야구 월드컵이 있다.++메이저 리그 야구 사무국은 야구의 열기 확대를 위해서 메이저 리그 야구 선수들도 참가하는 프로 야구 대회인 WBC(월드 베이스볼 클래식)을 2006년에 개최했다. 이 대회는 2009년에 열린 후 그 이후로는 4년마다 열릴 예정이다.[50]++각 대륙별 대회는 다음과 같다.+아프리카 - 올아프리카 게임 야구+아메리카 - 팬아메리칸 게임 야구+아시아 - 아시아 야구 선수권 대회+유럽 - 유럽 야구 선수권 대회+오세아니아 - 오세아니아 야구 선수권 대회+[편집]+야구 리그++세계 야구에서 가장 큰 규모의 프로 야구 리그는 미국의 메이저 리그 야구로, 내셔널 리그 16팀, 아메리칸 리그 14팀, 총 30개의 팀으로 각각 서부, 중부, 동부 지구로 나뉘어 있다.++메이저 리그 야구 밑으로는 트리플A, 더블A, 싱글A, 루키 등의 하위 리그들이 각 연고지마다 분포되있다. 그리고 메이저리그와는 별개로 독립리그들이 북중미권에 여럿 있다.++또한 네덜란드, 이탈리아, 오스트레일리아, 푸에르토리코, 도미니카 공화국, 파나마, 콜롬비아, 베네수엘라, 니카라과, 캐나다 등에도 리그가 있으며, 특히 카리브해 국가들의 리그는 기후상 겨울에도 리그를 연다. 쿠바는 공산국가 특유상 프로리그는 없지만 아마추어 국제대회에서는 상당한 실력을 보인다.++아시아에선 일본의 센트럴 리그와 퍼시픽 리그와 독립리그들이 있으며, 그 외에 대한민국, 타이완, 필리핀 등이 대표적이다.++또한 야구 리그는 난이도에 따라, 예를 들어서 아마추어, 프로에 따라서, 또는 성별에 따라, 나이에 따라서 리그가 다르다. 어린이 프로그램은 야구 규칙에 보다 더 쉬운 규칙을 적용하고 더 작은 구장에서 경기를 치르며, 코치나 기계로부터 보다 더 쉬운 투구를 한다. 또한 아마추어, 논-프로도 공식 야구 규칙에서 변형된 규칙을 사용한다.++야구 리그는 아메리카, 아시아, 유럽, 오세아니아 등에 존재한다. 특히 아시아의 경우 일본에서는 센트럴 리그와 퍼시픽 리그라는 양대 리그가 있다.++대한민국에서는 1982년 한국야구위원회 창설로 프로야구가 설립되었으며 롯데 자이언츠, 삼성 라이온즈, 해태 타이거즈, MBC 청룡, OB 베어스, 삼미 슈퍼스타즈 등 6개 팀으로 시작 2013년 현재는 삼성 라이온즈, SK 와이번스, 롯데 자이언츠, 두산 베어스, KIA 타이거즈. 넥센 히어로즈, LG 트윈스, 한화 이글스, NC 다이노스 등 9개 팀으로 리그가 진행중이다. 현재 대한민국 프로야구는 10구단 창설 논의가 진행중이며, 2013년에 10구단의 모기업이 결정될 예정이다. 10구단에 관심이 있는 지역과 모기업은 수원시와 KT의 연합과 전라북도와 부영의 연합이다.+[편집]+같이 보기야구 규칙/경기 진행+야구의 경기 용구+야구의 포지션+야구의 기록+야구의 점수 기록+야구장	야구 문화+분류:야구 문화+분류:야구 영화+분류:야구 게임+분류:야구상+야구 은어+야구 카드+야구 명예의 전당+스피드건(en:Speed gun)++	야구 관련 스포츠+방망이와 공을 이용하는 경기+마운드볼+오이나+소프트볼+크리켓+스틱볼+원 홀캣+타운볼+라프타+스툴볼+티볼++[편집]+참고 문헌+조지 벡시. 《야구의 역사》. 을유문화사. 8932430799+설리번 딘. 《Early Innings: A Documentary History of Baseball, 1825-1908》. U of Nebraska Press. 0803292449+설리번 딘. 《Late Innings: A Documentary History of Baseball, 1945-1972》. U of Nebraska Press. 0803292856+잭 스탈링스, 밥 베넷 (2003). 《Baseball Strategies: Your Guide to the Game Within the Game》. American Baseball Coaches Association/Human Kinetics. ISBN 0-7360-4218-0, OCLC 50203866+하일성. 《최신 야구교실》. 국일미디어. ISBN 978-89-7425-228-1+[편집]+주석+↑ 가 나 한국야구위원회. 한국야구위원회 : 경기규칙. 2012년 2월 23일에 확인.+↑ Major League Baseball. Major League Baseball: Official Baseball Rules. 2012년 2월 23일에 확인.+↑ 박동희. “SK 와이번스의 ‘야큐(野球)’ 실험”, 《스포츠 2.0》, 2007년 3월 23일 작성. 2009년 1월 1일 확인.+↑ Block (2005년), p.106~108.+↑ 야구의 역사, 조지 벡시 p. 59+↑ 야구의 역사, 조지 벡시 p.36+↑ Early Innings: A Documentary History of Baseball, 1825-1908, 설리번 p.292+↑ 쥘 티곌 (2002년). Past Time: Baseball as History. 《NINE: a Journal of Baseball History and Culture》 10: 170–171. doi:10.1353/nin.2002.0012. 2008년 6월 25일에 확인.+↑ Early Innings: A Documentary History of Baseball, 1825-1908, 설리번 p.80+↑ 야구의 역사, 조지 벡시 p. 32+↑ Early Innings: A Documentary History of Baseball, 1825-1908, 설리번 p.95+↑ “메이저리그”. 두산백과사전. 2008년 12월 14일에 읽어봄.+↑ 야구의 역사, 조지 벡시 p. 106+↑ 야구의 역사, 조지 벡시 p. 249+↑ Late Innings: A Documentary History of Baseball, 1945-1972, 설리번 p.162+↑ Late Innings: A Documentary History of Baseball, 1945-1972, 설리번 p.239+↑ 야구의 역사, 조지 벡시 p. 257+↑ “토론토 블루 제이스”. 두산백과사전. 2009년 4월 23일에 읽어봄.+↑ 가 나 국제 야구 연맹 (대륙 연맹/회원국 연맹). IBAF. 2009년 2월 3일에 확인.+↑ “They'rrre out! Baseball, softball out of Olympics”, 《NBCSports.com》, 2005년 7월 9일 작성.+↑ “IOC: Add golf, rugby to 2016 Olympics”, 《NBCSports.com》, 2009년 8월 13일 작성.+↑ 강준만 (2007). 《한국 근대사 산책4(러일전쟁에서 한국군 해산까지)》. 인물과사상사, 198쪽. ISBN 978-89-5906-074-0 “한국에 야구가 처음 들어온 것은 1905년으로, 당시 선교사로 온 미국인 질레트(P. L. Gillett)가 황성기독청년회 회원들에게 야구를 가르친 것이 그 시초이다. 1906년 2월 11일 훈련원 터에서 YMCA팀 대 덕어(독일어)학교팀 사이에 최초의 야구경기가 열렸다. 20) 『황성신문』1909년 3월 21일자엔 다음과 같은 〈야구단 운동가〉라는 노래가 소개돼 있을 정도로 야구는 큰 인기를 누렸다. "무쇠 골격 돌 근육 소년 남아야/애국의 정신을 분발하여라/다달았네 다달았네 우리나라에/소년의 활동 시대 다달았네 /(후렴) 만인 대적(對敵) 연습하여 후일 전공 세우세/절세 영웅 대사업이 우리 목적이 아닌가"21)”+↑ Thurston (2000), p. 15; Official Rules/Foreword. Major League Baseball. 2009년 2월 2일에 확인. Official Rules/1.00—Objectives of the Game (Rules 1.01–1.03). Major League Baseball. 2009년 2월 2일에 확인. Official Rules/2.00—Definitions of Terms. Major League Baseball. 2009년 2월 2일에 확인. Official Rules/4.00—Starting and Ending a Game (Rule 4.10). Major League Baseball. 2009년 2월 2일에 확인.+↑ 클레온 왈푸드 "Most 'Signs' Given by Coaches Are Merely Camouflage", Baseball Digest, 1960년 12월 ~ 1961년 1월, pp. 47–49.+↑ 허진우. “메이저리그, 오는 8월 비디오 판독제 도입 추진”, 《일간스포츠》, 2008년 6월 15일 작성.+↑ 가 나 다 하일성 (1995년 5월 1일). 《최신 야구교실》. 국일미디어, 19쪽. ISBN 978-89-7425-228-1+↑ 야구교실, 하일성 p.23+↑ 가 나 다 “전진수비”. 두산백과사전. 2010년 11월 30일에 읽어봄.+↑ 야구교실, 하일성 p.46+↑ “다운스윙”. 두산백과사전. 2010년 11월 30일에 읽어봄.+↑ 가 나 (한국어) 조해연 (2007). 《조해연의 우리말 야구용어 풀이》. 지성사, 49쪽. ISBN 8978891489+↑ 앤드류 배스트 (2008년 7월 18일). Southpaw’s Revenge. 2009년 2월 8일에 확인.+↑ 이상주. “'내 맘대로 타격' 스위치 타자의 세계”, 《스포츠서울》, 2008년 9월 26일 작성. 2009년 2월 24일 확인.+↑ 최민규. “무사 1루, 희생 번트 대지 말라”, 《스포츠 2.0》, 2006년 12월 27일 작성. 2009년 2월 24일 확인.+↑ Baseball Strategies: Your Guide to the Game Within the Game, 스탤링스, 베넷, 42–43, 47–48.+↑ Baseball Strategies: Your Guide to the Game Within the Game, 스탤링스, 베넷, p. 45.+↑ “전진수비”. 두산백과사전. 2009년 2월 24일에 읽어봄.+↑ 야구교실, 하일성 p.306+↑ 송재우. “사인, 또 하나의 야구 묘미”, 《송재우 칼럼》, 2007년 6월 1일 작성. 2009년 2월 24일 확인.+↑ “그린라이트”. 표준국어대사전. 2009년 2월 23일에 읽어봄.+↑ Cohen, Morris Raphael, "Baseball as a National Religion" (1919), in Cohen, The Faith of a Liberal (Transaction, 1993 [1946]), pp. 334–336: p. 334.+↑ 가 나 다 할 보드레이, "Baseball wants just a few more minutes", USA투데이, 2004년 2월 26일+↑ 가 나 제프 그린필드, "Midnight Baseball", 타임, 1998년 7월 13일+↑ 신인하. “경기시간 단축운동을 벌이고 있는 일본 야구계”, 《야큐 리포트》, 2008년 5월 8일 작성. 2009년 2월 26일 확인.+↑ MLB 공식 웹사이트.+↑ 가 나 문상열. “타율 〉출루율 진기록 나왔다”, 《동아일보》, 2008년 5월 16일 작성. 2008년 1월 2일 확인.+↑ “장타율”. 두산백과사전. 2009년 1월 3일에 읽어봄.+↑ 김형준. “마이리그 Tip - 타율 대비 최고 생산성의 타자는?”, 《김형준 칼럼》, 2008년 9월 3일 작성. 2009년 1월 3일 확인.+↑ 이호영. “롯데 자이언츠, 가을에도 야구한다”, 《스포츠 2.0》, 2008년 12월 16일 작성. 2009년 1월 2일 확인.+↑ 유해길. “WBC '파란 태풍' 야구 세계화 초석되다”, 《세계일보》, 2006년 3월 20일 작성.+[편집]+바깥 고리	위키미디어 공용에 관련 미디어 분류가 있습니다. +야구+	위키낱말사전에 이 문서와 관련된 글이 있습니다. +야구++야구 조직/리그+(영어) 메이저 리그 야구 공식 홈페이지+(영어) 마이너 리그 야구 공식 홈페이지+(영어) 국제 야구 연맹+(영어) 영국 야구 연맹+(한국어) 대한 야구 협회+야구 기록+(영어) 위키아 야구+(영어) 베이스볼-레퍼런스 공식 홈페이지+(영어) 더베이스볼큐브 공식 홈페이지+(영어) 야구-연감 공식 홈페이지+야구 뉴스/그 외+(영어) 초기 야구 온라인 박물관 홈페이지+(영어) 스팔딩 가이드 회의 도서관 공식 홈페이지+(영어) 야구 신문 기록 홈페이지+(영어) 중국의 야구+(영어) 온라인 야구 뉴스/잡지+(영어) 야구 경기장 구조, 설계+(영어) 유럽 야구 및 소프트볼 뉴스·정보[보이기]+ 야구와 관련된 항목+++분류: 야구+둘러보기 메뉴+계정 만들기+로그인+연습장+문서+토론+읽기+편집+역사++대문+사용자 모임+요즘 화제+최근 바뀜+모든 문서 보기+임의 문서로+도움말+기부+도구모음+여기를 가리키는 문서+가리키는 글의 바뀜+공용에 올리기+특수 문서 목록+고유링크+문서 정보+이 문서 인용하기+인쇄/내보내기+다른 언어++ 이 문서는 2013년 1월 9일 (수) 14:40에 마지막으로 바뀌었습니다.+모든 문서는 크리에이티브 커먼즈 저작자표시-동일조건변경허락 3.0에 따라 사용할 수 있습니다. 추가적인 조건이 적용될 수 있습니다. 자세한 내용은 이용 규약을 참고하십시오.+Wikipedia®는 미국 및 다른 국가에 등록되어 있는, Wikimedia Foundation, Inc. 소유의 등록 상표입니다.+개인정보 정책+위키백과 소개+면책 조항+모바일판에서 보기
+ benchmark/Streamly/Benchmark/Unicode/data/Vietnamese.txt view
@@ -0,0 +1,402 @@+Mời bạn tham gia bình chọn giao diện mới cho trang chính Wikipedia tiếng Việt.+Thành phố Hồ Chí Minh+Bách khoa toàn thư mở Wikipedia + Bước tới: menu, tìm kiếm Thành phố Hồ Chí Minh+Thành phố trực thuộc trung ương++Bến Bạch Đằng  · UBND TP Hồ Chí Minh  · Nhà thờ Đức Bà Sài Gòn  · Cảng Sài Gòn  · Tòa nhà Bitexco Financial  · Chợ Bến Thành  · Nhà hát Thành phố+Biệt danh: Hòn ngọc Viễn Đông+Địa lý+Tọa độ: 10°46′10″B 106°40′55″Đ+Diện tích 	2.095,6 km²+Dân số 2011+ Tổng cộng	7.521.100 người[1]+ Mật độ 	3.589 người/km²+Múi giờ 	UTC+7+[hiện]+Vị trí thành phố trên bản đồ Việt Nam++Hành chính+Quốc gia 	Việt Nam+Thành lập 	1698: Nguyễn Hữu Cảnh lập phủ Gia Định+Tên khác 	Sài Gòn+Chính quyền 	 + Chủ tịch UBND 	Lê Hoàng Quân+ Chủ tịch HĐND 	Nguyễn Thị Quyết Tâm+ Bí thư Thành ủy 	Lê Thanh Hải+Phân chia hành chính 	19 quận và 5 huyện+Mã hành chính 	VN-65+Mã bưu chính 	70xxxx-76xxxx+Mã điện thoại 	8+Biển số xe 	50 → 59+Web: hochiminhcity.gov.vn+++Tọa độ: 10°46′10″B 106°40′55″Đ++Thành phố Hồ Chí Minh là thành phố đông dân nhất, đồng thời cũng là trung tâm kinh tế, văn hóa, giáo dục quan trọng của Việt Nam.++Vùng đất này ban đầu được gọi là Prey Nokor, thành phố sau đó hình thành nhờ công cuộc khai phá miền Nam của nhà Nguyễn. Năm 1698, Nguyễn Hữu Cảnh cho lập phủ Gia Định, đánh dấu sự ra đời thành phố. Khi người Pháp vào Đông Dương, để phục vụ công cuộc khai thác thuộc địa, thành phố Sài Gòn được thành lập và nhanh chóng phát triển, trở thành một trong hai đô thị quan trọng nhất Việt Nam, được mệnh danh Hòn ngọc Viễn Đông hay Paris Phương Đông. Sài Gòn là thủ đô của Liên Bang Đông Dương giai đoạn 1887-1901. Năm 1954, Sài Gòn trở thành thủ đô của Việt Nam Cộng hòa và thành phố hoa lệ này trở thành một trong những đô thị quan trọng của vùng Đông Nam Á. Việt Nam Cộng hòa sụp đổ năm 1975, lãnh thổ Việt Nam hoàn toàn thống nhất. Ngày 2 tháng 7 năm 1976, Quốc hội nước Việt Nam thống nhất quyết định đổi tên Sài Gòn thành "Thành phố Hồ Chí Minh", theo tên vị Chủ tịch nước đầu tiên của Việt Nam Dân chủ Cộng hòa.++Nằm trong vùng chuyển tiếp giữa miền Đông Nam Bộ và Tây Nam Bộ, Thành phố Hồ Chí Minh ngày nay bao gồm 19 quận và 5 huyện, tổng diện tích 2.095,01 km². Theo kết quả điều tra dân số chính thức vào thời điểm 0 giờ ngày 1 tháng 4 năm 2009 thì dân số thành phố là 7.162.864 người (chiếm 8,34% dân số Việt Nam), mật độ trung bình 3.419 người/km². Đến ngày 1/4/2010 theo số liệu của Tổng cục Thống kê, dân dố thành phố tăng lên 7.382.287 người. Tuy nhiên nếu tính những người cư trú không đăng ký thì dân số thực tế của thành phố vượt trên 8 triệu người. Giữ vai trò quan trọng trong nền kinh tế Việt Nam, Thành phố Hồ Chí Minh chiếm 21,3% tổng sản phẩm (GDP) và 29,38% tổng thu ngân sách của cả nước[2][3]. Nhờ điều kiện tự nhiên thuận lợi, Thành phố Hồ Chí Minh trở thành một đầu mối giao thông quan trọng của Việt Nam và Đông Nam Á, bao gồm cả đường bộ, đường sắt, đường thủy và đường không. Vào năm 2007, thành phố đón khoảng 3 triệu khách du lịch quốc tế, tức 70% lượng khách vào Việt Nam. Các lĩnh vực giáo dục, truyền thông, thể thao, giải trí, Thành phố Hồ Chí Minh đều giữ vai trò quan trọng bậc nhất.++Tuy vậy, Thành phố Hồ Chí Minh đang phải đối diện với những vấn đề của một đô thị lớn có dân số tăng quá nhanh. Trong nội ô thành phố, đường sá trở nên quá tải, thường xuyên ùn tắc. Hệ thống giao thông công cộng kém hiệu quả. Môi trường thành phố cũng đang bị ô nhiễm do phương tiện giao thông, các công trường xây dựng và công nghiệp sản xuất.Mục lục  [ẩn] +1 Địa lý +1.1 Vị trí, địa hình+1.2 Địa chất, thủy văn+1.3 Khí hậu, thời tiết+1.4 Môi trường+2 Lịch sử +2.1 Thời kỳ hoang sơ+2.2 Khai phá+2.3 Từ Gia Định tới Sài Gòn+2.4 Thủ đô Sài Gòn+2.5 Thành phố Hồ Chí Minh+3 Hành chính+4 Kinh tế+5 Xã hội +5.1 Dân cư+5.2 Y tế+5.3 Giáo dục+6 Giao thông vận tải+7 Quy hoạch và kết cấu đô thị+8 Du lịch+9 Văn hóa +9.1 Truyền thông+9.2 Thể dục, thể thao+9.3 Trung tâm văn hóa, giải trí+10 Thành phố kết nghĩa+11 Chú thích+12 Liên kết ngoài++Địa lý+Vị trí, địa hình++Thành phố Hồ Chí Minh có tọa độ 10°10' – 10°38' Bắc và 106°22' – 106°54' Đông, phía Bắc giáp tỉnh Bình Dương, Tây Bắc giáp tỉnh Tây Ninh, Đông và Đông Bắc giáp tỉnh Đồng Nai, Đông Nam giáp tỉnh Bà Rịa - Vũng Tàu, Tây và Tây Nam giáp tỉnh Long An và Tiền Giang. Nằm ở miền Nam Việt Nam, Thành phố Hồ Chí Minh cách Hà Nội 1.730 km theo đường bộ, trung tâm thành phố cách bờ biển Đông 50 km theo đường chim bay. Với vị trí tâm điểm của khu vực Đông Nam Á, Thành phố Hồ Chí Minh là một đầu mối giao thông quan trọng về cả đường bộ, đường thủy và đường không, nối liền các tỉnh trong vùng và còn là một cửa ngõ quốc tế[4].++Nằm trong vùng chuyển tiếp giữa miền Đông Nam Bộ và đồng bằng sông Cửu Long, địa hình thành phố thấp dần từ Bắc xuống Nam và từ Tây sang Đông. Vùng cao nằm ở phía Bắc - Đông Bắc và một phần Tây Bắc, trung bình 10 đến 25 mét. Xen kẽ có một số gò đồi, cao nhất lên tới 32 mét như đồi Long Bình ở quận 9. Ngược lại, vùng trũng nằm ở phía Nam - Tây Nam và Ðông Nam thành phố, có độ cao trung bình trên dưới 1 mét, nơi thấp nhất 0,5 mét. Các khu vực trung tâm, một phần các quận Thủ Đức, quận 2, toàn bộ huyện Hóc Môn và quận 12 có độ cao trung bình, khoảng 5 tới 10 mét[5].++Thành phố Hồ Chí Minh gồm có bốn điểm cực:+Cực Bắc là xã Phú Mỹ Hưng, huyện Củ Chi.+Cực Tây là xã Thái Mỹ, huyện Củ Chi.+Cực Nam là xã Long Hòa, huyện Cần Giờ.+Cực Đông là xã Thạnh An, huyện Cần Giờ.+Địa chất, thủy văn+ +Sông Sài Gòn đoạn qua trung tâm thành phố và bán đảo Thủ Thiêm++Địa chất Thành phố Hồ Chí Minh bao gồm chủ yếu là hai tướng trầm tích Pleistocen và Holocen lộ ra trên bề mặt. Trầm tích Pleistocen chiếm hầu hết phần Bắc, Tây Bắc và Đông Bắc thành phố. Dưới tác động của các yếu tố tự nhiên và hoạt động của con người, trầm tích phù sa cổ hình thành nhóm đất đặc trưng riêng: đất xám. Với hơn 45 nghìn hecta, tức khoảng 23,4% diện tích thành phố, đất xám ở Thành phố Hồ Chí Minh có ba loại: đất xám cao, đất xám có tầng loang lổ đỏ vàng và hiếm hơn là đất xám gley. Trầm tích Holocen ở Thành phố Hồ Chí Minh có nhiều nguồn gốc: biển, vũng vịnh, sông biển, bãi bồi... hình thành nhiều loại đất khác nhau: nhóm đất phù sa biển với 15.100 ha, nhóm đất phèn với 40.800 ha và đất phèn mặn với 45.500 ha. Ngoài ra còn có một diện tích khoảng hơn 400 ha là "giồng" cát gần biển và đất feralite vàng nâu bị xói mòn trơ sỏi đá ở vùng đồi gò[6].++Về thủy văn, nằm ở vùng hạ lưu hệ thống sông Ðồng Nai - Sài Gòn, Thành phố Hồ Chí Minh có mạng lưới sông ngòi kênh rạch rất đa dạng. Sông Ðồng Nai Bắt nguồn từ cao nguyên Lâm Viên, hợp lưu bởi nhiều sông khác, có lưu vực lớn, khoảng 45.000 km². Với lưu lượng bình quân 20–500 m³/s, hàng năm cung cấp 15 tỷ m³ nước, sông Đồng Nai trở thành nguồn nước ngọt chính của thành phố. Sông Sài Gòn bắt nguồn từ vùng Hớn Quản, chảy qua Thủ Dầu Một đến Thành phố Hồ Chí Minh, với chiều dài 200 km và chảy dọc trên địa phận thành phố dài 80 km. Sông Sài Gòn có lưu lượng trung bình vào khoảng 54 m³/s, bề rộng tại thành phố khoảng 225 m đến 370 m, độ sâu tới 20 m. Nhờ hệ thống kênh Rạch Chiếc, hai con sông Đồng Nai và Sài Gòn nối thông ở phần nội thành mở rộng. Một con sông nữa của Thành phố Hồ Chí Minh là sông Nhà Bè, hình thành ở nơi hợp lưu hai sông Đồng Nai và Sài Gòn, chảy ra biển Đông bởi hai ngả chính Soài Rạp và Gành Rái. Trong đó, ngả Gành Rái chính là đường thủy chính cho tàu ra vào bến cảng Sài Gòn. Ngoài các con sông chính, Thành phố Hồ Chí Minh còn có một hệ thống kênh rạch chằng chịt: Láng The, Bàu Nông, rạch Tra, Bến Cát, An Hạ, Tham Lương, Cầu Bông, Nhiêu Lộc-Thị Nghè, Bến Nghé, Lò Gốm, Kênh Tẻ, Tàu Hũ, Kênh Ðôi...Hệ thống sông, kênh rạch giúp Thành phố Hồ Chí Minh trong việc tưới tiêu, nhưng do chịu ảnh hưởng dao động triều bán nhật của biển Ðông, thủy triều thâm nhập sâu đã gây nên những tác động xấu tới sản xuất nông nghiệp và hạn chế việc tiêu thoát nước ở khu vực nội thành[7].++Nhờ trầm tích Pleistocen, khu vực phía Bắc Thành phố Hồ Chí Minh có được lượng nước ngầm khá phong phú. Nhưng về phía Nam, trên trầm tích Holocen, nước ngầm thường bị nhiễm phèn, nhiễm mặn. Khu vực nội thành cũ có lượng nước ngầm đáng kể, tuy chất lượng không thực sự tốt, vẫn được khai thác chủ yếu ở ba tầng: 0–20 m, 60–90 m và 170–200 m (tầng trầm tích Miocen). Tại Quận 12, các huyện Hóc Môn và Củ Chi, chất lượng nước tốt, trữ lượng dồi dào, thường được khai thác ở tầng 60–90 m, trở thành nguồn nước bổ sung quan trọng.[7]+Khí hậu, thời tiết++Nằm trong vùng nhiệt đới xavan, Thành phố Hồ Chí Mình có nhiệt độ cao đều trong năm và hai mùa mưa – khô rõ rệt. Mùa mưa được bắt đầu từ tháng 5 tới tháng 11, còn mùa khô từ tháng 12 tới tháng 4 năm sau. Trung bình, Thành phố Hồ Chí Minh có 160 tới 270 giờ nắng một tháng, nhiệt độ trung bình 27 °C, cao nhất lên tới 40 °C, thấp nhất xuống 13,8 °C. Hàng năm, thành phố có 330 ngày nhiệt độ trung bình 25 tới 28 °C. Lượng mưa trung bình của thành phố đạt 1.949 mm/năm, trong đó năm 1908 đạt cao nhất 2.718 mm, thấp nhất xuống 1.392 mm vào năm 1958. Một năm, ở thành phố có trung bình 159 ngày mưa, tập trung nhiều nhất vào các tháng từ 5 tới 11, chiếm khoảng 90%, đặc biệt hai tháng 6 và 9. Trên phạm vi không gian thành phố, lượng mưa phân bố không đều, khuynh hướng tăng theo trục Tây Nam – Ðông Bắc. Các quận nội thành và các huyện phía Bắc có lượng mưa cao hơn khu vực còn lại[8].++Thành phố Hồ Chí Minh chịu ảnh hưởng bởi hai hướng gió chính là gió mùa Tây – Tây Nam và Bắc – Ðông Bắc. Gió Tây – Tây Nam từ Ấn Độ Dương, tốc độ trung bình 3,6 m/s, vào mùa mưa. Gió Gió Bắc – Ðông Bắc từ biển Đông, tốc độ trung bình 2,4 m/s, vào mùa khô. Ngoài ra còn có gió tín phong theo hướng Nam – Đông Nam vào khoảng tháng 3 tới tháng 5, trung bình 3,7 m/s. Có thể nói Thành phố Hồ Chí Minh thuộc vùng không có gió bão. Cũng như lượng mưa, độ ẩm không khí ở thành phố lên cao vào mùa mưa (80%), và xuống thấp vào mùa khô (74,5%). Bình quân độ ẩm không khí đạt 79,5%/năm[8].+ Khí hậu Thành phố Hồ Chí MinhTháng	1	2	3	4	5	6	7	8	9	10	11	12+Trung bình tối cao °C (°F)	32 (90)	33 (91)	34 (93)	34 (93)	33 (91)	32 (90)	31 (88)	32 (90)	31 (88)	31 (88)	30 (86)	31 (88)+Trung bình tối thấp °C (°F)	21 (70)	22 (72)	23 (73)	24 (75)	25 (77)	24 (75)	25 (77)	24 (75)	23 (73)	23 (73)	22 (72)	22 (72)+Lượng mưa mm (inch)	14 (0.6)	4 (0.2)	12 (0.5)	42 (1.7)	220 (8.7)	331 (13)	313 (12.3)	267 (10.5)	334 (13.1)	268 (10.6)	115 (4.5)	56 (2.2)++Nguồn: Đại sứ quán Việt Nam tại London[9] 26 tháng 2 năm 2008.+Môi trường++Với tốc độ gia tăng dân số quá nhanh, cơ sở hạ tầng chưa kịp quy hoạch nâng cấp tổng thể, ý thức một số người dân lại quá kém trong nhận thức và bảo vệ môi trường chung... Vì vậy, Thành phố Hồ Chí Minh hiện nay đang phải đối mặt với vấn đề ô nhiễm môi trường quá lớn. Hiện trạng nước thải không được xử lý đổ thẳng vào hệ thống sông ngòi còn rất phổ biến. Nhiều cơ sở sản xuất, bệnh viện và cơ sở y tế chưa có hệ thống xử lý nước thải là một thực trạng đáng báo động[10]. Tại cụm công nghiệp Tham Lương, nguồn nước bị nhiễm bẩn bởi chất thải công nghiệp với tổng lượng nước thải ước tính 500.000 m³/ngày[11]. Sông Sài Gòn, mức độ ô nhiễm vi sinh chủ yếu do hoạt động nuôi trồng thuỷ sản gây ra vượt tiêu chuẩn cho phép đến 220 lần. Cho tới 2008, vẫn chưa có giải pháp cụ thể nào để chấm dứt tình trạng ô nhiễm này[12].++Lượng rác thải ở Thành phố Hồ Chí Minh lên tới 6.000 tấn/ngày, trong đó một phần lượng rác thải rắn không được thu gom hết. Kết quả quan trắc năm 2007 cho thấy, so với năm 2006, sự ô nhiễm hữu cơ tăng 2 đến 4 lần. Các phương tiện giao thông, hoạt động xây dựng, sản xuất... còn góp phần gây ô nhiễm không khí. Khu vực ngoại thành, đất cũng bị ô nhiễm do tồn đọng thuốc bảo vệ thực vật từ sản xuất nông nghiệp gây nên[13].++Tình trạng ngập lụt trong trung tâm thành phố đang ở mức báo động cao, xảy ra cả trong mùa khô. Diện tích khu vực ngập lụt khoảng 140 km2 với 85% điểm ngập nước nằm ở khu vực trung tâm. Thiệt hại do ngập nước gây ra ước tính 8 tỷ đồng mỗi năm. Nguyên nhân là do hệ thống cống thoát nước được xây cách đây 50 năm đã xuống cấp. Ngoài ra, việc xây dựng các khu công nghiệp và đô thị ở khu vực phía nam – khu vực thoát nước của thành phố này đã làm cho tình hình ngập càng nghiêm trọng hơn[14].++Trước những bức xúc về thực trạng môi trường, Thành phố Hồ Chí Minh đang khẩn trương tìm mọi cách nâng cao chất lượng cuộc sống của người dân trên địa bàn. Việc trích ra một nguồn vốn lớn nhiều tỷ đồng đầu tư xây dựng hồ sinh học cải tạo nước kênh Ba Bò là một ví dụ[15].+Lịch sử+Bài chi tiết: Lịch sử Thành phố Hồ Chí Minh+Thời kỳ hoang sơ++Con người xuất hiện ở khu vực Sài Gòn từ khá sớm. Các cuộc khai quật khảo cổ trên địa phận Sài Gòn và khu vực lân cận cho thấy ở đây đã tồn tại nhiều nền văn hóa từ thời kỳ đồ đá cho tới thời kim khí. Những cư dân cổ từ nhiều thiên niên kỷ về trước đã biết đến kỹ thuật canh tác nông nghiệp. Văn hóa Sa Huỳnh từng tồn tại trên khu vực này với những nét rất riêng. Thời kỳ văn hóa Óc Eo, từ đầu Công Nguyên cho tới thế kỷ 7, khu vực miền Nam Đông Dương có nhiều tiểu quốc và Sài Gòn khi đó là miền đất có quan hệ với những vương quốc này.++Cho đến trước thế kỷ 16, vị trí tiếp giáp với các quốc gia cổ cũng khiến Sài Gòn trở thành nơi gặp gỡ của nhiều cộng đồng dân cư. Nhưng những cuộc tranh chấp đã khiến vùng đất Sài Gòn - Gia Định vẫn là miền đất hoang, vô chủ, địa bàn của vài nhóm dân cư cổ cho tới khi người Việt xuất hiện[16].+Khai phá+ + Sơ đồ Thành Bát Quái, công trình được xây dựng năm 1790++Những người Việt đầu tiên tự động vượt biển tới khai vùng đất này hoàn toàn không có sự tổ chức của nhà Nguyễn. Nhờ cuộc hôn nhân giữa công nữ Ngọc Vạn với vua Chân Lạp Chey Chetta II từ năm 1620, mối quan hệ giữa Đại Việt và Chân Lạp trở nên êm đẹp, dân cư hai nước có thể tự do qua lại sinh sống. Khu vực Sài Gòn, Đồng Nai bắt đầu xuất hiện những người Việt định cư. Trước đó, người Chăm, người Man cũng sinh sống rải rác ở đây từ xa xưa[17].++Giai đoạn từ 1623 tới 1698 được xem như thời kỳ hình thành của Sài Gòn sau này[18]. Năm 1623, chúa Nguyễn sai một phái bộ tới yêu cầu vua Chey Chettha II cho lập đồn thu thuế tại Prei Nokor (Sài Gòn) và Kas Krobei (Bến Nghé). Tuy đây là vùng rừng rậm hoang vắng nhưng lại nằm trên đường giao thông của các thương nhân Việt Nam qua Campuchia và Xiêm. Hai sự kiện quạn trọng tiếp theo của thời kỳ này là lập doanh trại và dinh thự của Phó vương Nặc Nộn và lập đồn dinh ở Tân Mỹ (gần ngã tư Cống Quỳnh - Nguyễn Trãi ngày nay). Có thể nói Sài Gòn hình thành từ ba cơ quan chính quyền này[18].++Năm 1679, chúa Nguyễn Phúc Tần cho một nhóm người Hoa "phản Thanh phục Minh" tới Mỹ Tho, Biên Hòa và Sài Gòn để lánh nạn. Đến năm 1698, chúa Nguyễn sai Nguyễn Hữu Cảnh kinh lý vào miền Nam. Trên cơ sở những lưu dân Việt đã tự phát tới khu vực này trước đó, Nguyễn Hữu Cảnh cho lập phủ Gia Định và hai huyện Phước Long, Tân Bình. Vùng Nam Bộ được sát nhập vào cương vực Việt Nam[19].++Thời điểm ban đầu này, khu vực Biên Hòa, Gia Định có khoảng 10.000 hộ với 200.000 khẩu. Công cuộc khai hoang được tiến hành theo những phương thức mới, mang lại hiệu quả hơn. Năm 1802, sau khi chiến thắng Tây Sơn, Nguyễn Ánh lên ngôi và đẩy mạnh công cuộc khai khẩn miền Nam. Các công trình kênh đào Rạch Giá - Hà Tiên, Vĩnh Tế... được thực hiện. Qua 300 năm, các trung tâm nông nghiệp phát triển bao quanh những đô thị sầm uất được hình thành[20].+Từ Gia Định tới Sài Gòn++Năm 1788, Nguyễn Ánh tái chiếm Sài Gòn, lấy nơi đây làm cơ sở để chống lại Tây Sơn. Năm 1790, với sự giúp đỡ của hai sĩ quan công binh người Pháp, Theodore Lebrun và Victor Olivier de Puymanel, Nguyễn Ánh cho xây dựng Thành Bát Quái làm trụ sở của chính quyền mới. "Gia Định thành" khi đó được đổi thành "Gia Định kinh"[21]. Tới năm 1802, Nguyễn Ánh lên ngôi ở Huế, miền Nam được chia thành 5 trấn. Sáu năm sau, 1808, "Gia Định trấn" lại được đổi thành "Gia Định thành". Trong khoảng thời gian 1833 đến 1835, Lê Văn Khôi khởi binh chống lại nhà Nguyễn, Thành Bát Quái trở thành địa điểm căn cứ. Sau khi trấn áp cuộc nổi dậy, năm 1835, vua Minh Mạng cho phá Thành Bát Quái, xây dựng Phụng Thành thay thế[22].+ +Chợ Bến Thành, Sài Gòn thời thuộc địa với những cột Morris đặc trưng của Pháp.++Ngay sau khi chiếm được thành Gia Định vào năm 1859, người Pháp gấp rút quy hoạch lại Sài Gòn thành một đô thị lớn phục vụ mục đích khai thác thuộc địa. Theo thiết kế ban đầu, Sài Gòn bao gồm cả khu vực Chợ Lớn. Nhưng đến 1864, nhận thấy diện tích dự kiến của thành phố quá rộng, khó bảo đảm về an ninh, chính quyền Pháp quyết định tách Chợ Lớn khỏi Sài Gòn. Rất nhanh chóng, các công trình quan trọng của thành phố, như Dinh Thống đốc Nam Kỳ, Dinh Toàn quyền, được thực hiện. Sau hai năm xây dựng và cải tạo, bộ mặt Sài Gòn hoàn toàn thay đổi[23].++Thành phố Sài Gòn khi đó được thiết kế theo mô hình châu Âu, nơi đặt văn phòng nhiều cơ quan công vụ như: dinh thống đốc, nha giám đốc nội vụ, tòa án, tòa thượng thẩm, tòa sơ thẩm, tòa án thương mại, tòa giám mục... Lục tỉnh Nam Kỳ là thuộc địa của Pháp và Sài Gòn nằm trong tỉnh Gia Định. Vào năm 1861, địa phận Sài Gòn được giới hạn bởi một bên là rạch Thị Nghè và rạch Bến Nghé với một bên là sông Sài Gòn cùng con đường nối liền chùa Cây Mai với những phòng tuyến cũ của đồn Kỳ Hòa. Đến năm 1867, việc quản lý Sài Gòn được giao cho Ủy ban thành phố gồm 1 ủy viên và 12 hội viên. Cho tới nửa đầu thập niên 1870, thành phố Sài Gòn vẫn nằm trong địa hạt hành chính tỉnh Gia Định[23]. Ngày 15 tháng 3 năm 1874, Tổng thống Pháp Jules Grévy ký sắc lệnh thành lập thành phố Sài Gòn[22]. Đứng đầu là viên Thị trưởng người Pháp. Đến năm 1879 thì chính quyền cho lập thêm Hội đồng thành phố Sài Gòn (hay đúng ra là Ủy hội thành phố - Commission municipale).[24]++Trong suốt thời kỳ Pháp thuộc, Sài Gòn trở thành trung tâm quan trọng, không chỉ hành chính mà còn kinh tế, văn hóa, giáo dục của cả Liên bang Đông Dương, được mệnh danh là Hòn ngọc Viễn Đông" ("the Pearl of the Far East") hoặc "Paris Phương Đông" ("Paris in the Orient")[cần dẫn nguồn].++Tính đến năm 1945 thì thành phố Sài Gòn-Chợ Lớn có dân số là 500.000. Chiến tranh Đông Dương tác động cuộc di dân từ nông thôn lên thành thị khiến bốn năm sau, 1949 thì dân số tăng hơn gấp đôi thành 1.200.000 và sang năm 1954 với hàng trăm nghìn người di cư vào Nam từ phía bắc vĩ tuyến 17 thì dân số Sài Gòn leo cao, đạt 2.000.000.[25]+Thủ đô Sài Gòn+ + Tòa đô chánh Saigon 1966++Từ năm 1949, Sài Gòn đã là thủ đô của Quốc gia Việt Nam. Đến năm 1955, Việt Nam Cộng hòa được thành lập, Sài Gòn trở thành thủ đô và cũng là thành phố lớn nhất của quốc gia non trẻ này với tên gọi chính thức "Thành đô Sài Gòn" (lưu ý, cách viết thông dụng là "Saigon"). Cũng năm 1954, thành phố tiếp nhận một lượng di dân mới từ miền Bắc Việt Nam (phần đông là người Công Giáo, còn gọi là dân Bắc Kỳ Công giáo) tập trung tại các khu vực như Xóm Mới-Gò Vấp, Bình An-quận 8, và rải rác tại các quận khác. Với nghị định số 110-NV ngày 27 tháng 3 năm 1959 của Tổng thống Ngô Đình Diệm, từ 6 quận, Sài Gòn được chia thành 8 quận với tổng cộng 45 phường.++Vào nửa cuối thập niên 1950, nhờ sự phát triển của kinh tế Việt Nam Cộng hòa và viện trợ của Chính phủ Hoa Kỳ và các nước đồng minh, Sài Gòn trở thành một thành phố hoa lệ với mệnh danh "Hòn ngọc Viễn Đông".[26] Từ giữa thập niên 1960 đến những năm đầu thập niên 1970, việc Quân đội Hoa Kỳ vào tham chiến tại miền Nam cũng gây nên những xáo trộn đối với thành phố. Nhiều cao ốc, công trình quân sự mọc lên[27]. Lối sống của giới trẻ Sài Gòn cũng chịu ảnh hưởng bởi văn hóa Âu Mỹ. Thành phố trở thành một trung tâm về chính trị, kinh tế, văn hóa, giải trí.++Nhưng tới những năm cuối của cuộc Chiến tranh Việt Nam, nền kinh tế miền Nam đi xuống do Mỹ cắt giảm viện trợ, nạn lạm phát trở nên nghiêm trọng. Hệ lụy và hậu quả trực tiếp của cuộc chiến gây ảnh hưởng xấu tới đô thị Sài Gòn. Sự kiện 30 tháng 4 năm 1975 đã khiến nhiều người dân Sài Gòn rời bỏ thành phố ra nước ngoài định cư.[28] Cũng trong thời gian này, ước tính 700.000 người khác được vận động đi kinh tế mới; nền văn hóa có ảnh hưởng phương Tây bị lu mờ rồi tàn lụi.[29]+Thành phố Hồ Chí Minh++Từ 30/04/1975, Chính quyền Việt Nam Cộng hòa bị xóa bỏ và Chính phủ Cách mạng lâm thời Cộng Hòa miền Nam Việt Nam - nằm dưới sự chỉ đạo của Đảng Cộng sản Việt Nam - quản lý miền Nam. Thành Đô Sài Gòn, tỉnh Gia Định và 2 quận Củ Chi và Phú Hòa kế cận dưới thời chính quyền Việt Nam Cộng hòa, được hợp nhất thành 1 đơn vị hành chính gọi là thành phố Sài Gòn - Gia Định. Đầu năm 1976, Đảng bộ và Ủy ban Nhân dân thành phố bắt đầu hoạt động. Ngày 2 tháng 7 năm 1976, Quốc hội đầu tiên của nước Việt Nam thống nhất quyết định đổi tên nước thành Cộng hòa Xã hội Chủ nghĩa Việt Nam, đồng thời đổi tên thành phố Sài Gòn - Gia Định thành "Thành phố Hồ Chí Minh", theo tên cuối cùng của chủ tịch nước đầu tiên, Hồ Chí Minh[30].+ +Dinh Độc Lập, công trình tiêu biểu của Sài Gòn trước 1975++Với tổng diện tích 2.095 km², Thành phố Hồ Chí Minh trở thành đô thị lớn nhất Việt Nam. 11 quận nội thành của Sài Gòn trước đây được chia lại thành 8 quận. Bốn quận Gò Vấp, Phú Nhuận, Bình Thạnh, Tân Bình được thành lập. Khu vực ngoại thành gồm 5 huyện: Thủ Đức, Hóc Môn, Củ Chi, Bình Chánh, Nhà Bè. Năm 1978, thành phố nhận thêm huyện Duyên Hải của tỉnh Đồng Nai. Năm 1979, các đơn vị hành chính cơ sở được phân chia lại, toàn thành phố có 261 phường, 86 xã. Sau đợt điều chỉnh tiếp theo vào năm 1989, thành phố còn 182 phường và 100 xã, thị trấn. Đến năm 1997, phân chia hành chính của thành phố lại thay đổi, gồm 17 quận, 5 huyện với 303 phường xã, thị trấn. Hiện nay, Thành phố Hồ Chí Minh gồm 19 quận nội thành và 5 huyện ngoại thành với 322 phường, xã và thị trấn[31].+Hành chính+Bài chi tiết: Tổ chức hành chính tại Thành phố Hồ Chí Minh+ +Trụ sở Ủy ban Nhân dân Thành phố++Thành phố Hồ Chí Minh hiện nay là một trong 5 thành phố trực thuộc Trung ương của Việt Nam. Về mặt hành chính, thành phố được chia thành 19 quận và 5 huyện.+Quận (19): 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, Bình Tân, Bình Thạnh, Gò Vấp, Phú Nhuận, Tân Bình, Tân Phú, Thủ Đức.+Huyện (5): Bình Chánh, Cần Giờ, Củ Chi, Hóc Môn, Nhà Bè.++Toàn thành phố có 322 đơn vị hành chính cấp xã, bao gồm: 259 phường, 58 xã và 5 thị trấn.. Với tổng diện tích 2.095,01 km², theo kết quả chính thức điều tra dân số ngày 01/04/2009 dân số thành phố là 7.162.864 người, mật độ 3.419 người/km². Lượng dân cư này tập trung chủ yếu trong nội thành, gồm 5.881.511 người, mật độ lên tới 11.906 người/km². Trong khi đó các huyện ngoại thành chỉ có 1.281.353 người, đạt 801 người/km².++Về hành chính, Hội đồng Nhân dân thành phố, với các đại biểu được bầu cử trực tiếp nhiệm kỳ 5 năm, có quyền quyết định các kế hoạch phát triển dài hạn về kinh tế, văn hóa, giáo dục... của thành phố. Đứng đầu Hội đồng Nhân dân gồm một Chủ tịch, một Phó chủ tịch và một Uỷ viên thường trực. Hội đồng Nhân dân chịu sự giám sát và hướng dẫn hoạt động của Ủy ban Thường vụ Quốc hội, chịu sự hướng dẫn và kiểm tra của Chính phủ trong việc thực hiện các văn bản của cơ quan nhà nước cấp trên theo quy định của Uỷ ban Thường vụ Quốc hội[32].++Hội đồng Nhân dân thành phố bầu nên Ủy ban Nhân dân, cơ quan trực tiếp chịu trách nhiệm quản lý về mọi hoạt động chính trị, an ninh, kinh tế và văn hóa trên địa bàn thành phố. Đứng đầu Ủy Ban Nhân dân gồm một Chủ tịch và các Phó chủ tịch. Các sở, ngành của Ủy ban Nhân dân sẽ quản lý về các lĩnh vực cụ thể, như y tế, giáo dục, đầu tư, tư pháp, tài chính. Tương tự, cấp quận, huyện cũng có Hội đồng Nhân dân và Ủy ban Nhân dân chịu sự chỉ đạo chung của cấp thành phố. Ngoài ra, Ủy ban Nhân dân còn quản lý một số tổng công ty trên địa bàn thành phố[33].++Bên cạnh Chủ tịch Hội đồng Nhân dân và Chủ tịch Ủy ban Nhân dân, đảng bộ Đảng Cộng sản Việt Nam tại thành phố còn bầu ra Bí thư Thành ủy. Quyền hạn và trách nhiệm của Bí thư Thành ủy được quy định theo Điều lệ Đảng Cộng sản Việt Nam. Vào năm 1995, hệ thống quản lý hành chính nhà nước trên địa bàn Thành phố Hồ Chí Minh có 976 địa chỉ, trong đó 47 thuộc trung ương, 73 thuộc thành phố, 549 thuộc các quận, huyện và 307 thuộc cấp phường xã. Các tổ chức đoàn thể, chính trị bao gồm cấp trung ương và thành phố có 291 địa chỉ, các đơn vị sự nghiệp có 2.719 địa chỉ.+Kinh tế+Bài chi tiết: Kinh tế Thành phố Hồ Chí Minh+ + Trung tâm thương mại Diamond Plaza++Thành phố Hồ Chí Minh giữ vai trò đầu tàu kinh tế của cả Việt Nam. Thành phố chiếm 0,6% diện tích và 8,34% dân số của Việt Nam nhưng chiếm tới 20,2% tổng sản phẩm, 27,9% giá trị sản xuất công nghiệp và 34,9% dự án nước ngoài[34]. Vào năm 2005, Thành phố Hồ Chí Minh có 4.344.000 lao động, trong đó 139 nghìn người ngoài độ tuổi lao động nhưng vẫn đang tham gia làm việc[35]. Năm 2010, thu nhập bình quân đầu người ở thành phố đạt 2.800 USD/năm, cao hơn nhiều so với trung bình cả nước, 1168 USD/năm.[36]. Tổng GDP cả năm 2010 đạt 418.053 tỷ đồng (tính theo gía thực tế khoảng 20,902 tỷ USD), tốc độ tăng trưởng đạt 11.8%[37].+ +Tòa nhà Bitexco Financial tại trung tâm Thành Phố vào ban đêm++Nền kinh tế của Thành phố Hồ Chí Minh đa dạng về lĩnh vực, từ khai thác mỏ, thủy sản, nông nghiệp, công nghiệp chế biến, xây dựng đến du lịch, tài chính... Cơ cấu kinh tế của thành phố, khu vực nhà nước chiếm 33,3%, ngoài quốc doanh chiếm 44,6%, phần còn lại là khu vực có vốn đầu tư nước ngoài. Về các ngành kinh tế, dịch vụ chiếm tỷ trọng cao nhất: 51,1%. Phần còn lại, công nghiệp và xây dựng chiếm 47,7%, nông nghiệp, lâm nghiệp và thủy sản chỉ chiếm 1,2%[38].++Tính đến giữa năm 2006, 3 khu chế xuất và 12 khu công nghiệp Thành phố Hồ Chí Minh đã thu hút được 1.092 dự án đầu tư, trong đó có 452 dự án có vốn đầu tư nước ngoài với tổng vốn đầu tư hơn 1,9 tỉ USD và 19,5 nghìn tỉ VND[39]. Thành phố cũng đứng đầu Việt Nam tổng lượng vốn đầu tư trực tiếp nước ngoài với 2.530 dự án FDI, tổng vốn 16,6 tỷ USD vào cuối năm 2007[40]. Riêng trong năm 2007, thành phố thu hút hơn 400 dự án với gần 3 tỷ USD[41]. Trong bảng xếp hạng về Chỉ số năng lực cạnh tranh cấp tỉnh của Việt Nam năm 2011, thành phố Hồ Chí Minh xếp ở vị trí thứ 20/63 tỉnh thành.[42]++Về thương mại, Thành phố Hồ Chí Minh có một hệ thống trung tâm mua sắm, siêu thị, chợ đa dạng. Chợ Bến Thành là biểu tượng về giao lưu thương mại từ xa xưa của thành phố, hiện nay vẫn giữ một vai trò quan trọng. Những thập niên gần đây, nhiều trung tâm thương mại hiện đại xuất hiện như Saigon Trade Centre, Diamond Plaza... Mức tiêu thụ của Thành phố Hồ Chí Minh cũng cao hơn nhiều so với các tỉnh khác của Việt Nam và gấp 1,5 lần thủ đô Hà Nội[43]. Sở Giao dịch Chứng khoán Thành phố Hồ Chí Minh, có mã giao dịch là VN-Index, được thành lập vào tháng 7 năm 1998. Tính đến ngày 31 tháng 12 năm 2007, toàn thị trường đã có 507 loại chứng khoán được niêm yết, trong đó có 138 cổ phiếu với tổng giá trị vốn hóa đạt 365 nghìn tỷ đồng[44].++Tuy vậy, nền kinh tế của Thành phố Hồ Chí Minh vẫn phải đối mặt với nhiều khó khăn. Toàn thành phố chỉ có 10% cơ sở công nghiệp có trình độ công nghệ hiện đại. Trong đó, có 21/212 cơ sở ngành dệt may, 4/40 cơ sở ngành da giày, 6/68 cơ sở ngành hóa chất, 14/144 cơ sở chế biến thực phẩm, 18/96 cơ sở cao su nhựa, 5/46 cơ sở chế tạo máy... có trình độ công nghệ, kỹ thuật sản xuất tiên tiến[45]. Cơ sở hạ tầng của thành phố lạc hậu, quá tải, chỉ giá tiêu dùng cao, tệ nạn xã hội, hành chính phức tạp... cũng gây khó khăn cho nền kinh tế[41]. Ngành công nghiệp thành phố hiện đang hướng tới các lĩnh vực cao, đem lại hiệu quả kinh tế hơn.+Xã hội+Dân cư+Vào tháng 05/1975 dân số thành phố Sài Gòn - Gia Định (đến tháng 07/1976 đổi tên thành Thành phố Hồ Chí Minh) là 3.498.120 người (thống kê của chính quyền thành phố).+Dân số Thành phố Hồ Chí Minh theo các kết quả điều tra dân số chính thức như sau: +Ngày 1/10/1979 (Điều tra toàn quốc): 3.419.977 người.[46]+Ngày 1/4/1989 (Điều tra toàn quốc): 3.988.124 người.+Ngày 1/4/1999 (Điều tra toàn quốc): 5.037.155 người.+Ngày 1/10/2004 (Điều tra của thành phố): 6.117.251 người.+Ngày 1/4/2009 (Điều tra toàn quốc): 7.162.864 người.+Theo số liệu điều tra của Tổng cục Thống kê ngày 1/4/2010, dân số thành phố là 7.382.287 người.[47]+Theo số liệu của Cục Thống kê Thành phố Hồ Chí Minh, dân số thành phố vào giữa năm 2010 là 7.396.446 người, mật độ 3.531 người/km2[48]+Theo số liệu điều tra của Tổng cục Thống kê ngày 1/4/2011, dân số thành phố là 7.549.341 người.[1]+Theo kết quả điều tra dân số ngày 01/04/2009 Thành phố Hồ Chí Minh có dân số 7.162.864 người, gồm 1.824.822 hộ dân trong đó: 1.509.930 hộ tại thành thị và 314.892 hộ tại nông thôn, bình quân 3,93 người/hộ. Phân theo giới tính: Nam có 3.435.734 người chiếm 47,97%, nữ có 3.727.130 người chiếm 52,03%. Những năm gần đây dân số thành phố tăng nhanh; trong 10 năm từ 1999-2009 dân số thành phố tăng thêm 2.125.709 người, bính quân tăng hơn 212.000 người/năm, tốc độ tăng 3,54%/năm, chiếm 22,32% số dân tăng thêm của cả nước trong vòng 10 năm. Với 572.132 người, tương đương với dân số một số tỉnh như: Quảng Trị, Ninh Thuận, quận Bình Tân có dân số lớn nhất trong số các quận cả nước. Tương tự, huyện Bình Chánh với 420.109 dân là huyện có dân số lớn nhất trong số các huyện cả nước. Trong khi đó huyện Cần Giờ với 68.846 người, có dân số thấp nhất trong số các quận, huyện của thành phố [49]. Không chỉ là thành phố đông dân nhất Việt Nam, quy mô dân số của Thành phố Hồ Chí Minh còn hơn phần lớn các thủ đô ở châu Âu ngoại trừ Moscow và London. Theo số liệu thống kê năm 2009, 83,32% dân cư sống trong khu vực thành thị. Thành phố Hồ Chí Minh có gần một phần ba là dân nhập cư từ các tỉnh khác.+Phân tích theo cơ cấu dân tộc: Người Việt (người Kinh) 6.699.124 người chiếm 93,52% dân số thành phố, tiếp theo tới người Hoa với 414.045 người chiếm 5,78%, còn lại là các dân tộc: Khmer 24.268 người, Chăm 7.819 người... Tổng cộng có đến 52/54 dân tộc được công nhận tại Việt Nam có người cư trú tại thành phố (chỉ thiếu dân tộc Bố Y và Cống), ít nhất là người La Hủ chỉ có 01 người. Ngoài ra còn 1.128 người được phân loại là người nước ngoài, có nguồn gốc từ các quốc gia khác (India, Pakistan, Indonesia, France...). Cộng đồng người Hoa ở Thành phố Hồ Chí Minh là cộng đồng người Hoa lớn nhất Việt Nam (bằng 50,3% tổng số người Hoa cả nước), cư trú khắp các quận, huyện, nhưng tập trung nhiều nhất tại Quận 5, 6, 8, 10, 11 và có những đóng góp đáng kể cho nền kinh tế thành phố[50].+Phân tích dân số theo tôn giáo: Căn cứ theo số liệu điều tra dân số năm 2009, 1.983.048 người (27,68% tổng số dân thành phố) kê khai có tôn giáo. Trong đó những tôn giáo có nhiều tín đồ là: Phật giáo 1.164.930 người chiếm 16,26%, Công giáo 745.283 người chiếm 10,4%, Cao đài 31.633 người chiếm 0,44%, Tin lành 27.016 người chiếm 0,37%, Hồi giáo 6.580 người chiếm 0,09%.++Sự phân bố dân cư ở Thành phố Hồ Chí Minh không đồng đều. Trong khi một số quận như: 3, 4, 10 và 11 có mật độ lên tới trên 40.000 người/km², thì huyện ngoại thành Cần Giờ có mật độ tương đối thấp 98 người/km²[51]. Về mức độ gia tăng dân số, trong khi tỷ lệ tăng tự nhiên khoảng 1,07% thì tỷ lệ tăng cơ học lên tới 2,5%[52]. Những năm gần đây dân số các quận trung tâm có xu hướng giảm; trong khi dân số các quận mới lập vùng ven tăng nhanh, do đón nhận dân từ trung tâm chuyển ra và người nhập cư từ các tỉnh đến sinh sống. Theo ước tính năm 2005, trung bình mỗi ngày có khoảng 1 triệu khách vãng lai tại Thành phố Hồ Chí Minh. Đến năm 2010, con số này còn có thể tăng lên tới 2 triệu[53].++Mặc dù Thành phố Hồ Chí Minh có thu nhập bình quân đầu người rất cao so với mức bình quân của cả Việt Nam, nhưng khoảng cách giàu nghèo ngày các lớn do những tác động của nền kinh tế thị trường. Những người hoạt động trong lĩnh vực thương mại cao hơn nhiều so với ngành sản xuất. Sự khác biệt xã hội vẫn còn thể hiện rõ giữa các quận nội ô so với các huyện ở ngoại thành.+Y tế+ + Bệnh viện tim Tâm Đức tại Quận 7++Thành phố Hồ Chí Minh, với dân số đông, mật độ cao trong nội thành, cộng thêm một lượng lớn dân vãng lai, đã phát sinh nhu cầu lớn về y tế và chăm sóc sức khỏe. Các tệ nạn xã hội, như mại dâm, ma túy, tình trạng ô nhiễm môi trường... gây ảnh hưởng lớn tới sức khỏe dân cư thành phố. Những bệnh truyền nhiễm phổ biến ở các nước đang phát triển như sốt rét, sốt xuất huyết, tả, thương hàn... hay các bệnh của những quốc gia công nghiệp phát triển, như tim mạch, tăng huyết áp, ung thư, tâm thần, bệnh nghề nghiệp... đều xuất hiện ở Thành phố Hồ Chí Minh[54]. Tuổi thọ trung bình của nam giới ở thành phố là 71,19, con số ở nữ giới là 75,00[55].++Vào năm 2005, Thành phố Hồ Chí Minh có 21.780 nhân viên y tế, trong đó có 3.399 bác sĩ. Tỷ lệ bác sĩ đạt 5.45 trên 10 nghìn dân, giảm so với con số 7.31 của năm 2002[56]. Toàn thành phố có 19.442 giường bệnh, 56 bệnh viện, 317 trạm y tế và 5 nhà hộ sinh[57]. Thế nhưng mạng lưới bệnh viện chưa được phân bổ hợp lý, tập trung chủ yếu trong nội ô. Theo con số năm 1994, chỉ riêng Quận 5 có tới 13 bệnh viện với 5.290 giường, chiếm 37% số giường bệnh toàn thành phố[58]. Bù lại, hệ thống y tế cộng đồng tương đối hoàn chỉnh, tất cả các xã, phường đều có trạm y tế. Bên cạnh hệ thống nhà nước, thành phố cũng có 2.303 cơ sở y tế tư nhân và 1.472 cơ sở dược tư nhân, góp phần giảm áp lực cho các bệnh viện lớn. Cũng tương tự hệ thống y tế nhà nước, các cơ sở này tập trung chủ yếu trong nội ô và việc đảm bảo các nguyên tắc chuyên môn chưa được chặt chẽ[54].++Sở Y tế thành phố hiện nay quản lý 8 bệnh viện đa khoa và 20 bệnh viện chuyên khoa. Nhiều bệnh viện của thành phố đã liên doanh với nước ngoài để tăng chất lượng phục vụ.+Giáo dục+ + Trụ sở Đại học Quốc gia Thành phố Hồ Chí Minh++Về mặt hành chính, Sở Giáo dục Thành phố Hồ Chí Minh chỉ quản lý các cơ sở giáo dục từ bậc mầm non tới phổ thông. Các trường đại học, cao đẳng phần lớn thuộc Bộ Giáo dục và Đào tạo Việt Nam. Trong năm học 2008–2009, toàn thành phố có 638 cơ sở giáo dục mầm non, 467 trường cấp I, 239 trường cấp II, 81 trường cấp III và 55 trường cấp II, III[59]. Ngoài ra, theo con số từ 1994, Thành phố Hồ Chí Minh còn có 20 trung tâm xóa mù chữ, 139 trung tâm tin học, ngoại ngữ và 12 cơ sở giáo dục đặc biệt. Tổng cộng 1.308 cơ sở giáo dục của thành phố có 1.169 cơ sở công lập và bán công, còn lại là các cơ sở dân lập, tư thục[60].++Hệ thống các trường từ bậc mầm non tới trung học trải đều khắp thành phố. Trong khi đó, những cơ sở xóa mù chữ, phổ cập giáo dục tập trung chủ yếu vào bốn huyện ngoại thành Củ Chi, Bình Chánh, Nhà Bè, Cần Giờ. Các trường ngoại ngữ ở Thành phố Hồ Chí Minh không chỉ giảng dạy những ngôn ngữ phổ biến mà còn một trường dạy quốc tế ngữ, một trường dạy Hán Nôm, bốn trường dạy tiếng Việt cho người nước ngoài. Thành phố Hồ Chí Minh hiện nay cũng có 40 trường quốc tế do các lãnh sự quán, công ty giáo dục đầu tư[61].+Bài chi tiết: Danh sách trường đại học tại Thành phố Hồ Chí Minh++Giáo dục bậc đại học, trên địa bàn thành phố có trên 80 trường, đa số do Bộ Giáo dục và Đào tạo quản lý, trong đó chỉ có 2 trường đại học công lập (Trường đại học Sài Gòn và Trường Đại học Y khoa Phạm Ngọc Thạch) do thành phố quản lý. Là thành phố lớn nhất Việt Nam, Thành phố Hồ Chí Minh cũng là trung tâm giáo dục bậc đại học lớn bậc nhất, cùng với Hà Nội. Đại học Quốc gia Thành phố Hồ Chí Minh với 6 trường đại học thành viên[62]. Nhiều đại học lớn khác của thành phố như Đại học Kiến trúc, Đại học Y Dược, Đại học Ngân hàng, Đại học Luật, Đại học Kinh tế... đều là các đại học quan trọng của Việt Nam. Trong số học sinh, sinh viên đang theo học tại các trường đại học, cao đẳng của thành phố, 40% đến từ các tỉnh khác của quốc gia[63].++Mặc dù đạt được những bước tiến quan trọng trong thời gian gần đây nhưng giáo dục Thành phố Hồ Chí Minh vẫn còn nhiều khiếm khuyết. Trình độ dân trí chưa cao và chênh lệch giữa các thành phần dân cư, đặc biệt là ngoại ô so với nội ô. Tỷ lệ trẻ em người Hoa không biết chữ vẫn còn nhiều, gấp 13 lần trẻ em người Kinh. Giáo dục đào tạo vẫn chưa tương xứng với nhu cầu của xã hội. Hệ thống cơ sở vật chất ngành giáo dục thành phố còn kém. Nhiều trường học sinh phải học ba ca. Thu nhập của giáo viên chưa cao, đặc biệt ở các huyện ngoại thành[63].+Giao thông vận tải+Bài chi tiết: Giao thông Thành phố Hồ Chí Minh+ +Bến Nhà Rồng, thương cảng cũ của Sài Gòn+ + Hầm Thủ Thiêm, hầm vượt sông dài nhất Đông Nam Á+ + Sân bay Quốc tế Tân Sơn Nhất++Nhờ điều kiện tự nhiên thuận lợi, Thành phố Hồ Chí Minh trở thành một đầu mối giao thông quan trọng của Việt Nam và khu vực Đông Nam Á. Khác với Hà Nội, vận tải thủy ở Thành phố Hồ Chí Minh chiếm một tỷ lệ quan trọng. Tính riêng vận tải hàng hóa, đường biển chiếm khoảng 29% và đường sông khoảng chiếm 20% tổng khối lượng thông qua đầu mối thành phố. Đường bộ chỉ chiếm 44% vận tại hàng hóa nhưng chiếm tới 85,6% vận tải hành khách[64]. Về giao thông đường không, Sân bay quốc tế Tân Sơn Nhất là phi trường lớn nhất Việt Nam về cả diện tích và công suất nhà ga[65]. Năm 2006, vận tải thành phố đã vận chuyển tổng cộng 73.743 tấn hàng hóa, 239 triệu lượt người và bốc xếp 44.341 tấn hàng[66]. Toàn thành phố hiện nay có khoảng 340.000 xe hơi và 3,5 triệu xe máy, gần gấp đôi so với Hà Nội[67].++Giao thông đường sắt của thành phố gồm tuyến nội ô và khu vực phụ cận - do Xí nghiệp Liên hiệp đường sắt 3 quản lý, tuyến Bắc - Nam và một vài đoạn đường chuyên dụng, hiện hầu như đã ngưng khai thác. Trong thành phố có hai nhà ga chính: Sóng Thần và Sài Gòn. Bên cạnh đó còn có một số nhà ga nhỏ như Dĩ An, Thủ Đức, Bình Triệu, Gò Vấp. Do mạng lưới đường sắt không được nối trực tiếp với các cảng, cơ sở đã cũ kỹ nên giao thông đường sắt Thành phố Hồ Chí Minh không phát triển, chỉ chiếm khoảng 6% khối lượng hàng hóa và 0,6% khối lượng hành khách[64].++Giao thông đường bộ, thành phố có 6 bến xe khách liên tỉnh được phân bố ở các cửa ngõ ra vào: Miền Đông, Văn Thánh, Miền Tây, Chợ Lớn, Tân Bình - Tây Ninh, Ký Thủ Ôn. Mạng lưới khả năng tiếp nhận trên 1.200 xe/ngày, vận chuyển gần 41.000 khách/ngày đi các tỉnh Nam Trung Bộ, Tây Nguyên, Đông Nam Bộ, Đồng bằng sông Cửu Long. Cũng theo số liệu từ 1994, tổng lượng hành khách liên tỉnh qua thành phố khoảng 106,4 triệu lượt người/năm, nhiều nhất qua quốc lộ 1A[64].++Khu vực Thành phố Hồ Chí Minh có bốn cảng biển chính: Sài Gòn, Bến Nghé, Nhà Bè, Tân Cảng cùng các cảng sông Bình Đông, Tân Thuận, Tôn Thất Thuyết, Bình Lợi, Bình Phước... Ngoài ra còn có khoảng 50 bến đò phục vụ giao thông hành khách. Cảng Sài Gòn là một trong những cảng lớn nhất Việt Nam, chiếm 25% trong tổng khối lượng hàng hóa thông qua các cảng biển cả nước. Cảng Bến Nghé nằm phía hạ lưu sông Sài Gòn, rộng 32 ha, tổng chiều dài cầu cảng 528 m, có thể cho tàu có tải trọng từ 15.000 - 20.000 tấn cập bến. Tuy năng lực của các cảng của Thành phố Hồ Chí Minh lớn nhưng việc chuyển tiếp giữa giao thông đường bộ, đường biển và đường sông gặp khó khăn. Tại hầu hết các cảng đường sông, do thiết bị thiếu, vẫn phải bốc dỡ thủ công[64].++Giao thông trong nội ô, do tốc độ tăng dân số nhanh, quy hoạch yếu, hệ thống đường xá nhỏ... khiến thành phố luôn phải đối mặt với vấn đề ùn tắc. Thành phố có 239 cây cầu nhưng phần lớn chiều rộng nhỏ hơn chiều rộng của đường nên gây khó khăn cho các phương tiện giao thông. Không những thế, một phần các cây cầu có trọng tải thấp hay đang trong tình trạng xuống cấp. Tại các huyện ngoại thành, hệ thống đường vẫn phần nhiều là đường đất đá. Trong khi đó, hệ thống đường trải nhựa còn lại cũng trở nên quá tải, cần sửa chữa.[64] Để giải quyết vấn đề giao thông đô thị, Thành phố Hồ Chí Minh đang đầu tư cho hệ thống giao thông công cộng. Hiện nay thành phố có 3.250 xe buýt và 8.000 xe taxi, mỗi năm chỉ đáp ứng khoảng 6,2% nhu cầu đi lại. Hệ thống xe buýt chưa đem lại hiệu quả cao, 65% tuyến trùng lặp[68]. Cùng mạng lưới xe buýt, dự án tàu điện ngầm Thành phố Hồ Chí Minh cũng được đang tiến hành. Theo dự kiến, thành phố sẽ có bốn tuyến, tổng chiều dài 54 km, 6 đường rày và 22 nhà ga. Cuối 2010, hai tuyến đầu tiên sẽ đi vào hoạt động[69].+Quy hoạch và kết cấu đô thị++Theo thiết kế đô thị ban đầu của người Pháp vào năm 1860, thành phố Sài Gòn sẽ là nơi sinh sống cho 500.000 dân. Chính quyền Việt Nam Cộng hòa đã tăng qui mô của thành phố lên đến 3 triệu dân. Tuy nhiên hiện nay thành phố này có dân số kể cả số lượng khách vãng lai là 10 triệu người, kết cấu đô thị đã quá tải[70]. Sài Gòn từng là thành phố của cây xanh với không gian kiến trúc theo quy hoạch của Pháp trước đây đã thay đổi với việc thu hẹp không gian xanh để xây dựng nhà cửa, không gian kiến trúc thành phố này trở nên chật chội với nhiều công trình xây dựng hỗn độn thiếu tính thống nhất[71].++Công tác quy hoạch có nhiều bất cập và yếu kém. Đến thời điểm đầu năm 2008 mới chỉ có 23% khối lượng công tác quy hoạch 1/2000 được thực hiện. Quy hoạch cho hệ thống công trình ngầm vẫn chưa được thực hiện xong[72]. Công tác xây quy họach và xây dựng đô thị mới vẫn mang nặng tư duy thời kỳ bao cấp. Trong 10 năm gần đây, khu vực đô thị mới để lại dấu ấn lớn trong quá trình phát triển thành phố này là khu đô thị mới Phú Mỹ Hưng do nước ngoài đầu tư xây dựng, không phải là những quận, huyện được chính quyền địa phương thành lập[73].++Quy hoạch thành phố Hồ Chí Minh tính tới thời điểm 2010 có khoảng trên dưới 600 dự án quy hoạch tại 13 quận huyện.++Chiến lược quy hoạch của Thành phố hiện nay là tránh dồn ứ dân cư về nội thành, đồng thời phát triển một số khu đô thị mới góp phần làm giảm mật độ dân số vốn đã quá cao như hiện nay.+Du lịch+Bài chi tiết: Du lịch Thành phố Hồ Chí Minh+ +Nhà hát lớn nằm tại khu vực trung tâm thành phố++Trong khoảng 4,3 triệu khách quốc tế đến Việt Nam vào năm 2007, 3 triệu khách đã tới thăm Thành phố Hồ Chí Minh, tức khoảng 70%[41]. Năm 2007 cũng là năm thành phố có được bước tiến mạnh mẽ, lượng khách tăng khoảng 12% so với 2006, doanh thu ngành du lịch đạt 19.500 tỷ VND, tăng 20%[74]. Là một thành phố trẻ chỉ với 300 năm lịch sử, nhưng Thành phố Hồ Chí Minh đã xây dựng được không ít công trình kiến trúc và sở hữu một nền văn hóa đa dạng.++Hiện nay Thành phố Hồ Chí Minh có 641 khách sạn với 17.646 phòng[75]. Phục vụ những khách cao cấp, thành phố có 11 khách sạn 5 sao, gồm: Caravelle, Sheraton, Moevenpick (Omni cũ), New World, Equatorial, Legend, Renaissance Riverside, Windsor Plaza, Sofitel Plaza, Park Hyatt, Majestic với tổng cộng 3.592 phòng[76]. Hầu hết các khách sạn này đều do những tập đoàn quốc tế như Accor, Furama, Mariot hay Sheraton quản lý và tập trung nhiều nhất tại Quận 1. Bên cạnh đó thành phố còn 8 khách sạn 4 sao với 1.281 phòng, 20 khách sạn 3 sao với 1.621 phòng. Do sự phát triển của du lịch, số phòng cao cấp tại thành phố hiện đang thiếu trầm trọng. Mặc dù nhiều nhà đầu tư có ý định xây dựng tiếp các khách sạn sạng trọng tại Thành phố Hồ Chí Minh nhưng họ lại gặp khó khăn trong việc tìm địa điểm. Theo dự kiến, đến năm 2020, thành phố sẽ có thêm 10 nghìn phòng 4 hoặc 5 sao[76].++Các địa điểm du lịch của thành phố tương đối đa dạng. Với hệ thống 11 viện bảo tàng, chủ yếu về đề tài lịch sử, Thành phố Hồ Chí Minh đứng đầu Việt Nam về số lượng bảo tàng. Bảo tàng lớn nhất và cổ nhất thành phố là Bảo tàng Lịch sử Việt Nam với 30 nghìn hiện vật. Trong khi phần lớn khách thăm Bảo tàng Chứng tích chiến tranh là người nước ngoài[77] thì bảo tàng thu hút nhiều khách nội địa nhất là Bảo tàng Hồ Chí Minh[78]. Thành phố Hồ Chí Minh cũng là một đô thị đa dạng về tôn giáo. Trên địa phận thành phố hiện nay có hơn một nghìn ngôi chùa, đình, miếu được xây dựng qua nhiều thời kỳ. Còn các nhà thờ xuất hiện chủ yếu trong thế kỷ 19 theo các phong cách Roman, Gothic. Nhà thờ lớn và nổi tiếng nhất của thành phố là nhà thờ Đức Bà, nằm ở Quận 1, hoàn thành năm 1880. Thời kỳ thuộc địa đã để lại cho thành phố nhiều công trình kiến trúc quan trọng, như Trụ sở Ủy ban Nhân dân Thành phố, Nhà hát lớn, Bưu điện trung tâm, Bến Nhà Rồng... Dinh Độc Lập và Thư viện Khoa học Tổng hợp được xây dựng dưới thời Việt Nam Cộng hòa. Kiến trúc hiện đại ghi dấu ấn ở thành phố bằng các cao ốc, khách sạn, trung tâm thương mại như Diamond Plaza, Saigon Trade Centre... Khu vực ngoài trung tâm, Địa đạo Củ Chi, Rừng ngập mặn Cần Giờ, Vườn cò Thủ Đức cũng là những địa điểm du lịch quan trọng.++Thành phố Hồ Chí Minh còn là một trung tâm mua sắm và giải trí. Bên cạnh các phòng trà ca nhạc, quán bar, vũ trường, sân khấu, thành phố có khá nhiều khu vui chơi như Công viên Đầm Sen, Suối Tiên, Thảo Cầm Viên. Các khu mua sắm, như Chợ Bến Thành, Diamond Plaza... hệ thống các nhà hàng, quán ăn cũng là một thế mạnh của du lịch thành phố.+Văn hóa+Truyền thông+ +Bưu điện trung tâm Thành phố++Là một trong hai trung tâm truyền thông của Việt Nam, Thành phố Hồ Chí Minh hiện nay có 38 đơn vị báo chí thành phố và 113 văn phòng đại diện báo chí trung ương và các tỉnh, 3 nhà xuất bản của thành phố và 21 chi nhánh nhà xuất bản trung ương cùng mạng lưới thông tấn xã, các đài phát thanh, truyền hình địa phương và trung ương. Tổng cộng, trên địa bàn thành phố hiện nay có trên một nghìn người hoạt động trong lĩnh vực báo chí[79].++Trong lĩnh vực xuất bản, từ năm 1995 tới nay, ba nhà xuất bản của thành phố chiếm 1/7 số đầu sách xuất bản của cả Việt Nam. Ước tính khoảng 60 đến 70% số lượng sách của cả nước được phát hành tại Thành phố Hồ Chí Minh[79]. Những năm gần đây, nhiều trung tâm sách, cửa hàng sách hiện đại xuất hiện. Sài Gòn cũng là nơi ra đời tờ Gia Định báo, tờ báo quốc ngữ đầu tiên. Sài Gòn giải phóng, Thanh Niên, Tuổi Trẻ nằm trong số những tờ báo lớn nhất Việt Nam hiện nay. Ngoài ra còn có thể kể đến những báo và tạp chí lớn khác như Công an thành phố, Người lao động, Thời báo kinh tế Sài Gòn, Thời trang, Thế giới mới, Kiến thức ngày nay... Ngoài báo chí tiếng Việt, Thành phố Hồ Chí Minh còn có Saigon Times daily, Thanhniennews bằng tiếng Anh, một ấn bản Sài Gòn giải phóng bằng tiếng Hoa.++Truyền hình đã xuất hiện tại Sài Gòn từ trước năm 1975, khi miền Bắc còn đang trong giai đoạn thử nghiệm. Ngay sau ngày chính quyền Việt Nam Cộng hòa sụp đổ, Đài truyền hình Giải phóng đã bắt đầu phát sóng. Đến nay, Đài Truyền hình Thành phố Hồ Chí Minh – HTV trở thành đài truyền hình địa phương quan trọng bậc nhất Việt Nam. Ngoài sáu kênh phát trên sóng analogue, HTV còn một số kênh truyền hình kỹ thuật số và truyền hình cáp. Đối tượng chính của HTV là dân cư thành phố và một số tỉnh lân cận.+Thể dục, thể thao+ + Sân vận động Thống Nhất++Theo số liệu thống kê vào năm 1994, toàn Thành phố Hồ Chí Minh có 492,7 hecta dành cho hoạt động thể thao, tức trung bình 1,02 m²/người, trong đó nội thành là 0,26 m²/người. Với sự gia tăng dân số, con số thực tế hiện nay thấp hơn[80]. Vào năm 2005, toàn thành phố có 91 sân bóng đá, 86 bể bơi, 256 phòng tập thể thao[81]. Sân vận động lớn nhất thành phố hiện nay là sân Thống Nhất, với 25 nghìn chỗ ngồi. Sân vận động lớn thứ hai là sân Quân khu 7, nằm ở quận Tân Bình. Không chỉ dành cho thi đấu thể thao, đây còn là địa điểm tổ chức nhiều chương trình ca nhạc quy mô lớn. Một địa điểm thể thao quan trọng khác của thành phố là Trường đua Phú Thọ. Xuất hiện từ thời thuộc địa, Trường đua Phú Thọ hiện nay là trường đua ngựa duy nhất của Việt Nam. Sở Thể dục - Thể thao thành phố cũng quản lý một số câu lạc bộ như Phan Đình Phùng, Thanh Đa, Yết Kiêu.++Thành phố Hồ Chí Minh cũng có những câu lạc bộ thể thao giàu thành tích. Môn bóng đá, Câu lạc Thép Miền Nam - Cảng Sài Gòn, có sân nhà là sân Thống Nhất, từng 4 lần vô định V League. Đội Công an Thành phố cũng từng một lần vô địch vào năm 1995. Các bộ môn thể thao khác có thể kể đến Câu lạc bộ Bưu điện Thành phố Hồ Chí Minh môn bóng chuyền, các câu lạc bộ bóng rổ, cờ, điền kinh, bóng bàn... của thành phố.+Trung tâm văn hóa, giải trí+ + Khách sạn Park Hyatt Saigon tại Quận 1++Những lý do lịch sử và địa lý đã khiến Sài Gòn luôn là một thành phố đa dạng về văn hóa. Ngay từ giai đoạn thành lập, dân cư của Sài Gòn đã thuộc nhiều dân tộc khác nhau: Kinh, Hoa, Chăm... Thời kỳ thuộc địa rồi chiến tranh Việt Nam, Sài Gòn hấp thụ thêm nền văn hóa Âu Mỹ. Cho tới những thập niên gần đây, những hoạt động kinh tế, du lịch tiếp tục giúp thành phố có một nền văn hóa đa dạng hơn.++Với vai trò một trung tâm văn hóa của Việt Nam, Thành phố Hồ Chí Minh hiện nay có 22 đơn vị nghệ thuật, 9 rạp hát, 11 bảo tàng, 22 rạp chiếu phim, 25 thư viện[82][83]. Hoạt động của ngành giải trí ở Thành phố Hồ Chí Minh nhộn nhịp hơn bất cứ thành phố nào ở Việt Nam. Hầu hết các hãng phim tư nhân lớn của Việt Nam hiện nay, như Phước Sang, Thiên Ngân, HKFilm, Việt Phim... đều có trụ sở chính ở Thành phố Hồ Chí Minh. Doanh thu các rạp của thành phố chiếm khoảng 60-70% doanh thu chiếu phim của cả nước[84]. Thành phố Hồ Chí Minh cũng sở hữu những sân khấu đa dạng. Nhà hát kịch Sân khấu nhỏ tại Quận 3 với những vở kịch thử nghiệm, những vở thư giãn ở Sân khấu Hài 135 Quận 1, Sân khấu kịch IDECAF với những vở lấy từ tuồng tích cổ hoặc tái hiện các danh tác trên thế giới. Lĩnh vực ca nhạc, Thành phố Hồ Chí Minh là thị trường sôi động nhất, điểm đến của phần lớn các ca sĩ nổi tiếng. Ngoài những sân khấu lớn như Nhà hát Thành phố, Nhà hát Bến Thành, Nhà hát Hòa Bình, Sân khấu Trống Đồng... hoạt động âm nhạc hoạt động âm nhạc ở thành phố ở những phòng trà, quán cà phê đa dạng: Tiếng Tơ Đồng, M&T, Catinat, ATB, Bodega, Carmen...+Thành phố kết nghĩa++Đến thời điểm năm 2008, Thành phố Hồ Chí Minh kết nghĩa với các thành phố sau[85]: Busan, Hàn Quốc+ Champasak, Lào+ Ekaterinburg, Nga+ Manila, Philippines+ Moskva, Nga	 Lyon, Pháp+ Quảng Châu, Trung Quốc+ Osaka, Nhật Bản+ Rhône-Alpes, Pháp+ Phnôm Pênh, Campuchia	 Viêng Chăn, Lào+ Thẩm Dương, Trung Quốc+ Toronto, Canada+ San Francisco, Hoa Kỳ+ Thượng Hải, Trung Quốc+ Yokohama, Nhật Bản.++Chú thích+^ a b “Diện tích, dân số và mật độ dân số năm 2011 phân theo địa phương”. Tổng cục Thống kê Việt Nam. Truy cập 30 tháng 9 năm 2012.+^ http://baodientu.chinhphu.vn/Home/Ban-hanh-Nghi-quyet-moi-cua-Bo-Chinh-tri-ve-phat-trien-TPHo-Chi-Minh/20127/142861.vgp+^ http://www.sggp.org.vn/chinhtri/2012/7/293239/+^ Thành phố với vẻ đẹp trời cho[liên kết hỏng] trên trang của Thành phố.+^ Ðịa hình[liên kết hỏng] trên trang của Thành phố.+^ Ðịa chất - đất đai[liên kết hỏng] trên trang của Thành phố.+^ a b Nguồn nước và thủy văn[liên kết hỏng] trên trang của Thành phố.+^ a b Khí hậu, thời tiết[liên kết hỏng] trên trang của Thành phố.+^ “Weather for Ho Chi Minh City”. Đại sứ quán Việt Nam tại London. Truy cập 26 tháng 2 năm 2008.+^ Cần một nghị quyết về môi trường Tin tức, truy cập 23 tháng 8 năm 2010.+^ Ô nhiễm môi trường và tình trạng ô nhiễm môi trường nước ở Việt Nam trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ "Chưa có giải pháp cụ thể hạn chế ô nhiễm sông Sài Gòn[liên kết hỏng]". Báo Lao Động, 21 tháng 6, 2008.+^ Kiều Anh, "Thành phố Hồ Chí Minh: Đối mặt với ô nhiễm môi trường". Báo Khoa học và Phát triển, 25 tháng 7, 2008.+^ “Tp. Hồ Chí Minh: Giải pháp nào chống ngập nước?”. Báo Giao thông Vận tải (30 tháng 3 năm 2006).+^ Ô nhiễm môi trường tại TPHCM: Hiểm họa mới SGGP Online, truy cập ngày 23 tháng 8 năm 2010.+^ Vùng Sài Gòn thời hoang sơ[liên kết hỏng] trên trang của Thành phố.+^ Con đường lập nghiệp của cha ông để có Sài Gòn - Gia Định[liên kết hỏng] trên trang của Thành phố.+^ a b Lập đồn thu thuế đầu tiên[liên kết hỏng] trên trang của Thành phố.+^ Lịch sử hình thành đất Sài Gòn[liên kết hỏng] trên trang của Thành phố.+^ Công cuộc khai hoang ở Nam Bộ vào thời các chúa Nguyễn[liên kết hỏng] trên trang của Thành phố.+^ Lê Quỳnh, Chuyển giao quân sự: Trường hợp nhà Nguyễn. BBC Việt ngữ, 19 tháng 2, 2004.+^ a b Niên biểu 300 năm Sài Gòn[liên kết hỏng] trên trang của Thành phố.+^ a b Sài Gòn biến đổi và hình thành một thành phố theo kiểu phương Tây[liên kết hỏng] trên trang của Thành phố.+^ Goodman, Allan E. Politics in War. Cambridge, MA: Havard University Press, 1973. tr 14+^ Pierre Brocheux và Daniel Hémery. Indochina, An Ambiguous Colonization 1858-1954. Berkeley, CA: University of California Press, 2009. tr 336-374.+^ Metzner, Edward. Reeducation in Postwar Vietnam. College Station, TX: Tẽas A&M University Press, 2001. tr 5-9.+^ BBCVietnamese.com | Diễn đàn | 'Kỳ tích xây dựng của thập kỷ'+^ Sài Gòn dưới thời Mỹ Ngụy[liên kết hỏng] trên trang của Thành phố.+^ Nigel Cawthorne, Chiến Tranh Việt Nam Được Và Mất, Nhà xuất bản Đà Nẵng, năm xuất bản 2007, tr. 396+^ Nghị quyết của Quốc hội năm 1976[liên kết hỏng] trên trang của Thành phố.+^ Sài Gòn xưa - Lịch sử vùng đất[liên kết hỏng] trên trang của Liên minh hợp tác xã Thành phố Hồ Chí Minh.+^ Quy định của luật tổ chức Hội đồng Nhân dân trên trang của Hội đồng Nhân dân thành phố+^ Thông tin tổ chức hành chính Thành phố Hồ Chí Minh[liên kết hỏng] trên trang của Thành phố.+^ Số liệu 2005[liên kết hỏng] trên trang của Thành phố.+^ Nguồn lao động trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ Kinh Te Vi Mo - Dau Tu tren trang cafef.vn+^ 10 điểm nổi bật trong tình hình kinh tế-xã hội của thành phố Hồ Chí Minh trog năm 2010+^ Chỉ tiêu tổng hợp giai đoạn 2001 - 2006[liên kết hỏng], trên trang của Thành phố.+^ Trang[liên kết hỏng] của Ban quản lý các khu chế xuất và công nghiệp Thành phố Hồ Chí Minh.+^ Hàn Ni, "TPHCM dẫn đầu thu hút vốn FDI vì biết cách bứt phá". Sài Gòn giải phóng, 3 tháng 11, 2007.+^ a b c "TPHCM sau 1 năm gia nhập WTO - Vượt lên chính mình...[liên kết hỏng]", Trung tâm thông tin thương mại.+^ “PCI 2011: Lào Cai và Bắc Ninh 'vượt vũ môn' ngoạn mục”. Phòng thương mại và Công nghiệp Việt Nam. Truy cập 23 tháng 2 năm 2012.+^ Minh Anh, "Quy mô tiêu dùng 41,5 tỉ USD: Đầu kéo phát triển!". Tuổi Trẻ, 20 tháng 8, 2007.+^ Hình thành và phát triển, trên trang Sở Giao dịch Chứng khoán Thành phố Hồ Chí Minh.+^ Thành phố Hồ Chí Minh: Chỉ có 10% cơ sở công nghiệp có trình độ công nghệ hiện đại, Mạng thông tin Khoa học và Công nghệ Việt Nam.+^ http://www.pso.hochiminhcity.gov.vn/an_pham/sltkcytphcm/30_so_lieu_thong_ke_chu_yeu+^ http://www.gso.gov.vn/default.aspx?tabid=512&idmid=5&ItemID=11010+^ http://www.pso.hochiminhcity.gov.vn/c/document_library/get_file?uuid=5fdc62bc-0523-453a-b596-57ad36af9831&groupId=18+^ Dang Bo Thanh Pho Ho Chi Minh+^ Kết quả điều tra dân số 1999 - 2004, trang của Cục thống kê Thành phố Hồ Chí Minh.+^ Kết quả toàn bộ Tổng điều tra Dân số và Nhà ở Việt Nam năm 2009, Tổng cục Thống kê Việt Nam+^ Dân số lao động[liên kết hỏng] trên trang của Thành phố.+^ Dự báo số khách vãng lai có mặt trung bình mỗi ngày trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ a b Y tế và chăm sóc sức khỏe trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ Các chỉ tiêu về thể lực trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ Số liệu nhân lực y tế năm 1996 - 2005 trên trang của Sở Y tế thành phố.+^ Thống kê về y tế năm 2005 trên trang của Cục thống kê Thành phố Hồ Chí Minh.+^ Mạng lưới y tế trên địa bàn TP.HCM trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ Các thông kê về giáo dục năm 2008, trên trang của Cục Thống kê Thành phố Hồ Chí Minh.+^ Số trường, lớp, học sinh, giáo viên hệ mầm non... trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ Danh sách các trường quốc tế trên trang Sở Giáo dục Thành phố Hồ Chí Minh.+^ [1]+^ a b Giáo dục và đào tạo I trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ a b c d e Giao thông vận tải I trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ "Có nên xây sân bay quốc tế mới ở tỉnh Hải Dương", Tạp chí Hàng không, số tháng 10 năm 2007 của Cục hàng không dân dụng Việt Nam.+^ Vận tải - Bưu điện[liên kết hỏng] trên trang của Thành phố.+^ Ngô Lực Tải, Tìm lời giải chung cho giao thông ở Hà Nội và TP. HCM. Bộ Giao thông Vận tải, 29 tháng 5, 2008.+^ Duy Anh, Bình Minh, "TP.Hồ Chí Minh: Đi xe buýt lãng phí nhiều, hiệu quả thấp[liên kết hỏng]". Đời sống và Pháp luật, 14 tháng 9, 2007.+^ Phan Anh, "3 năm nữa TP HCM có tàu điện ngầm". VnExpress 30 tháng 4, 2007.+^ “Giải pháp giao thông TP.HCM: Chỉ là đối phó”. VietnamNet (27 tháng 11 năm 2007).+^ “Không gian đô thị thành phố Hồ Chí Minh (Phần 2)”. Đài truyền hình Việt Nam (25 tháng 5 năm 2005).+^ “TP. Hồ Chí Minh – Ngán ngẩm với quy hoạch”. Báo Lao Động (8 tháng 1 năm 2008).[liên kết hỏng]+^ “Quy hoạch TP.HCM chưa xứng tầm”. Thư viện pháp luật (2 tháng 5 năm 2008).+^ Đổng Thị Kim Vui, "Du lịch Thành phố Hồ Chí Minh: Chuyển biến rõ rệt sau 1 năm gia nhập WTO[liên kết hỏng]". Kinh tế và Đô thị, 13 tháng 12, 2007.+^ Khách sạn[liên kết hỏng] trên trang của Thành phố.+^ a b Văn Thân, "Thành phố Hồ Chí Minh: “Khát” đất xây khách sạn cao cấp!". Báo Công an Thành Phố Hồ Chí Minh, 21 tháng 2, 2008.+^ Lê Trần Phương, "Cảm nhận từ bảo tàng chứng tích chiến tranh[liên kết hỏng]". Báo Bình Dương, 1 tháng 11, 2006.+^ Hệ thống bảo tàng[liên kết hỏng] trên trang của Thành phố.+^ a b Báo chí - xuất bản[liên kết hỏng] trên trang của Thành phố.+^ Văn hóa thông tin - thể dục thể thao trên trang Viện Kinh tế Thành phố Hồ Chí Minh.+^ Thể dục thể thao, trang của Cục thống kê Thành phố Hồ Chí Minh.+^ Văn hóa – Xã hội Thành phố Hồ Chí Minh[liên kết hỏng], trên trang của Thành phố.+^ Văn hóa nghệ thuật, trên trang của Cục thống kê Thành phố Hồ Chí Minh.+^ Trần Đình, "Rạp chiếu phim ở Thành phố Hồ Chí Minh: Trở lại đúng vị trí “công nghệ giải trí”[liên kết hỏng]". Tổng cục Tiêu chuẩn Đo lường Chất lượng, tháng 1, 2006.+^ Nguồn: Trang chính thức của Thành phố Hồ Chí Minh+Liên kết ngoài	Wikimedia Commons có thêm thể loại hình ảnh và tài liệu về: Thành phố Hồ Chí Minh.++Trang chính thức của Thành phố Hồ Chí Minh+Trang của Viện Kinh tế Thành phố Hồ Chí Minh+Hình chụp chi tiết độ phân giải cao một góc trung tâm TP.HCM
+ 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
@@ -0,0 +1,257 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module      : Streamly.Benchmark.Common+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++module Streamly.Benchmark.Common+    ( o_1_space_prefix+    , o_n_space_prefix+    , o_n_heap_prefix+    , o_n_stack_prefix++    , runWithCLIOptsEnv+    , runWithCLIOpts++    , benchIOSink1+    , benchPure+    , benchPureSink1+    , benchFold++    , benchIOSrc1+    , benchPureSrc++    , mkString+    , mkList+    , mkListString++    , defaultStreamSize+    )+where++#ifdef MIN_VERSION_gauge+import Control.Exception (evaluate)+import Control.Monad (when)+import Text.Read (readMaybe)+import Data.List (scanl')+import Data.Maybe (mapMaybe)+import System.Console.GetOpt+       (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt')+import System.Environment (getArgs, lookupEnv, setEnv)+#else+import Data.Proxy (Proxy(..))+import Test.Tasty.Ingredients.Basic (includingOptions)+import Test.Tasty.Options+    (IsOption(..), OptionDescription(..), lookupOption, safeRead)+import Test.Tasty.Runners (Ingredient, defaultMainWithIngredients, parseOptions)+#endif+import Control.DeepSeq (NFData(..))+import Data.Functor.Identity (Identity, runIdentity)+import System.Random (randomRIO)++import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as S++import Test.Tasty.Bench++-------------------------------------------------------------------------------+-- Benchmark Prefixes+-------------------------------------------------------------------------------++o_1_space_prefix :: String -> String+o_1_space_prefix name = name ++ "/o-1-space"++o_n_space_prefix :: String -> String+o_n_space_prefix name = name ++ "/o-n-space"++o_n_heap_prefix :: String -> String+o_n_heap_prefix name = name ++ "/o-n-heap"++o_n_stack_prefix :: String -> String+o_n_stack_prefix name = name ++ "/o-n-stack"++-------------------------------------------------------------------------------+-- Benchmarking utilities+-------------------------------------------------------------------------------++-- XXX once we convert all the functions to use this we can rename this to+-- benchIOSink+{-# INLINE benchIOSink1 #-}+benchIOSink1 :: NFData b => String -> (Int -> IO b) -> Benchmark+benchIOSink1 name f = bench name $ nfIO $ randomRIO (1,1) >>= f++{-# INLINE benchIOSrc1 #-}+benchIOSrc1 :: String -> (Int -> IO ()) -> Benchmark+benchIOSrc1 name f = bench name $ nfIO $ randomRIO (1,1) >>= f++-- 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 benchFold #-}+benchFold :: NFData b+    => String -> (t IO Int -> IO b) -> (Int -> t IO Int) -> Benchmark+benchFold name f src = bench name $ nfIO $ randomRIO (1,1) >>= f . src++{-# INLINE benchPure #-}+benchPure :: NFData b => String -> (Int -> a) -> (a -> b) -> Benchmark+benchPure name src f = bench name $ nfIO $ randomRIO (1,1) >>= return . f . src++-- XXX once we convert all the functions to use this we can rename this to+-- benchPureSink+{-# INLINE benchPureSink1 #-}+benchPureSink1 :: NFData b => String -> (Int -> Identity b) -> Benchmark+benchPureSink1 name f =+    bench name $ nfIO $ randomRIO (1,1) >>= return . runIdentity . f++{-# INLINE benchPureSrc #-}+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+-------------------------------------------------------------------------------++{-# INLINABLE mkString #-}+mkString :: Int -> String+mkString value = "fromList [1" ++ concat (replicate value ",1") ++ "]"++{-# INLINABLE mkListString #-}+mkListString :: Int -> String+mkListString value = "[1" ++ concat (replicate value ",1") ++ "]"++{-# INLINABLE mkList #-}+mkList :: Int -> [Int]+mkList value = [1..value]++-------------------------------------------------------------------------------+-- Stream size+-------------------------------------------------------------------------------++defaultStreamSize :: Int+defaultStreamSize = 100000++-------------------------------------------------------------------------------+-- Parse custom CLI options+-------------------------------------------------------------------------------++newtype BenchOpts = StreamSize Int deriving Show++#ifdef MIN_VERSION_gauge+getStreamSize :: String -> Int+getStreamSize size =+    case (readMaybe size :: Maybe Int) of+        Just x -> x+        Nothing -> error "Stream size must be numeric"++options :: [OptDescr BenchOpts]+options =+    [+        System.Console.GetOpt.Option [] ["stream-size"] (ReqArg getSize "COUNT") "Stream element count"+    ]++    where++    getSize = StreamSize . getStreamSize++deleteOptArgs+    :: (Maybe String, Maybe String) -- (prev, yielded)+    -> String+    -> (Maybe String, Maybe String)+deleteOptArgs (Nothing, _) opt =+    if opt == "--stream-size"+    then (Just opt, Nothing)+    else (Just opt, Just opt)++deleteOptArgs (Just prev, _) opt =+    if opt == "--stream-size" || prev == "--stream-size"+    then (Just opt, Nothing)+    else (Just opt, Just opt)++parseCLIOpts :: Int -> IO (Int, Config, [String])+parseCLIOpts defStreamSize = do+    args <- getArgs+    -- Parse custom options+    let (opts, _, _, errs) = getOpt' Permute options args+    when (not $ null errs) $ error $ concat errs+    (streamSize, args') <-+        case opts of+            StreamSize x : _ -> do+                putStrLn $ "Stream size: " ++ show x+                -- When using the gauge "--measure-with" option we need to make+                -- sure that we pass the stream size to child process forked by+                -- gauge. So we use this env var for that purpose.+                setEnv "STREAM_SIZE" (show x)+                -- Hack! remove the option and its argument from args+                -- getOpt should have a way to return the unconsumed args in+                -- correct order.+                newArgs <-+                          evaluate+                        $ mapMaybe snd+                        $ scanl' deleteOptArgs (Nothing, Nothing) args+                return (x, newArgs)+            _ -> do+                r <- lookupEnv "STREAM_SIZE"+                case r of+                    Just x -> do+                        s <- evaluate $ getStreamSize x+                        return (s, args)+                    Nothing -> do+                        setEnv "STREAM_SIZE" (show defStreamSize)+                        return (defStreamSize, args)++    -- Parse gauge options+    let config = defaultConfig+                { timeLimit = Just 1+                , minDuration = 0+                , includeFirstIter = streamSize > defStreamSize+                }+    let (cfg, benches) = parseWith config args'+    streamSize `seq` return (streamSize, cfg, benches)++#else+instance IsOption BenchOpts where+    defaultValue = StreamSize defaultStreamSize+    parseValue = fmap StreamSize . safeRead+    optionName = pure "stream-size"+    optionHelp = pure "Size of the stream to be used in benchmarks"++parseCLIOpts :: Int -> Benchmark -> IO (Int, [Ingredient])+parseCLIOpts defStreamSize benches = do+    let customOpts  = [Test.Tasty.Options.Option (Proxy :: Proxy BenchOpts)]+        ingredients = includingOptions customOpts : benchIngredients+    opts <- parseOptions ingredients benches -- (TestGroup "" [])+    let StreamSize size = lookupOption opts+    -- putStrLn $ "Stream size: " ++ show size+    if size == defaultStreamSize+    then return (defStreamSize, ingredients)+    else return (size, ingredients)+#endif++runWithCLIOptsEnv :: Int -> (Int -> IO a) -> (a -> Int -> [Benchmark]) -> IO ()+runWithCLIOptsEnv defStreamSize alloc mkBench = do++#ifdef MIN_VERSION_gauge+    (value, cfg, benches) <- parseCLIOpts defStreamSize+    r <- alloc value+    value `seq` runMode (mode cfg) cfg benches (mkBench r value)+#else+    r0 <- alloc 0+    (value, ingredients) <-+        parseCLIOpts defStreamSize $ bgroup "All" (mkBench r0 0)+    r <- alloc value+    value `seq` defaultMainWithIngredients ingredients+        $ bgroup "All" (mkBench r value)+#endif++runWithCLIOpts :: Int -> (Int -> [Benchmark]) -> IO ()+runWithCLIOpts defStreamSize f =+    runWithCLIOptsEnv defStreamSize+        (const $ return undefined)+        (\_ v -> f v)
+ benchmark/lib/Streamly/Benchmark/Common/Handle.hs view
@@ -0,0 +1,228 @@+-- |+-- Module      : Streamly.Benchmark.Common.Handle+-- 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 Streamly.Benchmark.Common.Handle+    ( BenchEnv (..)+    , RefHandles (..)+    , scratchDir+    , inFileSmall+    , inFileBig+    , outfile+    , mkBench+    , mkBenchSmall+    , 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)+import System.IO (openFile, IOMode(..), Handle, hClose, stderr, hPutStrLn)+import System.Process (callCommand)++import Data.IORef+import Prelude hiding (last, length)+import Test.Tasty.Bench hiding (env)+++scratchDir :: String+scratchDir = "benchmark-tmp/"++outfile :: String+outfile = scratchDir ++ "out.txt"++inFileSmall :: String+inFileSmall = scratchDir ++ "in-10MB.txt"++inFileBig :: String+inFileBig = scratchDir ++ "in-100MB.txt"++data RefHandles = RefHandles+    { smallInH :: Handle+    , bigInH :: Handle+    , outputH :: Handle+    }++data Handles = Handles !Handle !Handle++instance NFData Handles where+    rnf _ = ()++data BenchEnv = BenchEnv+    { href :: IORef RefHandles+    , smallSize :: Int+    , bigSize :: Int+    , nullH :: Handle+    , smallInFile :: String+    , bigInFile :: String+    }++withScaling :: BenchEnv -> String -> String+withScaling env str =+    let factor = round (fromIntegral (bigSize env)+                    / (fromIntegral (smallSize env) :: Double)) :: Int+    in if factor == 1+       then str+       else str ++ " (1/" ++ show factor ++ ")"++getHandles :: BenchEnv -> (RefHandles -> Handles) -> IO Handles+getHandles env mkHandles = do+    r <- readIORef $ href env+    -- close old handles+    hClose $ smallInH r+    hClose $ bigInH r+    hClose $ outputH r++    -- reopen+    smallInHandle <- openFile (smallInFile env) ReadMode+    bigInHandle <- openFile (bigInFile env) ReadMode+    outHandle <- openFile outfile WriteMode++    let refHandles = RefHandles+            { smallInH = smallInHandle+            , bigInH = bigInHandle+            , outputH = outHandle+            }++    -- update+    writeIORef (href env) refHandles+    return $ mkHandles refHandles++mkBenchCommon ::+       NFData b+    => (RefHandles -> Handles)+    -> String+    -> BenchEnv+    -> (Handle -> Handle -> IO b)+    -> Benchmark+mkBenchCommon mkHandles name env action =+     bench name $ nfIO $ do+        -- XXX adds significant cpu time to the benchmarks+        -- tasty-bench should provide a better way to do this+        (Handles h1 h2) <- getHandles env mkHandles+        action h1 h2++mkBench ::+    NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark+mkBench name env action = mkBenchCommon useBigH name env action++    where++    useBigH (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh++mkBenchSmall ::+    NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark+mkBenchSmall name env action =+    mkBenchCommon useSmallH (withScaling env name) env action++    where++    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 #-}+isSpace                 :: Char -> Bool+-- isSpace includes non-breaking space+-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints+-- at or below 0x377 have been assigned, so we shouldn't have to worry about+-- any new spaces appearing below there. It would probably be best to+-- use branchless ||, but currently the eqLit transformation will undo that,+-- 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++{-# INLINE isSp #-}+isSp :: Word8 -> Bool+isSp = isSpace . chr . fromIntegral++smallFileSize :: Int+smallFileSize = 10 * 1024 * 1024++bigFileSize :: Int+bigFileSize = 100 * 1024 * 1024++mkHandleBenchEnv :: IO BenchEnv+mkHandleBenchEnv = do+    r <- lookupEnv "Benchmark_FileSystem_Handle_InputFile"+    (small, big) <-+        case r of+            Just inFileName -> return (inFileName, inFileName)+            Nothing -> do+                -- XXX will this work on windows/msys?+                let cmd infile size =+                        "mkdir -p " ++ scratchDir+                            ++ "; test -e " ++ infile+                            ++ " || { echo \"creating input file " ++ infile+                            ++ "\" && head -c " ++ show size+                            ++ " </dev/urandom >" ++ infile+                            ++ ";}"+                callCommand (cmd inFileSmall smallFileSize)+                callCommand (cmd inFileBig bigFileSize)+                return (inFileSmall, inFileBig)++    hPutStrLn stderr $ "Using small input file: " ++ small+    smallHandle <- openFile small ReadMode++    hPutStrLn stderr $ "Using big input file: " ++ big+    bigHandle <- openFile big ReadMode++    hPutStrLn stderr $ "Using output file: " ++ outfile+    outHandle <- openFile outfile WriteMode+    devNull <- openFile "/dev/null" WriteMode++    ssize <- fromIntegral <$> getFileSize small+    bsize <- fromIntegral <$> getFileSize big++    ref <- newIORef $ RefHandles+        { smallInH = smallHandle+        , bigInH = bigHandle+        , outputH = outHandle+        }++    let env = BenchEnv+            { href = ref+            , smallSize = ssize+            , bigSize = bsize+            , nullH = devNull+            , smallInFile = small+            , bigInFile = big+            }+    return env
+ benchmark/lib/Streamly/Benchmark/Prelude.hs view
@@ -0,0 +1,598 @@++-- |+-- Module      : Streamly.Benchmark.Prelude+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : MIT+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}++module Streamly.Benchmark.Prelude+    ( absTimes+    , apDiscardFst+    , apDiscardSnd+    , apLiftA2+    , benchIO+    , benchIOSink+    , benchIOSrc+    , breakAfterSome+    , composeN+    , concatFoldableWith+    , concatForFoldableWith+    , concatPairsWith+    , concatStreamsWith+    , filterAllInM+    , filterAllOutM+    , filterSome+    , fmapN+    , mapM+    , mapN+    , mkAsync+    , monadThen+    , runToList+    , sourceConcatMapId+    , sourceFoldMapM+    , sourceFoldMapWith+    , sourceFoldMapWithM+    , sourceFoldMapWithStream+    , sourceFracFromThenTo+    , sourceFracFromTo+    , sourceFromFoldable+    , sourceFromFoldableM+    , sourceFromList+    , sourceFromListM+    , sourceIntegerFromStep+    , sourceIntFromThenTo+    , sourceIntFromTo+    , sourceUnfoldr+    , sourceUnfoldrAction+    , sourceUnfoldrM+    , sourceUnfoldrMSerial+    , toListM+    , toListSome+    , toNull+    , toNullAp+    , toNullM+    , toNullM3+    , transformComposeMapM+    , transformMapM+    , transformTeeMapM+    -- , transformZipMapM+    )+where++import Control.Applicative (liftA2)+import Control.DeepSeq (NFData(..))+import Control.Exception (try)+import Data.Functor.Identity (Identity)+import GHC.Exception (ErrorCall)+import Prelude hiding (mapM)+import System.Random (randomRIO)++import qualified Data.Foldable as F+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 as IsStream+import qualified Streamly.Internal.Data.Pipe as Pipe+import qualified Streamly.Internal.Data.Stream.Serial as Serial++import Test.Tasty.Bench+import Streamly.Internal.Data.Time.Units++-- Common polymorphic stream APIs used across multiple stream modules++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- enumerate+-------------------------------------------------------------------------------++{-# INLINE sourceIntFromTo #-}+sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int+sourceIntFromTo value n = S.enumerateFromTo n (n + value)++{-# INLINE sourceIntFromThenTo #-}+sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int+sourceIntFromThenTo value n = S.enumerateFromThenTo n (n + 1) (n + value)++{-# INLINE sourceFracFromTo #-}+sourceFracFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Double+sourceFracFromTo value n =+    S.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))++{-# INLINE sourceFracFromThenTo #-}+sourceFracFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Double+sourceFracFromThenTo value n = S.enumerateFromThenTo (fromIntegral n)+    (fromIntegral n + 1.0001) (fromIntegral (n + value))++{-# INLINE sourceIntegerFromStep #-}+sourceIntegerFromStep :: (Monad m, S.IsStream t) => Int -> Int -> t m Integer+sourceIntegerFromStep value n =+    S.take value $ S.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)++-------------------------------------------------------------------------------+-- unfold+-------------------------------------------------------------------------------++{-# INLINE sourceUnfoldr #-}+sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int+sourceUnfoldr count start = S.unfoldr step start+    where+    step cnt =+        if cnt > start + count+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int+sourceUnfoldrM count start = S.unfoldrM step start+    where+    step cnt =+        if cnt > start + count+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE sourceUnfoldrMSerial #-}+sourceUnfoldrMSerial :: (S.IsStream t, Monad m) => Int -> Int -> t m Int+sourceUnfoldrMSerial count start =+    IsStream.fromSerial $ Serial.unfoldrM step start+    where+    step cnt =+        if cnt > start + count+        then return Nothing+        else return (Just (cnt, cnt + 1))++-------------------------------------------------------------------------------+-- fromList+-------------------------------------------------------------------------------++{-# INLINE sourceFromList #-}+sourceFromList :: (Monad m, S.IsStream t) => Int -> Int -> t m Int+sourceFromList value n = S.fromList [n..n+value]++{-# INLINE sourceFromListM #-}+sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int+sourceFromListM value n = S.fromListM (fmap return [n..n+value])++-------------------------------------------------------------------------------+-- fromFoldable+-------------------------------------------------------------------------------++{-# INLINE sourceFromFoldable #-}+sourceFromFoldable :: S.IsStream t => Int -> Int -> t m Int+sourceFromFoldable value n = S.fromFoldable [n..n+value]++{-# INLINE sourceFromFoldableM #-}+sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int+sourceFromFoldableM value n = S.fromFoldableM (fmap return [n..n+value])++-------------------------------------------------------------------------------+-- Time enumeration+-------------------------------------------------------------------------------++{-# INLINE absTimes #-}+absTimes :: (S.IsStream t, S.MonadAsync m, Functor (t m))+    => Int -> Int -> t m AbsTime+absTimes value _ = S.take value Internal.absTimes++-------------------------------------------------------------------------------+-- Buffering+-------------------------------------------------------------------------------++{-# INLINE mkAsync #-}+mkAsync :: (S.MonadAsync m, S.IsStream t) => (t m a -> S.SerialT m a) -> t m a -> m ()+mkAsync adapter = S.drain . adapter . S.mkAsync++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE toNull #-}+toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()+toNull t = S.drain . t++-- 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.++-- | 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+benchIOSink value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value++-- | Takes a source, and uses it with a default drain/fold method.+{-# INLINE benchIOSrc #-}+benchIOSrc+    :: (t IO a -> S.SerialT IO a)+    -> String+    -> (Int -> t IO a)+    -> Benchmark+benchIOSrc t name f =+    bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f++{-# NOINLINE benchIO #-}+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++{-# INLINE sourceUnfoldrAction #-}+sourceUnfoldrAction :: (S.IsStream t, Monad m, Monad m1)+    => Int -> Int -> t m (m1 Int)+sourceUnfoldrAction value n = S.fromSerial $ S.unfoldr step n+    where+    step cnt =+        if cnt > n + value+        then Nothing+        else Just (return cnt, cnt + 1)++{-# INLINE composeN #-}+composeN ::+       (S.IsStream t, Monad m)+    => Int+    -> (t m Int -> S.SerialT m Int)+    -> t m Int+    -> m ()+composeN n f =+    case n of+        1 -> S.drain . f+        2 -> S.drain . f . S.adapt . f+        3 -> S.drain . f . S.adapt . f . S.adapt . f+        4 -> S.drain . f . S.adapt . f . S.adapt . f . S.adapt . f+        _ -> undefined++{-# INLINE fmapN #-}+fmapN ::+       (S.IsStream t, S.MonadAsync m, Functor (t m))+    => (t m Int -> S.SerialT m Int)+    -> Int+    -> t m Int+    -> m ()+fmapN t n = composeN n $ t . fmap (+ 1)++{-# INLINE mapN #-}+mapN ::+       (S.IsStream t, S.MonadAsync m)+    => (t m Int -> S.SerialT m Int)+    -> Int+    -> t m Int+    -> m ()+mapN t n = composeN n $ t . S.map (+ 1)++{-# INLINE mapM #-}+mapM ::+       (S.IsStream t, S.MonadAsync m)+    => (t m Int -> S.SerialT m Int)+    -> Int+    -> t m Int+    -> m ()+mapM t n = composeN n $ t . S.mapM return++-------------------------------------------------------------------------------+-- Pipes+-------------------------------------------------------------------------------++{-# INLINE transformMapM #-}+transformMapM ::+       (S.IsStream t, S.MonadAsync m)+    => (t m Int -> S.SerialT m Int)+    -> Int+    -> t m Int+    -> m ()+transformMapM t n = composeN n $ t . Internal.transform (Pipe.mapM return)++{-# INLINE transformComposeMapM #-}+transformComposeMapM ::+       (S.IsStream t, S.MonadAsync m)+    => (t m Int -> S.SerialT m Int)+    -> Int+    -> t m Int+    -> m ()+transformComposeMapM t n =+    composeN n $+    t .+    Internal.transform+        (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`+         Pipe.mapM (\x -> return (x + 2)))++{-# INLINE transformTeeMapM #-}+transformTeeMapM ::+       (S.IsStream t, S.MonadAsync m)+    => (t m Int -> S.SerialT m Int)+    -> Int+    -> t m Int+    -> m ()+transformTeeMapM t n =+    composeN n $+    t .+    Internal.transform+        (Pipe.mapM (\x -> return (x + 1)) `Pipe.teeMerge`+         Pipe.mapM (\x -> return (x + 2)))++{-+{-# INLINE transformZipMapM #-}+transformZipMapM ::+       (S.IsStream t, S.MonadAsync m)+    => (t m Int -> S.SerialT m Int)+    -> Int+    -> t m Int+    -> m ()+transformZipMapM t n =+    composeN n $+    t .+    Internal.transform+        (Pipe.zipWith+             (+)+             (Pipe.mapM (\x -> return (x + 1)))+             (Pipe.mapM (\x -> return (x + 2))))+-}++-------------------------------------------------------------------------------+-- Streams of streams+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Concat foldable+-------------------------------------------------------------------------------++{-# INLINE sourceFoldMapWith #-}+sourceFoldMapWith :: (S.IsStream t, Semigroup (t m Int))+    => Int -> Int -> t m Int+sourceFoldMapWith value n = S.concatMapFoldableWith (<>) S.fromPure [n..n+value]++{-# INLINE concatForFoldableWith #-}+concatForFoldableWith :: (S.IsStream t, Semigroup (t m Int))+    => Int -> Int -> t m Int+concatForFoldableWith value n =+    S.concatForFoldableWith (<>) [n..n+value] S.fromPure++{-# INLINE concatFoldableWith #-}+concatFoldableWith :: (S.IsStream t, Semigroup (t m Int))+    => Int -> Int -> t m Int+concatFoldableWith value n =+    let step x =+            if x <= n + value+            then Just (S.fromPure x, x + 1)+            else Nothing+        list = List.unfoldr step n+     in S.concatFoldableWith (<>) list++{-# INLINE sourceFoldMapWithStream #-}+sourceFoldMapWithStream :: (S.IsStream t, Semigroup (t m Int))+    => Int -> Int -> t m Int+sourceFoldMapWithStream value n = S.concatMapFoldableWith (<>) S.fromPure+    $ (S.enumerateFromTo n (n + value) :: S.SerialT Identity Int)++{-# INLINE sourceFoldMapWithM #-}+sourceFoldMapWithM :: (S.IsStream t, Monad m, Semigroup (t m Int))+    => Int -> Int -> t m Int+sourceFoldMapWithM value n =+    S.concatMapFoldableWith (<>) (S.fromEffect . return) [n..n+value]++{-# INLINE sourceFoldMapM #-}+sourceFoldMapM :: (S.IsStream t, Monad m, Monoid (t m Int))+    => Int -> Int -> t m Int+sourceFoldMapM value n = F.foldMap (S.fromEffect . return) [n..n+value]++-------------------------------------------------------------------------------+-- Concat+-------------------------------------------------------------------------------++{-# INLINE sourceConcatMapId #-}+sourceConcatMapId :: (S.IsStream t, Monad m)+    => Int -> Int -> t m (t m Int)+sourceConcatMapId value n =+    S.fromFoldable $ fmap (S.fromEffect . return) [n..n+value]++-- concatMapWith++{-# INLINE concatStreamsWith #-}+concatStreamsWith+    :: (S.SerialT IO Int -> S.SerialT IO Int -> S.SerialT IO Int)+    -> Int+    -> Int+    -> Int+    -> IO ()+concatStreamsWith op outer inner n =+    S.drain $ S.concatMapWith op+        (S.fromSerial . sourceUnfoldrM inner)+        (S.fromSerial $ sourceUnfoldrM outer n)++{-# INLINE concatPairsWith #-}+concatPairsWith+    :: (S.SerialT IO Int -> S.SerialT IO Int -> S.SerialT IO Int)+    -> Int+    -> Int+    -> Int+    -> IO ()+concatPairsWith op outer inner n =+    S.drain $ Internal.concatPairsWith op+        (S.fromSerial . sourceUnfoldrM inner)+        (S.fromSerial $ sourceUnfoldrM outer n)++-------------------------------------------------------------------------------+-- Monadic outer product+-------------------------------------------------------------------------------++{-# INLINE runToList #-}+runToList :: Monad m => S.SerialT m a -> m [a]+runToList = S.toList++{-# INLINE apDiscardFst #-}+apDiscardFst+    :: (S.IsStream t, S.MonadAsync m, Applicative (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+apDiscardFst linearCount t start = S.drain . t $+    S.fromSerial (sourceUnfoldrM nestedCount2 start)+        *> S.fromSerial (sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE apDiscardSnd #-}+apDiscardSnd+    :: (S.IsStream t, S.MonadAsync m, Applicative (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+apDiscardSnd linearCount t start = S.drain . t $+    S.fromSerial (sourceUnfoldrM nestedCount2 start)+        <* S.fromSerial (sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE apLiftA2 #-}+apLiftA2+    :: (S.IsStream t, S.MonadAsync m, Applicative (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+apLiftA2 linearCount t start = S.drain . t $+    liftA2 (+) (S.fromSerial (sourceUnfoldrM nestedCount2 start))+        (S.fromSerial (sourceUnfoldrM nestedCount2 start))++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullAp #-}+toNullAp+    :: (S.IsStream t, S.MonadAsync m, Applicative (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+toNullAp linearCount t start = S.drain . t $+    (+) <$> S.fromSerial (sourceUnfoldrM nestedCount2 start)+        <*> S.fromSerial (sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE monadThen #-}+monadThen+    :: (S.IsStream t, S.MonadAsync m, Monad (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+monadThen linearCount t start = S.drain . t $ do+    (S.fromSerial $ sourceUnfoldrM nestedCount2 start) >>+        (S.fromSerial $ sourceUnfoldrM nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullM #-}+toNullM+    :: (S.IsStream t, S.MonadAsync m, Monad (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+toNullM linearCount t start = S.drain . t $ do+    x <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    y <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    return $ x + y++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullM3 #-}+toNullM3+    :: (S.IsStream t, S.MonadAsync m, Monad (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+toNullM3 linearCount t start = S.drain . t $ do+    x <- S.fromSerial $ sourceUnfoldrM nestedCount3 start+    y <- S.fromSerial $ sourceUnfoldrM nestedCount3 start+    z <- S.fromSerial $ sourceUnfoldrM nestedCount3 start+    return $ x + y + z+  where+    nestedCount3 = round (fromIntegral linearCount**(1/3::Double))++{-# INLINE toListM #-}+toListM+    :: (S.IsStream t, S.MonadAsync m, Monad (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]+toListM linearCount t start = runToList . t $ do+    x <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    y <- S.fromSerial $ 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+    :: (S.IsStream t, S.MonadAsync m, Monad (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]+toListSome linearCount t start =+    runToList . t $ S.take 10000 $ do+        x <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+        y <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+        return $ x + y+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterAllOutM #-}+filterAllOutM+    :: (S.IsStream t, S.MonadAsync m, Monad (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+filterAllOutM linearCount t start = S.drain . t $ do+    x <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    y <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    let s = x + y+    if s < 0+    then return s+    else S.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterAllInM #-}+filterAllInM+    :: (S.IsStream t, S.MonadAsync m, Monad (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+filterAllInM linearCount t start = S.drain . t $ do+    x <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    y <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    let s = x + y+    if s > 0+    then return s+    else S.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterSome #-}+filterSome+    :: (S.IsStream t, S.MonadAsync m, Monad (t m))+    => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()+filterSome linearCount t start = S.drain . t $ do+    x <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    y <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+    let s = x + y+    if s > 1100000+    then return s+    else S.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE breakAfterSome #-}+breakAfterSome+    :: (S.IsStream t, Monad (t IO))+    => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()+breakAfterSome linearCount t start = do+    (_ :: Either ErrorCall ()) <- try $ S.drain . t $ do+        x <- S.fromSerial $ sourceUnfoldrM nestedCount2 start+        y <- S.fromSerial $ 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))
+ benchmark/streamly-benchmarks.cabal view
@@ -0,0 +1,802 @@+cabal-version:      2.2+name:               streamly-benchmarks+version:            0.0.0+synopsis:           Benchmarks for streamly+description: Benchmarks are separated from the main package because we+  want to have a library for benchmarks to reuse the code across different+  benchmark executables. For example, we have common benchmarking code for+  different types of streams. We need different benchmarking executables+  for serial, async, ahead style streams, therefore, we need to use+  the common code in several benchmarks, just changing the type of+  the stream. It takes a long time to compile this file and it gets+  compiled for each benchmark once if we do not have a library.  Cabal+  does not support internal libraries without per-component builds and+  per-component builds are not supported with Configure, so we are not+  left with any other choice.++flag fusion-plugin+  description: Use fusion plugin for benchmarks and executables+  manual: True+  default: False++flag limit-build-mem+  description: Limits memory when building the executables+  manual: True+  default: False++flag inspection+  description: Enable inspection testing+  manual: True+  default: False++flag debug+  description: Debug build with asserts enabled+  manual: True+  default: False++flag dev+  description: Development build+  manual: True+  default: False++flag include-strict-utf8+  description: Include strict utf8 input benchmarks+  manual: True+  default: False++flag has-llvm+  description: Use llvm backend for better performance+  manual: True+  default: False++flag opt+  description: off=-O0 (faster builds), on=-O2+  manual: True+  default: True++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 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++    if flag(include-strict-utf8)+      cpp-options:    -DINCLUDE_STRICT_UTF8++    if flag(inspection)+      cpp-options:    -DINSPECTION++    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++    if flag(dev)+      ghc-options:    -Wmissed-specialisations+                      -Wall-missed-specialisations++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+    ghc-options: -O0++common lib-options+  import: compile-options, optimization-options++common bench-depends+  build-depends:+    -- 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.23+    , deepseq             >= 1.4.1 && < 1.6+    , mtl                 >= 2.2   && < 2.4++    -- other libraries+    , exceptions >= 0.8   && < 0.11+    , random              >= 1.0   && < 2.0+    , transformers        >= 0.4   && < 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.6+    , ghc-prim          >= 0.4   && < 0.14+    , tasty-bench       >= 0.3   && < 0.6+    , tasty             >= 1.4.1 && < 1.6+    , streamly-core++  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.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)+    build-depends: inspection-and-dev-flags-cannot-be-used-together++-------------------------------------------------------------------------------+-- Library+-------------------------------------------------------------------------------++library+    import: lib-options, bench-depends+    hs-source-dirs: lib+    exposed-modules: Streamly.Benchmark.Common+                    , Streamly.Benchmark.Common.Handle+    if flag(use-prelude)+      exposed-modules: Streamly.Benchmark.Prelude+++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++common bench-options+  import: compile-options, optimization-options, bench-depends+  include-dirs: .+  ghc-options: -rtsopts -with-rtsopts "-t"+  if flag(limit-build-mem)+    ghc-options: +RTS -M512M -RTS+  build-depends: streamly-benchmarks == 0.0.0++-- Some benchmarks are threaded some are not+common bench-options-threaded+  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 "-t -N2"+  if flag(limit-build-mem)+    ghc-options: +RTS -M512M -RTS+  build-depends: streamly-benchmarks == 0.0.0++-------------------------------------------------------------------------------+-- Listed in alphabetical order+-------------------------------------------------------------------------------++benchmark Data.Array+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: ., Streamly/Benchmark/Data+  main-is: Streamly/Benchmark/Data/Array.hs+  other-modules:+      Stream.Common+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS++benchmark Data.Array.Generic+  import: bench-options+  type: exitcode-stdio-1.0+  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 -M1000M -RTS++benchmark Data.Array.Stream+  import: bench-options+  type: exitcode-stdio-1.0+  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 Data.Fold+  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++benchmark Data.Fold.Prelude+  import: bench-options+  type: exitcode-stdio-1.0+  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 Data.MutArray+  import: bench-options+  type: exitcode-stdio-1.0+  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 Data.Parser+  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+  if flag(limit-build-mem)+    if flag(dev)+      ghc-options: +RTS -M3000M -RTS+    else+      ghc-options: +RTS -M2500M -RTS++benchmark Data.ParserK+  import: bench-options+  type: exitcode-stdio-1.0+  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 Data.ParserK.Chunked+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data+  cpp-options: -DBENCH_CHUNKED+  main-is: ParserK.hs+  if impl(ghcjs)+    buildable: False+  else+    buildable: True+    build-depends: exceptions >= 0.8   && < 0.11++benchmark Data.ParserK.Chunked.Generic+  import: bench-options+  type: exitcode-stdio-1.0+  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.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: Scanl.hs++benchmark Data.Scanl.Window+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Scanl+  main-is: Window.hs++benchmark Data.Scanl.Concurrent+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Scanl+  main-is: Concurrent.hs+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True++-- XXX Should be renamed to MutByteArray+benchmark Data.Serialize+  import: bench-options+  type: exitcode-stdio-1.0+  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+  else+    buildable: False++benchmark Data.Stream+  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.Split+      Stream.Common+  if !flag(use-streamly-core)+    other-modules:+      Stream.Exceptions+  if flag(limit-build-mem)+    if flag(dev)+      ghc-options: +RTS -M3500M -RTS+    else+      ghc-options: +RTS -M2500M -RTS++benchmark Data.Stream.Adaptive+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Stream+  main-is: Adaptive.hs+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True++benchmark Data.Stream.Concurrent+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  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.ConcurrentEager+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  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++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+  else+    buildable: True++benchmark Data.Stream.ConcurrentOrdered+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  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 Data.Stream.ConcurrentThreadHeavy+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Stream+  main-is: ConcurrentThreadHeavy.hs+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True++benchmark Data.Stream.Rate+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/+  main-is: Rate.hs+  other-modules:+      Stream.ConcurrentCommon+      Stream.Common+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True++benchmark Data.StreamK+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data+  main-is: StreamK.hs+  if impl(ghcjs)+    buildable: False++-- XXX This needs to be cleaned up+benchmark Data.StreamK.FromStream+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/StreamK+  main-is: FromStream.hs+  if !flag(dev) || impl(ghcjs)+    buildable: False++benchmark Data.StreamK.StreamKAlt+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/StreamK+  main-is: StreamKAlt.hs+  if !flag(dev) || impl(ghcjs)+    buildable: False++benchmark Data.Unbox+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: .+  cpp-options: -DUSE_UNBOX+  main-is: Streamly/Benchmark/Data/Serialize.hs++benchmark Data.Unbox.Derive.TH+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: .+  cpp-options: -DUSE_UNBOX+  cpp-options: -DUSE_TH+  main-is: Streamly/Benchmark/Data/Serialize.hs++benchmark Data.Unfold+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: .+  main-is: Streamly/Benchmark/Data/Unfold.hs+  if impl(ghcjs)+    buildable: False+  else+    buildable: True++benchmark FileSystem.Handle+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/FileSystem+  main-is: Handle.hs+  other-modules:+      Handle.Read+    , Handle.ReadWrite+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True++benchmark FileSystem.DirIO+  import: bench-options+  type: exitcode-stdio-1.0+  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+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Unicode+  main-is: Char.hs+  -- Takes too much memory for 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/mk-hscope.sh view
@@ -0,0 +1,46 @@+#!/usr/bin/env bash++GHC_VERSION=8.10.4+STREAMLY_VERSION=0.9.0++case `uname` in+  Darwin) SYSTEM=x86_64-osx;;+  Linux) SYSTEM=x86_64-linux;;+  *) echo "Unsupported system"; exit 1 ;;+esac++pushd $(git rev-parse --show-toplevel)+git ls-files \+  | grep '\.l\?hs$' \+  | xargs hscope -b \+    -I src/ \+    -I test \+    -I dist-newstyle/build/$SYSTEM/ghc-$GHC_VERSION/streamly-$STREAMLY_VERSION/build/src/ \+    -X BangPatterns \+    -X CApiFFI \+    -X CPP \+    -X ConstraintKinds \+    -X DeriveDataTypeable \+    -X DeriveGeneric \+    -X DeriveTraversable \+    -X ExistentialQuantification \+    -X FlexibleContexts \+    -X FlexibleInstances \+    -X GeneralizedNewtypeDeriving \+    -X InstanceSigs \+    -X KindSignatures \+    -X LambdaCase \+    -X MagicHash \+    -X MultiParamTypeClasses \+    -X PatternSynonyms \+    -X RankNTypes \+    -X RecordWildCards \+    -X ScopedTypeVariables \+    -X TupleSections \+    -X TypeFamilies \+    -X ViewPatterns \+    -X NoMonoLocalBinds \+    -X TemplateHaskell \+    -X UnboxedTuples \+    -X UndecidableInstances+popd
+ bin/mk-tags.sh view
@@ -0,0 +1,25 @@+#!/bin/sh++HSCOPE_DIR=$HOME/.hscope+CODEX_CONFIG=$HOME/.codex++if test -e $CODEX_CONFIG+then+  echo "Please move or remove $CODEX_CONFIG and then run again"+  exit 1+fi++# XXX it does not seem to include the current project anyway+cat << EOF > $CODEX_CONFIG+currentProjectIncluded: true+hackagePath: $HSCOPE_DIR/packages/hackage.haskell.org/+tagsFileHeader: true+tagsFileName: tags+tagsFileSorted: true+tagsCmd: hasktags --ctags --follow-symlinks --output="\$TAGS" "\$SOURCES"+EOF++# XXX depends on cabal configure, does not seem to be supporting new cabal+# XXX it depends in the hackage index tar file in ~/.cabal+codex update --force+rm -f $CODEX_CONFIG
+ configure view
@@ -0,0 +1,4372 @@+#! /bin/sh+# Guess values for system-dependent variables and create Makefiles.+# Generated by GNU Autoconf 2.72 for streamly 0.11.1.+#+# Report bugs to <streamly@composewell.com>.+#+#+# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation,+# Inc.+#+#+# This configure script is free software; the Free Software Foundation+# gives unlimited permission to copy, distribute and modify it.+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1+then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+  setopt NO_GLOB_SUBST+else case e in #(+  e) case `(set -o) 2>/dev/null` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac ;;+esac+fi++++# Reset variables that may have inherited troublesome values from+# the environment.++# IFS needs to be set, to space, tab, and newline, in precisely that order.+# (If _AS_PATH_WALK were called with IFS unset, it would have the+# side effect of setting IFS to empty, thus disabling word splitting.)+# Quoting is to prevent editors from complaining about space-tab.+as_nl='+'+export as_nl+IFS=" ""	$as_nl"++PS1='$ '+PS2='> '+PS4='+ '++# Ensure predictable behavior from utilities with locale-dependent output.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# We cannot yet rely on "unset" to work, but we need these variables+# to be unset--not just set to an empty or harmless value--now, to+# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh).  This construct+# also avoids known problems related to "unset" and subshell syntax+# in other old shells (e.g. bash 2.01 and pdksh 5.2.14).+for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH+do eval test \${$as_var+y} \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done++# Ensure that fds 0, 1, and 2 are open.+if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi+if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi+if (exec 3>&2)            ; then :; else exec 2>/dev/null; fi++# The user is always right.+if ${PATH_SEPARATOR+false} :; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    test -r "$as_dir$0" && as_myself=$as_dir$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# We did not find ourselves, most probably we were run as 'sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+  as_myself=$0+fi+if test ! -f "$as_myself"; then+  printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi+++# Use a proper internal environment variable to ensure we don't fall+  # into an infinite loop, continuously re-executing ourselves.+  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then+    _as_can_reexec=no; export _as_can_reexec;+    # We cannot yet assume a decent shell, so we have to provide a+# neutralization value for shells without unset; and this also+# works around shells that cannot unset nonexistent variables.+# Preserve -v and -x to the replacement shell.+BASH_ENV=/dev/null+ENV=/dev/null+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+case $- in # ((((+  *v*x* | *x*v* ) as_opts=-vx ;;+  *v* ) as_opts=-v ;;+  *x* ) as_opts=-x ;;+  * ) as_opts= ;;+esac+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}+# Admittedly, this is quite paranoid, since all the known shells bail+# out after a failed 'exec'.+printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2+exit 255+  fi+  # We don't want this to propagate to other subprocesses.+          { _as_can_reexec=; unset _as_can_reexec;}+if test "x$CONFIG_SHELL" = x; then+  as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1+then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '\${1+\"\$@\"}'='\"\$@\"'+  setopt NO_GLOB_SUBST+else case e in #(+  e) case \`(set -o) 2>/dev/null\` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac ;;+esac+fi+"+  as_required="as_fn_return () { (exit \$1); }+as_fn_success () { as_fn_return 0; }+as_fn_failure () { as_fn_return 1; }+as_fn_ret_success () { return 0; }+as_fn_ret_failure () { return 1; }++exitcode=0+as_fn_success || { exitcode=1; echo as_fn_success failed.; }+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }+if ( set x; as_fn_ret_success y && test x = \"\$1\" )+then :++else case e in #(+  e) exitcode=1; echo positional parameters were not saved. ;;+esac+fi+test x\$exitcode = x0 || exit 1+blah=\$(echo \$(echo blah))+test x\"\$blah\" = xblah || exit 1+test -x / || exit 1"+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"+  if (eval "$as_required") 2>/dev/null+then :+  as_have_required=yes+else 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 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+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+  as_found=:+  case $as_dir in #(+	 /*)+	   for as_base in sh bash ksh sh5; do+	     # Try only shells that exist, to save several forks.+	     as_shell=$as_dir$as_base+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&+		    as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null+then :+  CONFIG_SHELL=$as_shell as_have_required=yes+		   if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null+then :+  break 2+fi+fi+	   done;;+       esac+  as_found=false+done+IFS=$as_save_IFS+if $as_found+then :++else 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 ;;+esac+fi+++      if test "x$CONFIG_SHELL" != x+then :+  export CONFIG_SHELL+             # We cannot yet assume a decent shell, so we have to provide a+# neutralization value for shells without unset; and this also+# works around shells that cannot unset nonexistent variables.+# Preserve -v and -x to the replacement shell.+BASH_ENV=/dev/null+ENV=/dev/null+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+case $- in # ((((+  *v*x* | *x*v* ) as_opts=-vx ;;+  *v* ) as_opts=-v ;;+  *x* ) as_opts=-x ;;+  * ) as_opts= ;;+esac+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}+# Admittedly, this is quite paranoid, since all the known shells bail+# out after a failed 'exec'.+printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2+exit 255+fi++    if test x$as_have_required = xno+then :+  printf "%s\n" "$0: This script requires a shell more modern than all"+  printf "%s\n" "$0: the shells that I found on your system."+  if test ${ZSH_VERSION+y} ; then+    printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should"+    printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later."+  else+    printf "%s\n" "$0: Please tell bug-autoconf@gnu.org and+$0: streamly@composewell.com about your system, including+$0: any error possibly output before this message. Then+$0: install a modern shell, or manually run the script+$0: under such a shell if you do have one."+  fi+  exit 1+fi ;;+esac+fi+fi+SHELL=${CONFIG_SHELL-/bin/sh}+export SHELL+# Unset more variables known to interfere with behavior of common tools.+CLICOLOR_FORCE= GREP_OPTIONS=+unset CLICOLOR_FORCE GREP_OPTIONS++## --------------------- ##+## M4sh Shell Functions. ##+## --------------------- ##+# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset+++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p++# as_fn_executable_p FILE+# -----------------------+# Test if FILE is an executable regular file.+as_fn_executable_p ()+{+  test -f "$1" && test -x "$1"+} # as_fn_executable_p+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null+then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else case e in #(+  e) as_fn_append ()+  {+    eval $1=\$$1\$2+  } ;;+esac+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null+then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else case e in #(+  e) as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  } ;;+esac+fi # as_fn_arith+++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  printf "%s\n" "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits+++  as_lineno_1=$LINENO as_lineno_1a=$LINENO+  as_lineno_2=$LINENO as_lineno_2a=$LINENO+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)+  sed -n '+    p+    /[$]LINENO/=+  ' <$as_myself |+    sed '+      t clear+      :clear+      s/[$]LINENO.*/&-/+      t lineno+      b+      :lineno+      N+      :loop+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/+      t loop+      s/-\n.*//+    ' >$as_me.lineno &&+  chmod +x "$as_me.lineno" ||+    { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }++  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have+  # already done that, so ensure we don't try to do so again and fall+  # in an infinite loop.  This has already happened in practice.+  _as_can_reexec=no; export _as_can_reexec+  # Don't try to exec as it changes $[0], causing all sort of problems+  # (the dirname of $[0] is not the place where we might find the+  # original and so on.  Autoconf is especially sensitive to this).+  . "./$as_me.lineno"+  # Exit status is that of the last command.+  exit+}+++# Determine whether it's possible to make 'echo' print without a newline.+# These variables are no longer used directly by Autoconf, but are AC_SUBSTed+# for compatibility with existing Makefiles.+ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++# For backward compatibility with old third-party macros, we provide+# the shell variables $as_echo and $as_echo_n.  New code should use+# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively.+as_echo='printf %s\n'+as_echo_n='printf %s'++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+  rm -f conf$$.dir/conf$$.file+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  if ln -s conf$$.file conf$$ 2>/dev/null; then+    as_ln_s='ln -s'+    # ... but there are two gotchas:+    # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable.+    # In both cases, we have to default to 'cp -pR'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -pR'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -pR'+  fi+else+  as_ln_s='cp -pR'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null++if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++as_test_x='test -x'+as_executable_p=as_fn_executable_p++# Sed expression to map a string onto a valid CPP name.+as_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_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+exec 6>&1++# Name of the host.+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,+# so uname gets run too.+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`++#+# Initializations.+#+ac_default_prefix=/usr/local+ac_clean_files=+ac_config_libobj_dir=.+LIBOBJS=+cross_compiling=no+subdirs=+MFLAGS=+MAKEFLAGS=++# Identity of this package.+PACKAGE_NAME='streamly'+PACKAGE_TARNAME='streamly'+PACKAGE_VERSION='0.11.1'+PACKAGE_STRING='streamly 0.11.1'+PACKAGE_BUGREPORT='streamly@composewell.com'+PACKAGE_URL='https://streamly.composewell.com'++ac_subst_vars='LTLIBOBJS+LIBOBJS+OBJEXT+EXEEXT+ac_ct_CC+CPPFLAGS+LDFLAGS+CFLAGS+CC+target_alias+host_alias+build_alias+LIBS+ECHO_T+ECHO_N+ECHO_C+DEFS+mandir+localedir+libdir+psdir+pdfdir+dvidir+htmldir+infodir+docdir+oldincludedir+includedir+runstatedir+localstatedir+sharedstatedir+sysconfdir+datadir+datarootdir+libexecdir+sbindir+bindir+program_transform_name+prefix+exec_prefix+PACKAGE_URL+PACKAGE_BUGREPORT+PACKAGE_STRING+PACKAGE_VERSION+PACKAGE_TARNAME+PACKAGE_NAME+PATH_SEPARATOR+SHELL'+ac_subst_files=''+ac_user_opts='+enable_option_checking+with_compiler+'+      ac_precious_vars='build_alias+host_alias+target_alias+CC+CFLAGS+LDFLAGS+LIBS+CPPFLAGS'+++# Initialize some variables set by options.+ac_init_help=+ac_init_version=false+ac_unrecognized_opts=+ac_unrecognized_sep=+# The variables have the same names as the options, with+# dashes changed to underlines.+cache_file=/dev/null+exec_prefix=NONE+no_create=+no_recursion=+prefix=NONE+program_prefix=NONE+program_suffix=NONE+program_transform_name=s,x,x,+silent=+site=+srcdir=+verbose=+x_includes=NONE+x_libraries=NONE++# Installation directory options.+# These are left unexpanded so users can "make install exec_prefix=/foo"+# and all the variables that are supposed to be based on exec_prefix+# by default will actually change.+# Use braces instead of parens because sh, perl, etc. also accept them.+# (The list follows the same order as the GNU Coding Standards.)+bindir='${exec_prefix}/bin'+sbindir='${exec_prefix}/sbin'+libexecdir='${exec_prefix}/libexec'+datarootdir='${prefix}/share'+datadir='${datarootdir}'+sysconfdir='${prefix}/etc'+sharedstatedir='${prefix}/com'+localstatedir='${prefix}/var'+runstatedir='${localstatedir}/run'+includedir='${prefix}/include'+oldincludedir='/usr/include'+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'+infodir='${datarootdir}/info'+htmldir='${docdir}'+dvidir='${docdir}'+pdfdir='${docdir}'+psdir='${docdir}'+libdir='${exec_prefix}/lib'+localedir='${datarootdir}/locale'+mandir='${datarootdir}/man'++ac_prev=+ac_dashdash=+for ac_option+do+  # If the previous option needs an argument, assign it.+  if test -n "$ac_prev"; then+    eval $ac_prev=\$ac_option+    ac_prev=+    continue+  fi++  case $ac_option in+  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;+  *=)   ac_optarg= ;;+  *)    ac_optarg=yes ;;+  esac++  case $ac_dashdash$ac_option in+  --)+    ac_dashdash=yes ;;++  -bindir | --bindir | --bindi | --bind | --bin | --bi)+    ac_prev=bindir ;;+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)+    bindir=$ac_optarg ;;++  -build | --build | --buil | --bui | --bu)+    ac_prev=build_alias ;;+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)+    build_alias=$ac_optarg ;;++  -cache-file | --cache-file | --cache-fil | --cache-fi \+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)+    ac_prev=cache_file ;;+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)+    cache_file=$ac_optarg ;;++  --config-cache | -C)+    cache_file=config.cache ;;++  -datadir | --datadir | --datadi | --datad)+    ac_prev=datadir ;;+  -datadir=* | --datadir=* | --datadi=* | --datad=*)+    datadir=$ac_optarg ;;++  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \+  | --dataroo | --dataro | --datar)+    ac_prev=datarootdir ;;+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)+    datarootdir=$ac_optarg ;;++  -disable-* | --disable-*)+    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid feature name: '$ac_useropt'"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=no ;;++  -docdir | --docdir | --docdi | --doc | --do)+    ac_prev=docdir ;;+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)+    docdir=$ac_optarg ;;++  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)+    ac_prev=dvidir ;;+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)+    dvidir=$ac_optarg ;;++  -enable-* | --enable-*)+    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid feature name: '$ac_useropt'"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=\$ac_optarg ;;++  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \+  | --exec | --exe | --ex)+    ac_prev=exec_prefix ;;+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \+  | --exec=* | --exe=* | --ex=*)+    exec_prefix=$ac_optarg ;;++  -gas | --gas | --ga | --g)+    # Obsolete; use --with-gas.+    with_gas=yes ;;++  -help | --help | --hel | --he | -h)+    ac_init_help=long ;;+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)+    ac_init_help=recursive ;;+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)+    ac_init_help=short ;;++  -host | --host | --hos | --ho)+    ac_prev=host_alias ;;+  -host=* | --host=* | --hos=* | --ho=*)+    host_alias=$ac_optarg ;;++  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)+    ac_prev=htmldir ;;+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \+  | --ht=*)+    htmldir=$ac_optarg ;;++  -includedir | --includedir | --includedi | --included | --include \+  | --includ | --inclu | --incl | --inc)+    ac_prev=includedir ;;+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \+  | --includ=* | --inclu=* | --incl=* | --inc=*)+    includedir=$ac_optarg ;;++  -infodir | --infodir | --infodi | --infod | --info | --inf)+    ac_prev=infodir ;;+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)+    infodir=$ac_optarg ;;++  -libdir | --libdir | --libdi | --libd)+    ac_prev=libdir ;;+  -libdir=* | --libdir=* | --libdi=* | --libd=*)+    libdir=$ac_optarg ;;++  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \+  | --libexe | --libex | --libe)+    ac_prev=libexecdir ;;+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \+  | --libexe=* | --libex=* | --libe=*)+    libexecdir=$ac_optarg ;;++  -localedir | --localedir | --localedi | --localed | --locale)+    ac_prev=localedir ;;+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)+    localedir=$ac_optarg ;;++  -localstatedir | --localstatedir | --localstatedi | --localstated \+  | --localstate | --localstat | --localsta | --localst | --locals)+    ac_prev=localstatedir ;;+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)+    localstatedir=$ac_optarg ;;++  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)+    ac_prev=mandir ;;+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)+    mandir=$ac_optarg ;;++  -nfp | --nfp | --nf)+    # Obsolete; use --without-fp.+    with_fp=no ;;++  -no-create | --no-create | --no-creat | --no-crea | --no-cre \+  | --no-cr | --no-c | -n)+    no_create=yes ;;++  -no-recursion | --no-recursion | --no-recursio | --no-recursi \+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)+    no_recursion=yes ;;++  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \+  | --oldin | --oldi | --old | --ol | --o)+    ac_prev=oldincludedir ;;+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)+    oldincludedir=$ac_optarg ;;++  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)+    ac_prev=prefix ;;+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)+    prefix=$ac_optarg ;;++  -program-prefix | --program-prefix | --program-prefi | --program-pref \+  | --program-pre | --program-pr | --program-p)+    ac_prev=program_prefix ;;+  -program-prefix=* | --program-prefix=* | --program-prefi=* \+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)+    program_prefix=$ac_optarg ;;++  -program-suffix | --program-suffix | --program-suffi | --program-suff \+  | --program-suf | --program-su | --program-s)+    ac_prev=program_suffix ;;+  -program-suffix=* | --program-suffix=* | --program-suffi=* \+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)+    program_suffix=$ac_optarg ;;++  -program-transform-name | --program-transform-name \+  | --program-transform-nam | --program-transform-na \+  | --program-transform-n | --program-transform- \+  | --program-transform | --program-transfor \+  | --program-transfo | --program-transf \+  | --program-trans | --program-tran \+  | --progr-tra | --program-tr | --program-t)+    ac_prev=program_transform_name ;;+  -program-transform-name=* | --program-transform-name=* \+  | --program-transform-nam=* | --program-transform-na=* \+  | --program-transform-n=* | --program-transform-=* \+  | --program-transform=* | --program-transfor=* \+  | --program-transfo=* | --program-transf=* \+  | --program-trans=* | --program-tran=* \+  | --progr-tra=* | --program-tr=* | --program-t=*)+    program_transform_name=$ac_optarg ;;++  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)+    ac_prev=pdfdir ;;+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)+    pdfdir=$ac_optarg ;;++  -psdir | --psdir | --psdi | --psd | --ps)+    ac_prev=psdir ;;+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)+    psdir=$ac_optarg ;;++  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil)+    silent=yes ;;++  -runstatedir | --runstatedir | --runstatedi | --runstated \+  | --runstate | --runstat | --runsta | --runst | --runs \+  | --run | --ru | --r)+    ac_prev=runstatedir ;;+  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \+  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \+  | --run=* | --ru=* | --r=*)+    runstatedir=$ac_optarg ;;++  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)+    ac_prev=sbindir ;;+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \+  | --sbi=* | --sb=*)+    sbindir=$ac_optarg ;;++  -sharedstatedir | --sharedstatedir | --sharedstatedi \+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \+  | --sharedst | --shareds | --shared | --share | --shar \+  | --sha | --sh)+    ac_prev=sharedstatedir ;;+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \+  | --sha=* | --sh=*)+    sharedstatedir=$ac_optarg ;;++  -site | --site | --sit)+    ac_prev=site ;;+  -site=* | --site=* | --sit=*)+    site=$ac_optarg ;;++  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)+    ac_prev=srcdir ;;+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)+    srcdir=$ac_optarg ;;++  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \+  | --syscon | --sysco | --sysc | --sys | --sy)+    ac_prev=sysconfdir ;;+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)+    sysconfdir=$ac_optarg ;;++  -target | --target | --targe | --targ | --tar | --ta | --t)+    ac_prev=target_alias ;;+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)+    target_alias=$ac_optarg ;;++  -v | -verbose | --verbose | --verbos | --verbo | --verb)+    verbose=yes ;;++  -version | --version | --versio | --versi | --vers | -V)+    ac_init_version=: ;;++  -with-* | --with-*)+    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid package name: '$ac_useropt'"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=\$ac_optarg ;;++  -without-* | --without-*)+    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`+    # Reject names that are not valid shell variable names.+    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&+      as_fn_error $? "invalid package name: '$ac_useropt'"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=no ;;++  --x)+    # Obsolete; use --with-x.+    with_x=yes ;;++  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \+  | --x-incl | --x-inc | --x-in | --x-i)+    ac_prev=x_includes ;;+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)+    x_includes=$ac_optarg ;;++  -x-libraries | --x-libraries | --x-librarie | --x-librari \+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)+    ac_prev=x_libraries ;;+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \+  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)+    x_libraries=$ac_optarg ;;++  -*) as_fn_error $? "unrecognized option: '$ac_option'+Try '$0 --help' for more information"+    ;;++  *=*)+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`+    # Reject names that are not valid shell variable names.+    case $ac_envvar in #(+      '' | [0-9]* | *[!_$as_cr_alnum]* )+      as_fn_error $? "invalid variable name: '$ac_envvar'" ;;+    esac+    eval $ac_envvar=\$ac_optarg+    export $ac_envvar ;;++  *)+    # FIXME: should be removed in autoconf 3.0.+    printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&+      printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2+    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"+    ;;++  esac+done++if test -n "$ac_prev"; then+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`+  as_fn_error $? "missing argument to $ac_option"+fi++if test -n "$ac_unrecognized_opts"; then+  case $enable_option_checking in+    no) ;;+    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;+    *)     printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;+  esac+fi++# Check all directory arguments for consistency.+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \+		datadir sysconfdir sharedstatedir localstatedir includedir \+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \+		libdir localedir mandir runstatedir+do+  eval ac_val=\$$ac_var+  # Remove trailing slashes.+  case $ac_val in+    */ )+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`+      eval $ac_var=\$ac_val;;+  esac+  # Be sure to have absolute directory names.+  case $ac_val in+    [\\/$]* | ?:[\\/]* )  continue;;+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;+  esac+  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"+done++# There might be people who depend on the old broken behavior: '$host'+# used to hold the argument of --host etc.+# FIXME: To remove some day.+build=$build_alias+host=$host_alias+target=$target_alias++# FIXME: To remove some day.+if test "x$host_alias" != x; then+  if test "x$build_alias" = x; then+    cross_compiling=maybe+  elif test "x$build_alias" != "x$host_alias"; then+    cross_compiling=yes+  fi+fi++ac_tool_prefix=+test -n "$host_alias" && ac_tool_prefix=$host_alias-++test "$silent" = yes && exec 6>/dev/null+++ac_pwd=`pwd` && test -n "$ac_pwd" &&+ac_ls_di=`ls -di .` &&+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||+  as_fn_error $? "working directory cannot be determined"+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||+  as_fn_error $? "pwd does not report name of working directory"+++# Find the source files, if location was not specified.+if test -z "$srcdir"; then+  ac_srcdir_defaulted=yes+  # Try the directory containing this script, then the parent directory.+  ac_confdir=`$as_dirname -- "$as_myself" ||+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_myself" : 'X\(//\)[^/]' \| \+	 X"$as_myself" : 'X\(//\)$' \| \+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X"$as_myself" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  srcdir=$ac_confdir+  if test ! -r "$srcdir/$ac_unique_file"; then+    srcdir=..+  fi+else+  ac_srcdir_defaulted=no+fi+if test ! -r "$srcdir/$ac_unique_file"; then+  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."+  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"+fi+ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work"+ac_abs_confdir=`(+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"+	pwd)`+# When building in place, set srcdir=.+if test "$ac_abs_confdir" = "$ac_pwd"; then+  srcdir=.+fi+# Remove unnecessary trailing slashes from srcdir.+# Double slashes in file names in object file debugging info+# mess up M-x gdb in Emacs.+case $srcdir in+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;+esac+for ac_var in $ac_precious_vars; do+  eval ac_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_env_${ac_var}_value=\$${ac_var}+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_cv_env_${ac_var}_value=\$${ac_var}+done++#+# Report the --help message.+#+if test "$ac_init_help" = "long"; then+  # Omit some internal or obsolete options to make the list less imposing.+  # This message is too long to be a string in the A/UX 3.1 sh.+  cat <<_ACEOF+'configure' configures streamly 0.11.1 to adapt to many kinds of systems.++Usage: $0 [OPTION]... [VAR=VALUE]...++To assign environment variables (e.g., CC, CFLAGS...), specify them as+VAR=VALUE.  See below for descriptions of some of the useful variables.++Defaults for the options are specified in brackets.++Configuration:+  -h, --help              display this help and exit+      --help=short        display options specific to this package+      --help=recursive    display the short help of all the included packages+  -V, --version           display version information and exit+  -q, --quiet, --silent   do not print 'checking ...' messages+      --cache-file=FILE   cache test results in FILE [disabled]+  -C, --config-cache      alias for '--cache-file=config.cache'+  -n, --no-create         do not create output files+      --srcdir=DIR        find the sources in DIR [configure dir or '..']++Installation directories:+  --prefix=PREFIX         install architecture-independent files in PREFIX+                          [$ac_default_prefix]+  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX+                          [PREFIX]++By default, 'make install' will install all the files in+'$ac_default_prefix/bin', '$ac_default_prefix/lib' etc.  You can specify+an installation prefix other than '$ac_default_prefix' using '--prefix',+for instance '--prefix=\$HOME'.++For better control, use the options below.++Fine tuning of the installation directories:+  --bindir=DIR            user executables [EPREFIX/bin]+  --sbindir=DIR           system admin executables [EPREFIX/sbin]+  --libexecdir=DIR        program executables [EPREFIX/libexec]+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]+  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]+  --libdir=DIR            object code libraries [EPREFIX/lib]+  --includedir=DIR        C header files [PREFIX/include]+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]+  --infodir=DIR           info documentation [DATAROOTDIR/info]+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]+  --mandir=DIR            man documentation [DATAROOTDIR/man]+  --docdir=DIR            documentation root [DATAROOTDIR/doc/streamly]+  --htmldir=DIR           html documentation [DOCDIR]+  --dvidir=DIR            dvi documentation [DOCDIR]+  --pdfdir=DIR            pdf documentation [DOCDIR]+  --psdir=DIR             ps documentation [DOCDIR]+_ACEOF++  cat <<\_ACEOF+_ACEOF+fi++if test -n "$ac_init_help"; then+  case $ac_init_help in+     short | recursive ) echo "Configuration of streamly 0.11.1:";;+   esac+  cat <<\_ACEOF++Optional Packages:+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)+GHC++Some influential environment variables:+  CC          C compiler command+  CFLAGS      C compiler flags+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a+              nonstandard directory <lib dir>+  LIBS        libraries to pass to the linker, e.g. -l<library>+  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if+              you have headers in a nonstandard directory <include dir>++Use these variables to override the choices made by 'configure' or to help+it to find libraries and programs with nonstandard names/locations.++Report bugs to <streamly@composewell.com>.+streamly home page: <https://streamly.composewell.com>.+_ACEOF+ac_status=$?+fi++if test "$ac_init_help" = "recursive"; then+  # If there are subdirs, report their specific --help.+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue+    test -d "$ac_dir" ||+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||+      continue+    ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix++    cd "$ac_dir" || { ac_status=$?; continue; }+    # Check for configure.gnu first; this name is used for a wrapper for+    # Metaconfig's "Configure" on case-insensitive file systems.+    if test -f "$ac_srcdir/configure.gnu"; then+      echo &&+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive+    elif test -f "$ac_srcdir/configure"; then+      echo &&+      $SHELL "$ac_srcdir/configure" --help=recursive+    else+      printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2+    fi || ac_status=$?+    cd "$ac_pwd" || { ac_status=$?; break; }+  done+fi++test -n "$ac_init_help" && exit $ac_status+if $ac_init_version; then+  cat <<\_ACEOF+streamly configure 0.11.1+generated by GNU Autoconf 2.72++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+  exit+fi++## ------------------------ ##+## Autoconf initialization. ##+## ------------------------ ##++# ac_fn_c_try_compile LINENO+# --------------------------+# Try to compile conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_compile ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  rm -f conftest.$ac_objext conftest.beam+  if { { ac_try="$ac_compile"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_compile") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    grep -v '^ *+' conftest.err >conftest.er1+    cat conftest.er1 >&5+    mv -f conftest.er1 conftest.err+  fi+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext+then :+  ac_retval=0+else case e in #(+  e) printf "%s\n" "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_retval=1 ;;+esac+fi+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_compile++# ac_fn_check_decl LINENO SYMBOL VAR INCLUDES EXTRA-OPTIONS FLAG-VAR+# ------------------------------------------------------------------+# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR+# accordingly. Pass EXTRA-OPTIONS to the compiler, using FLAG-VAR.+ac_fn_check_decl ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  as_decl_name=`echo $2|sed 's/ *(.*//'`+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5+printf %s "checking whether $as_decl_name is declared... " >&6; }+if eval test \${$3+y}+then :+  printf %s "(cached) " >&6+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+/* end confdefs.h.  */+$4+int+main (void)+{+#ifndef $as_decl_name+#ifdef __cplusplus+  (void) $as_decl_use;+#else+  (void) $as_decl_name;+#endif+#endif++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  eval "$3=yes"+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+ ;;+esac+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_configure_args_raw=+for ac_arg+do+  case $ac_arg in+  *\'*)+    ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+  esac+  as_fn_append ac_configure_args_raw " '$ac_arg'"+done++case $ac_configure_args_raw in+  *$as_nl*)+    ac_safe_unquote= ;;+  *)+    ac_unsafe_z='|&;<>()$`\\"*?[ ''	' # This string ends in space, tab.+    ac_unsafe_a="$ac_unsafe_z#~"+    ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g"+    ac_configure_args_raw=`      printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;;+esac++cat >config.log <<_ACEOF+This file contains any messages produced by compilers while+running configure, to aid debugging if configure makes a mistake.++It was created by streamly $as_me 0.11.1, which was+generated by GNU Autoconf 2.72.  Invocation command line was++  $ $0$ac_configure_args_raw++_ACEOF+exec 5>>config.log+{+cat <<_ASUNAME+## --------- ##+## Platform. ##+## --------- ##++hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`+uname -m = `(uname -m) 2>/dev/null || echo unknown`+uname -r = `(uname -r) 2>/dev/null || echo unknown`+uname -s = `(uname -s) 2>/dev/null || echo unknown`+uname -v = `(uname -v) 2>/dev/null || echo unknown`++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`++/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`++_ASUNAME++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    printf "%s\n" "PATH: $as_dir"+  done+IFS=$as_save_IFS++} >&5++cat >&5 <<_ACEOF+++## ----------- ##+## Core tests. ##+## ----------- ##++_ACEOF+++# Keep a trace of the command line.+# Strip out --no-create and --no-recursion so they do not pile up.+# Strip out --silent because we don't want to record it for future runs.+# Also quote any args containing shell meta-characters.+# Make two passes to allow for proper duplicate-argument suppression.+ac_configure_args=+ac_configure_args0=+ac_configure_args1=+ac_must_keep_next=false+for ac_pass in 1 2+do+  for ac_arg+  do+    case $ac_arg in+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \+    | -silent | --silent | --silen | --sile | --sil)+      continue ;;+    *\'*)+      ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    case $ac_pass in+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;+    2)+      as_fn_append ac_configure_args1 " '$ac_arg'"+      if test $ac_must_keep_next = true; then+	ac_must_keep_next=false # Got value, back to normal.+      else+	case $ac_arg in+	  *=* | --config-cache | -C | -disable-* | --disable-* \+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \+	  | -with-* | --with-* | -without-* | --without-* | --x)+	    case "$ac_configure_args0 " in+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;+	    esac+	    ;;+	  -* ) ac_must_keep_next=true ;;+	esac+      fi+      as_fn_append ac_configure_args " '$ac_arg'"+      ;;+    esac+  done+done+{ ac_configure_args0=; unset ac_configure_args0;}+{ ac_configure_args1=; unset ac_configure_args1;}++# When interrupted or exit'd, cleanup temporary files, and complete+# config.log.  We remove comments because anyway the quotes in there+# would cause problems or look ugly.+# WARNING: Use '\'' to represent an apostrophe within the trap.+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.+trap 'exit_status=$?+  # Sanitize IFS.+  IFS=" ""	$as_nl"+  # Save into config.log some information that might help in debugging.+  {+    echo++    printf "%s\n" "## ---------------- ##+## Cache variables. ##+## ---------------- ##"+    echo+    # The following way of writing the cache mishandles newlines in values,+(+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done+  (set) 2>&1 |+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      sed -n \+	"s/'\''/'\''\\\\'\'''\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"+      ;; #(+    *)+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+)+    echo++    printf "%s\n" "## ----------------- ##+## Output variables. ##+## ----------------- ##"+    echo+    for ac_var in $ac_subst_vars+    do+      eval ac_val=\$$ac_var+      case $ac_val in+      *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+      esac+      printf "%s\n" "$ac_var='\''$ac_val'\''"+    done | sort+    echo++    if test -n "$ac_subst_files"; then+      printf "%s\n" "## ------------------- ##+## File substitutions. ##+## ------------------- ##"+      echo+      for ac_var in $ac_subst_files+      do+	eval ac_val=\$$ac_var+	case $ac_val in+	*\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+	esac+	printf "%s\n" "$ac_var='\''$ac_val'\''"+      done | sort+      echo+    fi++    if test -s confdefs.h; then+      printf "%s\n" "## ----------- ##+## confdefs.h. ##+## ----------- ##"+      echo+      cat confdefs.h+      echo+    fi+    test "$ac_signal" != 0 &&+      printf "%s\n" "$as_me: caught signal $ac_signal"+    printf "%s\n" "$as_me: exit $exit_status"+  } >&5+  rm -f core *.core core.conftest.* &&+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&+    exit $exit_status+' 0+for ac_signal in 1 2 13 15; do+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal+done+ac_signal=0++# confdefs.h avoids OS command line length limits that DEFS can exceed.+rm -f -r conftest* confdefs.h++printf "%s\n" "/* confdefs.h */" > confdefs.h++# Predefined preprocessor variables.++printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h+++# Let the site file select an alternate cache file if it wants to.+# Prefer an explicitly selected file to automatically selected ones.+if test -n "$CONFIG_SITE"; then+  ac_site_files="$CONFIG_SITE"+elif test "x$prefix" != xNONE; then+  ac_site_files="$prefix/share/config.site $prefix/etc/config.site"+else+  ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"+fi++for ac_site_file in $ac_site_files+do+  case $ac_site_file in #(+  */*) :+     ;; #(+  *) :+    ac_site_file=./$ac_site_file ;;+esac+  if test -f "$ac_site_file" && test -r "$ac_site_file"; then+    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5+printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;}+    sed 's/^/| /' "$ac_site_file" >&5+    . "$ac_site_file" \+      || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}+as_fn_error $? "failed to load site script $ac_site_file+See 'config.log' for more details" "$LINENO" 5; }+  fi+done++if test -r "$cache_file"; then+  # Some versions of bash will fail to source /dev/null (special files+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then+    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5+printf "%s\n" "$as_me: loading cache $cache_file" >&6;}+    case $cache_file in+      [\\/]* | ?:[\\/]* ) . "$cache_file";;+      *)                      . "./$cache_file";;+    esac+  fi+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5+printf "%s\n" "$as_me: creating cache $cache_file" >&6;}+  >$cache_file+fi++# Test code for whether the C compiler supports C89 (global declarations)+ac_c_conftest_c89_globals='+/* Does the compiler advertise C89 conformance?+   Do not test the value of __STDC__, because some compilers set it to 0+   while being otherwise adequately conformant. */+#if !defined __STDC__+# error "Compiler does not advertise C89 conformance"+#endif++#include <stddef.h>+#include <stdarg.h>+struct stat;+/* Most of the following tests are stolen from RCS 5.7 src/conf.sh.  */+struct buf { int x; };+struct buf * (*rcsopen) (struct buf *, struct stat *, int);+static char *e (char **p, int i)+{+  return p[i];+}+static char *f (char * (*g) (char **, int), char **p, ...)+{+  char *s;+  va_list v;+  va_start (v,p);+  s = g (p, va_arg (v,int));+  va_end (v);+  return s;+}++/* 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+   as an "x".  The following induces an error, until -std is added to get+   proper ANSI mode.  Curiously \x00 != x always comes out true, for an+   array size at least.  It is necessary to write \x00 == 0 to get something+   that is true only with -std.  */+int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1];++/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters+   inside strings and character constants.  */+#define FOO(x) '\''x'\''+int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1];++int test (int i, double x);+struct s1 {int (*f) (int a);};+struct s2 {int (*f) (double a);};+int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int),+               int, int);'++# Test code for whether the C compiler supports C89 (body of main).+ac_c_conftest_c89_main='+ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]);+'++# Test code for whether the C compiler supports C99 (global declarations)+ac_c_conftest_c99_globals='+/* Does the compiler advertise C99 conformance? */+#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L+# error "Compiler does not advertise C99 conformance"+#endif++// 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+// FILE and stderr.+#define debug(...) dprintf (2, __VA_ARGS__)+#define showlist(...) puts (#__VA_ARGS__)+#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__))+static void+test_varargs_macros (void)+{+  int x = 1234;+  int y = 5678;+  debug ("Flag");+  debug ("X = %d\n", x);+  showlist (The first, second, and third items.);+  report (x>y, "x is %d but y is %d", x, y);+}++// Check long long types.+#define BIG64 18446744073709551615ull+#define BIG32 4294967295ul+#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0)+#if !BIG_OK+  #error "your preprocessor is broken"+#endif+#if BIG_OK+#else+  #error "your preprocessor is broken"+#endif+static long long int bignum = -9223372036854775807LL;+static unsigned long long int ubignum = BIG64;++struct incomplete_array+{+  int datasize;+  double data[];+};++struct named_init {+  int number;+  const wchar_t *name;+  double average;+};++typedef const char *ccp;++static inline int+test_restrict (ccp restrict text)+{+  // Iterate through items via the restricted pointer.+  // Also check for declarations in for loops.+  for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i)+    continue;+  return 0;+}++// Check varargs and va_copy.+static bool+test_varargs (const char *format, ...)+{+  va_list args;+  va_start (args, format);+  va_list args_copy;+  va_copy (args_copy, args);++  const char *str = "";+  int number = 0;+  float fnumber = 0;++  while (*format)+    {+      switch (*format++)+	{+	case '\''s'\'': // string+	  str = va_arg (args_copy, const char *);+	  break;+	case '\''d'\'': // int+	  number = va_arg (args_copy, int);+	  break;+	case '\''f'\'': // float+	  fnumber = va_arg (args_copy, double);+	  break;+	default:+	  break;+	}+    }+  va_end (args_copy);+  va_end (args);++  return *str && number && fnumber;+}+'++# Test code for whether the C compiler supports C99 (body of main).+ac_c_conftest_c99_main='+  // Check bool.+  _Bool success = false;+  success |= (argc != 0);++  // Check restrict.+  if (test_restrict ("String literal") == 0)+    success = true;+  char *restrict newvar = "Another string";++  // Check varargs.+  success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234);+  test_varargs_macros ();++  // Check flexible array members.+  struct incomplete_array *ia =+    malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10));+  ia->datasize = 10;+  for (int i = 0; i < ia->datasize; ++i)+    ia->data[i] = i * 1.234;+  // Work around memory leak warnings.+  free (ia);++  // Check named initializers.+  struct named_init ni = {+    .number = 34,+    .name = L"Test wide string",+    .average = 543.34343,+  };++  ni.number = 58;++  int dynamic_array[ni.number];+  dynamic_array[0] = argv[0][0];+  dynamic_array[ni.number - 1] = 543;++  // work around unused variable warnings+  ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\''+	 || dynamic_array[ni.number - 1] != 543);+'++# Test code for whether the C compiler supports C11 (global declarations)+ac_c_conftest_c11_globals='+/* Does the compiler advertise C11 conformance? */+#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L+# error "Compiler does not advertise C11 conformance"+#endif++// Check _Alignas.+char _Alignas (double) aligned_as_double;+char _Alignas (0) no_special_alignment;+extern char aligned_as_int;+char _Alignas (0) _Alignas (int) aligned_as_int;++// Check _Alignof.+enum+{+  int_alignment = _Alignof (int),+  int_array_alignment = _Alignof (int[100]),+  char_alignment = _Alignof (char)+};+_Static_assert (0 < -_Alignof (int), "_Alignof is signed");++// Check _Noreturn.+int _Noreturn does_not_return (void) { for (;;) continue; }++// Check _Static_assert.+struct test_static_assert+{+  int x;+  _Static_assert (sizeof (int) <= sizeof (long int),+                  "_Static_assert does not work in struct");+  long int y;+};++// Check UTF-8 literals.+#define u8 syntax error!+char const utf8_literal[] = u8"happens to be ASCII" "another string";++// Check duplicate typedefs.+typedef long *long_ptr;+typedef long int *long_ptr;+typedef long_ptr long_ptr;++// Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1.+struct anonymous+{+  union {+    struct { int i; int j; };+    struct { int k; long int l; } w;+  };+  int m;+} v1;+'++# Test code for whether the C compiler supports C11 (body of main).+ac_c_conftest_c11_main='+  _Static_assert ((offsetof (struct anonymous, i)+		   == offsetof (struct anonymous, w.k)),+		  "Anonymous union alignment botch");+  v1.i = 2;+  v1.w.k = 5;+  ok |= v1.i != 5;+'++# Test code for whether the C compiler supports C11 (complete).+ac_c_conftest_c11_program="${ac_c_conftest_c89_globals}+${ac_c_conftest_c99_globals}+${ac_c_conftest_c11_globals}++int+main (int argc, char **argv)+{+  int ok = 0;+  ${ac_c_conftest_c89_main}+  ${ac_c_conftest_c99_main}+  ${ac_c_conftest_c11_main}+  return ok;+}+"++# Test code for whether the C compiler supports C99 (complete).+ac_c_conftest_c99_program="${ac_c_conftest_c89_globals}+${ac_c_conftest_c99_globals}++int+main (int argc, char **argv)+{+  int ok = 0;+  ${ac_c_conftest_c89_main}+  ${ac_c_conftest_c99_main}+  return ok;+}+"++# Test code for whether the C compiler supports C89 (complete).+ac_c_conftest_c89_program="${ac_c_conftest_c89_globals}++int+main (int argc, char **argv)+{+  int ok = 0;+  ${ac_c_conftest_c89_main}+  return ok;+}+"++# Check that the precious variables saved in the cache have kept the same+# value.+ac_cache_corrupted=false+for ac_var in $ac_precious_vars; do+  eval ac_old_set=\$ac_cv_env_${ac_var}_set+  eval ac_new_set=\$ac_env_${ac_var}_set+  eval ac_old_val=\$ac_cv_env_${ac_var}_value+  eval ac_new_val=\$ac_env_${ac_var}_value+  case $ac_old_set,$ac_new_set in+    set,)+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5+printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,set)+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5+printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;}+      ac_cache_corrupted=: ;;+    ,);;+    *)+      if test "x$ac_old_val" != "x$ac_new_val"; then+	# differences in whitespace do not lead to failure.+	ac_old_val_w=`echo x $ac_old_val`+	ac_new_val_w=`echo x $ac_new_val`+	if test "$ac_old_val_w" != "$ac_new_val_w"; then+	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5+printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;}+	  ac_cache_corrupted=:+	else+	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5+printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;}+	  eval $ac_var=\$ac_old_val+	fi+	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   former value:  '$ac_old_val'" >&5+printf "%s\n" "$as_me:   former value:  '$ac_old_val'" >&2;}+	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   current value: '$ac_new_val'" >&5+printf "%s\n" "$as_me:   current value: '$ac_new_val'" >&2;}+      fi;;+  esac+  # Pass precious variables to config.status.+  if test "$ac_new_set" = set; then+    case $ac_new_val in+    *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;+    *) ac_arg=$ac_var=$ac_new_val ;;+    esac+    case " $ac_configure_args " in+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;+    esac+  fi+done+if $ac_cache_corrupted; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5+printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;}+  as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file'+	    and start over" "$LINENO" 5+fi+## -------------------- ##+## Main body of script. ##+## -------------------- ##++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu++++# To suppress "WARNING: unrecognized options: --with-compiler"++# Check whether --with-compiler was given.+if test ${with_compiler+y}+then :+  withval=$with_compiler;+fi+++# XXX Do this only for linux++++++++++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+if test -n "$ac_tool_prefix"; then+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.+set dummy ${ac_tool_prefix}gcc; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else 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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}gcc"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi ;;+esac+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++fi+if test -z "$ac_cv_prog_CC"; then+  ac_ct_CC=$CC+  # Extract the first word of "gcc", so it can be a program name with args.+set dummy gcc; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_ac_ct_CC+y}+then :+  printf %s "(cached) " >&6+else 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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="gcc"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi ;;+esac+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+printf "%s\n" "$ac_ct_CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+else+  CC="$ac_cv_prog_CC"+fi++if test -z "$CC"; then+          if test -n "$ac_tool_prefix"; then+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.+set dummy ${ac_tool_prefix}cc; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else 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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}cc"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi ;;+esac+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++  fi+fi+if test -z "$CC"; then+  # Extract the first word of "cc", so it can be a program name with args.+set dummy cc; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else 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+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then+       ac_prog_rejected=yes+       continue+     fi+    ac_cv_prog_CC="cc"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++if test $ac_prog_rejected = yes; then+  # We found a bogon in the path, so make sure we never use it.+  set dummy $ac_cv_prog_CC+  shift+  if test $# != 0; then+    # We chose a different compiler from the bogus one.+    # However, it has the same basename, so the bogon will be chosen+    # first if we set CC to just the basename; use the full file name.+    shift+    ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@"+  fi+fi+fi ;;+esac+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++fi+if test -z "$CC"; then+  if test -n "$ac_tool_prefix"; then+  for ac_prog in cl.exe+  do+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.+set dummy $ac_tool_prefix$ac_prog; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else 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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi ;;+esac+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++    test -n "$CC" && break+  done+fi+if test -z "$CC"; then+  ac_ct_CC=$CC+  for ac_prog in cl.exe+do+  # Extract the first word of "$ac_prog", so it can be a program name with args.+set dummy $ac_prog; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_ac_ct_CC+y}+then :+  printf %s "(cached) " >&6+else 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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="$ac_prog"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi ;;+esac+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+printf "%s\n" "$ac_ct_CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++  test -n "$ac_ct_CC" && break+done++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+fi++fi+if test -z "$CC"; then+  if test -n "$ac_tool_prefix"; then+  # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args.+set dummy ${ac_tool_prefix}clang; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else 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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}clang"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi ;;+esac+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++fi+if test -z "$ac_cv_prog_CC"; then+  ac_ct_CC=$CC+  # Extract the first word of "clang", so it can be a program name with args.+set dummy clang; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_ac_ct_CC+y}+then :+  printf %s "(cached) " >&6+else 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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="clang"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi ;;+esac+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+printf "%s\n" "$ac_ct_CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+else+  CC="$ac_cv_prog_CC"+fi++fi+++test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}+as_fn_error $? "no acceptable C compiler found in \$PATH+See 'config.log' for more details" "$LINENO" 5; }++# Provide some information about the compiler.+printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5+set X $ac_compile+ac_compiler=$2+for ac_option in --version -v -V -qversion -version; do+  { { ac_try="$ac_compiler $ac_option >&5"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    sed '10a\+... rest of stderr output deleted ...+         10q' conftest.err >conftest.er1+    cat conftest.er1 >&5+  fi+  rm -f conftest.er1 conftest.err+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+done++cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"+# Try to create an executable without -o first, disregard a.out.+# It will help us diagnose broken compilers, and finding out an intuition+# of exeext.+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5+printf %s "checking whether the C compiler works... " >&6; }+ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'`++# The possible output files:+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"++ac_rmfiles=+for ac_file in $ac_files+do+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;+  esac+done+rm -f $ac_rmfiles++if { { ac_try="$ac_link_default"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_link_default") 2>&5+  ac_status=$?+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+then :+  # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'.+# So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no'+# in a Makefile.  We should not override ac_cv_exeext if it was cached,+# so that the user can short-circuit this test for compilers unknown to+# Autoconf.+for ac_file in $ac_files ''+do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )+	;;+    [ab].out )+	# We found the default executable, but exeext='' is most+	# certainly right.+	break;;+    *.* )+	if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no;+	then :; else+	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	fi+	# We set ac_cv_exeext here because the later test for it is not+	# safe: cross compilers may not add the suffix if given an '-o'+	# argument, so we may need to know it at that point already.+	# Even if this section looks crufty: it has the advantage of+	# actually working.+	break;;+    * )+	break;;+  esac+done+test "$ac_cv_exeext" = no && ac_cv_exeext=++else case e in #(+  e) ac_file='' ;;+esac+fi+if test -z "$ac_file"+then :+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+printf "%s\n" "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}+as_fn_error 77 "C compiler cannot create executables+See 'config.log' for more details" "$LINENO" 5; }+else 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; }+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5+printf "%s\n" "$ac_file" >&6; }+ac_exeext=$ac_cv_exeext++rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out+ac_clean_files=$ac_clean_files_save+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5+printf %s "checking for suffix of executables... " >&6; }+if { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+then :+  # If both 'conftest.exe' and 'conftest' are 'present' (well, observable)+# catch 'conftest.exe'.  For instance with Cygwin, 'ls conftest' will+# work properly (i.e., refer to 'conftest.exe'), while it won't with+# 'rm'.+for ac_file in conftest.exe conftest conftest.*; do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	  break;;+    * ) break;;+  esac+done+else 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; } ;;+esac+fi+rm -f conftest conftest$ac_cv_exeext+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5+printf "%s\n" "$ac_cv_exeext" >&6; }++rm -f conftest.$ac_ext+EXEEXT=$ac_cv_exeext+ac_exeext=$EXEEXT+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdio.h>+int+main (void)+{+FILE *f = fopen ("conftest.out", "w");+ if (!f)+  return 1;+ return ferror (f) || fclose (f) != 0;++  ;+  return 0;+}+_ACEOF+ac_clean_files="$ac_clean_files conftest.out"+# Check that the compiler produces executables we can run.  If not, either+# the compiler is broken, or we cross compile.+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5+printf %s "checking whether we are cross compiling... " >&6; }+if test "$cross_compiling" != yes; then+  { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+  if { ac_try='./conftest$ac_cv_exeext'+  { { case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_try") 2>&5+  ac_status=$?+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; }; then+    cross_compiling=no+  else+    if test "$cross_compiling" = maybe; then+	cross_compiling=yes+    else+	{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}+as_fn_error 77 "cannot run C compiled programs.+If you meant to cross compile, use '--host'.+See 'config.log' for more details" "$LINENO" 5; }+    fi+  fi+fi+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5+printf "%s\n" "$cross_compiling" >&6; }++rm -f conftest.$ac_ext conftest$ac_cv_exeext \+  conftest.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 case e in #(+  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+rm -f conftest.o conftest.obj+if { { ac_try="$ac_compile"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_compile") 2>&5+  ac_status=$?+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+then :+  for ac_file in conftest.o conftest.obj conftest.*; do+  test -f "$ac_file" || continue;+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`+       break;;+  esac+done+else 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;}+as_fn_error $? "cannot compute suffix of object files: cannot compile+See 'config.log' for more details" "$LINENO" 5; } ;;+esac+fi+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; }+OBJEXT=$ac_cv_objext+ac_objext=$OBJEXT+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5+printf %s "checking whether the compiler supports GNU C... " >&6; }+if test ${ac_cv_c_compiler_gnu+y}+then :+  printf %s "(cached) " >&6+else case e in #(+  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{+#ifndef __GNUC__+       choke me+#endif++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  ac_compiler_gnu=yes+else 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; }+ac_compiler_gnu=$ac_cv_c_compiler_gnu++if test $ac_compiler_gnu = yes; then+  GCC=yes+else+  GCC=+fi+ac_test_CFLAGS=${CFLAGS+y}+ac_save_CFLAGS=$CFLAGS+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5+printf %s "checking whether $CC accepts -g... " >&6; }+if test ${ac_cv_prog_cc_g+y}+then :+  printf %s "(cached) " >&6+else 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"+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_g=yes+else case e in #(+  e) CFLAGS=""+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :++else 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.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_g=yes+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;+esac+fi+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 ;;+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; }+if test $ac_test_CFLAGS; then+  CFLAGS=$ac_save_CFLAGS+elif test $ac_cv_prog_cc_g = yes; then+  if test "$GCC" = yes; then+    CFLAGS="-g -O2"+  else+    CFLAGS="-g"+  fi+else+  if test "$GCC" = yes; then+    CFLAGS="-O2"+  else+    CFLAGS=+  fi+fi+ac_prog_cc_stdc=no+if test x$ac_prog_cc_stdc = xno+then :+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5+printf %s "checking for $CC option to enable C11 features... " >&6; }+if test ${ac_cv_prog_cc_c11+y}+then :+  printf %s "(cached) " >&6+else case e in #(+  e) ac_cv_prog_cc_c11=no+ac_save_CC=$CC+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$ac_c_conftest_c11_program+_ACEOF+for ac_arg in '' -std=gnu11+do+  CC="$ac_save_CC $ac_arg"+  if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_c11=$ac_arg+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam+  test "x$ac_cv_prog_cc_c11" != "xno" && break+done+rm -f conftest.$ac_ext+CC=$ac_save_CC ;;+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 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 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" ;;+esac+fi+  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11+  ac_prog_cc_stdc=c11 ;;+esac+fi+fi+if test x$ac_prog_cc_stdc = xno+then :+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5+printf %s "checking for $CC option to enable C99 features... " >&6; }+if test ${ac_cv_prog_cc_c99+y}+then :+  printf %s "(cached) " >&6+else case e in #(+  e) ac_cv_prog_cc_c99=no+ac_save_CC=$CC+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$ac_c_conftest_c99_program+_ACEOF+for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99=+do+  CC="$ac_save_CC $ac_arg"+  if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_c99=$ac_arg+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam+  test "x$ac_cv_prog_cc_c99" != "xno" && break+done+rm -f conftest.$ac_ext+CC=$ac_save_CC ;;+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 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 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" ;;+esac+fi+  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99+  ac_prog_cc_stdc=c99 ;;+esac+fi+fi+if test x$ac_prog_cc_stdc = xno+then :+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5+printf %s "checking for $CC option to enable C89 features... " >&6; }+if test ${ac_cv_prog_cc_c89+y}+then :+  printf %s "(cached) " >&6+else case e in #(+  e) ac_cv_prog_cc_c89=no+ac_save_CC=$CC+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$ac_c_conftest_c89_program+_ACEOF+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"+do+  CC="$ac_save_CC $ac_arg"+  if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_c89=$ac_arg+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam+  test "x$ac_cv_prog_cc_c89" != "xno" && break+done+rm -f conftest.$ac_ext+CC=$ac_save_CC ;;+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 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 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" ;;+esac+fi+  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89+  ac_prog_cc_stdc=c89 ;;+esac+fi+fi++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+++{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC options needed to detect all undeclared functions" >&5+printf %s "checking for $CC options needed to detect all undeclared functions... " >&6; }+if test ${ac_cv_c_undeclared_builtin_options+y}+then :+  printf %s "(cached) " >&6+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"+     # This test program should *not* compile successfully.+     cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{+(void) strchr;+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :++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+        # off chance that they somehow elicit warnings.+        cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <float.h>+#include <limits.h>+#include <stdarg.h>+#include <stddef.h>+extern void ac_decl (int, char *);++int+main (void)+{+(void) ac_decl (0, (char *) 0);+  (void) ac_decl;++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  if test x"$ac_arg" = x+then :+  ac_cv_c_undeclared_builtin_options='none needed'+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 ;;+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;}+as_fn_error $? "cannot make $CC report undeclared builtins+See 'config.log' for more details" "$LINENO" 5; } ;; #(+  'none needed') :+    ac_c_undeclared_builtin_options='' ;; #(+  *) :+    ac_c_undeclared_builtin_options=$ac_cv_c_undeclared_builtin_options ;;+esac++ac_fn_check_decl "$LINENO" "IN_MASK_CREATE" "ac_cv_have_decl_IN_MASK_CREATE" "#include <sys/inotify.h>+" "$ac_c_undeclared_builtin_options" "CFLAGS"+if test "x$ac_cv_have_decl_IN_MASK_CREATE" = xyes+then :+  ac_have_decl=1+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++ac_fn_check_decl "$LINENO" "IN_EXCL_UNLINK" "ac_cv_have_decl_IN_EXCL_UNLINK" "#include <sys/inotify.h>+" "$ac_c_undeclared_builtin_options" "CFLAGS"+if test "x$ac_cv_have_decl_IN_EXCL_UNLINK" = xyes+then :+  ac_have_decl=1+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+++# XXX Do this only for macOS+ac_fn_check_decl "$LINENO" "kFSEventStreamCreateFlagFileEvents" "ac_cv_have_decl_kFSEventStreamCreateFlagFileEvents" "#include <CoreServices/CoreServices.h>+" "$ac_c_undeclared_builtin_options" "CFLAGS"+if test "x$ac_cv_have_decl_kFSEventStreamCreateFlagFileEvents" = xyes+then :+  ac_have_decl=1+else case e in #(+  e) ac_have_decl=0 ;;+esac+fi+printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS $ac_have_decl" >>confdefs.h++ac_fn_check_decl "$LINENO" "kFSEventStreamCreateFlagFullHistory" "ac_cv_have_decl_kFSEventStreamCreateFlagFullHistory" "#include <CoreServices/CoreServices.h>+" "$ac_c_undeclared_builtin_options" "CFLAGS"+if test "x$ac_cv_have_decl_kFSEventStreamCreateFlagFullHistory" = xyes+then :+  ac_have_decl=1+else case e in #(+  e) ac_have_decl=0 ;;+esac+fi+printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY $ac_have_decl" >>confdefs.h++ac_fn_check_decl "$LINENO" "kFSEventStreamEventFlagItemCloned" "ac_cv_have_decl_kFSEventStreamEventFlagItemCloned" "#include <CoreServices/CoreServices.h>+" "$ac_c_undeclared_builtin_options" "CFLAGS"+if test "x$ac_cv_have_decl_kFSEventStreamEventFlagItemCloned" = xyes+then :+  ac_have_decl=1+else case e in #(+  e) ac_have_decl=0 ;;+esac+fi+printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMCLONED $ac_have_decl" >>confdefs.h++ac_fn_check_decl "$LINENO" "kFSEventStreamEventFlagItemIsHardlink" "ac_cv_have_decl_kFSEventStreamEventFlagItemIsHardlink" "#include <CoreServices/CoreServices.h>+" "$ac_c_undeclared_builtin_options" "CFLAGS"+if test "x$ac_cv_have_decl_kFSEventStreamEventFlagItemIsHardlink" = xyes+then :+  ac_have_decl=1+else case e in #(+  e) ac_have_decl=0 ;;+esac+fi+printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK $ac_have_decl" >>confdefs.h+++# Output+ac_config_headers="$ac_config_headers src/config.h"++cat >confcache <<\_ACEOF+# This file is a shell script that caches the results of configure+# tests run on this system so they can be shared between configure+# scripts and configure runs, see configure's option --config-cache.+# It is not useful on other systems.  If it contains results you don't+# want to keep, you may remove or edit it.+#+# config.status only pays attention to the cache file if you give it+# the --recheck option to rerun configure.+#+# 'ac_cv_env_foo' variables (set or unset) will be overridden when+# loading this file, other *unset* 'ac_cv_foo' will be assigned the+# following values.++_ACEOF++# The following way of writing the cache mishandles newlines in values,+# but we know of no workaround that is simple, portable, and efficient.+# So, we kill variables containing newlines.+# Ultrix sh set writes to stderr and can't be redirected directly,+# and sets the high bit in the cache file unless we assign to the vars.+(+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done++  (set) 2>&1 |+    case $as_nl`(ac_space=' '; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      # 'set' does not quote correctly, so add quotes: double-quote+      # substitution turns \\\\ into \\, and sed turns \\ into \.+      sed -n \+	"s/'/'\\\\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"+      ;; #(+    *)+      # 'set' quotes correctly as required by POSIX, so do not add quotes.+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+) |+  sed '+     /^ac_cv_env_/b end+     t clear+     :clear+     s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/+     t end+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/+     :end' >>confcache+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else+  if test -w "$cache_file"; then+    if test "x$cache_file" != "x/dev/null"; then+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5+printf "%s\n" "$as_me: updating cache $cache_file" >&6;}+      if test ! -f "$cache_file" || test -h "$cache_file"; then+	cat confcache >"$cache_file"+      else+        case $cache_file in #(+        */* | ?:*)+	  mv -f confcache "$cache_file"$$ &&+	  mv -f "$cache_file"$$ "$cache_file" ;; #(+        *)+	  mv -f confcache "$cache_file" ;;+	esac+      fi+    fi+  else+    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5+printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;}+  fi+fi+rm -f confcache++test "x$prefix" = xNONE && prefix=$ac_default_prefix+# Let make expand exec_prefix.+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'++DEFS=-DHAVE_CONFIG_H++ac_libobjs=+ac_ltlibobjs=+U=+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue+  # 1. Remove the extension, and $U if already installed.+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'+  ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"`+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR+  #    will be set to the directory where LIBOBJS objects are built.+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'+done+LIBOBJS=$ac_libobjs++LTLIBOBJS=$ac_ltlibobjs++++: "${CONFIG_STATUS=./config.status}"+ac_write_fail=0+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files $CONFIG_STATUS"+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5+printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;}+as_write_fail=0+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1+#! $SHELL+# Generated by $as_me.+# Run this file to recreate the current configuration.+# Compiler output produced by configure, useful for debugging+# configure, is in config.log if it exists.++debug=false+ac_cs_recheck=false+ac_cs_silent=false++SHELL=\${CONFIG_SHELL-$SHELL}+export SHELL+_ASEOF+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# Be more Bourne compatible+DUALCASE=1; export DUALCASE # for MKS sh+if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1+then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # is contrary to our usage.  Disable this feature.+  alias -g '${1+"$@"}'='"$@"'+  setopt NO_GLOB_SUBST+else case e in #(+  e) case `(set -o) 2>/dev/null` in #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac ;;+esac+fi++++# Reset variables that may have inherited troublesome values from+# the environment.++# IFS needs to be set, to space, tab, and newline, in precisely that order.+# (If _AS_PATH_WALK were called with IFS unset, it would have the+# side effect of setting IFS to empty, thus disabling word splitting.)+# Quoting is to prevent editors from complaining about space-tab.+as_nl='+'+export as_nl+IFS=" ""	$as_nl"++PS1='$ '+PS2='> '+PS4='+ '++# Ensure predictable behavior from utilities with locale-dependent output.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# We cannot yet rely on "unset" to work, but we need these variables+# to be unset--not just set to an empty or harmless value--now, to+# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh).  This construct+# also avoids known problems related to "unset" and subshell syntax+# in other old shells (e.g. bash 2.01 and pdksh 5.2.14).+for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH+do eval test \${$as_var+y} \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done++# Ensure that fds 0, 1, and 2 are open.+if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi+if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi+if (exec 3>&2)            ; then :; else exec 2>/dev/null; fi++# The user is always right.+if ${PATH_SEPARATOR+false} :; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    test -r "$as_dir$0" && as_myself=$as_dir$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# We did not find ourselves, most probably we were run as 'sh COMMAND'+# in which case we are not to be found in the path.+if test "x$as_myself" = x; then+  as_myself=$0+fi+if test ! -f "$as_myself"; then+  printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi++++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  printf "%s\n" "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error+++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset++# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null+then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else case e in #(+  e) as_fn_append ()+  {+    eval $1=\$$1\$2+  } ;;+esac+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null+then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else case e in #(+  e) as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  } ;;+esac+fi # as_fn_arith+++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits+++# Determine whether it's possible to make 'echo' print without a newline.+# These variables are no longer used directly by Autoconf, but are AC_SUBSTed+# for compatibility with existing Makefiles.+ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++# For backward compatibility with old third-party macros, we provide+# the shell variables $as_echo and $as_echo_n.  New code should use+# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively.+as_echo='printf %s\n'+as_echo_n='printf %s'++rm -f conf$$ conf$$.exe conf$$.file+if test -d conf$$.dir; then+  rm -f conf$$.dir/conf$$.file+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  if ln -s conf$$.file conf$$ 2>/dev/null; then+    as_ln_s='ln -s'+    # ... but there are two gotchas:+    # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable.+    # In both cases, we have to default to 'cp -pR'.+    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||+      as_ln_s='cp -pR'+  elif ln conf$$.file conf$$ 2>/dev/null; then+    as_ln_s=ln+  else+    as_ln_s='cp -pR'+  fi+else+  as_ln_s='cp -pR'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null+++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p+if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi+++# as_fn_executable_p FILE+# -----------------------+# Test if FILE is an executable regular file.+as_fn_executable_p ()+{+  test -f "$1" && test -x "$1"+} # as_fn_executable_p+as_test_x='test -x'+as_executable_p=as_fn_executable_p++# Sed expression to map a string onto a valid CPP name.+as_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_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g"+as_tr_sh="eval sed '$as_sed_sh'" # deprecated+++exec 6>&1+## ----------------------------------- ##+## Main body of $CONFIG_STATUS script. ##+## ----------------------------------- ##+_ASEOF+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# Save the log message, to keep $0 and so on meaningful, and to+# report actual input values of CONFIG_FILES etc. instead of their+# values after options handling.+ac_log="+This file was extended by streamly $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+  CONFIG_LINKS    = $CONFIG_LINKS+  CONFIG_COMMANDS = $CONFIG_COMMANDS+  $ $0 $@++on `(hostname || uname -n) 2>/dev/null | sed 1q`+"++_ACEOF+++case $ac_config_headers in *"+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;+esac+++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+# Files that config.status was made for.+config_headers="$ac_config_headers"++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+ac_cs_usage="\+'$as_me' instantiates files and other configuration actions+from templates according to the current configuration.  Unless the files+and actions are specified as TAGs, all are instantiated by default.++Usage: $0 [OPTION]... [TAG]...++  -h, --help       print this help, then exit+  -V, --version    print version number and configuration settings, then exit+      --config     print configuration, then exit+  -q, --quiet, --silent+                   do not print progress messages+  -d, --debug      don't remove temporary files+      --recheck    update $as_me by reconfiguring in the same conditions+      --header=FILE[:TEMPLATE]+                   instantiate the configuration header FILE++Configuration headers:+$config_headers++Report bugs to <streamly@composewell.com>.+streamly home page: <https://streamly.composewell.com>."++_ACEOF+ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"`+ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"`+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+ac_cs_config='$ac_cs_config_escaped'+ac_cs_version="\\+streamly config.status 0.11.1+configured by $0, generated by GNU Autoconf 2.72,+  with options \\"\$ac_cs_config\\"++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."++ac_pwd='$ac_pwd'+srcdir='$srcdir'+test -n "\$AWK" || AWK=awk+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# The default lists apply if the user does not specify any file.+ac_need_defaults=:+while test $# != 0+do+  case $1 in+  --*=?*)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`+    ac_shift=:+    ;;+  --*=)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=+    ac_shift=:+    ;;+  *)+    ac_option=$1+    ac_optarg=$2+    ac_shift=shift+    ;;+  esac++  case $ac_option in+  # Handling of the options.+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)+    ac_cs_recheck=: ;;+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )+    printf "%s\n" "$ac_cs_version"; exit ;;+  --config | --confi | --conf | --con | --co | --c )+    printf "%s\n" "$ac_cs_config"; exit ;;+  --debug | --debu | --deb | --de | --d | -d )+    debug=: ;;+  --header | --heade | --head | --hea )+    $ac_shift+    case $ac_optarg in+    *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"+    ac_need_defaults=false;;+  --he | --h)+    # Conflict between --help and --header+    as_fn_error $? "ambiguous option: '$1'+Try '$0 --help' for more information.";;+  --help | --hel | -h )+    printf "%s\n" "$ac_cs_usage"; exit ;;+  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil | --si | --s)+    ac_cs_silent=: ;;++  # This is an error.+  -*) as_fn_error $? "unrecognized option: '$1'+Try '$0 --help' for more information." ;;++  *) as_fn_append ac_config_targets " $1"+     ac_need_defaults=false ;;++  esac+  shift+done++ac_configure_extra_args=++if $ac_cs_silent; then+  exec 6>/dev/null+  ac_configure_extra_args="$ac_configure_extra_args --silent"+fi++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+if \$ac_cs_recheck; then+  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+  shift+  \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6+  CONFIG_SHELL='$SHELL'+  export CONFIG_SHELL+  exec "\$@"+fi++_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+exec 5>>config.log+{+  echo+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX+## Running $as_me. ##+_ASBOX+  printf "%s\n" "$ac_log"+} >&5++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1++# Handling of arguments.+for ac_config_target in $ac_config_targets+do+  case $ac_config_target in+    "src/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/config.h" ;;++  *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;;+  esac+done+++# If the user did not use the arguments to specify the items to instantiate,+# then the envvar interface is used.  Set only those that are not.+# We use the long form for the default assignment because of an extremely+# bizarre bug on SunOS 4.1.3.+if $ac_need_defaults; then+  test ${CONFIG_HEADERS+y} || CONFIG_HEADERS=$config_headers+fi++# Have a temporary directory for convenience.  Make it in the build tree+# simply because there is no reason against having it here, and in addition,+# creating and moving files from /tmp can sometimes cause problems.+# Hook for its removal unless debugging.+# Note that there is a small window in which the directory will not be cleaned:+# after its creation but before its name has been assigned to '$tmp'.+$debug ||+{+  tmp= ac_tmp=+  trap 'exit_status=$?+  : "${ac_tmp:=$tmp}"+  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status+' 0+  trap 'as_fn_exit 1' 1 2 13 15+}+# Create a (secure) tmp directory for tmp files.++{+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&+  test -d "$tmp"+}  ||+{+  tmp=./conf$$-$RANDOM+  (umask 077 && mkdir "$tmp")+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5+ac_tmp=$tmp++# Set up the scripts for CONFIG_HEADERS section.+# No need to generate them if there are no CONFIG_HEADERS.+# This happens for instance with './config.status Makefile'.+if test -n "$CONFIG_HEADERS"; then+cat >"$ac_tmp/defines.awk" <<\_ACAWK ||+BEGIN {+_ACEOF++# Transform confdefs.h into an awk script 'defines.awk', embedded as+# here-document in config.status, that substitutes the proper values into+# config.h.in to produce config.h.++# Create a delimiter string that does not exist in confdefs.h, to ease+# handling of long lines.+ac_delim='%!_!# '+for ac_last_try in false false :; do+  ac_tt=`sed -n "/$ac_delim/p" confdefs.h`+  if test -z "$ac_tt"; then+    break+  elif $ac_last_try; then+    as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5+  else+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+  fi+done++# For the awk script, D is an array of macro values keyed by name,+# likewise P contains macro parameters if any.  Preserve backslash+# newline sequences.++ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*+sed -n '+s/.\{148\}/&'"$ac_delim"'/g+t rset+:rset+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /+t def+d+:def+s/\\$//+t bsnl+s/["\\]/\\&/g+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\+D["\1"]=" \3"/p+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p+d+:bsnl+s/["\\]/\\&/g+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\+D["\1"]=" \3\\\\\\n"\\/p+t cont+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p+t cont+d+:cont+n+s/.\{148\}/&'"$ac_delim"'/g+t clear+:clear+s/\\$//+t bsnlc+s/["\\]/\\&/g; s/^/"/; s/$/"/p+d+:bsnlc+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p+b cont+' <confdefs.h | sed '+s/'"$ac_delim"'/"\\\+"/g' >>$CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+  for (key in D) D_is_set[key] = 1+  FS = ""+}+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {+  line = \$ 0+  split(line, arg, " ")+  if (arg[1] == "#") {+    defundef = arg[2]+    mac1 = arg[3]+  } else {+    defundef = substr(arg[1], 2)+    mac1 = arg[2]+  }+  split(mac1, mac2, "(") #)+  macro = mac2[1]+  prefix = substr(line, 1, index(line, defundef) - 1)+  if (D_is_set[macro]) {+    # Preserve the white space surrounding the "#".+    print prefix "define", macro P[macro] D[macro]+    next+  } else {+    # Replace #undef with comments.  This is necessary, for example,+    # in the case of _POSIX_SOURCE, which is predefined and required+    # on some systems where configure will not decide to define it.+    if (defundef == "undef") {+      print "/*", prefix defundef, macro, "*/"+      next+    }+  }+}+{ print }+_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+  as_fn_error $? "could not setup config headers machinery" "$LINENO" 5+fi # test -n "$CONFIG_HEADERS"+++eval set X "    :H $CONFIG_HEADERS    "+shift+for ac_tag+do+  case $ac_tag in+  :[FHLC]) ac_mode=$ac_tag; continue;;+  esac+  case $ac_mode$ac_tag in+  :[FHL]*:*);;+  :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;;+  :[FH]-) ac_tag=-:-;;+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;+  esac+  ac_save_IFS=$IFS+  IFS=:+  set x $ac_tag+  IFS=$ac_save_IFS+  shift+  ac_file=$1+  shift++  case $ac_mode in+  :L) ac_source=$1;;+  :[FH])+    ac_file_inputs=+    for ac_f+    do+      case $ac_f in+      -) ac_f="$ac_tmp/stdin";;+      *) # Look for the file first in the build tree, then in the source tree+	 # (if the path is not absolute).  The absolute path cannot be DOS-style,+	 # because $ac_f cannot contain ':'.+	 test -f "$ac_f" ||+	   case $ac_f in+	   [\\/$]*) false;;+	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;+	   esac ||+	   as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;;+      esac+      case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac+      as_fn_append ac_file_inputs " '$ac_f'"+    done++    # Let's still pretend it is 'configure' which instantiates (i.e., don't+    # use $as_me), people would be surprised to read:+    #    /* config.h.  Generated by config.status.  */+    configure_input='Generated from '`+	  printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'+	`' by configure.'+    if test x"$ac_file" != x-; then+      configure_input="$ac_file.  $configure_input"+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5+printf "%s\n" "$as_me: creating $ac_file" >&6;}+    fi+    # Neutralize special characters interpreted by sed in replacement strings.+    case $configure_input in #(+    *\&* | *\|* | *\\* )+       ac_sed_conf_input=`printf "%s\n" "$configure_input" |+       sed 's/[\\\\&|]/\\\\&/g'`;; #(+    *) ac_sed_conf_input=$configure_input;;+    esac++    case $ac_tag in+    *:-:* | *:-) cat >"$ac_tmp/stdin" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;+    esac+    ;;+  esac++  ac_dir=`$as_dirname -- "$ac_file" ||+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$ac_file" : 'X\(//\)[^/]' \| \+	 X"$ac_file" : 'X\(//\)$' \| \+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X"$ac_file" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  as_dir="$ac_dir"; as_fn_mkdir_p+  ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix+++  case $ac_mode in++  :H)+  #+  # CONFIG_HEADER+  #+  if test x"$ac_file" != x-; then+    {+      printf "%s\n" "/* $configure_input  */" >&1 \+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"+    } >"$ac_tmp/config.h" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5+    if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5+printf "%s\n" "$as_me: $ac_file is unchanged" >&6;}+    else+      rm -f "$ac_file"+      mv "$ac_tmp/config.h" "$ac_file" \+	|| as_fn_error $? "could not create $ac_file" "$LINENO" 5+    fi+  else+    printf "%s\n" "/* $configure_input  */" >&1 \+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \+      || as_fn_error $? "could not create -" "$LINENO" 5+  fi+ ;;+++  esac++done # for ac_tag+++as_fn_exit 0+_ACEOF+ac_clean_files=$ac_clean_files_save++test $ac_write_fail = 0 ||+  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5+++# configure is writing to config.log, and then calls config.status.+# config.status does its own redirection, appending to config.log.+# Unfortunately, on DOS this fails, as config.log is still kept open+# by configure, so config.status won't be able to write to it; its+# output is simply discarded.  So we exec the FD to /dev/null,+# effectively closing config.log, so it can be properly (re)opened and+# appended to by config.status.  When coming back to configure, we+# need to make the FD available again.+if test "$no_create" != yes; then+  ac_cs_success=:+  ac_config_status_args=+  test "$silent" = yes &&+    ac_config_status_args="$ac_config_status_args --quiet"+  exec 5>/dev/null+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false+  exec 5>>config.log+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which+  # would make configure fail if this is the last instruction.+  $ac_cs_success || as_fn_exit 1+fi+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5+printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}+fi++
+ configure.ac view
@@ -0,0 +1,23 @@+# Input file for autoconf to generate the configure script.++# See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on+# the macros used in this file.++AC_INIT([streamly], [0.11.1], [streamly@composewell.com], [streamly], [https://streamly.composewell.com])++# To suppress "WARNING: unrecognized options: --with-compiler"+AC_ARG_WITH([compiler], [GHC])++# XXX Do this only for linux+AC_CHECK_DECLS([IN_MASK_CREATE],[],[],[#include <sys/inotify.h>])+AC_CHECK_DECLS([IN_EXCL_UNLINK],[],[],[#include <sys/inotify.h>])++# XXX Do this only for macOS+AC_CHECK_DECLS([kFSEventStreamCreateFlagFileEvents],[],[],[#include <CoreServices/CoreServices.h>])+AC_CHECK_DECLS([kFSEventStreamCreateFlagFullHistory],[],[],[#include <CoreServices/CoreServices.h>])+AC_CHECK_DECLS([kFSEventStreamEventFlagItemCloned],[],[],[#include <CoreServices/CoreServices.h>])+AC_CHECK_DECLS([kFSEventStreamEventFlagItemIsHardlink],[],[],[#include <CoreServices/CoreServices.h>])++# Output+AC_CONFIG_HEADERS([src/config.h])+AC_OUTPUT
+ 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/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/streamly-vs-async.md 
@@ -1,230 +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 `yieldM`-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 `runStream` 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 $ parallely $ 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-stream `aheadly` 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 $ aheadly $ getURL 2 |: getURL 1 |: S.nil-```--### concurrently_--Use `runStream` instead of `toList` to run the actions but ignore the results:--```haskell-  runStream $ parallely $ 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 $ zipAsyncly $-              (,) <$> S.yieldM (getURLString 1) <*> S.yieldM (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 $ parallely $ 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 $ parallely $ 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 $ runStream $ parallely $-                   (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 $ aheadly $ 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 $ aheadly $ 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 $ aheadly $ foldMap (S.yieldM . 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 $ parallely $ 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 $ parallely $ 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 $ parallely $ 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://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html).
− docs/transformers.md 
@@ -1,32 +0,0 @@-## 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.--## Ordering of Monad Transformers--In most cases it is a good idea to keep streamly as the top level monad.--## 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.
− examples/AcidRain.hs 
@@ -1,43 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}---- This example is adapted from Gabriel Gonzalez's pipes-concurrency package.--- https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html--import Streamly-import Streamly.Prelude as S-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.State (MonadState, get, modify, runStateT, put)--data Event = Harm Int | Heal Int deriving (Show)--userAction :: MonadAsync m => SerialT m Event-userAction = S.repeatM $ liftIO askUser-    where-    askUser = do-        command <- getLine-        case command of-            "potion" -> return (Heal 10)-            "quit"   -> fail "quit"-            _        -> putStrLn "What?" >> askUser--acidRain :: MonadAsync m => SerialT m Event-acidRain = asyncly $ constRate 1 $ S.repeatM $ liftIO $ return $ Harm 1--game :: (MonadAsync m, MonadState Int m) => SerialT m ()-game = do-    event <- userAction `parallel` acidRain-    case event of-        Harm n -> modify $ \h -> h - n-        Heal n -> modify $ \h -> h + n--    h <- get-    when (h <= 0) $ fail "You die!"-    liftIO $ putStrLn $ "Health = " <> show h--main :: IO ()-main = do-    putStrLn "Your health is deteriorating due to acid rain,\-             \ type \"potion\" or \"quit\""-    _ <- runStateT (runStream game) 60-    return ()
− examples/CirclingSquare.hs 
@@ -1,83 +0,0 @@--- Adapted from the Yampa package.--- Displays a square moving in a circle. To move the position drag it with the--- mouse.------ Requires the SDL package, assuming streamly has already been built, you can--- compile it like this:--- stack ghc --package SDL CirclingSquare.hs--import Data.IORef-import Graphics.UI.SDL as SDL-import Streamly-import Streamly.Prelude as S----------------------------------------------------------------------------------- SDL Graphics Init---------------------------------------------------------------------------------sdlInit :: IO ()-sdlInit = do-  SDL.init [InitVideo]--  let width  = 640-      height = 480-  _ <- SDL.setVideoMode width height 16 [SWSurface]-  SDL.setCaption "Test" ""----------------------------------------------------------------------------------- Display a box at a given coordinates---------------------------------------------------------------------------------display :: (Double, Double) -> IO ()-display (playerX, playerY) = do-  screen <- getVideoSurface--  -- Paint screen green-  let format = surfaceGetPixelFormat screen-  bgColor <- mapRGB format 55 60 64-  _ <- fillRect screen Nothing bgColor--  -- Paint small red square, at an angle 'angle' with respect to the center-  foreC <- mapRGB format 212 108 73-  let side = 20-      x = round playerX-      y = round playerY-  _ <- fillRect screen (Just (Rect x y side side)) foreC--  -- Double buffering-  SDL.flip screen----------------------------------------------------------------------------------- Wait and update Controller Position if it changes---------------------------------------------------------------------------------updateController :: IORef (Double, Double) -> IO ()-updateController ref = do-    e <- pollEvent-    case e of-        MouseMotion x y _ _ -> writeIORef ref (fromIntegral x, fromIntegral y)-        _ -> return ()----------------------------------------------------------------------------------- Periodically refresh the output display---------------------------------------------------------------------------------updateDisplay :: IORef (Double, Double) -> IO ()-updateDisplay cref = do-    time <- SDL.getTicks-    (x, y) <- readIORef cref-    let t = fromIntegral time * speed / 1000-     in display (x + cos t * radius, y + sin t * radius)--    where--    speed  = 6-    radius = 60--main :: IO ()-main = do-    sdlInit-    cref <- newIORef (0,0)-    runStream $ asyncly $ constRate 40-        $ S.repeatM (updateController cref)-              `parallel` S.repeatM (updateDisplay cref)
− examples/ControlFlow.hs 
@@ -1,309 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}------------------------------------------------------------------------------------ Combining control flow manipulating monad transformers (MaybeT, exceptT,--- ContT) with Streamly-------------------------------------------------------------------------------------- Streamly streams are non-determinism (nested looping) monads. We can use a--- control flow monad on top or streamly on top depending on whether we want to--- superimpose control flow manipulation on top of non-deterministic--- composition or vice-versa.------ This file provides an example where we enter a sequence of characters "x",--- and "y" on separate lines, on the command line. When any other sequence is--- entered the control flow short circuits at the first non-matching char and--- exits.--import Control.Concurrent (threadDelay)-import Control.Exception (catch, SomeException)-import Control.Monad-import Control.Monad.Catch (MonadThrow, throwM, Exception)-import Control.Monad.IO.Class-import Control.Monad.Trans.Class-import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Except-import Control.Monad.Trans.Cont-import Streamly-import Streamly.Prelude ((|:))-import qualified Streamly.Prelude as S------------------------------------------------------------------------------------ Using MaybeT below streamly-------------------------------------------------------------------------------------- When streamly is on top MaybeT would terminate all iterations of--- non-determinism.----getSequenceMaybeBelow-    :: ( IsStream t-       , Monad m-       , MonadTrans t-       , Applicative (t (MaybeT m))-       , MonadIO (t (MaybeT m))-       )-    => t (MaybeT m) ()-getSequenceMaybeBelow = do-    liftIO $ putStrLn "MaybeT below streamly: Enter one char per line: "--    i <- S.fromFoldable [1..2 :: Int]-    liftIO $ putStrLn $ "iteration = " ++ show i--    r1 <- liftIO getLine-    when (r1 /= "x") $ lift mzero--    r2 <- liftIO getLine-    when (r2 /= "y") $ lift mzero--mainMaybeBelow :: IO ()-mainMaybeBelow = do-    r <- runMaybeT (runStream getSequenceMaybeBelow)-    case r of-        Just _ -> putStrLn "Bingo"-        Nothing -> putStrLn "Wrong"------------------------------------------------------------------------------------ Using MaybeT above streamly-------------------------------------------------------------------------------------- When MaybeT is on top a Nothing would terminate only the current iteration--- of non-determinism below.------ Note that this is redundant configuration as the same behavior can be--- acheived with just streamly, using mzero.----getSequenceMaybeAbove :: (IsStream t, MonadIO (t m)) => MaybeT (t m) ()-getSequenceMaybeAbove = do-    liftIO $ putStrLn "MaybeT above streamly: Enter one char per line: "--    i <- lift $ S.fromFoldable [1..2 :: Int]-    liftIO $ putStrLn $ "iteration = " ++ show i--    r1 <- liftIO getLine-    when (r1 /= "x") $ mzero--    r2 <- liftIO getLine-    when (r2 /= "y") $ mzero--mainMaybeAbove :: (IsStream t, MonadIO (t m)) => MaybeT (t m) ()-mainMaybeAbove = do-    getSequenceMaybeAbove-    liftIO $ putStrLn "Bingo"------------------------------------------------------------------------------------ Using ExceptT below streamly-------------------------------------------------------------------------------------- XXX need to have a specialized liftCatch to lift catchE------ Note that throwE would terminate all iterations of non-determinism--- altogether.-getSequenceEitherBelow-    :: ( IsStream t-       , MonadTrans t-       , Monad m-       , MonadIO (t m)-       , MonadIO (t (ExceptT String m))-       )-    => t (ExceptT String m) ()-getSequenceEitherBelow = do-    liftIO $ putStrLn "ExceptT below streamly: Enter one char per line: "--    i <- S.fromFoldable [1..2 :: Int]-    liftIO $ putStrLn $ "iteration = " ++ show i--    r1 <- liftIO getLine-    when (r1 /= "x") $ lift $ throwE $ "Expecting x got: " ++ r1--    r2 <- liftIO getLine-    when (r2 /= "y") $ lift $ throwE $ "Expecting y got: " ++ r2--mainEitherBelow :: IO ()-mainEitherBelow = do-    -- XXX Cannot lift catchE-    r <- runExceptT (runStream getSequenceEitherBelow)-    case r of-        Right _ -> liftIO $ putStrLn "Bingo"-        Left s  -> liftIO $ putStrLn s------------------------------------------------------------------------------------ Using ExceptT below concurrent streamly-------------------------------------------------------------------------------------- XXX does not work correctly yet----getSequenceEitherAsyncBelow-    :: ( IsStream t-       , MonadTrans t-       , MonadIO m-       , MonadAsync m-       , MonadIO (t m)-       , MonadIO (t (ExceptT String m))-       , Semigroup (t (ExceptT [Char] m) Integer)-       )-    => t (ExceptT String m) ()-getSequenceEitherAsyncBelow = do-    liftIO $ putStrLn "ExceptT below concurrent streamly: "--    i <- (liftIO (threadDelay 1000)-            >> lift (throwE "First task")-            >> return 1)-            <> (lift (throwE "Second task") >> return 2)-            <> S.yield (3 :: Integer)-    liftIO $ putStrLn $ "iteration = " ++ show i--mainEitherAsyncBelow :: IO ()-mainEitherAsyncBelow = do-    r <- runExceptT (runStream $ asyncly $ getSequenceEitherAsyncBelow)-    case r of-        Right _ -> liftIO $ putStrLn "Bingo"-        Left s  -> liftIO $ putStrLn s------------------------------------------------------------------------------------ Using ExceptT above streamly-------------------------------------------------------------------------------------- When ExceptT is on top, we can lift the non-determinism of stream from--- below.------ Note that throwE would terminate/break only current iteration of--- non-determinism and not all of them altogether.------ Here we can use catchE directly but will have to use monad-control to lift--- stream operations with stream arguments.-getSequenceEitherAbove :: (IsStream t, Monad m, MonadIO (t m))-    => ExceptT String (t m) ()-getSequenceEitherAbove = do-    liftIO $ putStrLn "ExceptT above streamly: Enter one char per line: "--    i <- lift $ S.fromFoldable [1..2 :: Int]-    liftIO $ putStrLn $ "iteration = " ++ show i--    r1 <- liftIO getLine-    when (r1 /= "x") $ throwE $ "Expecting x got: " ++ r1--    r2 <- liftIO getLine-    when (r2 /= "y") $ throwE $ "Expecting y got: " ++ r2--mainEitherAbove :: (IsStream t, Monad m, MonadIO (t m))-    => ExceptT String (t m) ()-mainEitherAbove = do-    catchE (getSequenceEitherAbove >> liftIO (putStrLn "Bingo"))-           (\e -> liftIO $ putStrLn e)------------------------------------------------------------------------------------ Using MonadThrow to throw exceptions in streamly------------------------------------------------------------------------------------data Unexpected = Unexpected String deriving Show--instance Exception Unexpected---- Note that unlike when ExceptT is used on top, MonadThrow terminates all--- iterations of non-determinism rather then just the current iteration.----getSequenceMonadThrow :: (IsStream t, Monad m, MonadIO (t m), MonadThrow (t m))-    => t m ()-getSequenceMonadThrow = do-    liftIO $ putStrLn "MonadThrow in streamly: Enter one char per line: "--    i <- S.fromFoldable [1..2 :: Int]-    liftIO $ putStrLn $ "iteration = " ++ show i--    r1 <- liftIO getLine-    when (r1 /= "x") $ throwM $ Unexpected $ "Expecting x got: " ++ r1--    r2 <- liftIO getLine-    when (r2 /= "y") $ throwM $ Unexpected $ "Expecting y got: " ++ r2--mainMonadThrow :: IO ()-mainMonadThrow = do-    catch (runStream getSequenceMonadThrow >> liftIO (putStrLn "Bingo"))-          (\(e :: SomeException) -> liftIO $ putStrLn $ show e)------------------------------------------------------------------------------------ Using ContT below streamly-------------------------------------------------------------------------------------- CallCC is the goto/setjmp/longjmp equivalent--- Allows us to manipulate the control flow in arbitrary ways------ XXX need to have a specialized liftCallCC to actually lift callCC----getSequenceContBelow-    :: (IsStream t, MonadTrans t, MonadIO m, MonadIO (t (ContT r m)))-    => t (ContT r m) (Either String ())-getSequenceContBelow = do-    liftIO $ putStrLn "ContT below streamly: Enter one char per line: "--    i <- S.fromFoldable [1..2 :: Int]-    liftIO $ putStrLn $ "iteration = " ++ show i--    r <- lift $ callCC $ \exit -> do-        r1 <- liftIO getLine-        _ <- if r1 /= "x"-             then exit $ Left $ "Expecting x got: " ++ r1-             else return $ Right ()--        r2 <- liftIO getLine-        if r2 /= "y"-        then exit $ Left $ "Expecting y got: " ++ r2-        else return $ Right ()-    liftIO $ putStrLn $ "done iteration = " ++ show i-    return r--mainContBelow-    :: (IsStream t, MonadIO m, MonadTrans t, MonadIO (t (ContT r m)))-    => t (ContT r m) ()-mainContBelow = do-    r <- getSequenceContBelow-    case r of-        Right _ -> liftIO $ putStrLn "Bingo"-        Left s  -> liftIO $ putStrLn s------------------------------------------------------------------------------------ Using ContT above streamly------------------------------------------------------------------------------------getSequenceContAbove :: (IsStream t, Monad m, MonadIO (t m))-    => ContT r (t m) (Either String ())-getSequenceContAbove = do-    liftIO $ putStrLn "ContT above streamly: Enter one char per line: "--    i <- lift $ S.fromFoldable [1..2 :: Int]-    liftIO $ putStrLn $ "iteration = " ++ show i--    callCC $ \exit -> do-        r1 <- liftIO getLine-        _ <- if r1 /= "x"-             then exit $ Left $ "Expecting x got: " ++ r1-             else return $ Right ()--        r2 <- liftIO getLine-        if r2 /= "y"-        then exit $ Left $ "Expecting y got: " ++ r2-        else return $ Right ()--mainContAbove :: (IsStream t, Monad m, MonadIO (t m)) => ContT r (t m) ()-mainContAbove = do-    r <- getSequenceContAbove-    case r of-        Right _ -> liftIO $ putStrLn "Bingo"-        Left s  -> liftIO $ putStrLn s------------------------------------------------------------------------------------ Combining control flow manipulating monad transformers (MaybeT, exceptT,--- ContT) with Streamly----------------------------------------------------------------------------------main :: IO ()-main = do-    mainMaybeBelow-    runStream $ runMaybeT mainMaybeAbove-    runContT (runStream mainContBelow) return-    runStream (runContT mainContAbove return)-    mainEitherBelow-    runStream (runExceptT mainEitherAbove)-    mainMonadThrow-    mainEitherAsyncBelow
− examples/ListDir.hs 
@@ -1,18 +0,0 @@-import Control.Monad.IO.Class (liftIO)-import Path.IO (listDir, getCurrentDir)-import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))-import Streamly (runStream, aheadly, (<>))---- | List the current directory recursively using concurrent processing------ This example demonstrates that there is little difference between regular--- IO code and concurrent streamly code. You can just remove--- 'runStream . aheadly' and this becomes your regular IO code.-main :: IO ()-main = do-    hSetBuffering stdout LineBuffering-    runStream . aheadly $ getCurrentDir >>= readdir-    where readdir d = do-            (ds, fs) <- listDir d-            liftIO $ mapM_ putStrLn $ fmap show fs <> fmap show ds-            foldMap readdir ds
− examples/MergeSort.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE FlexibleContexts    #-}--import Data.Word-import System.Random (getStdGen, randoms)-import Data.List (sort)-import Streamly-import Streamly.Prelude (yieldM)-import qualified Streamly.Prelude as A--getSorted :: Serial Word16-getSorted = do-    g <- yieldM getStdGen-    let ls = take 100000 (randoms g) :: [Word16]-    foldMap return (sort ls)---- | merge two streams generating the elements from each in parallel-mergeAsync :: Ord a => Serial a -> Serial a -> Serial a-mergeAsync a b = do-    x <- yieldM $ mkAsync a-    y <- yieldM $ mkAsync b-    merge x y--merge :: Ord a => Serial a -> Serial a -> Serial a-merge a b = do-    a1 <- yieldM $ A.uncons a-    case a1 of-        Nothing -> b-        Just (x, ma) -> do-            b1 <- yieldM $ A.uncons b-            case b1 of-                Nothing -> return x <> ma-                Just (y, mb) ->-                    if y < x-                    then return y <> merge (return x <> ma) mb-                    else return x <> merge ma (return y <> mb)--main :: IO ()-main = do-    xs <- A.toList $ mergeAsync getSorted getSorted-    print $ length xs
− examples/SearchQuery.hs 
@@ -1,29 +0,0 @@-import Streamly-import Streamly.Prelude (nil, yieldM, (|:))-import Network.HTTP.Simple---- | Runs three search engine queries in parallel and prints the search engine--- names in the fastest first order.------ Does it twice using two different ways.----main :: IO ()-main = do-    putStrLn "Using parallel stream construction"-    runStream . parallely $ google |: bing |: duckduckgo |: nil--    putStrLn "\nUsing parallel semigroup composition"-    runStream . parallely $ yieldM google <> yieldM bing <> yieldM duckduckgo--    putStrLn "\nUsing parallel applicative zip"-    runStream . zipAsyncly $-        (,,) <$> yieldM google <*> yieldM bing <*> yieldM duckduckgo--    where-        get :: String -> IO ()-        get s = httpNoBody (parseRequest_ s) >> print s--        google, bing, duckduckgo :: IO ()-        google     = get "https://www.google.com/search?q=haskell"-        bing       = get "https://www.bing.com/search?q=haskell"-        duckduckgo = get "https://www.duckduckgo.com/?q=haskell"
− src/Streamly.hs 
@@ -1,345 +0,0 @@--- |--- Module      : Streamly--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC------ The way a list represents a sequence of pure values, a stream represents a--- sequence of monadic actions. 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. In contrast to the "Prelude" lists, merging or--- appending streams of arbitrary length is scalable and inexpensive.------ 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'.------ Here is a simple console echo program example:------ @--- > runStream $ S.repeatM getLine & S.mapM putStrLn--- @------ For more details please see the "Streamly.Tutorial" module and the examples--- directory in this package.------ This module exports stream types, instances and some basic operations.--- Functionality exported by this module include:------ * Semigroup append ('<>') instances as well as explicit  operations for merging streams--- * Monad and Applicative instances for looping over streams--- * Zip Applicatives for zipping streams--- * Stream type combinators to convert between different composition styles--- * Some basic utilities to run and fold streams------ See the "Streamly.Prelude" module for comprehensive APIs for construction,--- generation, elimination and transformation of streams.------ This module is designed to be imported unqualified:------ @--- import Streamly--- @--{-# LANGUAGE CPP                       #-}--#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -Wno-orphans #-}-#endif--#include "Streamly/Streams/inline.h"--module Streamly-    (-      MonadAsync--    -- * Stream transformers-    -- ** Serial Streams-    -- $serial-    , SerialT-    , WSerialT--    -- ** Concurrent Lookahead Streams-    -- $lookahead-    , AheadT--    -- ** Concurrent Asynchronous Streams-    -- $async-    , AsyncT-    , WAsyncT-    , ParallelT--    -- ** Zipping Streams-    -- $zipping-    , ZipSerialM-    , ZipAsyncM--    -- * Running Streams-    , runStream--    -- * Parallel Function Application-    -- $application-    , (|$)-    , (|&)-    , (|$.)-    , (|&.)-    , mkAsync--    -- * Merging Streams-    -- $sum-    , serial-    , wSerial-    , ahead-    , async-    , wAsync-    , parallel--    -- * Concurrency Control-    -- $concurrency-    , maxThreads-    , maxBuffer--    -- * Rate Limiting-    , Rate (..)-    , rate-    , avgRate-    , minRate-    , maxRate-    , constRate--    -- * Folding Containers of Streams-    -- $foldutils-    , foldWith-    , foldMapWith-    , forEachWith--    -- * Stream Type Adapters-    -- $adapters-    , IsStream ()--    , serially-    , wSerially-    , asyncly-    , aheadly-    , wAsyncly-    , parallely-    , zipSerially-    , zipAsyncly-    , adapt--    -- * IO Streams-    , Serial-    , WSerial-    , Ahead-    , Async-    , WAsync-    , Parallel-    , ZipSerial-    , ZipAsync--    -- * Re-exports-    , Semigroup (..)-    -- * Deprecated-    , Streaming-    , runStreaming-    , runStreamT-    , runInterleavedT-    , runAsyncT-    , runParallelT-    , runZipStream-    , runZipAsync-    , StreamT-    , InterleavedT-    , ZipStream-    , interleaving-    , zipping-    , zippingAsync-    , (<=>)-    , (<|)-    )-where--import Streamly.Streams.StreamK hiding (runStream, serial)-import Streamly.Streams.Serial-import Streamly.Streams.Async-import Streamly.Streams.Ahead-import Streamly.Streams.Parallel-import Streamly.Streams.Zip-import Streamly.Streams.Prelude-import Streamly.Streams.SVar-import Streamly.SVar (MonadAsync, Rate (..))-import Data.Semigroup (Semigroup(..))--import qualified Streamly.Streams.StreamD as D-import qualified Streamly.Streams.StreamK as K---- XXX This should perhaps be moved to Prelude.----------------------------------------------------------------------------------- Eliminating a stream----------------------------------------------------------------------------------- | Run a streaming composition, discard the results. By default it interprets--- the stream as 'SerialT', to run other types of streams use the type adapting--- combinators for example @runStream . 'asyncly'@.------ @since 0.2.0-{-# INLINE_EARLY runStream #-}-runStream :: Monad m => SerialT m a -> m ()-runStream m = D.runStream $ D.fromStreamK (toStream m)-{-# RULES "runStream fallback to CPS" [1]-    forall a. D.runStream (D.fromStreamK a) = K.runStream a #-}---- | Same as 'runStream'------ @since 0.1.0-{-# DEPRECATED runStreaming "Please use runStream instead." #-}-runStreaming :: (Monad m, IsStream t) => t m a -> m ()-runStreaming = runStream . K.adapt---- | Same as @runStream@.------ @since 0.1.0-{-# DEPRECATED runStreamT "Please use runStream instead." #-}-runStreamT :: Monad m => SerialT m a -> m ()-runStreamT = runStream---- | Same as @runStream . wSerially@.------ @since 0.1.0-{-# DEPRECATED runInterleavedT "Please use 'runStream . interleaving' instead." #-}-runInterleavedT :: Monad m => WSerialT m a -> m ()-runInterleavedT = runStream . K.adapt---- | Same as @runStream . parallely@.------ @since 0.1.0-{-# DEPRECATED runParallelT "Please use 'runStream . parallely' instead." #-}-runParallelT :: Monad m => ParallelT m a -> m ()-runParallelT = runStream . K.adapt---- | Same as @runStream . asyncly@.------ @since 0.1.0-{-# DEPRECATED runAsyncT "Please use 'runStream . asyncly' instead." #-}-runAsyncT :: Monad m => AsyncT m a -> m ()-runAsyncT = runStream . K.adapt---- | Same as @runStream . zipping@.------ @since 0.1.0-{-# DEPRECATED runZipStream "Please use 'runStream . zipSerially instead." #-}-runZipStream :: Monad m => ZipSerialM m a -> m ()-runZipStream = runStream . K.adapt---- | Same as @runStream . zippingAsync@.------ @since 0.1.0-{-# DEPRECATED runZipAsync "Please use 'runStream . zipAsyncly instead." #-}-runZipAsync :: Monad m => ZipAsyncM m a -> m ()-runZipAsync = runStream . K.adapt----------------------------------------------------------------------------------- Documentation----------------------------------------------------------------------------------- $serial------ Serial streams compose serially or non-concurrently. In a composed stream,--- each action is executed only after the previous action has finished.  The two--- serial stream types 'SerialT' and 'WSerialT' differ in how they traverse the--- streams in a 'Semigroup' or 'Monad' composition.---- $async------ The async style streams execute actions asynchronously and consume the--- outputs as well asynchronously. In a composed stream, at any point of time--- more than one stream can run concurrently and yield elements.  The elements--- are yielded by the composed stream as they are generated by the constituent--- streams on a first come first serve basis.  Therefore, on each run the--- stream may yield elements in a different sequence depending on the delays--- introduced by scheduling.  The two async types 'AsyncT' and 'WAsyncT' differ--- in how they traverse streams in 'Semigroup' or 'Monad' compositions.---- $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 enclosed stream.  A parameter--- set at any point remains effective for any concurrent combinators used--- downstream until it is reset.  These control parameters have no effect on--- non-concurrent combinators in the stream, or on non-concurrent streams. They--- also do not affect 'Parallel' streams, as concurrency for 'Parallel' streams--- is always unbounded.---- $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. 'asyncly' or 'wSerially'. 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.------- $foldutils------ These are variants of standard 'Foldable' fold functions that use a--- polymorphic stream sum operation (e.g. 'async' or 'wSerial') to fold a--- container of streams.
+ src/Streamly/Data/Array/Foreign.hs view
@@ -0,0 +1,119 @@+{-# OPTIONS_GHC -Wno-orphans #-}+#include "inline.hs"++-- |+-- Module      : Streamly.Data.Array.Foreign+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- 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+--+-- 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 as Array+--+-- 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++    -- * 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+    , A.readRev++    -- ** Casting+    , cast+    , asBytes++    -- ** Random Access+    , A.length+    -- , (!!)+    , A.getIndex+    )+where++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/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
@@ -0,0 +1,16 @@+-- |+-- Module      : Streamly.Data.Fold.Tee+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+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
+ 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
@@ -0,0 +1,34 @@+-- |+-- Module      : Streamly.Data.SmallArray+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Data.SmallArray+  ( SmallArray++  -- * Construction+  , A.fromListN+  , A.fromStreamN++  , A.writeN++  -- * Elimination+  , A.read+  , A.readRev+  , A.reader++  -- * Folding Arrays+  , A.streamFold+  , A.fold++  , A.length+  )+where++import Streamly.Internal.Data.SmallArray (SmallArray)++import qualified Streamly.Internal.Data.SmallArray as A
+ 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/Internal.hs 
@@ -1,19 +0,0 @@--- |--- Module      : Streamly.Internal--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC------ This module is only for internal use. There is no warranty for the routines--- in this module to work correctly, please use at your own risk. These--- routines are subject to change or be removed without notice.----module Streamly.Internal-    ( inspectMode-    )-where--import Streamly.Streams.SVar
+ src/Streamly/Internal/Control/Concurrent.hs view
@@ -0,0 +1,77 @@+-- |+-- Module      : Streamly.Internal.Control.Concurrent+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Note: This module is primarily for abstractions related to MonadBaseControl.+-- Please do not add any general routines in this. It should be renamed+-- appropriately.++module Streamly.Internal.Control.Concurrent+    (+      MonadAsync+    , MonadRunInIO+    , RunInIO(..)+    , askRunInIO+    , withRunInIO+    , withRunInIONoRestore+    , restoreM+    )+where++import Control.Monad.Catch (MonadThrow)+import Streamly.Internal.Data.SVar.Type (RunInIO(..))++#ifdef USE_UNLIFTIO+import Control.Monad.IO.Unlift (MonadUnliftIO(..), UnliftIO(..), askUnliftIO)+#else+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Control (MonadBaseControl(..), control)+#endif++#ifdef USE_UNLIFTIO+type MonadRunInIO m = MonadUnliftIO m+#else+type MonadRunInIO m = (MonadIO m, MonadBaseControl IO m)+#endif++-- | A monad that can perform concurrent or parallel IO operations. Streams+-- that can be composed concurrently require the underlying monad to be+-- 'MonadAsync'.+--+#ifdef USE_UNLIFTIO+type MonadAsync m = (MonadUnliftIO m, MonadThrow m)+#else+type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)+#endif++-- | When we run computations concurrently, we completely isolate the state of+-- the concurrent computations from the parent computation.  The invariant is+-- that we should never be running two concurrent computations in the same+-- thread without using the runInIO function.  Also, we should never be running+-- a concurrent computation in the parent thread, otherwise it may affect the+-- state of the parent which is against the defined semantics of concurrent+-- execution.+askRunInIO :: MonadRunInIO m => m (RunInIO m)+#ifdef USE_UNLIFTIO+askRunInIO = fmap (\(UnliftIO run) -> RunInIO run) askUnliftIO+#else+askRunInIO = control $ \run -> run (return $ RunInIO run)+#endif++#ifdef USE_UNLIFTIO+withRunInIONoRestore :: MonadRunInIO m => ((forall a. m a -> IO a) -> IO b) -> m b+withRunInIONoRestore = withRunInIO++restoreM :: MonadRunInIO m => a -> m a+restoreM = return+#else+withRunInIO :: MonadRunInIO m => ((forall a. m a -> IO (StM m a)) -> IO (StM m b)) -> m b+withRunInIO = control++withRunInIONoRestore :: MonadRunInIO m => ((forall a. m a -> IO (StM m a)) -> IO b) -> m b+withRunInIONoRestore = liftBaseWith+#endif
+ src/Streamly/Internal/Control/ForkLifted.hs view
@@ -0,0 +1,66 @@+-- |+-- Module      : Streamly.Internal.Control.ForkLifted+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Control.ForkLifted+    (+      doFork+    , doForkWith+    , fork+    , forkManaged+    )+where++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.ForkIO (rawForkIO, forkManagedWith)++-- | Fork a thread to run the given computation, installing the provided+-- exception handler. Lifted to any monad with 'MonadRunInIO m'+-- capability.+--+-- TODO: the RunInIO argument can be removed, we can directly pass the action+-- as "mrun action" instead.+{-# INLINE doFork #-}+doFork :: MonadRunInIO m+    => m ()+    -> RunInIO m+    -> (SomeException -> IO ())+    -> m ThreadId+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+                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.+--+{-# INLINABLE fork #-}+fork :: MonadRunInIO m => m () -> m ThreadId+fork m = withRunInIONoRestore $ \run -> forkIO $ void $ run m++-- | Fork a thread that is automatically killed as soon as the reference to the+-- returned threadId is garbage collected.+--+{-# INLINABLE forkManaged #-}+forkManaged :: MonadRunInIO m => m () -> m ThreadId+forkManaged = forkManagedWith fork
+ src/Streamly/Internal/Data/Atomics.hs view
@@ -0,0 +1,80 @@+-- |+-- Module      : Streamly.Internal.Data.Atomics+-- Copyright   : (c) 2018-2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Atomics+    (+      atomicModifyIORefCAS+    , atomicModifyIORefCAS_+    , writeBarrier+    , storeLoadBarrier+    )+where++import Data.IORef (IORef, atomicModifyIORef)+#ifdef ghcjs_HOST_OS+import Data.IORef (modifyIORef)+#else+import qualified Data.Atomics as A+#endif++#ifndef ghcjs_HOST_OS++-- XXX Does it make sense to have replacements for atomicModifyIORef etc. on a+-- single threaded system.+--+-- Slightly faster version of CAS. Gained some improvement by avoiding the use+-- of "evaluate" because we know we do not have exceptions in fn.+{-# INLINE atomicModifyIORefCAS #-}+atomicModifyIORefCAS :: IORef a -> (a -> (a,b)) -> IO b+atomicModifyIORefCAS ref fn = do+    tkt <- A.readForCAS ref+    loop tkt retries++    where++    retries = 25 :: Int+    loop _   0     = atomicModifyIORef ref fn+    loop old tries = do+        let (new, result) = fn $ A.peekTicket old+        (success, tkt) <- A.casIORef ref old new+        if success+        then return result+        else loop tkt (tries - 1)++{-# INLINE atomicModifyIORefCAS_ #-}+atomicModifyIORefCAS_ :: IORef t -> (t -> t) -> IO ()+atomicModifyIORefCAS_ = A.atomicModifyIORefCAS_++{-# INLINE writeBarrier #-}+writeBarrier :: IO ()+writeBarrier = A.writeBarrier++{-# INLINE storeLoadBarrier #-}+storeLoadBarrier :: IO ()+storeLoadBarrier = A.storeLoadBarrier++#else++{-# INLINE atomicModifyIORefCAS #-}+atomicModifyIORefCAS :: IORef a -> (a -> (a,b)) -> IO b+atomicModifyIORefCAS = atomicModifyIORef++{-# INLINE atomicModifyIORefCAS_ #-}+atomicModifyIORefCAS_ :: IORef a -> (a -> a) -> IO ()+atomicModifyIORefCAS_ = modifyIORef++{-# INLINE writeBarrier #-}+writeBarrier :: IO ()+writeBarrier = return ()++{-# INLINE storeLoadBarrier #-}+storeLoadBarrier :: IO ()+storeLoadBarrier = return ()++#endif
+ 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/Cont.hs view
@@ -0,0 +1,36 @@+-- |+-- Module      : Streamly.Internal.Data.Cont+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Continuation style utilities.+--+module Streamly.Internal.Data.Cont+    ( contListMap+    )+where++import Control.Monad.Cont (runCont, cont)++-- | Given a continuation based transformation from @a@ to @b@ and a+-- continuation based transformation from @[b]@ to @c@, make continuation based+-- transformation from @[a]@ to @c@.+--+-- /Pre-release/++-- You can read the definition as:+--+-- > contListMap f g = \xs final ->+--+contListMap ::+       (a -> (b -> r) -> r)      -- transform a -> b+    -> ([b] -> (c -> r) -> r)    -- transform [b] -> c+    -> ([a] -> (c -> r) -> r)    -- transform [a] -> c+contListMap f g xs final =+    let bconts = fmap (cont . f) xs  -- [Cont b]+        blistCont = sequence bconts  -- Cont [b]+        k ys = g ys final            -- [b] -> r+     in runCont blistCont k          -- r
+ 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
@@ -0,0 +1,80 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+-- |+-- Module      : Streamly.Internal.Data.Fold.SVar+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.Fold.SVar+    {-# DEPRECATED "The functionality is moved to Fold.Concurrent" #-}+    (+      write+    , writeLimited+    )+where++#include "inline.hs"++import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Streamly.Internal.Data.Fold (Fold(..))++import qualified Streamly.Internal.Data.Fold as FL (Step(Done, Partial))++import Streamly.Internal.Data.SVar++-- | A fold to write a stream to an SVar. Unlike 'toSVar' this does not allow+-- for concurrent evaluation of the stream, as the fold receives the input one+-- element at a time, it just forwards the elements to the SVar. However, we+-- can safely execute the fold in an independent thread, the SVar can act as a+-- buffer decoupling the sender from the receiver. Also, we can have multiple+-- folds running concurrently pusing the streams to the SVar.+--+{-# INLINE write #-}+write :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()+write svar winfo = Fold step initial return final++    where++    initial = return $ FL.Partial ()++    -- XXX we can have a separate fold for unlimited buffer case to avoid a+    -- branch in the step here.+    step () x =+        liftIO $ do+            decrementBufferLimit svar+            void $ send svar (ChildYield x)+            return $ FL.Partial ()++    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 (const (return ())) final++    where++    initial = return $ FL.Partial True++    step True x =+        liftIO $ do+            yieldLimitOk <- decrementYieldLimit svar+            if yieldLimitOk+            then do+                decrementBufferLimit svar+                void $ send svar (ChildYield x)+                return $ FL.Partial True+            else do+                cleanupSVarFromWorker svar+                sendStop svar winfo+                return $ FL.Done ()+    step False _ = return $ FL.Done ()++    final True = liftIO $ sendStop svar winfo+    final False = return ()
+ 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/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/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/SVar.hs view
@@ -0,0 +1,539 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.SVar+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.SVar+    {-# DEPRECATED "SVar is replaced by Channel." #-}+    (+      module Streamly.Internal.Data.SVar.Type+    , module Streamly.Internal.Data.SVar.Worker+    , module Streamly.Internal.Data.SVar.Dispatch+    , module Streamly.Internal.Data.SVar.Pull++    -- * New SVar+    , getYieldRateInfo+    , newSVarStats++    -- ** Parallel+    , newParallelVar++    -- ** Ahead+    , enqueueAhead+    , reEnqueueAhead+    , queueEmptyAhead+    , dequeueAhead+    , HeapDequeueResult(..)+    , dequeueFromHeap+    , dequeueFromHeapSeq+    , requeueOnHeapTop+    , updateHeapSeq+    , withIORef+    , heapIsSane+    , newAheadVar+    )+where++#include "inline.hs"++import Control.Concurrent (myThreadId, takeMVar)+import Control.Concurrent.MVar (newEmptyMVar, tryPutMVar, tryTakeMVar, newMVar)+import Control.Exception (assert)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Heap (Heap, Entry(..))+import Data.IORef (newIORef, readIORef)+import Data.IORef (IORef, atomicModifyIORef)+import Streamly.Internal.Control.Concurrent (MonadAsync, askRunInIO)+import Streamly.Internal.Data.Atomics+       (atomicModifyIORefCAS, atomicModifyIORefCAS_, writeBarrier)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units (NanoSecond64(..))++import qualified Data.Heap as H+import qualified Data.Set as S++import Streamly.Internal.Data.SVar.Dispatch+import Streamly.Internal.Data.SVar.Pull+import Streamly.Internal.Data.SVar.Type+import Streamly.Internal.Data.SVar.Worker++-------------------------------------------------------------------------------+-- Creating an SVar+-------------------------------------------------------------------------------++getYieldRateInfo :: State t m a -> IO (Maybe YieldRateInfo)+getYieldRateInfo 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+            }++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+        }++-------------------------------------------------------------------------------+-- Ahead+-------------------------------------------------------------------------------++-- 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.++-- 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.+-- Thererefore the queue never has more than one item in it.+--+-- 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.+{-# INLINE enqueueAhead #-}+enqueueAhead :: SVar t m a -> IORef ([t m a], Int) -> (RunInIO m, t m a) -> IO ()+enqueueAhead sv q m = do+    atomicModifyIORefCAS_ q $ \ case+        ([], n) -> ([snd m], n + 1)  -- increment sequence+        _ -> error "enqueueAhead: queue is not empty"+    ringDoorBell sv++-- enqueue without incrementing the sequence number+{-# INLINE reEnqueueAhead #-}+reEnqueueAhead :: SVar t m a -> IORef ([t m a], Int) -> t m a -> IO ()+reEnqueueAhead sv q m = do+    atomicModifyIORefCAS_ q $ \ case+        ([], n) -> ([m], n)  -- DO NOT increment sequence+        _ -> error "reEnqueueAhead: queue is not empty"+    ringDoorBell 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 queueEmptyAhead #-}+queueEmptyAhead :: MonadIO m => IORef ([t m a], Int) -> m Bool+queueEmptyAhead q = liftIO $ do+    (xs, _) <- readIORef q+    return $ null xs++{-# INLINE dequeueAhead #-}+dequeueAhead :: MonadIO m+    => IORef ([t m a], Int) -> m (Maybe (t m a, Int))+dequeueAhead q = liftIO $+    atomicModifyIORefCAS q $ \case+            ([], n) -> (([], n), Nothing)+            (x : [], n) -> (([], n), Just (x, n))+            _ -> error "more than one item on queue"++-------------------------------------------------------------------------------+-- 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 HeapDequeueResult t m a =+      Clearing+    | Waiting Int+    | Ready (Entry Int (AheadHeapEntry t m a))++{-# INLINE dequeueFromHeap #-}+dequeueFromHeap+    :: IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)+    -> IO (HeapDequeueResult t 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)++{-# INLINE dequeueFromHeapSeq #-}+dequeueFromHeapSeq+    :: IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)+    -> Int+    -> IO (HeapDequeueResult t 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 t m a)), Maybe Int)+    -> Entry Int (AheadHeapEntry t 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 t m a)), Maybe Int)+    -> Int+    -> IO ()+updateHeapSeq hpVar seqNo =+    atomicModifyIORef_ hpVar $ \(hp, snum) ->+        assert (heapIsSane snum seqNo) (hp, Just seqNo)++-- XXX remove polymorphism in t, inline f+getAheadSVar :: MonadAsync m+    => State t m a+    -> (   IORef ([t m a], Int)+        -> IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)+        -> State t m a+        -> SVar t m a+        -> Maybe WorkerInfo+        -> m ())+    -> RunInIO m+    -> IO (SVar t m a)+getAheadSVar st f mrun = do+    outQ    <- newIORef ([], 0)+    -- the second component of the tuple is "Nothing" when heap is being+    -- cleared, "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 S.empty+    -- Sequence number is incremented whenever something is queued, therefore,+    -- first sequence number would be 0+    q <- newIORef ([], -1)+    stopMVar <- newMVar ()+    yl <- case getYieldLimit st of+            Nothing -> return Nothing+            Just x -> Just <$> newIORef x+    rateInfo <- getYieldRateInfo st++    stats <- newSVarStats+    tid <- myThreadId++    let getSVar sv readOutput postProc = SVar+            { outputQueue      = outQ+            , outputQueueFromConsumer = undefined+            , remainingWork  = yl+            , maxBufferLimit   = getMaxBuffer st+            , pushBufferSpace = undefined+            , pushBufferPolicy = undefined+            , pushBufferMVar   = undefined+            , maxWorkerLimit   = min (getMaxThreads st) (getMaxBuffer st)+            , yieldRateInfo    = rateInfo+            , outputDoorBell   = outQMv+            , outputDoorBellFromConsumer = undefined+            , readOutputQ      = readOutput sv+            , postProcess      = postProc sv+            , workerThreads    = running+            , workLoop         = f q outH st{streamVar = Just sv} sv+            , enqueue          = enqueueAhead sv q+            , isWorkDone       = isWorkDoneAhead sv q outH+            , isQueueDone      = isQueueDoneAhead sv q+            , needDoorBell     = wfw+            , svarStyle        = AheadVar+            , svarStopStyle    = StopNone+            , svarStopBy       = undefined+            , svarMrun         = mrun+            , workerCount      = active+            , accountThread    = delThread sv+            , workerStopMVar   = stopMVar+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode st+            , svarCreator      = tid+            , aheadWorkQueue   = q+            , outputHeap       = outH+            , svarStats        = stats+            }++    let sv =+            case getStreamRate st of+                Nothing -> getSVar sv readOutputQBounded postProcessBounded+                Just _  -> getSVar sv readOutputQPaced postProcessPaced+     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++{-# INLINABLE newAheadVar #-}+newAheadVar :: MonadAsync m+    => State t m a+    -> t m a+    -> (   IORef ([t m a], Int)+        -> IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)+        -> State t m a+        -> SVar t m a+        -> Maybe WorkerInfo+        -> m ())+    -> m (SVar t m a)+newAheadVar st m wloop = do+    mrun <- askRunInIO+    sv <- liftIO $ getAheadSVar st wloop mrun+    sendFirstWorker sv m++-------------------------------------------------------------------------------+-- WAhead+-------------------------------------------------------------------------------++-- XXX To be implemented. Use a linked queue like WAsync and put back the+-- remaining computation at the back of the queue instead of the heap, and+-- increment the sequence number.++-------------------------------------------------------------------------------+-- Parallel+-------------------------------------------------------------------------------++getParallelSVar :: MonadIO m+    => SVarStopStyle -> State t m a -> RunInIO m -> IO (SVar t m a)+getParallelSVar ss st mrun = do+    outQ    <- newIORef ([], 0)+    outQRev <- newIORef ([], 0)+    outQMv  <- newEmptyMVar+    outQMvRev <- newEmptyMVar+    active  <- newIORef 0+    running <- newIORef S.empty+    yl <- case getYieldLimit st of+            Nothing -> return Nothing+            Just x -> Just <$> newIORef x+    rateInfo <- getYieldRateInfo st+    let bufLim =+            case getMaxBuffer st of+                Unlimited -> undefined+                Limited x -> fromIntegral x+    remBuf <- newIORef bufLim+    pbMVar <- newMVar ()++    stats <- newSVarStats+    tid <- myThreadId++    stopBy <-+        case ss of+            StopBy -> liftIO $ newIORef undefined+            _ -> return undefined++    let sv =+            SVar { outputQueue      = outQ+                 , outputQueueFromConsumer = outQRev+                 , remainingWork    = yl+                 , maxBufferLimit   = getMaxBuffer st+                 , pushBufferSpace  = remBuf+                 , pushBufferPolicy = PushBufferBlock+                 , pushBufferMVar   = pbMVar+                 , maxWorkerLimit   = Unlimited+                 -- Used only for diagnostics+                 , yieldRateInfo    = rateInfo+                 , outputDoorBell   = outQMv+                 , outputDoorBellFromConsumer = outQMvRev+                 , readOutputQ      = readOutputQPar sv+                 , postProcess      = allThreadsDone sv+                 , workerThreads    = running+                 , workLoop         = undefined+                 , enqueue          = undefined+                 , isWorkDone       = undefined+                 , isQueueDone      = undefined+                 , needDoorBell     = undefined+                 , svarStyle        = ParallelVar+                 , svarStopStyle    = ss+                 , svarStopBy       = stopBy+                 , svarMrun         = mrun+                 , workerCount      = active+                 , accountThread    = modifyThread sv+                 , workerStopMVar   = undefined+                 , svarRef          = Nothing+                 , svarInspectMode  = getInspectMode st+                 , svarCreator      = tid+                 , aheadWorkQueue   = undefined+                 , outputHeap       = undefined+                 , svarStats        = stats+                 }+     in return sv++    where++    readOutputQPar sv = liftIO $ do+        withDiagMVar sv "readOutputQPar: doorbell"+            $ takeMVar (outputDoorBell sv)+        case yieldRateInfo sv of+            Nothing -> return ()+            Just yinfo -> void $ collectLatency sv yinfo False+        r <- fst `fmap` readOutputQRaw sv+        liftIO $ do+            void $ tryTakeMVar (pushBufferMVar sv)+            resetBufferLimit sv+            writeBarrier+            void $ tryPutMVar (pushBufferMVar sv) ()+        return r++{-# INLINABLE newParallelVar #-}+newParallelVar :: MonadAsync m+    => SVarStopStyle -> State t m a -> m (SVar t m a)+newParallelVar ss st = do+    mrun <- askRunInIO+    liftIO $ getParallelSVar ss st mrun
+ src/Streamly/Internal/Data/SVar/Dispatch.hs view
@@ -0,0 +1,742 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.SVar.Dispatch+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.SVar.Dispatch+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}+    (+    -- * Latency collection+      collectLatency++    -- * Diagnostics+    , withDiagMVar+    , dumpSVar+    , printSVar++    -- * Thread accounting+    , delThread+    , modifyThread+    , allThreadsDone++    -- * Dispatching+    , recordMaxWorkers+    , pushWorker+    , pushWorkerPar+    , dispatchWorker+    , dispatchWorkerPaced+    , sendWorkerWait+    , sendFirstWorker+    , sendWorkerDelay+    , sendWorkerDelayPaced+    )+where++#include "inline.hs"++import Control.Concurrent (takeMVar, tryReadMVar, ThreadId, threadDelay)+import Control.Concurrent.MVar (tryPutMVar)+import Control.Exception+       (assert, catches, throwIO, Handler(..), BlockedIndefinitelyOnMVar(..),+        BlockedIndefinitelyOnSTM(..))+import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Maybe (fromJust, fromMaybe)+import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef)+import Streamly.Internal.Control.Concurrent (MonadAsync, askRunInIO)+import Streamly.Internal.Control.ForkLifted (doFork)+import Streamly.Internal.Data.Atomics+       (atomicModifyIORefCAS, atomicModifyIORefCAS_, writeBarrier,+        storeLoadBarrier)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units+       (AbsTime, NanoSecond64(..), MicroSecond64(..), diffAbsTime64,+        fromRelTime64, toRelTime64, showNanoSecond64, showRelTime64)+import System.IO (hPutStrLn, stderr)++import qualified Data.Heap as H+import qualified Data.Set as S++import Streamly.Internal.Data.SVar.Type+import Streamly.Internal.Data.SVar.Worker++-------------------------------------------------------------------------------+-- Worker latency data processing+-------------------------------------------------------------------------------++-- 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+        cnt = max 1 $ minThreadDelay `div` latency+        period = min cnt (fromIntegral magicMaxBuffer)++    writeIORef periodRef (fromIntegral period)++{-# INLINE recordMinMaxLatency #-}+recordMinMaxLatency :: SVar t m a -> NanoSecond64 -> IO ()+recordMinMaxLatency sv new = do+    let ss = svarStats sv+    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 :: SVar t m a -> (Count, NanoSecond64) -> IO ()+recordAvgLatency sv (count, time) = do+    let ss = svarStats sv+    modifyIORef (avgWorkerLatency ss) $+        \(cnt, t) -> (cnt + count, t + time)++-- Pour the pending latency stats into a collection bucket+{-# INLINE collectWorkerPendingLatency #-}+collectWorkerPendingLatency+    :: IORef (Count, Count, NanoSecond64)+    -> IORef (Count, Count, NanoSecond64)+    -> IO (Count, Maybe (Count, NanoSecond64))+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)++-- Returns a triple, (1) yield count since last collection, (2) the base time+-- when we started counting, (3) average latency in the last measurement+-- period. The former two are used for accurate measurement of the going rate+-- whereas the average is used for future estimates e.g. how many workers+-- should be maintained to maintain the rate.+-- CAUTION! keep it in sync with getWorkerLatency+collectLatency :: SVar t m a+               -> YieldRateInfo+               -> Bool+               -> IO (Count, AbsTime, NanoSecond64)+collectLatency sv 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 (svarInspectMode sv) $ recordMinMaxLatency sv 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 (svarInspectMode sv) $ recordAvgLatency sv (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 :: SVar t m a -> SVarStats -> SVarStyle -> IO String+dumpSVarStats sv ss style = do+    case yieldRateInfo sv of+        Nothing -> return ()+        Just yinfo -> do+            _ <- liftIO $ collectLatency sv 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+    (svarCnt, svarGainLossCnt, svarLat) <- case yieldRateInfo sv of+        Nothing -> return (0, 0, 0)+        Just yinfo -> do+            (cnt, startTime) <- readIORef $ svarAllTimeLatency yinfo+            if cnt > 0+            then do+                t <- readIORef (svarStopTime ss)+                gl <- readIORef (svarGainedLostYields yinfo)+                case t of+                    Nothing -> do+                        now <- getTime Monotonic+                        let interval = diffAbsTime64 now startTime+                        return (cnt, gl, interval `div` fromIntegral cnt)+                    Just stopTime -> do+                        let interval = diffAbsTime64 stopTime startTime+                        return (cnt, gl, interval `div` fromIntegral cnt)+            else return (0, 0, 0)++    return $ unlines+        [ "total dispatches = " <> show dispatches+        , "max workers = " <> show maxWrk+        , "max outQSize = " <> show maxOq+            <> (if style == AheadVar+               then "\nheap max size = " <> show maxHp+               else "")+            <> (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 "\nSVar latency = " <> showRelTime64 svarLat+               else "")+            <> (if svarCnt > 0+               then "\nSVar yield count = " <> show svarCnt+               else "")+            <> (if svarGainLossCnt > 0+               then "\nSVar gain/loss yield count = " <> show svarGainLossCnt+               else "")+        ]++{-# NOINLINE dumpSVar #-}+dumpSVar :: SVar t m a -> IO String+dumpSVar sv = do+    (oqList, oqLen) <- readIORef $ outputQueue sv+    db <- tryReadMVar $ outputDoorBell sv+    aheadDump <-+        if svarStyle sv == AheadVar+        then do+            (oheap, oheapSeq) <- readIORef $ outputHeap sv+            (wq, wqSeq) <- readIORef $ aheadWorkQueue sv+            return $ unlines+                [ "heap length = " <> show (H.size oheap)+                , "heap seqeunce = " <> show oheapSeq+                , "work queue length = " <> show (length wq)+                , "work queue sequence = " <> show wqSeq+                ]+        else return []++    let style = svarStyle sv+    waiting <-+        if style /= ParallelVar+        then readIORef $ needDoorBell sv+        else return False+    rthread <- readIORef $ workerThreads sv+    workers <- readIORef $ workerCount sv+    stats <- dumpSVarStats sv (svarStats sv) (svarStyle sv)++    return $ unlines+        [+          "Creator tid = " <> show (svarCreator sv),+          "style = " <> show (svarStyle sv)+        , "---------CURRENT STATE-----------"+        , "outputQueue length computed  = " <> show (length oqList)+        , "outputQueue length maintained = " <> show oqLen+        -- XXX print the types of events in the outputQueue, first 5+        , "outputDoorBell = " <> show db+        ]+        <> aheadDump+        <> unlines+        [ "needDoorBell = " <> show waiting+        , "running threads = " <> show rthread+        -- XXX print the status of first 5 threads+        , "running thread count = " <> show workers+        ]+        <> "---------STATS-----------\n"+        <> stats++-- 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.++{-# NOINLINE mvarExcHandler #-}+mvarExcHandler :: SVar t m a -> String -> BlockedIndefinitelyOnMVar -> IO ()+mvarExcHandler sv label e@BlockedIndefinitelyOnMVar = do+    svInfo <- dumpSVar sv+    hPutStrLn stderr $ label <> " " <> "BlockedIndefinitelyOnMVar\n" <> svInfo+    throwIO e++{-# NOINLINE stmExcHandler #-}+stmExcHandler :: SVar t m a -> String -> BlockedIndefinitelyOnSTM -> IO ()+stmExcHandler sv label e@BlockedIndefinitelyOnSTM = do+    svInfo <- dumpSVar sv+    hPutStrLn stderr $ label <> " " <> "BlockedIndefinitelyOnSTM\n" <> svInfo+    throwIO e++withDiagMVar :: SVar t m a -> String -> IO () -> IO ()+withDiagMVar sv label action =+    if svarInspectMode sv+    then+        action `catches` [ Handler (mvarExcHandler sv label)+                         , Handler (stmExcHandler sv label)+                         ]+    else action++printSVar :: SVar t m a -> String -> IO ()+printSVar sv how = do+    svInfo <- dumpSVar sv+    hPutStrLn stderr $ "\n" <> how <> "\n" <> svInfo++-------------------------------------------------------------------------------+-- 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 => SVar t m a -> ThreadId -> m ()+addThread sv tid =+    liftIO $ modifyIORef (workerThreads sv) (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 => SVar t m a -> ThreadId -> m ()+delThread sv tid =+    liftIO $ modifyIORef (workerThreads sv) (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 => SVar t m a -> ThreadId -> m ()+modifyThread sv tid = do+    changed <- liftIO $ atomicModifyIORefCAS (workerThreads sv) $ \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 (outputDoorBell sv) ()++-- | 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 => SVar t m a -> m Bool+allThreadsDone sv = liftIO $ S.null <$> readIORef (workerThreads sv)++-------------------------------------------------------------------------------+-- Dispatching workers+-------------------------------------------------------------------------------++{-# NOINLINE recordMaxWorkers #-}+recordMaxWorkers :: MonadIO m => SVar t m a -> m ()+recordMaxWorkers sv = liftIO $ do+    active <- readIORef (workerCount sv)+    maxWrk <- readIORef (maxWorkers $ svarStats sv)+    when (active > maxWrk) $ writeIORef (maxWorkers $ svarStats sv) active+    modifyIORef (totalDispatches $ svarStats sv) (+1)++{-# NOINLINE pushWorker #-}+pushWorker :: MonadAsync m => Count -> SVar t m a -> m ()+pushWorker yieldMax sv = do+    liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1+    when (svarInspectMode sv) $ recordMaxWorkers sv+    -- This allocation matters when significant number of workers are being+    -- sent. We allocate it only when needed.+    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+                    }+    doFork (workLoop sv winfo) (svarMrun sv) (handleChildException sv)+        >>= addThread sv++-- XXX we can push the workerCount modification in accountThread and use the+-- same pushWorker for Parallel case as well.+--+-- | In contrast to pushWorker which always happens only from the consumer+-- thread, a pushWorkerPar can happen concurrently from multiple threads on the+-- producer side. So we need to use a thread safe modification of+-- workerThreads. Alternatively, we can use a CreateThread event to avoid+-- using a CAS based modification.+{-# INLINE pushWorkerPar #-}+pushWorkerPar+    :: MonadAsync m+    => SVar t m a -> (Maybe WorkerInfo -> m ()) -> m ()+pushWorkerPar sv wloop =+    if svarInspectMode sv+    then forkWithDiag+    else doFork (wloop Nothing) (svarMrun sv) (handleChildException sv)+            >>= modifyThread sv++    where++    {-# NOINLINE forkWithDiag #-}+    forkWithDiag = do+        -- We do not use workerCount in case of ParallelVar but still there is+        -- no harm in maintaining it correctly.+        liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1+        recordMaxWorkers sv+        -- This allocation matters when significant number of workers are being+        -- sent. We allocate it only when needed. The overhead increases by 4x.+        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 = 0+                        , workerYieldCount = cntRef+                        , workerLatencyStart = lat+                        }++        doFork (wloop winfo) (svarMrun sv) (handleChildException sv)+            >>= modifyThread sv++-- Returns:+-- True: can dispatch more+-- False: cannot dispatch any more+dispatchWorker :: MonadAsync m => Count -> SVar t m a -> m Bool+dispatchWorker yieldCount sv = do+    let workerLimit = maxWorkerLimit sv+    -- 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.+    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 not be accurate as it is decremented by the workers+        -- and we have no synchronization with that decrement.+        active <- liftIO $ readIORef $ workerCount sv+        if not qDone+        then 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 <- 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)++            -- 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.+            let dispatch = pushWorker yieldCount sv >> return True+             in case limit of+                Unlimited -> dispatch+                -- 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 | lim > fromIntegral active -> dispatch+                _ -> return False+        else do+            when (active <= 0) $ pushWorker 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.+--+-- Returns:+-- True: can dispatch more+-- False: full, no more dispatches+dispatchWorkerPaced :: MonadAsync m => SVar t m a -> m Bool+dispatchWorkerPaced sv = do+    let yinfo = fromJust $ yieldRateInfo sv+    (svarYields, svarElapsed, wLatency) <- do+        now <- liftIO $ getTime Monotonic+        (yieldCount, baseTime, lat) <-+            liftIO $ collectLatency 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, otherwise we will+                -- defer the output of those. Note we cannot use workerCount+                -- here as it is not a reliable way to ensure there are+                -- definitely no active workers. When workerCount is 0 we may+                -- still have a Stop event waiting in the outputQueue.+                done <- allThreadsDone 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 sv+                when done $ void $ dispatchWorker yields sv+                return False+            ManyWorkers netWorkers yields -> do+                assert (netWorkers >= 1) (return ())+                assert (yields >= 0) (return ())+                updateGainedLostYields yinfo yields++                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++    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++{-# NOINLINE sendWorkerWait #-}+sendWorkerWait+    :: MonadAsync m+    => (SVar t m a -> IO ())+    -> (SVar t m a -> m Bool)+    -> SVar t m a+    -> m ()+sendWorkerWait delay dispatch sv = 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) $ 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_ (needDoorBell 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 sendWorkerWait delay dispatch sv+        else do+            liftIO $ withDiagMVar sv "sendWorkerWait: nothing to do"+                             $ takeMVar (outputDoorBell sv)+            (_, len) <- liftIO $ readIORef (outputQueue sv)+            when (len <= 0) $ sendWorkerWait delay dispatch sv++sendFirstWorker :: MonadAsync m => SVar t m a -> t m a -> m (SVar t m a)+sendFirstWorker sv m = do+    -- Note: We must have all the work on the queue before sending the+    -- pushworker, otherwise the pushworker may exit before we even get a+    -- chance to push.+    runIn <- askRunInIO+    liftIO $ enqueue sv (runIn, m)+    case yieldRateInfo sv of+        Nothing -> pushWorker 0 sv+        Just yinfo  ->+            if svarLatencyTarget yinfo == maxBound+            then liftIO $ threadDelay maxBound+            else pushWorker 1 sv+    return sv++sendWorkerDelayPaced :: SVar t m a -> IO ()+sendWorkerDelayPaced _ = return ()++sendWorkerDelay :: SVar t 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/SVar/Pull.hs view
@@ -0,0 +1,167 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.SVar.Pull+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.SVar.Pull+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}+    (+    -- * Read Output+      readOutputQBasic+    , readOutputQRaw+    , readOutputQPaced+    , readOutputQBounded++    -- * Postprocess Hook After Reading+    , postProcessPaced+    , postProcessBounded++    -- * Release Resources+    , cleanupSVar+    , cleanupSVarFromWorker+    )+where++#include "inline.hs"++import Control.Concurrent (myThreadId, throwTo)+import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (readIORef, writeIORef)+import Data.IORef (IORef)+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS)++import qualified Data.Set as S++import Streamly.Internal.Data.SVar.Type+import Streamly.Internal.Data.SVar.Dispatch++-------------------------------------------------------------------------------+-- Reading from the workers' output queue/buffer+-------------------------------------------------------------------------------++{-# INLINE readOutputQBasic #-}+readOutputQBasic :: IORef ([ChildEvent a], Int) -> IO ([ChildEvent a], Int)+readOutputQBasic q = atomicModifyIORefCAS q $ \x -> (([],0), x)++{-# INLINE readOutputQRaw #-}+readOutputQRaw :: SVar t m a -> IO ([ChildEvent a], Int)+readOutputQRaw sv = do+    (list, len) <- readOutputQBasic (outputQueue sv)+    when (svarInspectMode sv) $ do+        let ref = maxOutQSize $ svarStats sv+        oqLen <- readIORef ref+        when (len > oqLen) $ writeIORef ref len+    return (list, len)++readOutputQBounded :: MonadAsync m => SVar t m a -> m [ChildEvent a]+readOutputQBounded sv = do+    (list, len) <- liftIO $ readOutputQRaw 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) (pushWorker 0 sv)++    {-# INLINE blockingRead #-}+    blockingRead = do+        sendWorkerWait sendWorkerDelay (dispatchWorker 0) sv+        liftIO (fst `fmap` readOutputQRaw sv)++readOutputQPaced :: MonadAsync m => SVar t m a -> m [ChildEvent a]+readOutputQPaced sv = do+    (list, len) <- liftIO $ readOutputQRaw 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+        sendWorkerWait sendWorkerDelayPaced dispatchWorkerPaced sv+        liftIO (fst `fmap` readOutputQRaw sv)++postProcessPaced :: MonadAsync m => SVar t m a -> m Bool+postProcessPaced sv = do+    workersDone <- allThreadsDone 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 sv+            when noWorker $ pushWorker 0 sv+        return r+    else return False++postProcessBounded :: MonadAsync m => SVar t m a -> m Bool+postProcessBounded sv = do+    workersDone <- allThreadsDone 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) (pushWorker 0 sv)+        -- XXX do we need to dispatch many here?+        -- void $ dispatchWorker sv+        return r+    else return False++-------------------------------------------------------------------------------+-- Cleanup+-------------------------------------------------------------------------------++cleanupSVar :: SVar t m a -> IO ()+cleanupSVar sv = do+    workers <- readIORef (workerThreads sv)+    Prelude.mapM_ (`throwTo` ThreadAbort)+          workers++cleanupSVarFromWorker :: SVar t m a -> IO ()+cleanupSVarFromWorker sv = do+    workers <- readIORef (workerThreads sv)+    self <- myThreadId+    Prelude.mapM_ (`throwTo` ThreadAbort)+          (Prelude.filter (/= self) $ S.toList workers)
+ src/Streamly/Internal/Data/SVar/Worker.hs view
@@ -0,0 +1,547 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.SVar.Worker+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.SVar.Worker+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}+    (+    -- * Adjusting Limits+      decrementYieldLimit+    , incrementYieldLimit+    , decrementBufferLimit+    , incrementBufferLimit+    , resetBufferLimit++    -- * Rate Control+    , Work (..)+    , isBeyondMaxRate+    , estimateWorkers+    , updateYieldCount+    , minThreadDelay+    , workerRateControl+    , workerUpdateLatency++    -- * Send Events+    , send+    , ringDoorBell++    -- ** Yield+    , sendYield+    , sendToProducer++    -- ** Stop+    , sendStop+    , sendStopToProducer++    -- ** Exception+    , handleChildException+    , handleFoldException+    )+where++#include "inline.hs"++import Control.Concurrent (myThreadId, takeMVar)+import Control.Concurrent.MVar (MVar, tryPutMVar)+import Control.Exception (SomeException(..), assert)+import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (IORef, readIORef, writeIORef)+import Streamly.Internal.Data.Atomics+       (atomicModifyIORefCAS, atomicModifyIORefCAS_, writeBarrier,+        storeLoadBarrier)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units+       (AbsTime, NanoSecond64(..), diffAbsTime64, fromRelTime64)++import Streamly.Internal.Data.SVar.Type++------------------------------------------------------------------------------+-- Collecting results from child workers in a streamed fashion+------------------------------------------------------------------------------++-- 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 :: SVar t m a -> IO Bool+decrementYieldLimit sv =+    case remainingWork sv of+        Nothing -> return True+        Just ref -> do+            r <- atomicModifyIORefCAS ref $ \x -> (x - 1, x)+            return $ r >= 1++{-# INLINE incrementYieldLimit #-}+incrementYieldLimit :: SVar t m a -> IO ()+incrementYieldLimit sv =+    case remainingWork sv of+        Nothing -> return ()+        Just ref -> atomicModifyIORefCAS_ ref (+ 1)++-- XXX exception safety of all atomic/MVar operations++-- TBD Each worker can have their own queue and the consumer can empty one+-- queue at a time, that way contention can be reduced.++-- XXX Only yields should be counted in the buffer limit and not the Stop+-- events.++{-# INLINE decrementBufferLimit #-}+decrementBufferLimit :: SVar t m a -> IO ()+decrementBufferLimit sv =+    case maxBufferLimit sv of+        Unlimited -> return ()+        Limited _ -> do+            let ref = pushBufferSpace sv+            old <- atomicModifyIORefCAS ref $ \x ->+                        (if x >= 1 then x - 1 else x, x)+            when (old <= 0) $+                case pushBufferPolicy sv of+                    PushBufferBlock -> blockAndRetry+                    PushBufferDropNew -> do+                        -- We just drop one item and proceed. It is possible+                        -- that by the time we drop the item the consumer+                        -- thread might have run and created space in the+                        -- buffer, but we do not care about that condition.+                        -- This is not pedantically correct but it should be+                        -- fine in practice.+                        -- XXX we may want to drop only if n == maxBuf+                        -- otherwise we must have space in the buffer and a+                        -- decrement should be possible.+                        block <- atomicModifyIORefCAS (outputQueue sv) $+                            \(es, n) ->+                                case es of+                                    [] -> (([],n), True)+                                    _ : xs -> ((xs, n - 1), False)+                        when block blockAndRetry+                    -- XXX need a dequeue or ring buffer for this+                    PushBufferDropOld -> undefined++    where++    blockAndRetry = do+        let ref = pushBufferSpace sv+        liftIO $ takeMVar (pushBufferMVar sv)+        old <- atomicModifyIORefCAS ref $ \x ->+                        (if x >= 1 then x - 1 else x, x)+        -- When multiple threads sleep on takeMVar, the first thread would+        -- wakeup due to a putMVar by the consumer, but the rest of the threads+        -- would have to put back the MVar after taking it and decrementing the+        -- buffer count, otherwise all other threads will remain asleep.+        if old >= 1+        then void $ liftIO $ tryPutMVar (pushBufferMVar sv) ()+        -- We do not put the MVar back in this case, instead we+        -- wait for the consumer to put it.+        else blockAndRetry++{-# INLINE incrementBufferLimit #-}+incrementBufferLimit :: SVar t m a -> IO ()+incrementBufferLimit sv =+    case maxBufferLimit sv of+        Unlimited -> return ()+        Limited _ -> do+            atomicModifyIORefCAS_ (pushBufferSpace sv) (+ 1)+            writeBarrier+            void $ liftIO $ tryPutMVar (pushBufferMVar sv) ()++{-# INLINE resetBufferLimit #-}+resetBufferLimit :: SVar t m a -> IO ()+resetBufferLimit sv =+    case maxBufferLimit sv of+        Unlimited -> return ()+        Limited n -> atomicModifyIORefCAS_ (pushBufferSpace sv)+                                           (const (fromIntegral n))++-------------------------------------------------------------------------------+-- 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+-------------------------------------------------------------------------------++{-# INLINE ringDoorBell #-}+ringDoorBell :: SVar t m a -> IO ()+ringDoorBell sv = do+    storeLoadBarrier+    w <- readIORef $ needDoorBell sv+    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_ (needDoorBell sv) (const False)+        void $ tryPutMVar (outputDoorBell sv) ()++{-# INLINE sendWithDoorBell #-}+sendWithDoorBell ::+    IORef ([ChildEvent a], Int) -> MVar () -> ChildEvent a -> IO Int+sendWithDoorBell 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++-- | This function is used by the producer threads to queue output for the+-- consumer thread to consume. Returns whether the queue has more space.+send :: SVar t m a -> ChildEvent a -> IO Int+send sv = sendWithDoorBell (outputQueue sv) (outputDoorBell sv)++-- There is no bound implemented on the buffer, this is assumed to be low+-- traffic.+sendToProducer :: SVar t m a -> ChildEvent a -> IO Int+sendToProducer 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) ()+    sendWithDoorBell (outputQueueFromConsumer sv)+                     (outputDoorBellFromConsumer sv) msg++-------------------------------------------------------------------------------+-- Collect and update worker latency+-------------------------------------------------------------------------------++workerCollectLatency :: WorkerInfo -> IO (Maybe (Count, NanoSecond64))+workerCollectLatency winfo = do+    (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+-------------------------------------------------------------------------------++-- We either block, or send one worker with limited yield count or one or more+-- workers with unlimited yield count.+data Work+    = BlockWait NanoSecond64+    | PartialWorker Count+    | ManyWorkers Int Count+    deriving Show++-- | 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++-- | 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++-- | Get the worker latency without resetting workerPendingLatency+-- Returns (total yield count, base time, measured latency)+-- CAUTION! keep it in sync with collectLatency+getWorkerLatency :: YieldRateInfo -> IO (Count, AbsTime, NanoSecond64)+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+estimateWorkers+    :: Limit+    -> Count+    -> Count+    -> NanoSecond64+    -> NanoSecond64+    -> NanoSecond64+    -> LatencyRange+    -> 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)++isBeyondMaxRate :: SVar t m a -> YieldRateInfo -> IO Bool+isBeyondMaxRate sv yinfo = do+    (count, tstamp, wLatency) <- getWorkerLatency yinfo+    now <- getTime Monotonic+    let duration = fromRelTime64 $ diffAbsTime64 now tstamp+    let targetLat = svarLatencyTarget yinfo+    gainLoss <- readIORef (svarGainedLostYields yinfo)+    let work = estimateWorkers (maxWorkerLimit sv) count gainLoss duration+                               wLatency targetLat (svarLatencyRange yinfo)+    cnt <- readIORef $ workerCount sv+    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.+{-# NOINLINE checkRatePeriodic #-}+checkRatePeriodic :: SVar t m a+                  -> YieldRateInfo+                  -> WorkerInfo+                  -> Count+                  -> IO Bool+checkRatePeriodic sv yinfo winfo ycnt = do+    i <- readIORef (workerPollingInterval yinfo)+    -- XXX use generation count to check if the interval has been updated+    if i /= 0 && (ycnt `mod` i) == 0+    then do+        workerUpdateLatency yinfo winfo+        -- XXX not required for parallel streams+        isBeyondMaxRate sv yinfo+    else return False++-- CAUTION! this also updates the yield count and therefore should be called+-- only when we are actually yielding an element.+{-# NOINLINE workerRateControl #-}+workerRateControl :: SVar t m a -> YieldRateInfo -> WorkerInfo -> IO Bool+workerRateControl sv yinfo winfo = do+    cnt <- updateYieldCount winfo+    beyondMaxRate <- checkRatePeriodic sv yinfo winfo cnt+    return $ not (isBeyondMaxYield cnt winfo || 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.+--+-- returns whether the worker should continue (True) or stop (False).+{-# INLINE sendYield #-}+sendYield :: SVar t m a -> Maybe WorkerInfo -> ChildEvent a -> IO Bool+sendYield sv mwinfo msg = do+    oldlen <- send sv msg+    let limit = maxBufferLimit sv+    bufferSpaceOk <- case limit of+            Unlimited -> return True+            Limited lim -> do+                active <- readIORef (workerCount sv)+                return $ (oldlen + 1) < (fromIntegral lim - active)+    rateLimitOk <-+        case mwinfo of+            Just winfo ->+                case yieldRateInfo sv of+                    Nothing -> return True+                    Just yinfo -> workerRateControl sv 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++{-# INLINABLE sendStop #-}+sendStop :: SVar t m a -> Maybe WorkerInfo -> IO ()+sendStop sv mwinfo = do+    atomicModifyIORefCAS_ (workerCount sv) $ \n -> n - 1+    case (mwinfo, yieldRateInfo sv) of+      (Just winfo, Just info) ->+          workerStopUpdate winfo info+      _ ->+          return ()+    myThreadId >>= \tid -> void $ send sv (ChildStop tid Nothing)++-- {-# NOINLINE sendStopToProducer #-}+sendStopToProducer :: MonadIO m => SVar t m a -> m ()+sendStopToProducer sv = liftIO $ do+    tid <- myThreadId+    void $ sendToProducer sv (ChildStop tid Nothing)++-------------------------------------------------------------------------------+-- Send exceptions+-------------------------------------------------------------------------------++{-# NOINLINE handleFoldException #-}+handleFoldException :: SVar t m a -> SomeException -> IO ()+handleFoldException sv e = do+    tid <- myThreadId+    void $ sendToProducer sv (ChildStop tid (Just e))++{-# NOINLINE handleChildException #-}+handleChildException :: SVar t m a -> SomeException -> IO ()+handleChildException sv e = do+    tid <- myThreadId+    void $ send sv (ChildStop tid (Just e))
+ 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/SmallArray.hs view
@@ -0,0 +1,195 @@+-- |+-- Module      : Streamly.Internal.Data.SmallArray+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UnboxedTuples #-}++#include "inline.hs"++module Streamly.Internal.Data.SmallArray+  (+    -- XXX should it be just Array instead? We should be able to replace one+    -- array type with another easily.+    SmallArray(..)++  , foldl'+  , foldr++  , length++  , writeN++  , toStreamD+  , toStreamDRev++  , read+  , readRev+  , reader++  , fromListN+  , fromStreamDN+  , fromStreamN++  , streamFold+  , fold+  )+where++import Prelude hiding (foldr, length, read)+import Control.DeepSeq (NFData(..))+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO, liftIO)+import GHC.IO (unsafePerformIO)+import Data.Functor.Identity (runIdentity)++import Streamly.Data.Fold (Fold)+import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Unfold (Unfold(..))++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++{-# INLINE length #-}+length :: SmallArray a -> Int+length = sizeofSmallArray++{-# INLINE_NORMAL toStreamD #-}+toStreamD :: Monad m => SmallArray a -> D.Stream m a+toStreamD arr = D.Stream step 0+  where+    {-# INLINE_LATE step #-}+    step _ i+        | i == length arr = return D.Stop+        | otherwise =+            return $+            case indexSmallArray## arr i of+                (# x #) -> D.Yield x (i + 1)++{-# INLINE_NORMAL toStreamDRev #-}+toStreamDRev :: Monad m => SmallArray a -> D.Stream m a+toStreamDRev arr = D.Stream step (length arr - 1)+  where+    {-# INLINE_LATE step #-}+    step _ i+        | i < 0 = return D.Stop+        | otherwise =+            return $+            case indexSmallArray## arr i of+                (# x #) -> D.Yield x (i - 1)++{-# INLINE_NORMAL foldl' #-}+foldl' :: (b -> a -> b) -> b -> SmallArray a -> b+foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr++{-# INLINE_NORMAL foldr #-}+foldr :: (a -> b -> b) -> b -> SmallArray a -> b+foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr++-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an+-- '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.Generic" or "Streamly.Data.Array.Foreign".+{-# INLINE_NORMAL writeN #-}+writeN :: MonadIO m => Int -> Fold m a (SmallArray a)+writeN len = FL.Fold step initial extract 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 $ newSmallArray len bottomElement+        next marr (-1)++    step (Tuple' marr i) x = do+        liftIO $ writeSmallArray marr i x+        next marr i++    extract (Tuple' marr l) = liftIO $ freezeSmallArray marr 0 l+++{-# INLINE_NORMAL fromStreamDN #-}+fromStreamDN :: MonadIO m => Int -> D.Stream m a -> m (SmallArray a)+fromStreamDN limit str = do+    marr <- liftIO $ newSmallArray (max limit 0) bottomElement+    i <-+        D.foldlM'+            (\i x -> i `seq` liftIO (writeSmallArray marr i x) >> return (i + 1))+            (return 0) $+        D.take limit str+    liftIO $ freezeSmallArray marr 0 i++-- | Create a 'SmallArray' from the first @n@ elements of a list. The+-- array may hold less than @n@ elements if the length of the list <=+-- @n@.+--+-- It is recommended to use a value of @n@ <= 128. For larger sized+-- arrays, use an 'Array' from "Streamly.Data.Array" or+-- "Streamly.Data.Array.Foreign"+{-# INLINABLE fromListN #-}+fromListN :: Int -> [a] -> SmallArray a+fromListN n xs = unsafePerformIO $ fromStreamDN n $ D.fromList xs++instance NFData a => NFData (SmallArray a) where+    {-# INLINE rnf #-}+    rnf = foldl' (\_ x -> rnf x) ()++-- | Create a 'SmallArray' 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.+--+-- For optimal performance use this with @n@ <= 128.+{-# INLINE fromStreamN #-}+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 m++{-# INLINE_EARLY read #-}+read :: Monad m => SmallArray a -> Stream m a+read = toStreamD++{-# 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 => (Stream m a -> m b) -> SmallArray a -> m b+streamFold f arr = f (read arr)++{-# INLINE_NORMAL reader #-}+reader :: Monad m => Unfold m (SmallArray a) a+reader = Unfold step inject+  where+    inject arr = return (arr, 0)+    step (arr, i)+        | i == length arr = return D.Stop+        | otherwise =+            return $+            case indexSmallArray## arr i of+                (# x #) -> D.Yield x (arr, i + 1)
+ src/Streamly/Internal/Data/SmallArray/Type.hs view
@@ -0,0 +1,762 @@+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonoLocalBinds #-}++-- |+-- Module : Data.Primitive.SmallArray+-- Copyright: (c) 2015 Dan Doel+-- License: BSD3+--+-- Maintainer  : streamly@composewell.com+-- Portability: non-portable+--+-- Small arrays are boxed (im)mutable arrays.+--+-- The underlying structure of the 'Array' type contains a card table, allowing+-- segments of the array to be marked as having been mutated. This allows the+-- garbage collector to only re-traverse segments of the array that have been+-- marked during certain phases, rather than having to traverse the entire+-- array.+--+-- 'SmallArray' lacks this table. This means that it takes up less memory and+-- has slightly faster writes. It is also more efficient during garbage+-- collection so long as the card table would have a single entry covering the+-- entire array. These advantages make them suitable for use as arrays that are+-- known to be small.+--+-- The card size is 128, so for uses much larger than that, 'Array' would likely+-- be superior.+--+-- The underlying type, 'SmallArray#', was introduced in GHC 7.10, so prior to+-- that version, this module simply implements small arrays as 'Array'.++module Streamly.Internal.Data.SmallArray.Type+  ( SmallArray(..)+  , SmallMutableArray(..)+  , newSmallArray+  , readSmallArray+  , writeSmallArray+  , copySmallArray+  , copySmallMutableArray+  , indexSmallArray+  , indexSmallArrayM+  , indexSmallArray##+  , cloneSmallArray+  , cloneSmallMutableArray+  , freezeSmallArray+  , unsafeFreezeSmallArray+  , thawSmallArray+  , runSmallArray+  , unsafeThawSmallArray+  , sizeofSmallArray+  , sizeofSmallMutableArray+  , smallArrayFromList+  , smallArrayFromListN+  , mapSmallArray'+  , traverseSmallArrayP+  ) where++import GHC.Exts hiding (toList)+import qualified GHC.Exts+import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Control.Monad.Primitive+import Control.Monad.ST+import Control.Monad.Zip+import Data.Data+import Data.Foldable as Foldable+import Data.Functor.Identity+import Data.Functor.Classes (Eq1(..),Ord1(..),Show1(..),Read1(..))++import qualified Control.Monad.Fail as Fail+import qualified GHC.ST as GHCST++import Text.ParserCombinators.ReadP++data SmallArray a = SmallArray (SmallArray# a)++data SmallMutableArray s a = SmallMutableArray (SmallMutableArray# s a)++-- | Create a new small mutable array.+newSmallArray+  :: PrimMonad m+  => Int -- ^ size+  -> a   -- ^ initial contents+  -> m (SmallMutableArray (PrimState m) a)+newSmallArray (I# i#) x = primitive $ \s ->+  case newSmallArray# i# x s of+    (# s', sma# #) -> (# s', SmallMutableArray sma# #)+{-# INLINE newSmallArray #-}++-- | Read the element at a given index in a mutable array.+readSmallArray+  :: PrimMonad m+  => SmallMutableArray (PrimState m) a -- ^ array+  -> Int                               -- ^ index+  -> m a+readSmallArray (SmallMutableArray sma#) (I# i#) =+  primitive $ readSmallArray# sma# i#+{-# INLINE readSmallArray #-}++-- | Write an element at the given idex in a mutable array.+writeSmallArray+  :: PrimMonad m+  => SmallMutableArray (PrimState m) a -- ^ array+  -> Int                               -- ^ index+  -> a                                 -- ^ new element+  -> m ()+writeSmallArray (SmallMutableArray sma#) (I# i#) x =+  primitive_ $ writeSmallArray# sma# i# x+{-# INLINE writeSmallArray #-}++-- | Look up an element in an immutable array.+--+-- The purpose of returning a result using a monad is to allow the caller to+-- avoid retaining references to the array. Evaluating the return value will+-- cause the array lookup to be performed, even though it may not require the+-- element of the array to be evaluated (which could throw an exception). For+-- instance:+--+-- > data Box a = Box a+-- > ...+-- >+-- > f sa = case indexSmallArrayM sa 0 of+-- >   Box x -> ...+--+-- 'x' is not a closure that references 'sa' as it would be if we instead+-- wrote:+--+-- > let x = indexSmallArray sa 0+--+-- And does not prevent 'sa' from being garbage collected.+--+-- Note that 'Identity' is not adequate for this use, as it is a newtype, and+-- cannot be evaluated without evaluating the element.+indexSmallArrayM+  :: Monad m+  => SmallArray a -- ^ array+  -> Int          -- ^ index+  -> m a+indexSmallArrayM (SmallArray sa#) (I# i#) =+  case indexSmallArray# sa# i# of+    (# x #) -> pure x+{-# INLINE indexSmallArrayM #-}++-- | Look up an element in an immutable array.+indexSmallArray+  :: SmallArray a -- ^ array+  -> Int          -- ^ index+  -> a+indexSmallArray sa i = runIdentity $ indexSmallArrayM sa i+{-# INLINE indexSmallArray #-}++-- | Read a value from the immutable array at the given index, returning+-- the result in an unboxed unary tuple. This is currently used to implement+-- folds.+indexSmallArray## :: SmallArray a -> Int -> (# a #)+indexSmallArray## (SmallArray ary) (I# i) = indexSmallArray# ary i+{-# INLINE indexSmallArray## #-}++-- | Create a copy of a slice of an immutable array.+cloneSmallArray+  :: SmallArray a -- ^ source+  -> Int          -- ^ offset+  -> Int          -- ^ length+  -> SmallArray a+cloneSmallArray (SmallArray sa#) (I# i#) (I# j#) =+  SmallArray (cloneSmallArray# sa# i# j#)+{-# INLINE cloneSmallArray #-}++-- | Create a copy of a slice of a mutable array.+cloneSmallMutableArray+  :: PrimMonad m+  => SmallMutableArray (PrimState m) a -- ^ source+  -> Int                               -- ^ offset+  -> Int                               -- ^ length+  -> m (SmallMutableArray (PrimState m) a)+cloneSmallMutableArray (SmallMutableArray sma#) (I# o#) (I# l#) =+  primitive $ \s -> case cloneSmallMutableArray# sma# o# l# s of+    (# s', smb# #) -> (# s', SmallMutableArray smb# #)+{-# INLINE cloneSmallMutableArray #-}++-- | Create an immutable array corresponding to a slice of a mutable array.+--+-- This operation copies the portion of the array to be frozen.+freezeSmallArray+  :: PrimMonad m+  => SmallMutableArray (PrimState m) a -- ^ source+  -> Int                               -- ^ offset+  -> Int                               -- ^ length+  -> m (SmallArray a)+freezeSmallArray (SmallMutableArray sma#) (I# i#) (I# j#) =+  primitive $ \s -> case freezeSmallArray# sma# i# j# s of+    (# s', sa# #) -> (# s', SmallArray sa# #)+{-# INLINE freezeSmallArray #-}++-- | Render a mutable array immutable.+--+-- This operation performs no copying, so care must be taken not to modify the+-- input array after freezing.+unsafeFreezeSmallArray+  :: PrimMonad m => SmallMutableArray (PrimState m) a -> m (SmallArray a)+unsafeFreezeSmallArray (SmallMutableArray sma#) =+  primitive $ \s -> case unsafeFreezeSmallArray# sma# s of+    (# s', sa# #) -> (# s', SmallArray sa# #)+{-# INLINE unsafeFreezeSmallArray #-}++-- | Create a mutable array corresponding to a slice of an immutable array.+--+-- This operation copies the portion of the array to be thawed.+thawSmallArray+  :: PrimMonad m+  => SmallArray a -- ^ source+  -> Int          -- ^ offset+  -> Int          -- ^ length+  -> m (SmallMutableArray (PrimState m) a)+thawSmallArray (SmallArray sa#) (I# o#) (I# l#) =+  primitive $ \s -> case thawSmallArray# sa# o# l# s of+    (# s', sma# #) -> (# s', SmallMutableArray sma# #)+{-# INLINE thawSmallArray #-}++-- | Render an immutable array mutable.+--+-- This operation performs no copying, so care must be taken with its use.+unsafeThawSmallArray+  :: PrimMonad m => SmallArray a -> m (SmallMutableArray (PrimState m) a)+unsafeThawSmallArray (SmallArray sa#) =+  primitive $ \s -> case unsafeThawSmallArray# sa# s of+    (# s', sma# #) -> (# s', SmallMutableArray sma# #)+{-# INLINE unsafeThawSmallArray #-}++-- | Copy a slice of an immutable array into a mutable array.+copySmallArray+  :: PrimMonad m+  => SmallMutableArray (PrimState m) a -- ^ destination+  -> Int                               -- ^ destination offset+  -> SmallArray a                      -- ^ source+  -> Int                               -- ^ source offset+  -> Int                               -- ^ length+  -> m ()+copySmallArray+  (SmallMutableArray dst#) (I# do#) (SmallArray src#) (I# so#) (I# l#) =+    primitive_ $ copySmallArray# src# so# dst# do# l#+{-# INLINE copySmallArray #-}++-- | Copy a slice of one mutable array into another.+copySmallMutableArray+  :: PrimMonad m+  => SmallMutableArray (PrimState m) a -- ^ destination+  -> Int                               -- ^ destination offset+  -> SmallMutableArray (PrimState m) a -- ^ source+  -> Int                               -- ^ source offset+  -> Int                               -- ^ length+  -> m ()+copySmallMutableArray+  (SmallMutableArray dst#) (I# do#)+  (SmallMutableArray src#) (I# so#)+  (I# l#) =+    primitive_ $ copySmallMutableArray# src# so# dst# do# l#+{-# INLINE copySmallMutableArray #-}++sizeofSmallArray :: SmallArray a -> Int+sizeofSmallArray (SmallArray sa#) = I# (sizeofSmallArray# sa#)+{-# INLINE sizeofSmallArray #-}++sizeofSmallMutableArray :: SmallMutableArray s a -> Int+sizeofSmallMutableArray (SmallMutableArray sa#) =+  I# (sizeofSmallMutableArray# sa#)+{-# INLINE sizeofSmallMutableArray #-}++-- | This is the fastest, most straightforward way to traverse+-- an array, but it only works correctly with a sufficiently+-- "affine" 'PrimMonad' instance. In particular, it must only produce+-- *one* result array. 'Control.Monad.Trans.List.ListT'-transformed+-- monads, for example, will not work right at all.+traverseSmallArrayP+  :: PrimMonad m+  => (a -> m b)+  -> SmallArray a+  -> m (SmallArray b)+traverseSmallArrayP f !ary =+  let+    !sz = sizeofSmallArray ary+    go !i !mary+      | i == sz+      = unsafeFreezeSmallArray mary+      | otherwise+      = do+          a <- indexSmallArrayM ary i+          b <- f a+          writeSmallArray mary i b+          go (i + 1) mary+  in do+    mary <- newSmallArray sz badTraverseValue+    go 0 mary+{-# INLINE traverseSmallArrayP #-}++-- | Strict map over the elements of the array.+mapSmallArray' :: (a -> b) -> SmallArray a -> SmallArray b+mapSmallArray' f sa = createSmallArray (length sa) (die "mapSmallArray'" "impossible") $ \smb ->+  fix ? 0 $ \go i ->+    when (i < length sa) $ do+      x <- indexSmallArrayM sa i+      let !y = f x+      writeSmallArray smb i y *> go (i+1)+{-# INLINE mapSmallArray' #-}+-- 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+-- how we special-case the empty array, we can make GHC smarter about this.+-- The only downside is that separately created 0-length arrays won't share+-- their Array constructors, although they'll share their underlying+-- Array#s.+runSmallArray+  :: (forall s. ST s (SmallMutableArray s a))+  -> SmallArray a+runSmallArray m = SmallArray (runSmallArray# m)++runSmallArray#+  :: (forall s. ST s (SmallMutableArray s a))+  -> SmallArray# a+runSmallArray# m = case runRW# $ \s ->+  case unST m s of { (# s', SmallMutableArray mary# #) ->+  unsafeFreezeSmallArray# mary# s'} of (# _, ary# #) -> ary#++unST :: ST s a -> State# s -> (# State# s, a #)+unST (GHCST.ST f) = f++-- See the comment on runSmallArray for why we use emptySmallArray#.+createSmallArray+  :: Int+  -> a+  -> (forall s. SmallMutableArray s a -> ST s ())+  -> SmallArray a+createSmallArray 0 _ _ = SmallArray (emptySmallArray# (# #))+createSmallArray n x f = runSmallArray $ do+  mary <- newSmallArray n x+  f mary+  pure mary++emptySmallArray# :: (# #) -> SmallArray# a+emptySmallArray# _ = case emptySmallArray of SmallArray ar -> ar+{-# NOINLINE emptySmallArray# #-}++die :: String -> String -> a+die fun problem = error $ "Data.Primitive.SmallArray." ++ fun ++ ": " ++ problem++emptySmallArray :: SmallArray a+emptySmallArray =+  runST $ newSmallArray 0 (die "emptySmallArray" "impossible")+            >>= unsafeFreezeSmallArray+{-# NOINLINE emptySmallArray #-}+++infixl 1 ?+(?) :: (a -> b -> c) -> (b -> a -> c)+(?) = flip+{-# INLINE (?) #-}++noOp :: a -> ST s ()+noOp = const $ pure ()++smallArrayLiftEq :: (a -> b -> Bool) -> SmallArray a -> SmallArray b -> Bool+smallArrayLiftEq p sa1 sa2 = length sa1 == length sa2 && loop (length sa1 - 1)+  where+  loop i+    | i < 0+    = True+    | (# x #) <- indexSmallArray## sa1 i+    , (# y #) <- indexSmallArray## sa2 i+    = p x y && loop (i-1)+instance Eq1 SmallArray where+  liftEq = smallArrayLiftEq++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#)++smallArrayLiftCompare :: (a -> b -> Ordering) -> SmallArray a -> SmallArray b -> Ordering+smallArrayLiftCompare elemCompare a1 a2 = loop 0+  where+  mn = length a1 `min` length a2+  loop i+    | i < mn+    , (# x1 #) <- indexSmallArray## a1 i+    , (# x2 #) <- indexSmallArray## a2 i+    = elemCompare x1 x2 `mappend` loop (i+1)+    | otherwise = compare (length a1) (length a2)++instance Ord1 SmallArray where+  liftCompare = smallArrayLiftCompare++-- | Lexicographic ordering. Subject to change between major versions.+instance Ord a => Ord (SmallArray a) where+  compare = smallArrayLiftCompare compare++instance Foldable SmallArray where+  -- Note: we perform the array lookups eagerly so we won't+  -- create thunks to perform lookups even if GHC can't see+  -- that the folding function is strict.+  foldr f = \z !ary ->+    let+      !sz = sizeofSmallArray ary+      go i+        | i == sz = z+        | (# x #) <- indexSmallArray## ary i+        = f x (go (i+1))+    in go 0+  {-# INLINE foldr #-}+  foldl f = \z !ary ->+    let+      go i+        | i < 0 = z+        | (# x #) <- indexSmallArray## ary i+        = f (go (i-1)) x+    in go (sizeofSmallArray ary - 1)+  {-# INLINE foldl #-}+  foldr1 f = \ !ary ->+    let+      !sz = sizeofSmallArray ary - 1+      go i =+        case indexSmallArray## ary i of+          (# x #) | i == sz -> x+                  | otherwise -> f x (go (i+1))+    in if sz < 0+       then die "foldr1" "Empty SmallArray"+       else go 0+  {-# INLINE foldr1 #-}+  foldl1 f = \ !ary ->+    let+      !sz = sizeofSmallArray ary - 1+      go i =+        case indexSmallArray## ary i of+          (# x #) | i == 0 -> x+                  | otherwise -> f (go (i - 1)) x+    in if sz < 0+       then die "foldl1" "Empty SmallArray"+       else go sz+  {-# INLINE foldl1 #-}+  foldr' f = \z !ary ->+    let+      go i !acc+        | i == -1 = acc+        | (# x #) <- indexSmallArray## ary i+        = go (i-1) (f x acc)+    in go (sizeofSmallArray ary - 1) z+  {-# INLINE foldr' #-}+  foldl' f = \z !ary ->+    let+      !sz = sizeofSmallArray ary+      go i !acc+        | i == sz = acc+        | (# x #) <- indexSmallArray## ary i+        = go (i+1) (f acc x)+    in go 0 z+  {-# INLINE foldl' #-}+  null a = sizeofSmallArray a == 0+  {-# INLINE null #-}+  length = sizeofSmallArray+  {-# INLINE length #-}+  maximum ary | sz == 0   = die "maximum" "Empty SmallArray"+              | (# frst #) <- indexSmallArray## ary 0+              = go 1 frst+   where+     sz = sizeofSmallArray ary+     go i !e+       | i == sz = e+       | (# x #) <- indexSmallArray## ary i+       = go (i+1) (max e x)+  {-# INLINE maximum #-}+  minimum ary | sz == 0   = die "minimum" "Empty SmallArray"+              | (# frst #) <- indexSmallArray## ary 0+              = go 1 frst+   where sz = sizeofSmallArray ary+         go i !e+           | i == sz = e+           | (# x #) <- indexSmallArray## ary i+           = go (i+1) (min e x)+  {-# INLINE minimum #-}+  sum = foldl' (+) 0+  {-# INLINE sum #-}+  product = foldl' (*) 1+  {-# INLINE product #-}++newtype STA a = STA {_runSTA :: forall s. SmallMutableArray# s a -> ST s (SmallArray a)}++runSTA :: Int -> STA a -> SmallArray a+runSTA !sz = \ (STA m) -> runST $ newSmallArray_ sz >>=+                        \ (SmallMutableArray ar#) -> m ar#+{-# INLINE runSTA #-}++newSmallArray_ :: Int -> ST s (SmallMutableArray s a)+newSmallArray_ !n = newSmallArray n badTraverseValue++badTraverseValue :: a+badTraverseValue = die "traverse" "bad indexing"+{-# NOINLINE badTraverseValue #-}++instance Traversable SmallArray where+  traverse f = traverseSmallArray f+  {-# INLINE traverse #-}++traverseSmallArray+  :: Applicative f+  => (a -> f b) -> SmallArray a -> f (SmallArray b)+traverseSmallArray f = \ !ary ->+  let+    !len = sizeofSmallArray ary+    go !i+      | i == len+      = pure $ STA $ \mary -> unsafeFreezeSmallArray (SmallMutableArray mary)+      | (# x #) <- indexSmallArray## ary i+      = liftA2 (\b (STA m) -> STA $ \mary ->+                  writeSmallArray (SmallMutableArray mary) i b >> m mary)+               (f x) (go (i + 1))+  in if len == 0+     then pure emptySmallArray+     else runSTA len <$> go 0+{-# INLINE [1] traverseSmallArray #-}++{-# RULES+"traverse/ST" forall (f :: a -> ST s b). traverseSmallArray f = traverseSmallArrayP f+"traverse/IO" forall (f :: a -> IO b). traverseSmallArray f = traverseSmallArrayP f+"traverse/Id" forall (f :: a -> Identity b). traverseSmallArray f =+   (coerce :: (SmallArray a -> SmallArray (Identity b))+           -> SmallArray a -> Identity (SmallArray b)) (fmap f)+ #-}+++instance Functor SmallArray where+  fmap f sa = createSmallArray (length sa) (die "fmap" "impossible") $ \smb ->+    fix ? 0 $ \go i ->+      when (i < length sa) $ do+        x <- indexSmallArrayM sa i+        writeSmallArray smb i (f x) *> go (i+1)+  {-# INLINE fmap #-}++  x <$ sa = createSmallArray (length sa) x noOp++instance Applicative SmallArray where+  pure x = createSmallArray 1 x noOp++  sa *> sb = createSmallArray (la*lb) (die "*>" "impossible") $ \smb ->+    fix ? 0 $ \go i ->+      when (i < la) $+        copySmallArray smb 0 sb 0 lb *> go (i+1)+   where+   la = length sa ; lb = length sb++  a <* b = createSmallArray (sza*szb) (die "<*" "impossible") $ \ma ->+    let fill off i e = when (i < szb) $+                         writeSmallArray ma (off+i) e >> fill off (i+1) e+        go i = when (i < sza) $ do+                 x <- indexSmallArrayM a i+                 fill (i*szb) 0 x+                 go (i+1)+     in go 0+   where sza = sizeofSmallArray a ; szb = sizeofSmallArray b++  ab <*> a = createSmallArray (szab*sza) (die "<*>" "impossible") $ \mb ->+    let go1 i = when (i < szab) $+            do+              f <- indexSmallArrayM ab i+              go2 (i*sza) f 0+              go1 (i+1)+        go2 off f j = when (j < sza) $+            do+              x <- indexSmallArrayM a j+              writeSmallArray mb (off + j) (f x)+              go2 off f (j + 1)+    in go1 0+   where szab = sizeofSmallArray ab ; sza = sizeofSmallArray a++instance Alternative SmallArray where+  empty = emptySmallArray++  sl <|> sr =+    createSmallArray (length sl + length sr) (die "<|>" "impossible") $ \sma ->+      copySmallArray sma 0 sl 0 (length sl)+        *> copySmallArray sma (length sl) sr 0 (length sr)++  many sa | null sa   = pure []+          | otherwise = die "many" "infinite arrays are not well defined"++  some sa | null sa   = emptySmallArray+          | otherwise = die "some" "infinite arrays are not well defined"++data ArrayStack a+  = PushArray !(SmallArray a) !(ArrayStack a)+  | EmptyStack+-- TODO: This isn't terribly efficient. It would be better to wrap+-- ArrayStack with a type like+--+-- data NES s a = NES !Int !(SmallMutableArray s a) !(ArrayStack a)+--+-- We'd copy incoming arrays into the mutable array until we would+-- overflow it. Then we'd freeze it, push it on the stack, and continue.+-- Any sufficiently large incoming arrays would go straight on the stack.+-- Such a scheme would make the stack much more compact in the case+-- of many small arrays.++instance Monad SmallArray where+  return = pure+  (>>) = (*>)++  sa >>= f = collect 0 EmptyStack (la-1)+   where+   la = length sa+   collect sz stk i+     | i < 0 = createSmallArray sz (die ">>=" "impossible") $ fill 0 stk+     | (# x #) <- indexSmallArray## sa i+     , let sb = f x+           lsb = length sb+       -- If we don't perform this check, we could end up allocating+       -- a stack full of empty arrays if someone is filtering most+       -- things out. So we refrain from pushing empty arrays.+     = if lsb == 0+       then collect sz stk (i-1)+       else collect (sz + lsb) (PushArray sb stk) (i-1)++   fill _ EmptyStack _ = return ()+   fill off (PushArray sb sbs) smb =+     copySmallArray smb off sb 0 (length sb)+       *> fill (off + length sb) sbs smb++#if !(MIN_VERSION_base(4,13,0)) && MIN_VERSION_base(4,9,0)+  fail = Fail.fail+#endif+instance Fail.MonadFail SmallArray where+  fail _ = emptySmallArray++instance MonadPlus SmallArray where+  mzero = empty+  mplus = (<|>)++zipW :: String -> (a -> b -> c) -> SmallArray a -> SmallArray b -> SmallArray c+zipW nm f sa sb =+  let mn = length sa `min` length sb in+  createSmallArray mn (die nm "impossible") $ \mc ->+    fix ? 0 $ \go i -> when (i < mn) $ do+      x <- indexSmallArrayM sa i+      y <- indexSmallArrayM sb i+      writeSmallArray mc i (f x y)+      go (i+1)+{-# INLINE zipW #-}++instance MonadZip SmallArray where+  mzip = zipW "mzip" (,)+  mzipWith = zipW "mzipWith"+  {-# INLINE mzipWith #-}+  munzip sab = runST $ do+    let sz = length sab+    sma <- newSmallArray sz $ die "munzip" "impossible"+    smb <- newSmallArray sz $ die "munzip" "impossible"+    fix ? 0 $ \go i ->+      when (i < sz) $ case indexSmallArray sab i of+        (x, y) -> do writeSmallArray sma i x+                     writeSmallArray smb i y+                     go $ i+1+    (,) <$> unsafeFreezeSmallArray sma+        <*> unsafeFreezeSmallArray smb++instance MonadFix SmallArray where+  mfix f = createSmallArray (sizeofSmallArray (f err))+                            (die "mfix" "impossible") $ flip fix 0 $+    \r !i !mary -> when (i < sz) $ do+                      writeSmallArray mary i (fix (\xi -> f xi `indexSmallArray` i))+                      r (i + 1) mary+    where+      sz = sizeofSmallArray (f err)+      err = error "mfix for Data.Primitive.SmallArray applied to strict function."++-- | @since 0.6.3.0+instance Semigroup (SmallArray a) where+  (<>) = (<|>)++instance Monoid (SmallArray a) where+  mempty = empty+  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++instance IsList (SmallArray a) where+  type Item (SmallArray a) = a+  fromListN = smallArrayFromListN+  fromList = smallArrayFromList+  toList = Foldable.toList++smallArrayLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> SmallArray a -> ShowS+smallArrayLiftShowsPrec elemShowsPrec elemListShowsPrec p sa = showParen (p > 10) $+  showString "fromListN " . shows (length sa) . showString " "+    . listLiftShowsPrec elemShowsPrec elemListShowsPrec 11 (toList sa)++-- this need to be included for older ghcs+listLiftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS+listLiftShowsPrec _ sl _ = sl++instance Show a => Show (SmallArray a) where+  showsPrec = smallArrayLiftShowsPrec showsPrec showList+instance Show1 SmallArray where+  liftShowsPrec = smallArrayLiftShowsPrec++smallArrayLiftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (SmallArray a)+smallArrayLiftReadsPrec _ listReadsPrec p = readParen (p > 10) . readP_to_S $ do+  () <$ string "fromListN"+  skipSpaces+  n <- readS_to_P reads+  skipSpaces+  l <- readS_to_P listReadsPrec+  return $ smallArrayFromListN n l++instance Read a => Read (SmallArray a) where+  readsPrec = smallArrayLiftReadsPrec readsPrec readList++instance Read1 SmallArray where+  liftReadsPrec = smallArrayLiftReadsPrec++smallArrayDataType :: DataType+smallArrayDataType =+  mkDataType "Data.Primitive.SmallArray.SmallArray" [fromListConstr]++fromListConstr :: Constr+fromListConstr = mkConstr smallArrayDataType "fromList" [] Prefix++instance Data a => Data (SmallArray a) where+  toConstr _ = fromListConstr+  dataTypeOf _ = smallArrayDataType+  gunfold k z c = case constrIndex c of+    1 -> k (z fromList)+    _ -> die "gunfold" "SmallArray"+  gfoldl f z m = z fromList `f` toList m++instance (Typeable s, Typeable a) => Data (SmallMutableArray s a) where+  toConstr _ = die "toConstr" "SmallMutableArray"+  gunfold _ _ = die "gunfold" "SmallMutableArray"+  dataTypeOf _ = mkNoRepType "Data.Primitive.SmallArray.SmallMutableArray"++-- | Create a 'SmallArray' from a list of a known length. If the length+--   of the list does not match the given length, this throws an exception.+smallArrayFromListN :: Int -> [a] -> SmallArray a+smallArrayFromListN n l =+  createSmallArray n+      (die "smallArrayFromListN" "uninitialized element") $ \sma ->+  let go !ix [] = if ix == n+        then return ()+        else die "smallArrayFromListN" "list length less than specified size"+      go !ix (x : xs) = if ix < n+        then do+          writeSmallArray sma ix x+          go (ix+1) xs+        else die "smallArrayFromListN" "list length greater than specified size"+  in go 0 l++-- | Create a 'SmallArray' from a list.+smallArrayFromList :: [a] -> SmallArray a+smallArrayFromList l = smallArrayFromListN (length l) l
+ src/Streamly/Internal/Data/Stream/Ahead.hs view
@@ -0,0 +1,776 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.Ahead+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- To run examples in this module:+--+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Control.Concurrent (threadDelay)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}+--+module Streamly.Internal.Data.Stream.Ahead {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream.Concurrent\" from streamly package instead." #-}+    (+      AheadT(..)+    , Ahead+    , aheadK+    , consM+    )+where++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)+import GHC.Exts (inline)++import qualified Data.Heap as H++import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, MonadAsync, askRunInIO, restoreM)+import Streamly.Internal.Data.StreamK (Stream)++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+import Prelude hiding (map)++#include "Instances.hs"++-- $setup+-- >>> :set -fno-warn-deprecations+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Control.Concurrent (threadDelay)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      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+-------------------------------------------------------------------------------++-- 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 ::+       SVar Stream m a+    -> Heap (Entry Int (AheadHeapEntry Stream 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 ::+       SVar Stream m a+    -> IORef (Heap (Entry Int (AheadHeapEntry Stream 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 stop = 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+                    rateOk <- isBeyondMaxRate sv yinfo+                    if rateOk then continue else stop+        else stop++abortExecution ::+       IORef ([Stream m a], Int)+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> Stream m a+    -> IO ()+abortExecution q sv winfo m = do+    reEnqueueAhead sv q m+    incrementYieldLimit sv+    sendStop sv winfo++-- 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.+--+processHeap+    :: MonadRunInIO m+    => IORef ([Stream m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> AheadHeapEntry Stream m a+    -> Int+    -> Bool -- we are draining the heap before we stop+    -> m ()+processHeap q heap st sv winfo entry sno stopping = loopHeap sno entry++    where++    stopIfNeeded ent seqNo r = 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+            sendStop sv winfo+        else runStreamWithYieldLimit True seqNo r++    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 $ send sv (ChildYield a)+                nextHeap seqNo+            AheadEntryStream (RunInIO runin, r) ->+                if stopping+                then stopIfNeeded ent seqNo r+                else do+                    res <- liftIO $ runin (runStreamWithYieldLimit True seqNo r)+                    restoreM res+++    nextHeap prevSeqNo = do+        res <- liftIO $ dequeueFromHeapSeq heap (prevSeqNo + 1)+        case res of+            Ready (Entry seqNo hent) -> loopHeap seqNo hent+            Clearing -> liftIO $ sendStop sv winfo+            Waiting _ ->+                if stopping+                then do+                    r <- liftIO $ preStopCheck sv heap+                    if r+                    then liftIO $ sendStop sv winfo+                    else processWorkQueue prevSeqNo+                else inline processWorkQueue prevSeqNo++    processWorkQueue prevSeqNo = do+        work <- dequeueAhead q+        case work of+            Nothing -> liftIO $ sendStop sv winfo+            Just (m, seqNo) -> do+                yieldLimitOk <- liftIO $ decrementYieldLimit sv+                if yieldLimitOk+                then+                    if seqNo == prevSeqNo + 1+                    then processWithToken q heap st sv winfo m seqNo+                    else processWithoutToken q heap st sv winfo m seqNo+                else liftIO $ abortExecution q sv winfo m++    -- 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 $ sendYield sv winfo (ChildYield a)+        nextHeap seqNo++    -- 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 sv+        if continue -- see comment above -- && yieldLimitOk+        then do+            let stop = do+                  liftIO (incrementYieldLimit sv)+                  nextHeap seqNo+            K.foldStreamShared st+                          (yieldStreamFromHeap seqNo)+                          (singleStreamFromHeap seqNo)+                          stop+                          r+        else do+            runIn <- askRunInIO+            let ent = Entry seqNo (AheadEntryStream (runIn, r))+            liftIO $ do+                requeueOnHeapTop heap ent seqNo+                incrementYieldLimit sv+                sendStop sv winfo++    yieldStreamFromHeap seqNo a r = do+        continue <- liftIO $ sendYield sv winfo (ChildYield a)+        runStreamWithYieldLimit continue seqNo r++{-# NOINLINE drainHeap #-}+drainHeap+    :: MonadRunInIO m+    => IORef ([Stream m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> m ()+drainHeap q heap st sv winfo = do+    r <- liftIO $ dequeueFromHeap heap+    case r of+        Ready (Entry seqNo hent) ->+            processHeap q heap st sv winfo hent seqNo True+        _ -> liftIO $ sendStop sv winfo++data HeapStatus = HContinue | HStop+data WorkerStatus = Continue | Suspend++processWithoutToken+    :: MonadRunInIO m+    => IORef ([Stream m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> Stream m a+    -> Int+    -> m ()+processWithoutToken q heap st sv winfo m seqNo = do+    -- we have already decremented the yield limit for m+    let stop = do+            liftIO (incrementYieldLimit 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++    r <- liftIO $ mrun $+            K.foldStreamShared st+                (\a r -> do+                    runIn <- askRunInIO+                    toHeap $ AheadEntryStream (runIn, K.cons a r))+                (toHeap . AheadEntryPure)+                stop+                m+    res <- restoreM r+    case res of+        Continue -> workLoopAhead q heap st sv winfo+        Suspend -> drainHeap q heap st 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+        status <-+            case yieldRateInfo sv of+                Nothing -> return HContinue+                Just yinfo ->+                    case winfo of+                        Just info -> do+                            rateOk <- liftIO $ workerRateControl 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++processWithToken+    :: MonadRunInIO m+    => IORef ([Stream m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> Stream m a+    -> Int+    -> m ()+processWithToken q heap st sv winfo action sno = do+    -- Note, we enter this function with yield limit already decremented+    -- XXX deduplicate stop in all invocations+    let stop = do+            liftIO (incrementYieldLimit sv)+            return $ TokenContinue (sno + 1)+        mrun = runInIO $ svarMrun sv++    r <- liftIO $ mrun $+        K.foldStreamShared st (yieldOutput sno) (singleOutput sno) stop action++    res <- restoreM r+    case res of+        TokenContinue seqNo -> loopWithToken seqNo+        TokenSuspend -> drainHeap q heap st sv winfo++    where++    singleOutput seqNo a = do+        continue <- liftIO $ sendYield sv winfo (ChildYield 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 $ sendYield sv winfo (ChildYield a)+        yieldLimitOk <- liftIO $ decrementYieldLimit sv+        if continue && yieldLimitOk+        then do+            let stop = do+                    liftIO (incrementYieldLimit sv)+                    return $ TokenContinue (seqNo + 1)+            K.foldStreamShared st+                          (yieldOutput seqNo)+                          (singleOutput seqNo)+                          stop+                          r+        else do+            runIn <- askRunInIO+            let ent = Entry seqNo (AheadEntryStream (runIn, r))+            liftIO $ requeueOnHeapTop heap ent seqNo+            liftIO $ incrementYieldLimit sv+            return TokenSuspend++    loopWithToken nextSeqNo = do+        work <- dequeueAhead q+        case work of+            Nothing -> do+                liftIO $ updateHeapSeq heap nextSeqNo+                workLoopAhead q heap st sv winfo++            Just (m, seqNo) -> do+                yieldLimitOk <- liftIO $ decrementYieldLimit sv+                let undo = liftIO $ do+                        updateHeapSeq heap nextSeqNo+                        reEnqueueAhead sv q m+                        incrementYieldLimit sv+                if yieldLimitOk+                then+                    if seqNo == nextSeqNo+                    then do+                        let stop = do+                                liftIO (incrementYieldLimit sv)+                                return $ TokenContinue (seqNo + 1)+                            mrun = runInIO $ svarMrun sv+                        r <- liftIO $ mrun $+                            K.foldStreamShared st+                                          (yieldOutput seqNo)+                                          (singleOutput seqNo)+                                          stop+                                          m+                        res <- restoreM r+                        case res of+                            TokenContinue seqNo1 -> loopWithToken seqNo1+                            TokenSuspend -> drainHeap q heap st sv winfo++                    else+                        -- 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.+                        undo >> workLoopAhead q heap st sv winfo+                else undo >> drainHeap q heap st 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.++-- XXX we can remove the sv parameter as it can be derived from st++workLoopAhead+    :: MonadRunInIO m+    => IORef ([Stream m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> m ()+workLoopAhead q heap st sv winfo = do+        r <- liftIO $ dequeueFromHeap heap+        case r of+            Ready (Entry seqNo hent) ->+                processHeap q heap st sv winfo hent seqNo False+            Clearing -> liftIO $ sendStop sv winfo+            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.+                --+                work <- dequeueAhead q+                case work of+                    Nothing -> liftIO $ sendStop sv winfo+                    Just (m, seqNo) -> do+                        yieldLimitOk <- liftIO $ decrementYieldLimit sv+                        if yieldLimitOk+                        then+                            if seqNo == 0+                            then processWithToken q heap st sv winfo m seqNo+                            else processWithoutToken q heap st sv winfo m seqNo+                        -- If some worker decremented the yield limit but then+                        -- did not yield anything and therefore incremented it+                        -- later, then if we did not requeue m here we may find+                        -- the work queue empty and therefore miss executing+                        -- the remaining action.+                        else liftIO $ abortExecution q sv winfo m++-------------------------------------------------------------------------------+-- WAhead+-------------------------------------------------------------------------------++-- XXX To be implemented. Use a linked queue like WAsync and put back the+-- remaining computation at the back of the queue instead of the heap, and+-- increment the sequence number.++-- The only difference between forkSVarAsync and this is that we run the left+-- computation without a shared SVar.+forkSVarAhead :: MonadAsync m => Stream m a -> Stream m a -> Stream m a+forkSVarAhead m1 m2 = K.mkStream $ \st yld sng stp -> do+        sv <- newAheadVar st (concurrently m1 m2)+                          workLoopAhead+        K.foldStream st yld sng stp $ Stream.toStreamK (fromSVar sv)+    where+    concurrently ma mb = K.mkStream $ \st yld sng stp -> do+        runInIO <- askRunInIO+        liftIO $ enqueue (fromJust $ streamVar st) (runInIO, mb)+        K.foldStream st yld sng stp ma++{-# INLINE aheadK #-}+aheadK :: MonadAsync m => Stream m a -> Stream m a -> Stream m a+aheadK m1 m2 = K.mkStream $ \st yld sng stp ->+    case streamVar st of+        Just sv | svarStyle sv == AheadVar -> do+            runInIO <- askRunInIO+            liftIO $ enqueue sv (runInIO, m2)+            -- Always run the left side on a new SVar to avoid complexity in+            -- sequencing results. This means the left side cannot further+            -- split into more ahead computations on the same SVar.+            K.foldStream st yld sng stp m1+        _ -> K.foldStreamShared st yld sng stp (forkSVarAhead m1 m2)++-- | XXX we can implement it more efficienty by directly implementing instead+-- of combining streams using ahead.+{-# INLINE consM #-}+{-# SPECIALIZE consM :: IO a -> AheadT IO a -> AheadT IO a #-}+consM :: MonadAsync m => m a -> AheadT m a -> AheadT m a+consM m (AheadT r) = AheadT $ aheadK (K.fromEffect m) r++------------------------------------------------------------------------------+-- AheadT+------------------------------------------------------------------------------++-- | For 'AheadT' streams:+--+-- @+-- (<>) = 'Streamly.Prelude.ahead'+-- (>>=) = flip . 'Streamly.Prelude.concatMapWith' 'Streamly.Prelude.ahead'+-- @+--+-- A single 'Monad' bind behaves like a @for@ loop with iterations executed+-- concurrently, ahead of time, producing side effects of iterations out of+-- order, but results in order:+--+-- >>> :{+-- Stream.toList $ Stream.fromAhead $ do+--      x <- Stream.fromList [2,1] -- foreach x in stream+--      Stream.fromEffect $ delay x+-- :}+-- 1 sec+-- 2 sec+-- [2,1]+--+-- Nested monad binds behave like nested @for@ loops with nested iterations+-- executed concurrently, ahead of time:+--+-- >>> :{+-- Stream.toList $ Stream.fromAhead $ do+--     x <- Stream.fromList [1,2] -- foreach x in stream+--     y <- Stream.fromList [2,4] -- foreach y in stream+--     Stream.fromEffect $ delay (x + y)+-- :}+-- 3 sec+-- 4 sec+-- 5 sec+-- 6 sec+-- [3,5,4,6]+--+-- The behavior can be explained as follows. All the iterations corresponding+-- to the element @1@ in the first stream constitute one output stream and all+-- the iterations corresponding to @2@ constitute another output stream and+-- these two output streams are merged using 'ahead'.+--+-- /Since: 0.3.0 ("Streamly")/+--+-- @since 0.8.0+newtype AheadT m a = AheadT {getAheadT :: Stream m a}++#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.+--+-- /Since: 0.3.0 ("Streamly")/+--+-- @since 0.8.0+type Ahead = AheadT IO++------------------------------------------------------------------------------+-- Semigroup+------------------------------------------------------------------------------++{-# INLINE append #-}+{-# SPECIALIZE append :: AheadT IO a -> AheadT IO a -> AheadT IO a #-}+append :: MonadAsync m => AheadT m a -> AheadT m a -> AheadT m a+append (AheadT m1) (AheadT m2) = AheadT $ aheadK m1 m2++instance MonadAsync m => Semigroup (AheadT m a) where+    (<>) = append++------------------------------------------------------------------------------+-- Monoid+------------------------------------------------------------------------------++instance MonadAsync m => Monoid (AheadT m a) where+    mempty = AheadT K.nil+    mappend = (<>)++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++{-# 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 (K.fromPure . x1) m2+    in AheadT $ K.concatMapWith aheadK f m1++instance (Monad m, MonadAsync m) => Applicative (AheadT m) where+    {-# INLINE pure #-}+    pure = AheadT . K.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = apAhead++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++{-# INLINE bindAhead #-}+{-# SPECIALIZE bindAhead ::+    AheadT IO a -> (a -> AheadT IO b) -> AheadT IO b #-}+bindAhead :: MonadAsync m => AheadT m a -> (a -> AheadT m b) -> AheadT m b+bindAhead (AheadT m) f = AheadT $ K.bindWith aheadK m (getAheadT . f)++instance MonadAsync m => Monad (AheadT m) where+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = bindAhead++------------------------------------------------------------------------------+-- 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
@@ -0,0 +1,1064 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++#include "inline.hs"++-- |+-- Module      : Streamly.Internal.Data.Stream.Async+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- To run examples in this module:+--+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Control.Concurrent (threadDelay)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}+--+module Streamly.Internal.Data.Stream.Async {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream.Concurrent\" from streamly package instead." #-}+    (+      AsyncT(..)+    , Async+    , consMAsync+    , asyncK+    , mkAsyncK+    , mkAsyncD++    , WAsyncT(..)+    , WAsync+    , consMWAsync+    , wAsyncK+    )+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)++import Prelude hiding (map)+import qualified Data.Set as S++import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, MonadAsync, askRunInIO, restoreM)+import Streamly.Internal.Data.Atomics+    (atomicModifyIORefCAS, atomicModifyIORefCAS_)+import Streamly.Internal.Data.StreamK (Stream)+import Streamly.Internal.Data.Stream.SVar.Generate (fromSVar, fromSVarD)++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++#include "Instances.hs"++-- $setup+-- >>> :set -fno-warn-deprecations+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Control.Concurrent (threadDelay)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      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++-------------------------------------------------------------------------------+-- Async+-------------------------------------------------------------------------------++-- Note: For purely right associated expressions this queue should have at most+-- one element. It grows to more than one when we have left associcated+-- expressions. Large left associated compositions can grow this to a+-- large size+{-# INLINE enqueueLIFO #-}+enqueueLIFO ::+       SVar t m a -> IORef [(RunInIO m, t m a)] -> (RunInIO m, t m a) -> IO ()+enqueueLIFO sv q m = do+    atomicModifyIORefCAS_ q $ \ms -> m : ms+    ringDoorBell sv++data WorkerStatus = Continue | Suspend++{-# INLINE workLoopLIFO #-}+workLoopLIFO+    :: MonadRunInIO m+    => IORef [(RunInIO m, Stream m a)]+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> m ()+workLoopLIFO q st sv winfo = run++    where++    stop = liftIO $ sendStop sv winfo+    run = do+        work <- dequeue+        case work of+            Nothing -> stop+            Just (RunInIO 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 st yieldk single (return Continue) m+                res <- restoreM r+                case res of+                    Continue -> run+                    Suspend -> stop++    single a = do+        res <- liftIO $ sendYield sv winfo (ChildYield a)+        return $ if res then Continue else Suspend++    yieldk a r = do+        res <- liftIO $ sendYield sv winfo (ChildYield a)+        if res+        then K.foldStreamShared st yieldk single (return Continue) r+        else do+            runInIO <- askRunInIO+            liftIO $ enqueueLIFO sv q (runInIO, r)+            return Suspend++    dequeue = liftIO $ atomicModifyIORefCAS q $ \case+                [] -> ([], Nothing)+                x : xs -> (xs, Just x)++-- 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, Stream m a)]+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> m ()+workLoopLIFOLimited q st sv winfo = run++    where++    incrContinue = liftIO (incrementYieldLimit sv) >> return Continue+    stop = liftIO $ sendStop sv winfo+    run = do+        work <- dequeue+        case work of+            Nothing -> stop+            Just (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 sv+                if yieldLimitOk+                then do+                    r <- liftIO $ runin $+                            K.foldStreamShared st yieldk single incrContinue m+                    res <- restoreM r+                    case res of+                        Continue -> run+                        Suspend -> stop+                -- Avoid any side effects, undo the yield limit decrement if we+                -- never yielded anything.+                else liftIO $ do+                    enqueueLIFO sv q (RunInIO runin, m)+                    incrementYieldLimit sv+                    sendStop sv winfo++    single a = do+        res <- liftIO $ sendYield sv winfo (ChildYield 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 $ sendYield sv winfo (ChildYield a)+        yieldLimitOk <- liftIO $ decrementYieldLimit sv+        if res && yieldLimitOk+        then K.foldStreamShared st yieldk single incrContinue r+        else do+            runInIO <- askRunInIO+            liftIO $ incrementYieldLimit sv+            liftIO $ enqueueLIFO sv q (runInIO, r)+            return Suspend++    dequeue = liftIO $ atomicModifyIORefCAS q $ \case+                [] -> ([], Nothing)+                x : xs -> (xs, Just x)++-------------------------------------------------------------------------------+-- WAsync+-------------------------------------------------------------------------------++-- XXX we can use the Ahead style sequence/heap mechanism to make the best+-- effort to always try to finish the streams on the left side of an expression+-- first as long as possible.++{-# INLINE enqueueFIFO #-}+enqueueFIFO ::+       SVar t m a+    -> LinkedQueue (RunInIO m, t m a)+    -> (RunInIO m, t m a)+    -> IO ()+enqueueFIFO sv q m = do+    pushL q m+    ringDoorBell sv++-- XXX we can remove sv as it is derivable from st++{-# INLINE workLoopFIFO #-}+workLoopFIFO+    :: MonadRunInIO m+    => LinkedQueue (RunInIO m, Stream m a)+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> m ()+workLoopFIFO q st sv winfo = run++    where++    stop = liftIO $ sendStop sv winfo+    run = do+        work <- liftIO $ tryPopR q+        case work of+            Nothing -> stop+            Just (RunInIO runin, m) -> do+                r <- liftIO $ runin $+                        K.foldStreamShared st yieldk single (return Continue) m+                res <- restoreM r+                case res of+                    Continue -> run+                    Suspend -> stop++    single a = do+        res <- liftIO $ sendYield sv winfo (ChildYield 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 $ sendYield sv winfo (ChildYield a)+        runInIO <- askRunInIO+        liftIO $ enqueueFIFO sv q (runInIO, r)+        return $ if res then Continue else Suspend++{-# INLINE workLoopFIFOLimited #-}+workLoopFIFOLimited+    :: forall m a. MonadRunInIO m+    => LinkedQueue (RunInIO m, Stream m a)+    -> State Stream m a+    -> SVar Stream m a+    -> Maybe WorkerInfo+    -> m ()+workLoopFIFOLimited q st sv winfo = run++    where++    stop = liftIO $ sendStop sv winfo+    incrContinue = liftIO (incrementYieldLimit sv) >> return Continue+    run = do+        work <- liftIO $ tryPopR q+        case work of+            Nothing -> stop+            Just (RunInIO runin, m) -> do+                yieldLimitOk <- liftIO $ decrementYieldLimit sv+                if yieldLimitOk+                then do+                    r <- liftIO $ runin $+                            K.foldStreamShared st yieldk single incrContinue m+                    res <- restoreM r+                    case res of+                        Continue -> run+                        Suspend -> stop+                else liftIO $ do+                    enqueueFIFO sv q (RunInIO runin, m)+                    incrementYieldLimit sv+                    sendStop sv winfo++    single a = do+        res <- liftIO $ sendYield sv winfo (ChildYield a)+        return $ if res then Continue else Suspend++    yieldk a r = do+        res <- liftIO $ sendYield sv winfo (ChildYield a)+        runInIO <- askRunInIO+        liftIO $ enqueueFIFO sv q (runInIO, r)+        yieldLimitOk <- liftIO $ decrementYieldLimit sv+        if res && yieldLimitOk+        then return Continue+        else liftIO $ do+            incrementYieldLimit sv+            return Suspend++-------------------------------------------------------------------------------+-- 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.+getLifoSVar :: forall m a. MonadAsync m+    => State Stream m a -> RunInIO m -> IO (SVar Stream m a)+getLifoSVar st mrun = do+    outQ    <- newIORef ([], 0)+    outQMv  <- newEmptyMVar+    active  <- newIORef 0+    wfw     <- newIORef False+    running <- newIORef S.empty+    q       <- newIORef ([] :: [(RunInIO m, Stream m a)])+    yl      <- case getYieldLimit st of+                Nothing -> return Nothing+                Just x -> Just <$> newIORef x+    rateInfo <- getYieldRateInfo st++    stats <- newSVarStats+    tid <- myThreadId++    let isWorkFinished _ = null <$> readIORef q++    let isWorkFinishedLimited sv = do+            yieldsDone <-+                    case remainingWork sv of+                        Just ref -> do+                            n <- readIORef ref+                            return (n <= 0)+                        Nothing -> return False+            qEmpty <- null <$> readIORef q+            return $ qEmpty || yieldsDone++    let getSVar :: SVar Stream m a+            -> (SVar Stream m a -> m [ChildEvent a])+            -> (SVar Stream m a -> m Bool)+            -> (SVar Stream m a -> IO Bool)+            -> (IORef [(RunInIO m, Stream m a)]+                -> State Stream m a+                -> SVar Stream m a+                -> Maybe WorkerInfo+                -> m())+            -> SVar Stream m a+        getSVar sv readOutput postProc workDone wloop = SVar+            { outputQueue      = outQ+            , outputQueueFromConsumer = undefined+            , remainingWork    = yl+            , maxBufferLimit   = getMaxBuffer st+            , pushBufferSpace  = undefined+            , pushBufferPolicy = undefined+            , pushBufferMVar   = undefined+            , maxWorkerLimit   = min (getMaxThreads st) (getMaxBuffer st)+            , yieldRateInfo    = rateInfo+            , outputDoorBell   = outQMv+            , outputDoorBellFromConsumer = undefined+            , readOutputQ      = readOutput sv+            , postProcess      = postProc sv+            , workerThreads    = running+            , workLoop         = wloop q st{streamVar = Just sv} sv+            , enqueue          = enqueueLIFO sv q+            , isWorkDone       = workDone sv+            , isQueueDone      = workDone sv+            , needDoorBell     = wfw+            , svarStyle        = AsyncVar+            , svarStopStyle    = StopNone+            , svarStopBy       = undefined+            , svarMrun         = mrun+            , workerCount      = active+            , accountThread    = delThread sv+            , workerStopMVar   = undefined+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode st+            , svarCreator      = tid+            , aheadWorkQueue   = undefined+            , outputHeap       = undefined+            , svarStats        = stats+            }++    let sv =+            case getStreamRate st of+                Nothing ->+                    case getYieldLimit st of+                        Nothing -> getSVar sv readOutputQBounded+                                              postProcessBounded+                                              isWorkFinished+                                              workLoopLIFO+                        Just _  -> getSVar sv readOutputQBounded+                                              postProcessBounded+                                              isWorkFinishedLimited+                                              workLoopLIFOLimited+                Just _  ->+                    case getYieldLimit st of+                        Nothing -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinished+                                              workLoopLIFO+                        Just _  -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinishedLimited+                                              workLoopLIFOLimited+     in return sv++getFifoSVar :: forall m a. MonadAsync m+    => State Stream m a -> RunInIO m -> IO (SVar Stream m a)+getFifoSVar st mrun = do+    outQ    <- newIORef ([], 0)+    outQMv  <- newEmptyMVar+    active  <- newIORef 0+    wfw     <- newIORef False+    running <- newIORef S.empty+    q       <- newQ+    yl      <- case getYieldLimit st of+                Nothing -> return Nothing+                Just x -> Just <$> newIORef x+    rateInfo <- getYieldRateInfo st++    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 :: SVar Stream m a+            -> (SVar Stream m a -> m [ChildEvent a])+            -> (SVar Stream m a -> m Bool)+            -> (SVar Stream m a -> IO Bool)+            -> (LinkedQueue (RunInIO m, Stream m a)+                -> State Stream m a+                -> SVar Stream m a+                -> Maybe WorkerInfo+                -> m())+            -> SVar Stream m a+        getSVar sv readOutput postProc workDone wloop = SVar+            { outputQueue      = outQ+            , outputQueueFromConsumer = undefined+            , remainingWork    = yl+            , maxBufferLimit   = getMaxBuffer st+            , pushBufferSpace  = undefined+            , pushBufferPolicy = undefined+            , pushBufferMVar   = undefined+            , maxWorkerLimit   = min (getMaxThreads st) (getMaxBuffer st)+            , yieldRateInfo    = rateInfo+            , outputDoorBell   = outQMv+            , outputDoorBellFromConsumer = undefined+            , readOutputQ      = readOutput sv+            , postProcess      = postProc sv+            , workerThreads    = running+            , workLoop         = wloop q st{streamVar = Just sv} sv+            , enqueue          = enqueueFIFO sv q+            , isWorkDone       = workDone sv+            , isQueueDone      = workDone sv+            , needDoorBell     = wfw+            , svarStyle        = WAsyncVar+            , svarStopStyle    = StopNone+            , svarStopBy       = undefined+            , svarMrun         = mrun+            , workerCount      = active+            , accountThread    = delThread sv+            , workerStopMVar   = undefined+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode st+            , svarCreator      = tid+            , aheadWorkQueue   = undefined+            , outputHeap       = undefined+            , svarStats        = stats+            }++    let sv =+            case getStreamRate st of+                Nothing ->+                    case getYieldLimit st of+                        Nothing -> getSVar sv readOutputQBounded+                                              postProcessBounded+                                              isWorkFinished+                                              workLoopFIFO+                        Just _  -> getSVar sv readOutputQBounded+                                              postProcessBounded+                                              isWorkFinishedLimited+                                              workLoopFIFOLimited+                Just _  ->+                    case getYieldLimit st of+                        Nothing -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinished+                                              workLoopFIFO+                        Just _  -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinishedLimited+                                              workLoopFIFOLimited+     in return sv++{-# INLINABLE newAsyncVar #-}+newAsyncVar :: MonadAsync m+    => State Stream m a -> Stream m a -> m (SVar Stream m a)+newAsyncVar st m = do+    mrun <- askRunInIO+    sv <- liftIO $ getLifoSVar st mrun+    sendFirstWorker sv m++-- | Generate a stream asynchronously to keep it buffered, lazily consume+-- from the buffer.+--+-- /Pre-release/+--+{-# INLINABLE mkAsyncK #-}+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 $ Stream.toStreamK $ fromSVar sv++--+-- This is slightly faster than the CPS version above+--+{-# INLINE_NORMAL mkAsyncD #-}+mkAsyncD :: MonadAsync m => D.Stream m a -> D.Stream m a+mkAsyncD m = D.Stream step Nothing+    where++    step gst Nothing = do+        sv <- newAsyncVar gst (D.toStreamK m)+        return $ D.Skip $ Just $ fromSVarD sv++    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++-- XXX We can pass captureMonadState instead of using MonadAsync+-- | Create a new SVar and enqueue one stream computation on it.+{-# INLINABLE newWAsyncVar #-}+newWAsyncVar :: MonadAsync m+    => State Stream m a -> Stream m a -> m (SVar Stream m a)+newWAsyncVar st m = do+    mrun <- askRunInIO+    sv <- liftIO $ getFifoSVar st mrun+    -- XXX Use just Stream and IO in all the functions below+    -- XXX pass mrun instead of calling captureMonadState again inside it+    sendFirstWorker sv m++------------------------------------------------------------------------------+-- Running streams concurrently+------------------------------------------------------------------------------++-- Concurrency rate control.+--+-- Our objective is to create more threads on demand if the consumer is running+-- faster than us. As soon as we encounter a concurrent composition we create a+-- push pull pair of threads. We use an SVar for communication between the+-- consumer, pulling from the SVar and the producer who is pushing to the SVar.+-- The producer creates more threads if the SVar drains and becomes empty, that+-- is the consumer is running faster.+--+-- XXX Note 1: This mechanism can be problematic if the initial production+-- latency is high, we may end up creating too many threads. So we need some+-- way to monitor and use the latency as well. Having a limit on the dispatches+-- (programmer controlled) may also help.+--+-- TBD Note 2: We may want to run computations at the lower level of the+-- composition tree serially even when they are composed using a parallel+-- combinator. We can use 'serial' in place of 'async' and 'wSerial' in+-- place of 'wAsync'. If we find that an SVar immediately above a computation+-- gets drained empty we can switch to parallelizing the computation.  For that+-- we can use a state flag to fork the rest of the computation at any point of+-- time inside the Monad bind operation if the consumer is running at a faster+-- speed.+--+-- TBD Note 3: the binary operation ('parallel') composition allows us to+-- dispatch a chunkSize of only 1.  If we have to dispatch in arbitrary+-- chunksizes we will need to compose the parallel actions using a data+-- constructor (A Free container) instead so that we can divide it in chunks of+-- arbitrary size before dispatching. If the stream is composed of+-- hierarchically composed grains of different sizes then we can always switch+-- to a desired granularity depending on the consumer speed.+--+-- TBD Note 4: for pure work (when we are not in the IO monad) we can divide it+-- into just the number of CPUs.++-- | Join two computations on the currently running 'SVar' queue for concurrent+-- execution.  When we are using parallel composition, an SVar is passed around+-- as a state variable. We try to schedule a new parallel computation on the+-- SVar passed to us. The first time, when no SVar exists, a new SVar is+-- created.  Subsequently, 'joinStreamVarAsync' may get called when a computation+-- already scheduled on the SVar is further evaluated. For example, when (a+-- `parallel` b) is evaluated it calls a 'joinStreamVarAsync' to put 'a' and 'b' on+-- the current scheduler queue.+--+-- The 'SVarStyle' required by the current composition context is passed as one+-- of the parameters.  If the scheduling and composition style of the new+-- computation being scheduled is different than the style of the current SVar,+-- then we create a new SVar and schedule it on that.  The newly created SVar+-- joins as one of the computations on the current SVar queue.+--+-- Cases when we need to switch to a new SVar:+--+-- * (x `parallel` y) `parallel` (t `parallel` u) -- all of them get scheduled on the same SVar+-- * (x `parallel` y) `parallel` (t `async` u) -- @t@ and @u@ get scheduled on a new child SVar+--   because of the scheduling policy change.+-- * if we 'adapt' a stream of type 'async' to a stream of type+--   'Parallel', we create a new SVar at the transitioning bind.+-- * When the stream is switching from disjunctive composition to conjunctive+--   composition and vice-versa we create a new SVar to isolate the scheduling+--   of the two.++forkSVarAsync :: MonadAsync m+    => SVarStyle -> Stream m a -> Stream m a -> Stream m a+forkSVarAsync style m1 m2 = K.mkStream $ \st yld sng stp -> do+    sv <- case style of+        AsyncVar -> newAsyncVar st (concurrently m1 m2)+        WAsyncVar -> newWAsyncVar st (concurrently m1 m2)+        _ -> error "illegal svar type"+    K.foldStream st yld sng stp $ Stream.toStreamK $ fromSVar sv+    where+    concurrently ma mb = K.mkStream $ \st yld sng stp -> do+        runInIO <- askRunInIO+        liftIO $ enqueue (fromJust $ streamVar st) (runInIO, mb)+        K.foldStreamShared st yld sng stp ma++{-# INLINE joinStreamVarAsync #-}+joinStreamVarAsync :: MonadAsync m+    => SVarStyle -> Stream m a -> Stream m a -> Stream m a+joinStreamVarAsync style m1 m2 = K.mkStream $ \st yld sng stp ->+    case streamVar st of+        Just sv | svarStyle sv == style -> do+            runInIO <- askRunInIO+            liftIO $ enqueue sv (runInIO, m2)+            K.foldStreamShared st yld sng stp m1+        _ -> K.foldStreamShared st yld sng stp (forkSVarAsync style m1 m2)++------------------------------------------------------------------------------+-- Semigroup and Monoid style compositions for parallel actions+------------------------------------------------------------------------------++{-# INLINE asyncK #-}+asyncK :: MonadAsync m => Stream m a -> Stream m a -> Stream m a+asyncK = joinStreamVarAsync AsyncVar++-- IMPORTANT: using a monomorphically typed and SPECIALIZED consMAsync makes a+-- huge difference in the performance of consM in IsStream instance even we+-- have a SPECIALIZE in the instance.+--+-- | XXX we can implement it more efficienty by directly implementing instead+-- of combining streams using async.+{-# INLINE consMAsync #-}+{-# SPECIALIZE consMAsync :: IO a -> AsyncT IO a -> AsyncT IO a #-}+consMAsync :: MonadAsync m => m a -> AsyncT m a -> AsyncT m a+consMAsync m (AsyncT r) = AsyncT $ asyncK (K.fromEffect m) r++------------------------------------------------------------------------------+-- AsyncT+------------------------------------------------------------------------------++-- | For 'AsyncT' streams:+--+-- @+-- (<>) = 'Streamly.Prelude.async'+-- (>>=) = flip . 'Streamly.Prelude.concatMapWith' 'Streamly.Prelude.async'+-- @+--+-- A single 'Monad' bind behaves like a @for@ loop with iterations of the loop+-- executed concurrently a la the 'async' combinator, producing results and+-- side effects of iterations out of order:+--+-- >>> :{+-- Stream.toList $ Stream.fromAsync $ do+--      x <- Stream.fromList [2,1] -- foreach x in stream+--      Stream.fromEffect $ delay x+-- :}+-- 1 sec+-- 2 sec+-- [1,2]+--+-- Nested monad binds behave like nested @for@ loops with nested iterations+-- executed concurrently, a la the 'async' combinator:+--+-- >>> :{+-- Stream.toList $ Stream.fromAsync $ do+--     x <- Stream.fromList [1,2] -- foreach x in stream+--     y <- Stream.fromList [2,4] -- foreach y in stream+--     Stream.fromEffect $ delay (x + y)+-- :}+-- 3 sec+-- 4 sec+-- 5 sec+-- 6 sec+-- [3,4,5,6]+--+-- The behavior can be explained as follows. All the iterations corresponding+-- to the element @1@ in the first stream constitute one output stream and all+-- the iterations corresponding to @2@ constitute another output stream and+-- these two output streams are merged using 'async'.+--+-- /Since: 0.1.0 ("Streamly")/+--+-- @since 0.8.0+newtype AsyncT m a = AsyncT {getAsyncT :: Stream m a}++#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.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+type Async = AsyncT IO++------------------------------------------------------------------------------+-- Semigroup+------------------------------------------------------------------------------++-- Monomorphically typed version of "async" for better performance of Semigroup+-- instance.+{-# INLINE append #-}+{-# SPECIALIZE append :: AsyncT IO a -> AsyncT IO a -> AsyncT IO a #-}+append :: MonadAsync m => AsyncT m a -> AsyncT m a -> AsyncT m a+append (AsyncT m1) (AsyncT m2) = AsyncT $ asyncK m1 m2++instance MonadAsync m => Semigroup (AsyncT m a) where+    (<>) = append++------------------------------------------------------------------------------+-- Monoid+------------------------------------------------------------------------------++instance MonadAsync m => Monoid (AsyncT m a) where+    mempty = AsyncT K.nil+    mappend = (<>)++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++{-# INLINE apAsync #-}+{-# 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 (K.fromPure . x1) m2+    in AsyncT $ K.concatMapWith asyncK f m1++instance (Monad m, MonadAsync m) => Applicative (AsyncT m) where+    {-# INLINE pure #-}+    pure = AsyncT . K.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = apAsync++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++-- GHC: if we change the implementation of bindWith with arguments in a+-- different order we see a significant performance degradation (~2x).+{-# INLINE bindAsync #-}+{-# SPECIALIZE bindAsync ::+    AsyncT IO a -> (a -> AsyncT IO b) -> AsyncT IO b #-}+bindAsync :: MonadAsync m => AsyncT m a -> (a -> AsyncT m b) -> AsyncT m b+bindAsync (AsyncT m) f = AsyncT $ K.bindWith asyncK m (getAsyncT . f)++-- GHC: if we specify arguments in the definition of (>>=) we see a significant+-- performance degradation (~2x).+instance MonadAsync m => Monad (AsyncT m) where+    return = pure+    (>>=) = bindAsync++------------------------------------------------------------------------------+-- 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)++------------------------------------------------------------------------------+-- WAsyncT+------------------------------------------------------------------------------++{-# INLINE wAsyncK #-}+wAsyncK :: MonadAsync m => Stream m a -> Stream m a -> Stream m a+wAsyncK = joinStreamVarAsync WAsyncVar++-- | XXX we can implement it more efficienty by directly implementing instead+-- of combining streams using wAsync.+{-# INLINE consMWAsync #-}+{-# SPECIALIZE consMWAsync :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}+consMWAsync :: MonadAsync m => m a -> WAsyncT m a -> WAsyncT m a+consMWAsync m (WAsyncT r) = WAsyncT $ wAsyncK (K.fromEffect m) r++-- | For 'WAsyncT' streams:+--+-- @+-- (<>) = 'Streamly.Prelude.wAsync'+-- (>>=) = flip . 'Streamly.Prelude.concatMapWith' 'Streamly.Prelude.wAsync'+-- @+--+-- A single 'Monad' bind behaves like a @for@ loop with iterations of the loop+-- executed concurrently a la the 'wAsync' combinator, producing results and+-- side effects of iterations out of order:+--+-- >>> :{+-- Stream.toList $ Stream.fromWAsync $ do+--      x <- Stream.fromList [2,1] -- foreach x in stream+--      Stream.fromEffect $ delay x+-- :}+-- 1 sec+-- 2 sec+-- [1,2]+--+-- Nested monad binds behave like nested @for@ loops with nested iterations+-- executed concurrently, a la the 'wAsync' combinator:+--+-- >>> :{+-- Stream.toList $ Stream.fromWAsync $ do+--     x <- Stream.fromList [1,2] -- foreach x in stream+--     y <- Stream.fromList [2,4] -- foreach y in stream+--     Stream.fromEffect $ delay (x + y)+-- :}+-- 3 sec+-- 4 sec+-- 5 sec+-- 6 sec+-- [3,4,5,6]+--+-- The behavior can be explained as follows. All the iterations corresponding+-- to the element @1@ in the first stream constitute one 'WAsyncT' output+-- stream and all the iterations corresponding to @2@ constitute another+-- 'WAsyncT' output stream and these two output streams are merged using+-- 'wAsync'.+--+-- The @W@ in the name stands for @wide@ or breadth wise scheduling in+-- contrast to the depth wise scheduling behavior of 'AsyncT'.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0++-- XXX This documentation is redundant, need to be cleaned up/removed.+--+-- @+-- import qualified "Streamly.Prelude" as S+-- import Control.Concurrent+--+-- main = (S.toList . S.'fromWAsync' . S.maxThreads 1 $ (S.fromList [1,2]) \<> (S.fromList [3,4])) >>= print+-- @+-- @+-- [1,3,2,4]+-- @+--+-- For this example, we are using @maxThreads 1@ so that concurrent thread+-- scheduling does not affect the results and make them unpredictable. Let's+-- now take a more general example:+--+-- @+-- main = (S.toList . S.'fromWAsync' . S.maxThreads 1 $ (S.fromList [1,2,3]) \<> (S.fromList [4,5,6]) \<> (S.fromList [7,8,9])) >>= print+-- @+-- @+-- [1,4,2,7,5,3,8,6,9]+-- @+--+-- This is how the execution of the above stream proceeds:+--+-- 1. The scheduler queue is initialized with @[S.fromList [1,2,3],+-- (S.fromList [4,5,6]) \<> (S.fromList [7,8,9])]@ assuming the head of the+-- queue is represented by the  rightmost item.+-- 2. @S.fromList [1,2,3]@ is executed, yielding the element @1@ and putting+-- @[2,3]@ at the back of the scheduler queue. The scheduler queue now looks+-- like @[(S.fromList [4,5,6]) \<> (S.fromList [7,8,9]), S.fromList [2,3]]@.+-- 3. Now @(S.fromList [4,5,6]) \<> (S.fromList [7,8,9])@ is picked up for+-- execution, @S.fromList [7,8,9]@ is added at the back of the queue and+-- @S.fromList [4,5,6]@ is executed, yielding the element @4@ and adding+-- @S.fromList [5,6]@ at the back of the queue. The queue now looks like+-- @[S.fromList [2,3], S.fromList [7,8,9], S.fromList [5,6]]@.+-- 4. Note that the scheduler queue expands by one more stream component in+-- every pass because one more @<>@ is broken down into two components. At this+-- point there are no more @<>@ operations to be broken down further and the+-- queue has reached its maximum size. Now these streams are scheduled in+-- round-robin fashion yielding @[2,7,5,3,8,6,9]@.+--+-- As we see above, in a right associated expression composed with @<>@, only+-- one @<>@ operation is broken down into two components in one execution,+-- therefore, if we have @n@ streams composed using @<>@ it will take @n@+-- scheduler passes to expand the whole expression.  By the time @n-th@+-- component is added to the scheduler queue, the first component would have+-- received @n@ scheduler passes.+--+-- Since all streams get interleaved, this operation is not suitable for+-- folding an infinite lazy container of infinite size streams.  However, if+-- the streams are small, the streams on the left may get finished before more+-- streams are added to the scheduler queue from the right side of the+-- expression, so it may be possible to fold an infinite lazy container of+-- streams. For example, if the streams are of size @n@ then at most @n@+-- streams would be in the scheduler queue at a time.+--+-- Note that 'WSerialT' and 'WAsyncT' differ in their scheduling behavior,+-- therefore the output of 'WAsyncT' even with a single thread of execution is+-- not the same as that of 'WSerialT' See notes in 'WSerialT' for details about+-- its scheduling behavior.+--+-- Any exceptions generated by a constituent stream are propagated to the+-- output stream. The output and exceptions from a single stream are guaranteed+-- to arrive in the same order in the resulting stream as they were generated+-- in the input stream. However, the relative ordering of elements from+-- different streams in the resulting stream can vary depending on scheduling+-- and generation delays.+--+-- Similarly, the 'Monad' instance of 'WAsyncT' runs /all/ iterations fairly+-- concurrently using a round robin scheduling.+--+-- @+-- main = S.'drain' . S.'fromWAsync' $ do+--     n <- return 3 \<\> return 2 \<\> return 1+--     S.fromEffect $ do+--          threadDelay (n * 1000000)+--          myThreadId >>= \\tid -> putStrLn (show tid ++ ": Delay " ++ show n)+-- @+-- @+-- ThreadId 40: Delay 1+-- ThreadId 39: Delay 2+-- ThreadId 38: Delay 3+-- @+--+newtype WAsyncT m a = WAsyncT {getWAsyncT :: Stream m a}++#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.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+type WAsync = WAsyncT IO++------------------------------------------------------------------------------+-- Semigroup+------------------------------------------------------------------------------++{-# INLINE wAppend #-}+{-# SPECIALIZE wAppend :: WAsyncT IO a -> WAsyncT IO a -> WAsyncT IO a #-}+wAppend :: MonadAsync m => WAsyncT m a -> WAsyncT m a -> WAsyncT m a+wAppend (WAsyncT m1) (WAsyncT m2) = WAsyncT $ wAsyncK m1 m2++instance MonadAsync m => Semigroup (WAsyncT m a) where+    (<>) = wAppend++------------------------------------------------------------------------------+-- Monoid+------------------------------------------------------------------------------++instance MonadAsync m => Monoid (WAsyncT m a) where+    mempty = WAsyncT K.nil+    mappend = (<>)++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++{-# INLINE apWAsync #-}+{-# SPECIALIZE apWAsync ::+    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 (K.fromPure . x1) m2+    in WAsyncT $ K.concatMapWith wAsyncK f m1++-- GHC: if we specify arguments in the definition of (<*>) we see a significant+-- performance degradation (~2x).+instance (Monad m, MonadAsync m) => Applicative (WAsyncT m) where+    pure = WAsyncT . K.fromPure+    (<*>) = apWAsync++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++-- GHC: if we change the implementation of bindWith with arguments in a+-- different order we see a significant performance degradation (~2x).+{-# INLINE bindWAsync #-}+{-# SPECIALIZE bindWAsync ::+    WAsyncT IO a -> (a -> WAsyncT IO b) -> WAsyncT IO b #-}+bindWAsync :: MonadAsync m => WAsyncT m a -> (a -> WAsyncT m b) -> WAsyncT m b+bindWAsync (WAsyncT m) f = WAsyncT $ K.bindWith wAsyncK m (getWAsyncT . f)++-- GHC: if we specify arguments in the definition of (>>=) we see a significant+-- performance degradation (~2x).+instance MonadAsync m => Monad (WAsyncT m) where+    return = pure+    (>>=) = bindWAsync++------------------------------------------------------------------------------+-- 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
@@ -0,0 +1,168 @@+------------------------------------------------------------------------------+-- CPP macros for common instances+------------------------------------------------------------------------------++-- XXX use template haskell instead and include Monoid and IsStream instances+-- as well.++#define MONADPARALLEL , MonadAsync m++#define MONAD_COMMON_INSTANCES(STREAM,CONSTRAINT)                             \+instance Monad m => Functor (STREAM m) where {                                \+    {-# INLINE fmap #-};                                                      \+    fmap f (STREAM m) =                                                       \+        STREAM $ D.toStreamK $ D.mapM (return . f) $ D.fromStreamK m;         \+    {-# INLINE (<$) #-};                                                      \+    (<$) =  fmap . const };                                                   \+                                                                              \+instance (MonadIO m CONSTRAINT) => MonadIO (STREAM m) where {                 \+    liftIO x = STREAM $ K.fromEffect $ liftIO x };                            \+                                                                              \+instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where {           \+    throwM x = STREAM $ K.fromEffect $ throwM x };                            \+                                                                              \+{- \+instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where {       \+    throwError = lift . throwError;                                           \+    catchError m h =                                                          \+        fromStream $ withCatchError (toStream m) (\e -> toStream $ h e) };  \+-} \+                                                                              \+instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where {     \+    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 = STREAM $ K.fromEffect get;                                          \+    {-# INLINE put #-}; \+    put x = STREAM $ K.fromEffect $ put x;                                    \+    {-# INLINE state #-}; \+    state k = STREAM $ K.fromEffect $ state k }++------------------------------------------------------------------------------+-- Lists+------------------------------------------------------------------------------++-- Serial streams can act like regular lists using the Identity monad++-- XXX Show instance is 10x slower compared to read, we can do much better.+-- The list show instance itself is really slow.++-- XXX The default definitions of "<" in the Ord instance etc. do not perform+-- well, because they do not get inlined. Need to add INLINE in Ord class in+-- base?++#define NFDATA1_INSTANCE(STREAM)                                              \+instance NFData1 (STREAM Identity) where {                                    \+    {-# INLINE liftRnf #-};                                                   \+    liftRnf f (STREAM xs) = runIdentity $ P.foldl' (\_ x -> f x) () xs}++#define LIST_INSTANCES(STREAM)                                                \+instance IsList (STREAM Identity a) where {                                   \+    type (Item (STREAM Identity a)) = a;                                      \+    {-# INLINE fromList #-};                                                  \+    fromList xs = STREAM $ P.fromList xs;                                     \+    {-# INLINE toList #-};                                                    \+    toList (STREAM xs) = runIdentity $ P.toList xs };                         \+                                                                              \+instance Eq a => Eq (STREAM Identity a) where {                               \+    {-# INLINE (==) #-};                                                      \+    (==) (STREAM xs) (STREAM ys) = runIdentity $ P.eqBy (==) xs ys };         \+                                                                              \+instance Ord a => Ord (STREAM Identity a) where {                             \+    {-# INLINE compare #-};                                                   \+    compare (STREAM xs) (STREAM ys) = runIdentity $ P.cmpBy compare xs ys;    \+    {-# INLINE (<) #-};                                                       \+    x <  y = case compare x y of { LT -> True;  _ -> False };                 \+    {-# INLINE (<=) #-};                                                      \+    x <= y = case compare x y of { GT -> False; _ -> True };                  \+    {-# INLINE (>) #-};                                                       \+    x >  y = case compare x y of { GT -> True;  _ -> False };                 \+    {-# INLINE (>=) #-};                                                      \+    x >= y = case compare x y of { LT -> False; _ -> True };                  \+    {-# INLINE max #-};                                                       \+    max x y = if x <= y then y else x;                                        \+    {-# INLINE min #-};                                                       \+    min x y = if x <= y then x else y; };                                     \+                                                                              \+instance Show a => Show (STREAM Identity a) where {                           \+    showsPrec p dl = showParen (p > 10) $                                     \+        showString "fromList " . shows (toList dl) };                         \+                                                                              \+instance Read a => Read (STREAM Identity a) where {                           \+    readPrec = parens $ prec 10 $ do {                                        \+        Ident "fromList" <- lexP;                                             \+        fromList <$> readPrec };                                              \+    readListPrec = readListPrecDefault };                                     \+                                                                              \+instance (a ~ Char) => IsString (STREAM Identity a) where {                   \+    {-# INLINE fromString #-};                                                \+    fromString xs = STREAM $ P.fromList xs };                                                \+                                                                              \+instance NFData a => NFData (STREAM Identity a) where {                       \+    {-# INLINE rnf #-};                                                       \+    rnf (STREAM xs) = runIdentity $ P.foldl' (\_ x -> rnf x) () xs};                        \++-------------------------------------------------------------------------------+-- Foldable+-------------------------------------------------------------------------------++-- The default Foldable instance has several issues:+-- 1) several definitions do not have INLINE on them, so we provide+--    re-implementations with INLINE pragmas.+-- 2) the definitions of sum/product/maximum/minimum are inefficient as they+--    use right folds, they cannot run in constant memory. We provide+--    implementations using strict left folds here.++#define FOLDABLE_INSTANCE(STREAM)                                             \+instance (Foldable m, Monad m) => Foldable (STREAM m) where {                 \+                                                                              \+    {-# INLINE foldMap #-};                                                   \+    foldMap f (STREAM xs) = fold $ P.foldr (mappend . f) mempty xs;           \+                                                                              \+    {-# INLINE foldr #-};                                                     \+    foldr f z t = appEndo (foldMap (Endo #. f) t) z;                          \+                                                                              \+    {-# INLINE foldl' #-};                                                    \+    foldl' f z0 xs = foldr f' id xs z0                                        \+        where {f' x k = oneShot $ \z -> k $! f z x};                          \+                                                                              \+    {-# INLINE length #-};                                                    \+    length = foldl' (\n _ -> n + 1) 0;                                        \+                                                                              \+    {-# INLINE elem #-};                                                      \+    elem = any . (==);                                                        \+                                                                              \+    {-# INLINE maximum #-};                                                   \+    maximum =                                                                 \+          fromMaybe (errorWithoutStackTrace "maximum: empty stream")        \+        . toMaybe                                                             \+        . foldl' getMax Nothing' where {                                      \+            getMax Nothing' x = Just' x;                                      \+            getMax (Just' mx) x = Just' $! max mx x };                        \+                                                                              \+    {-# INLINE minimum #-};                                                   \+    minimum =                                                                 \+          fromMaybe (errorWithoutStackTrace "minimum: empty stream")        \+        . toMaybe                                                             \+        . foldl' getMin Nothing' where {                                      \+            getMin Nothing' x = Just' x;                                      \+            getMin (Just' mn) x = Just' $! min mn x };                        \+                                                                              \+    {-# INLINE sum #-};                                                       \+    sum = foldl' (+) 0;                                                       \+                                                                              \+    {-# INLINE product #-};                                                   \+    product = foldl' (*) 1 }++-------------------------------------------------------------------------------+-- Traversable+-------------------------------------------------------------------------------++#define TRAVERSABLE_INSTANCE(STREAM)                                          \+instance Traversable (STREAM Identity) where {                                \+    {-# INLINE traverse #-};                                                  \+    traverse f (STREAM xs) =                                                  \+        fmap STREAM $ runIdentity $ P.foldr consA (pure mempty) xs            \+        where { consA x ys = liftA2 K.cons (f x) ys }}
+ src/Streamly/Internal/Data/Stream/IsStream.hs view
@@ -0,0 +1,56 @@+{-# 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   : 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  {-# 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+    , module Streamly.Internal.Data.Stream.IsStream.Transform+    , module Streamly.Internal.Data.Stream.IsStream.Expand+    , module Streamly.Internal.Data.Stream.IsStream.Reduce+    , 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 hiding (toStream)+import Streamly.Internal.Data.Stream.IsStream.Exception+import Streamly.Internal.Data.Stream.IsStream.Generate+import Streamly.Internal.Data.Stream.IsStream.Lift+import Streamly.Internal.Data.Stream.IsStream.Expand+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', 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
@@ -0,0 +1,236 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.Combinators+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.Stream.IsStream.Combinators {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    ( maxThreads+    , maxBuffer+    , maxYields+    , rate+    , avgRate+    , minRate+    , maxRate+    , constRate+    , inspectMode+    , printState+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Int (Int64)++import Streamly.Internal.Data.Stream.IsStream.Type+    (IsStream, mkStream, foldStreamShared)+import Streamly.Internal.Data.Stream.Serial (SerialT)+import Streamly.Internal.Data.StreamK (Stream)++import Streamly.Internal.Data.SVar++-------------------------------------------------------------------------------+-- Concurrency control+-------------------------------------------------------------------------------+--+-- XXX need to write these in direct style otherwise they will break fusion.+--+-- | Specify the maximum number of threads that can be spawned concurrently for+-- any concurrent combinator in a stream.+-- A value of 0 resets the thread limit to default, a negative value means+-- there is no limit. The default value is 1500. 'maxThreads' does not affect+-- 'ParallelT' streams as they can use unbounded number of threads.+--+-- 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.+--+-- /Since: 0.4.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE_NORMAL maxThreads #-}+maxThreads :: IsStream t => Int -> t m a -> t m a+maxThreads n m = mkStream $ \st stp sng yld ->+    foldStreamShared (setMaxThreads n st) stp sng yld m++{-+{-# RULES "maxThreadsSerial serial" maxThreads = maxThreadsSerial #-}+maxThreadsSerial :: Int -> SerialT m a -> SerialT m a+maxThreadsSerial _ = id+-}++-- | 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.+--+-- /Since: 0.4.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE_NORMAL maxBuffer #-}+maxBuffer :: IsStream t => Int -> t m a -> t m a+maxBuffer n m = mkStream $ \st stp sng yld ->+    foldStreamShared (setMaxBuffer n st) stp sng yld m++{-+{-# RULES "maxBuffer serial" maxBuffer = maxBufferSerial #-}+maxBufferSerial :: Int -> SerialT m a -> SerialT m a+maxBufferSerial _ = id+-}++-- | Specify the pull rate of a stream.+-- A 'Nothing' value resets the rate to default which is unlimited.  When the+-- rate is specified, concurrent production may be ramped up or down+-- automatically to achieve the specified yield rate. The specific behavior for+-- different styles of 'Rate' specifications is documented under 'Rate'.  The+-- effective maximum production rate achieved by a stream 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+--+-- /Since: 0.5.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE_NORMAL rate #-}+rate :: IsStream t => Maybe Rate -> t m a -> t m a+rate r m = mkStream $ \st stp sng yld ->+    case r of+        Just (Rate low goal _ _) | goal < low ->+            error "rate: Target rate cannot be lower than minimum rate."+        Just (Rate _ goal high _) | goal > high ->+            error "rate: Target rate cannot be greater than maximum rate."+        Just (Rate low _ high _) | low > high ->+            error "rate: Minimum rate cannot be greater than maximum rate."+        _ -> foldStreamShared (setStreamRate r st) stp sng yld m++-- XXX implement for serial streams as well, as a simple delay++{-+{-# RULES "rate serial" rate = yieldRateSerial #-}+yieldRateSerial :: Double -> SerialT m a -> SerialT m a+yieldRateSerial _ = id+-}++-- | 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.+--+-- /Since: 0.5.0 ("Streamly")/+--+-- @since 0.8.0+avgRate :: IsStream t => Double -> t m a -> t m a+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.+--+-- /Since: 0.5.0 ("Streamly")/+--+-- @since 0.8.0+minRate :: IsStream t => Double -> t m a -> t m a+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.+--+-- /Since: 0.5.0 ("Streamly")/+--+-- @since 0.8.0+maxRate :: IsStream t => Double -> t m a -> t m a+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.+--+-- /Since: 0.5.0 ("Streamly")/+--+-- @since 0.8.0+constRate :: IsStream t => Double -> t m a -> t m a+constRate r = rate (Just $ Rate r r r 0)++-- | Specify the average latency, in nanoseconds, of a single threaded action+-- in a concurrent composition. Streamly can measure the latencies, but that is+-- possible only after at least one task has completed. This combinator can be+-- used to provide a latency hint so that rate control using 'rate' can take+-- that into account right from the beginning. When not specified then a+-- default behavior is chosen which could be too slow or too fast, and would be+-- restricted by any other control parameters configured.+-- A value of 0 indicates default behavior, a negative value means there is no+-- limit i.e. zero latency.+-- This would normally be useful only in high latency and high throughput+-- cases.+--+{-# INLINE_NORMAL _serialLatency #-}+_serialLatency :: IsStream t => Int -> t m a -> t m a+_serialLatency n m = mkStream $ \st stp sng yld ->+    foldStreamShared (setStreamLatency n st) stp sng yld m++{-+{-# RULES "serialLatency serial" _serialLatency = serialLatencySerial #-}+serialLatencySerial :: Int -> SerialT m a -> SerialT m a+serialLatencySerial _ = id+-}++-- Stop concurrent dispatches after this limit. This is useful in API's like+-- "take" where we want to dispatch only upto the number of elements "take"+-- needs.  This value applies only to the immediate next level and is not+-- inherited by everything in enclosed scope.+{-# INLINE_NORMAL maxYields #-}+maxYields :: IsStream t => Maybe Int64 -> t m a -> t m a+maxYields n m = mkStream $ \st stp sng yld ->+    foldStreamShared (setYieldLimit n st) stp sng yld m++{-# RULES "maxYields serial" maxYields = maxYieldsSerial #-}+maxYieldsSerial :: Maybe Int64 -> SerialT m a -> SerialT m a+maxYieldsSerial _ = id++printState :: MonadIO m => State Stream m a -> m ()+printState st = liftIO $ do+    let msv = streamVar st+    case msv of+        Just sv -> dumpSVar sv >>= putStrLn+        Nothing -> putStrLn "No SVar"++-- | Print debug information about an SVar when the stream ends+--+-- /Pre-release/+--+inspectMode :: IsStream t => t m a -> t m a+inspectMode m = mkStream $ \st stp sng yld ->+     foldStreamShared (setInspectMode st) stp sng yld m
+ src/Streamly/Internal/Data/Stream/IsStream/Common.hs view
@@ -0,0 +1,748 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans  #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.IsStream.Common+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Bottom level IsStream module that can be used by all other upper level+-- IsStream modules.++module Streamly.Internal.Data.Stream.IsStream.Common {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * Generation+      fromPure+    , fromEffect+    , repeatM+    , timesWith+    , absTimesWith+    , relTimesWith++    -- * Elimination+    , foldContinue+    , fold++    -- * Transformation+    , map+    , scanlMAfter'+    , postscanlMAfter'+    , postscanlM'+    , smapM+    , foldManyPost+    -- $smapM_Notes+    , take+    , takeWhile+    , takeEndBy+    , drop+    , findIndices+    , intersperseM+    , interjectSuffix+    , reverse+    , reverse'++    -- * Concurrent+    , mkAsync+    , mkParallel+    , parallelFst++    -- * Nesting+    , concatM+    , concatMapM+    , concatMap+    , splitOnSeq++    -- * Zipping+    , zipWithM+    , zipWith++    -- * Deprecated+    , yield+    , yieldM+    )+where++#include "inline.hs"++import Control.Concurrent (threadDelay)+import Control.Monad.IO.Class (MonadIO(..))+import Foreign.Storable (Storable)+import Streamly.Internal.Control.Concurrent (MonadAsync)+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)+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 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.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)+-- >>> import Data.Function (fix, (&))+-- >>> import Data.Semigroup (cycle1)+-- >>> import Prelude hiding (take, takeWhile, drop, reverse)+-- >>> import System.IO.Unsafe (unsafePerformIO)+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Streamly.Internal.Data.Stream.IsStream as Stream+-- >>> 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++------------------------------------------------------------------------------+-- Generation+------------------------------------------------------------------------------++-- Faster than fromEffect because there is no bind.+--+-- |+-- @+-- fromPure a = a \`cons` nil+-- @+--+-- Create a singleton stream from a pure value.+--+-- The following holds in monadic streams, but not in Zip streams:+--+-- @+-- fromPure = pure+-- fromPure = fromEffect . pure+-- @+--+-- In Zip applicative streams 'fromPure' is not the same as 'pure' because in that+-- case 'pure' is equivalent to 'repeat' instead. 'fromPure' and 'pure' are+-- equally efficient, in other cases 'fromPure' may be slightly more efficient+-- than the other equivalent definitions.+--+-- /Since: 0.8.0 (Renamed yield to fromPure)/+--+{-# INLINE fromPure #-}+fromPure :: IsStream t => a -> t m a+fromPure = fromStream . K.fromPure++-- | Same as 'fromPure'+--+-- @since 0.4.0+{-# DEPRECATED yield "Please use fromPure instead." #-}+{-# INLINE yield #-}+yield :: IsStream t => a -> t m a+yield = fromPure++-- |+-- @+-- fromEffect m = m \`consM` nil+-- @+--+-- Create a singleton stream from a monadic action.+--+-- @+-- > Stream.toList $ Stream.fromEffect getLine+-- hello+-- ["hello"]+-- @+--+-- /Since: 0.8.0 (Renamed yieldM to fromEffect)/+--+{-# INLINE fromEffect #-}+fromEffect :: (Monad m, IsStream t) => m a -> t m a+fromEffect = fromStream . K.fromEffect++-- | Same as 'fromEffect'+--+-- @since 0.4.0+{-# DEPRECATED yieldM "Please use fromEffect instead." #-}+{-# INLINE yieldM #-}+yieldM :: (Monad m, IsStream t) => m a -> t m a+yieldM = fromEffect+-- |+-- >>> repeatM = fix . consM+-- >>> repeatM = cycle1 . fromEffect+--+-- Generate a stream by repeatedly executing a monadic action forever.+--+-- >>> :{+-- repeatAsync =+--        Stream.repeatM (threadDelay 1000000 >> print 1)+--      & Stream.take 10+--      & Stream.fromAsync+--      & Stream.drain+-- :}+--+-- /Concurrent, infinite (do not use with 'fromParallel')/+--+-- @since 0.2.0+{-# INLINE_EARLY repeatM #-}+repeatM :: (IsStream t, MonadAsync m) => m a -> t m a+repeatM = K.repeatMWith IsStream.consM++{-# RULES "repeatM serial" repeatM = repeatMSerial #-}+{-# INLINE repeatMSerial #-}+repeatMSerial :: MonadAsync m => m a -> SerialT m a+repeatMSerial = fromStreamD . D.repeatM++------------------------------------------------------------------------------+-- Generation - Time related+------------------------------------------------------------------------------++-- | @timesWith g@ returns a stream of time value tuples. The first component+-- of the tuple is an absolute time reference (epoch) denoting the start of the+-- stream and the second component is a time relative to the reference.+--+-- The argument @g@ specifies the granularity of the relative time in seconds.+-- A lower granularity clock gives higher precision but is more expensive in+-- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.+--+-- >>> import Control.Concurrent (threadDelay)+-- >>> import Streamly.Internal.Data.Stream.IsStream.Common as Stream (timesWith)+-- >>> Stream.mapM_ (\x -> print x >> threadDelay 1000000) $ Stream.take 3 $ Stream.timesWith 0.01+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE timesWith #-}+timesWith :: (IsStream t, MonadAsync m) => Double -> t m (AbsTime, RelTime64)+timesWith g = fromStreamD $ D.timesWith g++-- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of+-- granularity @g@ specified in seconds. A low granularity clock is more+-- expensive in terms of CPU usage.  Any granularity lower than 1 ms is treated+-- as 1 ms.+--+-- >>> Stream.mapM_ print $ Stream.delayPre 1 $ Stream.take 3 $ absTimesWith 0.01+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE absTimesWith #-}+absTimesWith :: (IsStream t, MonadAsync m, Functor (t m))+    => Double -> t m AbsTime+absTimesWith = fmap (uncurry addToAbsTime64) . timesWith++-- | @relTimesWith g@ returns a stream of relative time values starting from 0,+-- using a clock of granularity @g@ specified in seconds. A low granularity+-- clock is more expensive in terms of CPU usage.  Any granularity lower than 1+-- ms is treated as 1 ms.+--+-- >>> Stream.mapM_ print $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimesWith 0.01+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE relTimesWith #-}+relTimesWith :: (IsStream t, MonadAsync m, Functor (t m))+    => Double -> t m RelTime64+relTimesWith = fmap snd . timesWith++------------------------------------------------------------------------------+-- Elimination - Running a 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.foldContinue Fold.sum+--+-- > fold f = Fold.extractM . Stream.foldContinue f+--+-- /Internal/+{-# 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+-- 'Fold' can terminate early without consuming the full stream. See the+-- documentation of individual 'Fold's for termination behavior.+--+-- >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100)+-- 5050+--+-- Folds never fail, therefore, they produce a default value even when no input+-- is provided. It means we can always fold an empty stream and get a valid+-- result.  For example:+--+-- >>> Stream.fold Fold.sum Stream.nil+-- 0+--+-- However, 'foldMany' on an empty stream results in an empty stream.+-- Therefore, @Stream.fold f@ is not the same as @Stream.head . Stream.foldMany+-- f@.+--+-- @fold f = Stream.parse (Parser.fromFold f)@+--+-- @since 0.7.0+{-# INLINE fold #-}+fold :: Monad m => Fold m a b -> SerialT m a -> m b+fold fl strm = D.fold fl $ IsStream.toStreamD strm++------------------------------------------------------------------------------+-- Transformation+------------------------------------------------------------------------------++-- |+-- @+-- map = fmap+-- @+--+-- Same as 'fmap'.+--+-- @+-- > D.toList $ D.map (+1) $ D.fromList [1,2,3]+-- [2,3,4]+-- @+--+-- @since 0.4.0+{-# INLINE map #-}+map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b+map f = fromStreamD . D.map f . toStreamD++-- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except+-- that it provides an additional @done@ function to be applied on the+-- accumulator when the stream stops. The result of @done@ is also emitted in+-- the stream.+--+-- This function can be used to allocate a resource in the beginning of the+-- scan and release it when the stream ends or to flush the internal state of+-- the scan at the end.+--+-- /Pre-release/+--+{-# INLINE scanlMAfter' #-}+scanlMAfter' :: (IsStream t, Monad m)+    => (b -> a -> m b) -> m b -> (b -> m b) -> t m a -> t m b+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.+--+-- >>> postscanlM' f z xs = Stream.drop 1 $ Stream.scanlM' f z xs+--+-- /Since: 0.7.0/+--+-- /Since: 0.8.0 (signature change)/+{-# INLINE postscanlM' #-}+postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b+postscanlM' step z m = fromStreamD $ D.postscanlM' step z $ toStreamD m++-- $smapM_Notes+--+-- The stateful step function can be simplified to @(s -> a -> m b)@ to provide+-- a read-only environment. However, that would just be 'mapM'.+--+-- The initial action could be @m (s, Maybe b)@, and we can also add a final+-- action @s -> m (Maybe b)@. This can be used to get pre/post scan like+-- functionality and also to flush the state in the end like scanlMAfter'.+-- We can also use it along with a fusible version of bracket to get+-- scanlMAfter' like functionality. See issue #677.+--+-- This can be further generalized to a type similar to Fold/Parser, giving it+-- filtering and parsing capability as well (this is in fact equivalent to+-- parseMany):+--+-- smapM :: (s -> a -> m (Step s b)) -> m s -> t m a -> t m b+--++-- | A stateful 'mapM', equivalent to a left scan, more like mapAccumL.+-- Hopefully, this is a better alternative to @scan@. Separation of state from+-- the output makes it easier to think in terms of a shared state, and also+-- makes it easier to keep the state fully strict and the output lazy.+--+-- See also: 'scanlM''+--+-- /Pre-release/+--+{-# INLINE smapM #-}+smapM :: (IsStream t, Monad m) =>+       (s -> a -> m (s, b))+    -> m s+    -> t m a+    -> t m b+smapM step initial stream =+    -- XXX implement this directly instead of using scanlM'+    -- Once we have postscanlM' with monadic initial we can use this code+    -- let r = postscanlM'+    --              (\(s, _) a -> step s a)+    --              (fmap (,undefined) initial)+    --              stream+    let r = postscanlM'+                (\(s, _) a -> step s a)+                (fmap (,undefined) initial)+                stream+     in map snd r++------------------------------------------------------------------------------+-- Transformation - Trimming+------------------------------------------------------------------------------++-- | Take first 'n' elements from the stream and discard the rest.+--+-- @since 0.1.0+{-# INLINE take #-}+take :: (IsStream t, Monad m) => Int -> t m a -> t m a+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.+--+-- @since 0.1.0+{-# INLINE takeWhile #-}+takeWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a+takeWhile p m = fromStreamD $ D.takeWhile p $ toStreamD m++{-# INLINE takeEndBy #-}+takeEndBy :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a+takeEndBy p m = fromStreamD $ D.takeEndBy p $ toStreamD m++-- | Discard first 'n' elements from the stream and take the rest.+--+-- @since 0.1.0+{-# INLINE drop #-}+drop :: (IsStream t, Monad m) => Int -> t m a -> t m a+drop n m = fromStreamD $ D.drop n $ toStreamD m++------------------------------------------------------------------------------+-- Searching+------------------------------------------------------------------------------++-- | Find all the indices where the element in the stream satisfies the given+-- predicate.+--+-- > findIndices = fold Fold.findIndices+--+-- @since 0.5.0+{-# INLINE findIndices #-}+findIndices :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m Int+findIndices p m = fromStreamD $ D.findIndices p (toStreamD m)++------------------------------------------------------------------------------+-- Transformation by Inserting+------------------------------------------------------------------------------++-- intersperseM = intersperseMWith 1++-- | Insert an effect and its output before consuming an element of a stream+-- except the first one.+--+-- >>> Stream.toList $ Stream.trace putChar $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.fromList "hello"+-- h.,e.,l.,l.,o"h,e,l,l,o"+--+-- Be careful about the order of effects. In the above example we used trace+-- after the intersperse, if we use it before the intersperse the output would+-- be he.l.l.o."h,e,l,l,o".+--+-- >>> Stream.toList $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.trace putChar $ Stream.fromList "hello"+-- he.l.l.o."h,e,l,l,o"+--+-- @since 0.5.0+{-# INLINE intersperseM #-}+intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a+intersperseM m = fromStreamD . D.intersperseM m . toStreamD++-- | Intersperse a monadic action into the input stream after every @n@+-- seconds.+--+-- @+-- > import Control.Concurrent (threadDelay)+-- > Stream.drain $ Stream.interjectSuffix 1 (putChar ',') $ Stream.mapM (\x -> threadDelay 1000000 >> putChar x) $ Stream.fromList "hello"+-- h,e,l,l,o+-- @+--+-- /Pre-release/+{-# INLINE interjectSuffix #-}+interjectSuffix+    :: (IsStream t, MonadAsync m)+    => Double -> m a -> t m a -> t m a+interjectSuffix n f xs = xs `parallelFst` repeatM timed+    where timed = liftIO (threadDelay (round $ n * 1000000)) >> f++------------------------------------------------------------------------------+-- Transformation by Reordering+------------------------------------------------------------------------------++-- XXX Use a compact region list to temporarily store the list, in both reverse+-- as well as in reverse'.+--+-- /Note:/ 'reverse'' is much faster than this, use that when performance+-- matters.+--+-- | Returns the elements of the stream in reverse order.  The stream must be+-- finite. Note that this necessarily buffers the entire stream in memory.+--+-- >>> reverse = Stream.foldlT (flip Stream.cons) Stream.nil+--+-- /Since 0.7.0 (Monad m constraint)/+--+-- /Since: 0.1.1/+{-# INLINE reverse #-}+reverse :: (IsStream t, Monad m) => t m a -> t m a+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, Unbox a) => t m a -> t m a+-- reverse' s = fromStreamD $ D.reverse' $ toStreamD s+reverse' =+        fromStreamD+        . A.concatRev -- unfoldMany A.readerRev+        . D.fromStreamK+        . K.reverse+        . D.toStreamK+        . A.chunksOf defaultChunkSize+        . toStreamD++------------------------------------------------------------------------------+-- Concurrent Transformations and Combining+------------------------------------------------------------------------------++-- | Make the stream producer and consumer run concurrently by introducing a+-- buffer between them. The producer thread evaluates the input stream until+-- the buffer fills, it terminates if the buffer is full and a worker thread is+-- kicked off again to evaluate the remaining stream when there is space in the+-- buffer.  The consumer consumes the stream lazily from the buffer.+--+-- /Since: 0.2.0 (Streamly)/+--+-- @since 0.8.0+--+{-# INLINE_NORMAL mkAsync #-}+mkAsync :: (IsStream t, MonadAsync m) => t m a -> t m a+mkAsync = fromStreamD . Async.mkAsyncD . toStreamD++-- Compare with mkAsync. mkAsync uses an Async style SVar whereas this uses a+-- parallel style SVar for evaluation. Currently, parallel style cannot use+-- rate control whereas Async style can use rate control. In async style SVar+-- the worker thread terminates when the buffer is full whereas in Parallel+-- style it blocks.+--+-- | Make the stream producer and consumer run concurrently by introducing a+-- buffer between them. The producer thread evaluates the input stream until+-- the buffer fills, it blocks if the buffer is full until there is space in+-- the buffer. The consumer consumes the stream lazily from the buffer.+--+-- @mkParallel = IsStream.fromStreamD . mkParallelD . IsStream.toStreamD@+--+-- /Pre-release/+--+{-# INLINE_NORMAL mkParallel #-}+mkParallel :: (IsStream t, MonadAsync m) => t m a -> t m a+mkParallel = fromStreamD . Par.mkParallelD . toStreamD++-- | Like `parallel` but stops the output as soon as the first stream stops.+--+-- /Pre-release/+{-# INLINE parallelFst #-}+parallelFst :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+parallelFst m1 m2 = fromStream $ Par.parallelFstK (toStream m1) (toStream m2)++------------------------------------------------------------------------------+-- Combine streams and flatten+------------------------------------------------------------------------------++-- | Map a stream producing monadic function on each element of the stream+-- and then flatten the results into a single stream. Since the stream+-- generation function is monadic, unlike 'concatMap', it can produce an+-- effect at the beginning of each iteration of the inner loop.+--+-- @since 0.6.0+{-# INLINE concatMapM #-}+concatMapM :: (IsStream t, Monad m) => (a -> m (t m b)) -> t m a -> t m b+concatMapM f m = fromStreamD $ D.concatMapM (fmap toStreamD . f) (toStreamD m)++-- | Map a stream producing function on each element of the stream and then+-- flatten the results into a single stream.+--+-- >>> concatMap f = Stream.concatMapM (return . f)+-- >>> concatMap f = Stream.concatMapWith Stream.serial f+-- >>> concatMap f = Stream.concat . Stream.map f+--+-- @since 0.6.0+{-# INLINE concatMap #-}+concatMap ::(IsStream t, Monad m) => (a -> t m b) -> t m a -> t m b+concatMap f m = fromStreamD $ D.concatMap (toStreamD . f) (toStreamD m)++-- | Given a stream value in the underlying monad, lift and join the underlying+-- monad with the stream monad.+--+-- >>> concatM = Stream.concat . Stream.fromEffect+-- >>> concatM = Stream.concat . lift    -- requires (MonadTrans t)+-- >>> concatM = join . lift             -- requires (MonadTrans t, Monad (t m))+--+-- See also: 'concat', 'sequence'+--+--  /Internal/+--+{-# INLINE concatM #-}+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+------------------------------------------------------------------------------++-- $+-- > intercalate . splitOnSeq == id+-- prop> (\f -> unsafePerformIO . Stream.toList . f . Stream.fromList) (Stream.intercalate Unfold.fromList " " .  Stream.splitOnSeq (Array.fromList " ") Fold.toList) xs == xs++-- | Like 'splitOn' but the separator is a sequence of elements instead of a+-- single element.+--+-- For illustration, let's define a function that operates on pure lists:+--+-- >>> splitOnSeq' pat xs = Stream.toList $ Stream.splitOnSeq (Array.fromList pat) Fold.toList (Stream.fromList xs)+--+-- >>> splitOnSeq' "" "hello"+-- ["h","e","l","l","o"]+--+-- >>> splitOnSeq' "hello" ""+-- []+--+-- >>> splitOnSeq' "hello" "hello"+-- ["",""]+--+-- >>> splitOnSeq' "x" "hello"+-- ["hello"]+--+-- >>> splitOnSeq' "h" "hello"+-- ["","ello"]+--+-- >>> splitOnSeq' "o" "hello"+-- ["hell",""]+--+-- >>> splitOnSeq' "e" "hello"+-- ["h","llo"]+--+-- >>> splitOnSeq' "l" "hello"+-- ["he","","o"]+--+-- >>> splitOnSeq' "ll" "hello"+-- ["he","o"]+--+-- 'splitOnSeq' is an inverse of 'intercalate'. The following law always holds:+--+-- > intercalate . splitOnSeq == id+--+-- The following law holds when the separator is non-empty and contains none of+-- the elements present in the input lists:+--+-- > 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+-- sequence, that way we can avoid the Storable constraint. If we still need+-- Storable Array for performance, we can use a separate splitOnArray API for+-- that. We can also have an API where the sequence itself is a lazy stream, so+-- that we can search files in files for example.+{-# INLINE splitOnSeq #-}+splitOnSeq+    :: (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+------------------------------------------------------------------------------++-- | Like 'zipWith' but using a monadic zipping function.+--+-- @since 0.4.0+{-# 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.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+-- result @c@ is yielded to the consumer.+--+-- If stream @a@ or stream @b@ ends, the zipped stream ends. If stream @b@ ends+-- first, the element @a@ from previous evaluation of stream @a@ is discarded.+--+-- @+-- > D.toList $ D.zipWith (+) (D.fromList [1,2,3]) (D.fromList [4,5,6])+-- [5,7,9]+-- @+--+-- @since 0.1.0+{-# INLINE zipWith #-}+zipWith :: (IsStream t, Monad m) => (a -> b -> c) -> t m a -> t m b -> t m c+zipWith f m1 m2 =+    IsStream.fromStreamD+        $ D.zipWith f (IsStream.toStreamD m1) (IsStream.toStreamD m2)
+ src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs view
@@ -0,0 +1,1035 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.IsStream.Eliminate+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- This module contains functions ending in the shape:+--+-- @+-- t m a -> m b+-- @+--+-- 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 {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * Running Examples+    -- $setup++    -- * Running a 'Fold'+    --  See "Streamly.Internal.Data.Fold".+      fold++    -- * Running a 'Parser'+    -- "Streamly.Internal.Data.Parser".+    , parse+    -- , parseK+    , parseD++    -- * Stream Deconstruction+    -- | foldr and foldl do not provide the remaining stream.  'uncons' is more+    -- general, as it can be used to implement those as well.  It allows to use+    -- the stream one element at a time, and we have the remaining stream all+    -- the time.+    , uncons++    -- * Right Folds+    , foldrM+    , foldr++    -- * Left Folds+    -- Lazy left folds are useful only for reversing the stream+    , foldlS+    , foldlT++    , foldl'+    , foldl1'+    , foldlM'++    -- * Specific Fold Functions+    -- | Folds as functions of the shape @t m a -> m b@.+    --+    -- These functions are good to run individually but they do not compose+    -- well. Prefer writing folds as the 'Fold' data type. Use folds from+    -- "Streamly.Internal.Data.Fold" instead of using the functions in this+    -- section.+    --+    -- This section can possibly be removed in future.  Are these better in+    -- some case compared to 'Fold'? When the input stream is in CPS style+    -- (StreamK) we may want to rewrite the function call to CPS implementation+    -- of the fold through these definitions. Will that be more efficient for+    -- StreamK?++    -- ** Full Folds++    -- -- ** To Summary (Full Folds)+    , mapM_+    , drain+    , last+    , length+    , sum+    , product+    , mconcat++    -- -- ** To Summary (Maybe) (Full Folds)+    , maximumBy+    , maximum+    , minimumBy+    , minimum+    , the++    -- ** Partial Folds++    -- -- ** To Elements (Partial Folds)+    , drainN+    , drainWhile++    -- -- | Folds that extract selected elements of a stream or their properties.+    , (!!)+    , head+    , headElse+    , tail+    , init+    , findM+    , find+    , findIndex+    , elemIndex+    , lookup++    -- -- ** To Boolean (Partial Folds)+    , null+    , elem+    , notElem+    , all+    , any+    , and+    , or++    -- -- ** Lazy Folds+    -- ** To Containers+    , toList+    , toListRev+    , toStream+    , toStreamRev++    -- * Concurrent Folds+    , foldAsync+    , (|$.)+    , (|&.)++    -- * Multi-Stream folds+    -- Full equivalence+    , eqBy+    , cmpBy++    -- finding subsequences+    , isPrefixOf+    , isInfixOf+    , isSuffixOf+    , isSubsequenceOf++    -- trimming sequences+    , stripPrefix+    -- , stripInfix+    , stripSuffix++    -- * Deprecated+    , foldx+    , foldxM+    , foldr1+    , runStream+    , runN+    , runWhile+    , toHandle+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Trans.Class (MonadTrans(..))+import Foreign.Storable (Storable)+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Parser (Parser (..))+import Streamly.Internal.Data.SVar (defState)+import Streamly.Internal.Data.Stream.IsStream.Common+    ( fold, drop, findIndices, reverse, splitOnSeq+    , take , takeWhile, mkParallel)+import Streamly.Internal.Data.Stream.IsStream.Type+    (IsStream, fromStreamD, toStreamD)+import Streamly.Internal.Data.Stream.Serial (SerialT)+import Streamly.Data.MutByteArray (Unbox)++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 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++import Prelude hiding+       ( 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.Internal.Data.Fold as Fold++------------------------------------------------------------------------------+-- Deconstruction+------------------------------------------------------------------------------++-- | Decompose a stream into its head and tail. If the stream is empty, returns+-- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is+-- the head of the stream and @ma@ its tail.+--+-- 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,+-- 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 = fmap (fmap (fmap IsStream.fromStream)) . K.uncons . Stream.toStreamK++------------------------------------------------------------------------------+-- Right Folds+------------------------------------------------------------------------------++-- | Right associative/lazy pull fold. @foldrM build final stream@ constructs+-- an output structure using the step function @build@. @build@ is invoked with+-- the next input element and the remaining (lazy) tail of the output+-- structure. It builds a lazy output expression using the two. When the "tail+-- structure" in the output expression is evaluated it calls @build@ again thus+-- lazily consuming the input @stream@ until either the output expression built+-- by @build@ is free of the "tail" or the input is exhausted in which case+-- @final@ is used as the terminating case for the output structure. For more+-- details see the description in the previous section.+--+-- Example, determine if any element is 'odd' in a stream:+--+-- >>> Stream.foldrM (\x xs -> if odd x then return True else xs) (return False) $ Stream.fromList (2:4:5:undefined)+-- True+--+-- /Since: 0.7.0 (signature changed)/+--+-- /Since: 0.2.0 (signature changed)/+--+-- /Since: 0.1.0/+{-# INLINE foldrM #-}+foldrM :: Monad m => (a -> m b -> m b) -> m b -> SerialT m a -> m b+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.+--+-- Please avoid using this routine in strict monads like IO unless you need a+-- strict right fold. This is provided only for use in lazy monads (e.g.+-- Identity) or pure streams. Note that with this signature it is not possible+-- to implement a lazy foldr when the monad @m@ is strict. In that case it+-- would be strict in its accumulator and therefore would necessarily consume+-- all its input.+--+-- @since 0.1.0+{-# INLINE foldr #-}+foldr :: Monad m => (a -> b -> b) -> b -> SerialT m a -> m b+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.+--+-- | Lazy right fold for non-empty streams, using first element as the starting+-- value. Returns 'Nothing' if the stream is empty.+--+-- @since 0.5.0+{-# INLINE foldr1 #-}+{-# DEPRECATED foldr1 "Use foldrM instead." #-}+foldr1 :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)+foldr1 f m = D.foldr1 f (toStreamD m)++------------------------------------------------------------------------------+-- Left Folds+------------------------------------------------------------------------------++-- | Lazy left fold to a stream.+{-# INLINE foldlS #-}+foldlS :: IsStream t => (t m b -> a -> t m b) -> t m b -> t m a -> t m b+foldlS f z =+    IsStream.fromStream+        . K.foldlS+            (\xs x -> IsStream.toStream $ f (IsStream.fromStream xs) x)+            (IsStream.toStream z)+        . IsStream.toStream++-- | Lazy left fold to a transformer monad.+--+-- For example, to reverse a stream:+--+-- > 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 = 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+-- 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.2.0+{-# DEPRECATED foldx "Please use foldl' followed by fmap instead." #-}+{-# INLINE foldx #-}+foldx :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b+foldx = IsStream.foldlx'++-- | Left associative/strict push fold. @foldl' reduce initial stream@ invokes+-- @reduce@ with the accumulator and the next input in the input stream, using+-- @initial@ as the initial value of the current value of the accumulator. When+-- the input is exhausted the current value of the accumulator is returned.+-- Make sure to use a strict data structure for accumulator to not build+-- unnecessary lazy expressions unless that's what you want. See the previous+-- section for more details.+--+-- @since 0.2.0+{-# INLINE foldl' #-}+foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b+foldl' = IsStream.foldl'++-- | Strict left fold, for non-empty streams, using first element as the+-- starting value. Returns 'Nothing' if the stream is empty.+--+-- @since 0.5.0+{-# INLINE foldl1' #-}+foldl1' :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)+foldl1' step m = do+    r <- uncons m+    case r of+        Nothing -> return Nothing+        Just (h, t) -> do+            res <- foldl' step h t+            return $ Just res++-- | Like 'foldx', but with a monadic step function.+--+-- @since 0.2.0+{-# DEPRECATED foldxM "Please use foldlM' followed by fmap instead." #-}+{-# INLINE foldxM #-}+foldxM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b+foldxM = IsStream.foldlMx'++-- | Like 'foldl'' but with a monadic step function.+--+-- /Since: 0.2.0/+--+-- /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 = D.foldlM' step begin . IsStream.toStreamD++------------------------------------------------------------------------------+-- Running a sink+------------------------------------------------------------------------------++{-+-- | Drain a stream to a 'Sink'.+{-# INLINE runSink #-}+runSink :: Monad m => Sink m a -> SerialT m a -> m ()+runSink = fold . toFold+-}++------------------------------------------------------------------------------+-- Running a Parser+------------------------------------------------------------------------------++-- | Parse a stream using the supplied ParserD 'PRD.Parser'.+--+-- /Internal/+--+{-# INLINE_NORMAL parseD #-}+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 :: 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'.+--+-- Unlike folds, parsers may not always result in a valid output, they may+-- result in an error.  For example:+--+-- >>> Stream.parse (Parser.takeEQ 1 Fold.drain) Stream.nil+-- Left (ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0")+--+-- Note:+--+-- @+-- fold f = Stream.parse (Parser.fromFold f)+-- @+--+-- @parse p@ is not the same as  @head . parseMany p@ on an empty stream.+--+-- /Pre-release/+--+{-# INLINE [3] parse #-}+parse :: Monad m => Parser a m b -> SerialT m a -> m (Either PRD.ParseError b)+parse = parseD++------------------------------------------------------------------------------+-- Specific Fold Functions+------------------------------------------------------------------------------++-- XXX this can utilize parallel mapping if we implement it as drain . mapM+-- |+-- > mapM_ = Stream.drain . Stream.mapM+--+-- Apply a monadic action to each element of the stream and discard the output+-- of the action. This is not really a pure transformation operation but a+-- transformation followed by fold.+--+-- @since 0.1.0+{-# INLINE mapM_ #-}+mapM_ :: Monad m => (a -> m b) -> SerialT m a -> m ()+mapM_ f = D.mapM_ f . IsStream.toStreamD++-- |+-- > drain = mapM_ (\_ -> return ())+-- > drain = Stream.fold Fold.drain+--+-- Run a stream, discarding the results. By default it interprets the stream+-- as 'SerialT', to run other types of streams use the type adapting+-- combinators for example @Stream.drain . 'fromAsync'@.+--+-- @since 0.7.0+{-# INLINE drain #-}+drain :: Monad m => SerialT m a -> m ()+drain = IsStream.drain++-- |+-- > drainN n = Stream.drain . Stream.take n+-- > drainN n = Stream.fold (Fold.take n Fold.drain)+--+-- Run maximum up to @n@ iterations of a stream.+--+-- @since 0.7.0+{-# INLINE drainN #-}+drainN :: Monad m => Int -> SerialT m a -> m ()+drainN n = drain . take n++-- |+-- > runN n = runStream . take n+--+-- Run maximum up to @n@ iterations of a stream.+--+-- @since 0.6.0+{-# DEPRECATED runN "Please use \"drainN\" instead" #-}+{-# INLINE runN #-}+runN :: Monad m => Int -> SerialT m a -> m ()+runN = drainN++-- |+-- > drainWhile p = Stream.drain . Stream.takeWhile p+--+-- Run a stream as long as the predicate holds true.+--+-- @since 0.7.0+{-# INLINE drainWhile #-}+drainWhile :: Monad m => (a -> Bool) -> SerialT m a -> m ()+drainWhile p = drain . takeWhile p++-- |+-- > runWhile p = runStream . takeWhile p+--+-- Run a stream as long as the predicate holds true.+--+-- @since 0.6.0+{-# DEPRECATED runWhile "Please use \"drainWhile\" instead" #-}+{-# INLINE runWhile #-}+runWhile :: Monad m => (a -> Bool) -> SerialT m a -> m ()+runWhile = drainWhile++-- | Run a stream, discarding the results. By default it interprets the stream+-- as 'SerialT', to run other types of streams use the type adapting+-- combinators for example @runStream . 'fromAsync'@.+--+-- @since 0.2.0+{-# DEPRECATED runStream "Please use \"drain\" instead" #-}+{-# INLINE runStream #-}+runStream :: Monad m => SerialT m a -> m ()+runStream = drain++-- | Determine whether the stream is empty.+--+-- > null = Stream.fold Fold.null+--+-- @since 0.1.1+{-# INLINE null #-}+null :: Monad m => SerialT m a -> m Bool+null = D.null . toStreamD++-- | Extract the first element of the stream, if any.+--+-- > head = (!! 0)+-- > head = Stream.fold Fold.one+--+-- @since 0.1.0+{-# INLINE head #-}+head :: Monad m => SerialT m a -> m (Maybe a)+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+-- code.+--+-- /Pre-release/+{-# INLINE headElse #-}+headElse :: Monad m => a -> SerialT m a -> m a+headElse x = D.headElse x . toStreamD++-- |+-- > tail = fmap (fmap snd) . Stream.uncons+--+-- Extract all but the first element of the stream, if any.+--+-- @since 0.1.1+{-# INLINE tail #-}+tail :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))+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 m = fmap (fmap IsStream.fromStream) $ K.init $ Stream.toStreamK m++-- | Extract the last element of the stream, if any.+--+-- > last xs = xs !! (Stream.length xs - 1)+-- > last = Stream.fold Fold.last+--+-- @since 0.1.1+{-# INLINE last #-}+last :: Monad m => SerialT m a -> m (Maybe a)+last m = D.last $ toStreamD m++-- | Determine whether an element is present in the stream.+--+-- > elem = Stream.fold Fold.elem+--+-- @since 0.1.0+{-# INLINE elem #-}+elem :: (Monad m, Eq a) => a -> SerialT m a -> m Bool+elem e m = D.elem e (toStreamD m)++-- | Determine whether an element is not present in the stream.+--+-- > notElem = Stream.fold Fold.length+--+-- @since 0.1.0+{-# INLINE notElem #-}+notElem :: (Monad m, Eq a) => a -> SerialT m a -> m Bool+notElem e m = D.notElem e (toStreamD m)++-- | Determine the length of the stream.+--+-- @since 0.1.0+{-# INLINE length #-}+length :: Monad m => SerialT m a -> m Int+length = foldl' (\n _ -> n + 1) 0++-- | Determine whether all elements of a stream satisfy a predicate.+--+-- > all = Stream.fold Fold.all+--+-- @since 0.1.0+{-# INLINE all #-}+all :: Monad m => (a -> Bool) -> SerialT m a -> m Bool+all p m = D.all p (toStreamD m)++-- | Determine whether any of the elements of a stream satisfy a predicate.+--+-- > any = Stream.fold Fold.any+--+-- @since 0.1.0+{-# INLINE any #-}+any :: Monad m => (a -> Bool) -> SerialT m a -> m Bool+any p m = D.any p (toStreamD m)++-- | Determines if all elements of a boolean stream are True.+--+-- > and = Stream.fold Fold.and+--+-- @since 0.5.0+{-# INLINE and #-}+and :: Monad m => SerialT m Bool -> m Bool+and = all (==True)++-- | Determines whether at least one element of a boolean stream is True.+--+-- > or = Stream.fold Fold.or+--+-- @since 0.5.0+{-# INLINE or #-}+or :: Monad m => SerialT m Bool -> m Bool+or = any (==True)++-- | Determine the sum of all elements of a stream of numbers. Returns @0@ when+-- the stream is empty. Note that this is not numerically stable for floating+-- point numbers.+--+-- > sum = Stream.fold Fold.sum+--+-- @since 0.1.0+{-# INLINE sum #-}+sum :: (Monad m, Num a) => SerialT m a -> m a+sum = foldl' (+) 0++-- | Determine the product of all elements of a stream of numbers. Returns @1@+-- when the stream is empty.+--+-- > product = Stream.fold Fold.product+--+-- @since 0.1.1+{-# INLINE product #-}+product :: (Monad m, Num a) => SerialT m a -> m a+product = foldl' (*) 1++-- | Fold a stream of monoid elements by appending them.+--+-- > mconcat = Stream.fold Fold.mconcat+--+-- /Pre-release/+{-# INLINE mconcat #-}+mconcat :: (Monad m, Monoid a) => SerialT m a -> m a+mconcat = foldr mappend mempty++-- |+-- @+-- minimum = 'minimumBy' compare+ -- minimum = Stream.fold Fold.minimum+-- @+--+-- Determine the minimum element in a stream.+--+-- @since 0.1.0+{-# INLINE minimum #-}+minimum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)+minimum m = D.minimum (toStreamD m)++-- | Determine the minimum element in a stream using the supplied comparison+-- function.+--+-- > minimumBy = Stream.fold Fold.minimumBy+--+-- @since 0.6.0+{-# INLINE minimumBy #-}+minimumBy :: Monad m => (a -> a -> Ordering) -> SerialT m a -> m (Maybe a)+minimumBy cmp m = D.minimumBy cmp (toStreamD m)++-- |+-- @+-- maximum = 'maximumBy' compare+-- maximum = Stream.fold Fold.maximum+-- @+--+-- Determine the maximum element in a stream.+--+-- @since 0.1.0+{-# INLINE maximum #-}+maximum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)+maximum m = D.maximum (toStreamD m)++-- | Determine the maximum element in a stream using the supplied comparison+-- function.+--+-- > maximumBy = Stream.fold Fold.maximumBy+--+-- @since 0.6.0+{-# INLINE maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> SerialT m a -> m (Maybe a)+maximumBy cmp m = D.maximumBy cmp (toStreamD m)++-- | Ensures that all the elements of the stream are identical and then returns+-- that unique element.+--+-- @since 0.6.0+{-# INLINE the #-}+the :: (Eq a, Monad m) => SerialT m a -> m (Maybe a)+the m = D.the (toStreamD m)++------------------------------------------------------------------------------+-- Searching+------------------------------------------------------------------------------++-- | Lookup the element at the given index.+--+-- @since 0.6.0+{-# INLINE (!!) #-}+(!!) :: Monad m => SerialT m a -> Int -> m (Maybe a)+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@.+--+-- > lookup = snd <$> Stream.find ((==) . fst)+-- > lookup = Stream.fold Fold.lookup+--+-- @since 0.5.0+{-# INLINE lookup #-}+lookup :: (Monad m, Eq a) => a -> SerialT m (a, b) -> m (Maybe b)+lookup a m = D.lookup a (toStreamD m)++-- | Like 'findM' but with a non-monadic predicate.+--+-- > find p = findM (return . p)+-- > find = Stream.fold Fold.find+--+-- @since 0.5.0+{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe a)+find p m = D.find p (toStreamD m)++-- | Returns the first element that satisfies the given predicate.+--+-- > findM = Stream.fold Fold.findM+--+-- @since 0.6.0+{-# INLINE findM #-}+findM :: Monad m => (a -> m Bool) -> SerialT m a -> m (Maybe a)+findM p m = D.findM p (toStreamD m)++-- | Returns the first index that satisfies the given predicate.+--+-- > findIndex = Stream.fold Fold.findIndex+--+-- @since 0.5.0+{-# INLINE findIndex #-}+findIndex :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe Int)+findIndex p = head . findIndices p++-- | Returns the first index where a given value is found in the stream.+--+-- > elemIndex a = Stream.findIndex (== a)+--+-- @since 0.5.0+{-# INLINE elemIndex #-}+elemIndex :: (Monad m, Eq a) => a -> SerialT m a -> m (Maybe Int)+elemIndex a = findIndex (== a)++------------------------------------------------------------------------------+-- To containers+------------------------------------------------------------------------------++-- |+-- @+-- toList = Stream.foldr (:) []+-- @+--+-- Convert a stream into a list in the underlying monad. The list can be+-- consumed lazily in a lazy monad (e.g. 'Identity'). In a strict monad (e.g.+-- IO) the whole list is generated and buffered before it can be consumed.+--+-- /Warning!/ working on large lists accumulated as buffers in memory could be+-- very inefficient, consider using "Streamly.Array" instead.+--+-- @since 0.1.0+{-# INLINE toList #-}+toList :: Monad m => SerialT m a -> m [a]+toList = IsStream.toList++-- |+-- @+-- toListRev = Stream.foldl' (flip (:)) []+-- @+--+-- Convert a stream into a list in reverse order in the underlying monad.+--+-- /Warning!/ working on large lists accumulated as buffers in memory could be+-- very inefficient, consider using "Streamly.Array" instead.+--+-- /Pre-release/+{-# INLINE toListRev #-}+toListRev :: Monad m => SerialT m a -> m [a]+toListRev = D.toListRev . toStreamD++-- |+-- @+-- toHandle h = D.mapM_ $ hPutStrLn h+-- @+--+-- Write a stream of Strings to an IO Handle.+--+-- @since 0.1.0+{-# DEPRECATED toHandle+   "Please use Streamly.FileSystem.Handle module (see the changelog)" #-}+toHandle :: MonadIO m => IO.Handle -> SerialT m String -> m ()+toHandle h = go+    where+    go m1 =+        let stop = return ()+            single a = liftIO (IO.hPutStrLn h a)+            yieldk a r = liftIO (IO.hPutStrLn h a) >> go r+        in IsStream.foldStream defState yieldk single stop m1++-- | Convert a stream to a pure stream.+--+-- @+-- toStream = Stream.foldr Stream.cons Stream.nil+-- @+--+-- /Pre-release/+--+{-# INLINE toStream #-}+toStream :: Monad m => SerialT m a -> m (SerialT n a)+toStream = foldr IsStream.cons IsStream.nil++-- | Convert a stream to a pure stream in reverse order.+--+-- @+-- toStreamRev = Stream.foldl' (flip Stream.cons) Stream.nil+-- @+--+-- /Pre-release/+--+{-# INLINE toStreamRev #-}+toStreamRev :: Monad m => SerialT m a -> m (SerialT n a)+toStreamRev = foldl' (flip IsStream.cons) IsStream.nil++------------------------------------------------------------------------------+-- Concurrent Application+------------------------------------------------------------------------------++-- | Parallel fold application operator; applies a fold function @t m a -> m b@+-- to a stream @t m a@ concurrently; The the input stream is evaluated+-- asynchronously in an independent thread yielding elements to a buffer and+-- the folding action runs in another thread consuming the input from the+-- buffer.+--+-- If you read the signature as @(t m a -> m b) -> (t m a -> m b)@ you can look+-- at it as a transformation that converts a fold function to a buffered+-- concurrent fold function.+--+-- The @.@ at the end of the operator is a mnemonic for termination of the+-- stream.+--+-- In the example below, each stage introduces a delay of 1 sec but output is+-- printed every second because both stages are concurrent.+--+-- >>> import Control.Concurrent (threadDelay)+-- >>> import Streamly.Prelude ((|$.))+-- >>> :{+--  Stream.foldlM' (\_ a -> threadDelay 1000000 >> print a) (return ())+--      |$. Stream.replicateM 3 (threadDelay 1000000 >> return 1)+-- :}+-- 1+-- 1+-- 1+--+-- /Concurrent/+--+-- /Since: 0.3.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE (|$.) #-}+(|$.) :: (IsStream t, MonadAsync m) => (t m a -> m b) -> (t m a -> m b)+-- (|$.) f = f . Async.mkAsync+(|$.) f = f . mkParallel++infixr 0 |$.++-- | Same as '|$.'.+--+--  /Internal/+--+{-# INLINE foldAsync #-}+foldAsync :: (IsStream t, MonadAsync m) => (t m a -> m b) -> (t m a -> m b)+foldAsync = (|$.)++-- | Same as '|$.' but with arguments reversed.+--+-- > (|&.) = flip (|$.)+--+-- /Concurrent/+--+-- /Since: 0.3.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE (|&.) #-}+(|&.) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> m b) -> m b+x |&. f = f |$. x++infixl 1 |&.++------------------------------------------------------------------------------+-- Multi-stream folds+------------------------------------------------------------------------------++-- | Returns 'True' if the first stream is the same as or a prefix of the+-- second. A stream is a prefix of itself.+--+-- >>> Stream.isPrefixOf (Stream.fromList "hello") (Stream.fromList "hello" :: SerialT IO Char)+-- True+--+-- @since 0.6.0+{-# INLINE isPrefixOf #-}+isPrefixOf :: (Eq a, IsStream t, Monad m) => t m a -> t m a -> m Bool+isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)++-- | Returns 'True' if the first stream is an infix of the second. A stream is+-- considered an infix of itself.+--+-- > Stream.isInfixOf (Stream.fromList "hello") (Stream.fromList "hello" :: SerialT IO Char)+-- True+--+-- Space: @O(n)@ worst case where @n@ is the length of the infix.+--+-- /Pre-release/+--+-- /Requires 'Storable' constraint/+--+{-# INLINE isInfixOf #-}+isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a)+    => SerialT m a -> SerialT m a -> m Bool+isInfixOf infx stream = do+    arr <- fold A.write infx+    -- XXX can use breakOnSeq instead (when available)+    r <- null $ drop 1 $ splitOnSeq arr FL.drain stream+    return (not r)++-- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf+-- may use the suffix stream many times. To run in optimal memory we do not+-- want to buffer the suffix stream in memory therefore  we need an ability to+-- clone (or consume it multiple times) the suffix stream without any side+-- effects so that multiple potential suffix matches can proceed in parallel+-- without buffering the suffix stream. For example, we may create the suffix+-- stream from a file handle, however, if we evaluate the stream multiple+-- times, once for each match, we will need a different file handle each time+-- which may exhaust the file descriptors. Instead, we want to share the same+-- underlying file descriptor, use pread on it to generate the stream and clone+-- the stream for each match. Therefore the suffix stream should be built in+-- such a way that it can be consumed multiple times without any problems.++-- XXX Can be implemented with better space/time complexity.+-- Space: @O(n)@ worst case where @n@ is the length of the suffix.++-- | Returns 'True' if the first stream is a suffix of the second. A stream is+-- considered a suffix of itself.+--+-- >>> Stream.isSuffixOf (Stream.fromList "hello") (Stream.fromList "hello" :: SerialT IO Char)+-- True+--+-- Space: @O(n)@, buffers entire input stream and the suffix.+--+-- /Pre-release/+--+-- /Suboptimal/ - Help wanted.+--+{-# INLINE isSuffixOf #-}+isSuffixOf :: (Monad m, Eq a) => SerialT m a -> SerialT m a -> m Bool+isSuffixOf suffix stream = reverse suffix `isPrefixOf` reverse stream++-- | Returns 'True' if all the elements of the first stream occur, in order, in+-- the second stream. The elements do not have to occur consecutively. A stream+-- is a subsequence of itself.+--+-- >>> Stream.isSubsequenceOf (Stream.fromList "hlo") (Stream.fromList "hello" :: SerialT IO Char)+-- True+--+-- @since 0.6.0+{-# INLINE isSubsequenceOf #-}+isSubsequenceOf :: (Eq a, IsStream t, Monad m) => t m a -> t m a -> m Bool+isSubsequenceOf m1 m2 = D.isSubsequenceOf (toStreamD m1) (toStreamD m2)++-- Note: If we want to return a Maybe value to know whether the+-- suffix/infix was present or not along with the stripped stream then+-- we need to buffer the whole input stream.+--+-- | @stripPrefix prefix stream@ strips @prefix@ from @stream@ if it is a+-- prefix of stream. Returns 'Nothing' if the stream does not start with the+-- given prefix, stripped stream otherwise. Returns @Just nil@ when the prefix+-- is the same as the stream.+--+-- See also "Streamly.Internal.Data.Stream.IsStream.Nesting.dropPrefix".+--+-- Space: @O(1)@+--+-- @since 0.6.0+{-# INLINE stripPrefix #-}+stripPrefix+    :: (Eq a, IsStream t, Monad m)+    => t m a -> t m a -> m (Maybe (t m a))+stripPrefix m1 m2 = fmap fromStreamD <$>+    D.stripPrefix (toStreamD m1) (toStreamD m2)++-- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does+-- not end with the given suffix. Returns @Just nil@ when the suffix is the+-- same as the stream.+--+-- It may be more efficient to convert the stream to an Array and use+-- stripSuffix on that especially if the elements have a Storable or Prim+-- instance.+--+-- See also "Streamly.Internal.Data.Stream.IsStream.Nesting.dropSuffix".+--+-- Space: @O(n)@, buffers the entire input stream as well as the suffix+--+-- /Pre-release/+{-# INLINE stripSuffix #-}+stripSuffix+    :: (Monad m, Eq a)+    => SerialT m a -> SerialT m a -> m (Maybe (SerialT m a))+stripSuffix m1 m2 = fmap reverse <$> stripPrefix (reverse m1) (reverse m2)++------------------------------------------------------------------------------+-- Comparison+------------------------------------------------------------------------------++-- | Compare two streams for equality using an equality function.+--+-- @since 0.6.0+{-# INLINABLE eqBy #-}+eqBy :: (IsStream t, Monad m) => (a -> b -> Bool) -> t m a -> t m b -> m Bool+eqBy = IsStream.eqBy++-- | Compare two streams lexicographically using a comparison function.+--+-- @since 0.6.0+{-# INLINABLE cmpBy #-}+cmpBy+    :: (IsStream t, Monad m)+    => (a -> b -> Ordering) -> t m a -> t m b -> m Ordering+cmpBy = IsStream.cmpBy
+ src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs view
@@ -0,0 +1,594 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.Enumeration+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- The functions defined in this module should be rarely needed for direct use,+-- try to use the operations from the 'Enumerable' type class+-- instances instead.+--+-- This module provides an 'Enumerable' type class to enumerate 'Enum' types+-- into a stream. The operations in this type class correspond to similar+-- perations in the 'Enum' type class, the only difference is that they produce+-- a stream instead of a list. These operations cannot be defined generically+-- based on the 'Enum' type class. We provide instances for commonly used+-- types. If instances for other types are needed convenience functions defined+-- in this module can be used to define them. Alternatively, these functions+-- can be used directly.++module Streamly.Internal.Data.Stream.IsStream.Enumeration {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+      Enumerable (..)++    -- ** Enumerating 'Bounded' 'Enum' Types+    , enumerate+    , enumerateTo+    , enumerateFromBounded++    -- ** Enumerating 'Enum' Types not larger than 'Int'+    , enumerateFromToSmall+    , enumerateFromThenToSmall+    , enumerateFromThenSmallBounded++    -- ** Enumerating 'Bounded' 'Integral' Types+    , enumerateFromIntegral+    , enumerateFromThenIntegral++    -- ** Enumerating 'Integral' Types+    , enumerateFromToIntegral+    , enumerateFromThenToIntegral++    -- ** Enumerating unbounded 'Integral' Types+    , enumerateFromStepIntegral++    -- ** Enumerating 'Fractional' Types+    , enumerateFromFractional+    , enumerateFromToFractional+    , enumerateFromThenFractional+    , enumerateFromThenToFractional+    )+where++import Data.Fixed+import Data.Int+import Data.Ratio+import Data.Word+import Numeric.Natural+import Data.Functor.Identity (Identity(..))++import Streamly.Internal.Data.Stream.IsStream.Type (IsStream(..), fromStreamD)++import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream+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++-------------------------------------------------------------------------------+-- Enumeration of Integral types+-------------------------------------------------------------------------------+--+-- | @enumerateFromStepIntegral from step@ generates an infinite stream whose+-- first element is @from@ and the successive elements are in increments of+-- @step@.+--+-- CAUTION: This function is not safe for finite integral types. It does not+-- check for overflow, underflow or bounds.+--+-- @+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromStepIntegral 0 2+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.take 3 $ Stream.enumerateFromStepIntegral 0 (-2)+-- [0,-2,-4]+--+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromStepIntegral #-}+enumerateFromStepIntegral+    :: (IsStream t, Monad m, Integral a)+    => a -> a -> t m a+enumerateFromStepIntegral from stride =+    fromStreamD $ D.enumerateFromStepIntegral from stride++-- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a+-- stream whose first element is @from@ and the successive elements are in+-- increments of @1@. The stream is bounded by the size of the 'Integral' type.+--+-- @+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromIntegral (0 :: Int)+-- [0,1,2,3]+--+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromIntegral #-}+enumerateFromIntegral+    :: (IsStream t, Monad m, Integral a, Bounded a)+    => a -> t m a+enumerateFromIntegral from = fromStreamD $ D.enumerateFromIntegral from++-- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from+-- then@ generates a stream whose first element is @from@, the second element+-- is @then@ and the successive elements are in increments of @then - from@.+-- The stream is bounded by the size of the 'Integral' type.+--+-- @+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) 2+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) (-2)+-- [0,-2,-4,-6]+--+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromThenIntegral #-}+enumerateFromThenIntegral+    :: (IsStream t, Monad m, Integral a, Bounded a)+    => a -> a -> t m a+enumerateFromThenIntegral from next =+    fromStreamD $ D.enumerateFromThenIntegral from next++-- | Enumerate an 'Integral' type up to a given limit.+-- @enumerateFromToIntegral from to@ generates a finite stream whose first+-- element is @from@ and successive elements are in increments of @1@ up to+-- @to@.+--+-- @+-- >>> Stream.toList $ Stream.enumerateFromToIntegral 0 4+-- [0,1,2,3,4]+--+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromToIntegral #-}+enumerateFromToIntegral :: (IsStream t, Monad m, Integral a) => a -> a -> t m a+enumerateFromToIntegral from to =+    fromStreamD $ D.enumerateFromToIntegral from to++-- | Enumerate an 'Integral' type in steps up to a given limit.+-- @enumerateFromThenToIntegral from then to@ generates a finite stream whose+-- first element is @from@, the second element is @then@ and the successive+-- elements are in increments of @then - from@ up to @to@.+--+-- @+-- >>> Stream.toList $ Stream.enumerateFromThenToIntegral 0 2 6+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.enumerateFromThenToIntegral 0 (-2) (-6)+-- [0,-2,-4,-6]+--+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromThenToIntegral #-}+enumerateFromThenToIntegral+    :: (IsStream t, Monad m, Integral a)+    => a -> a -> a -> t m a+enumerateFromThenToIntegral from next to =+    fromStreamD $ D.enumerateFromThenToIntegral from next to++-------------------------------------------------------------------------------+-- Enumeration of Fractional types+-------------------------------------------------------------------------------+--+-- Even though the underlying implementation of enumerateFromFractional and+-- enumerateFromThenFractional works for any 'Num' we have restricted these to+-- 'Fractional' because these do not perform any bounds check, in contrast to+-- integral versions and are therefore not equivalent substitutes for those.+--+-- | Numerically stable enumeration from a 'Fractional' number in steps of size+-- @1@. @enumerateFromFractional from@ generates a stream whose first element+-- is @from@ and the successive elements are in increments of @1@.  No overflow+-- or underflow checks are performed.+--+-- This is the equivalent to 'enumFrom' for 'Fractional' types. For example:+--+-- @+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromFractional 1.1+-- [1.1,2.1,3.1,4.1]+--+-- @+--+--+-- @since 0.6.0+{-# INLINE enumerateFromFractional #-}+enumerateFromFractional :: (IsStream t, Monad m, Fractional a) => a -> t m a+enumerateFromFractional from = fromStreamD $ D.enumerateFromNum from++-- | Numerically stable enumeration from a 'Fractional' number in steps.+-- @enumerateFromThenFractional from then@ generates a stream whose first+-- element is @from@, the second element is @then@ and the successive elements+-- are in increments of @then - from@.  No overflow or underflow checks are+-- performed.+--+-- This is the equivalent of 'enumFromThen' for 'Fractional' types. For+-- example:+--+-- @+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 2.1+-- [1.1,2.1,3.1,4.1]+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 (-2.1)+-- [1.1,-2.1,-5.300000000000001,-8.500000000000002]+--+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromThenFractional #-}+enumerateFromThenFractional+    :: (IsStream t, Monad m, Fractional a)+    => a -> a -> t m a+enumerateFromThenFractional from next = fromStreamD $ D.enumerateFromThenNum from next++-- | Numerically stable enumeration from a 'Fractional' number to a given+-- limit.  @enumerateFromToFractional from to@ generates a finite stream whose+-- first element is @from@ and successive elements are in increments of @1@ up+-- to @to@.+--+-- This is the equivalent of 'enumFromTo' for 'Fractional' types. For+-- example:+--+-- @+-- >>> Stream.toList $ Stream.enumerateFromToFractional 1.1 4+-- [1.1,2.1,3.1,4.1]+--+-- >>> Stream.toList $ Stream.enumerateFromToFractional 1.1 4.6+-- [1.1,2.1,3.1,4.1,5.1]+--+-- @+--+-- Notice that the last element is equal to the specified @to@ value after+-- rounding to the nearest integer.+--+-- @since 0.6.0+{-# INLINE enumerateFromToFractional #-}+enumerateFromToFractional+    :: (IsStream t, Monad m, Fractional a, Ord a)+    => a -> a -> t m a+enumerateFromToFractional from to =+    fromStreamD $ D.enumerateFromToFractional from to++-- | Numerically stable enumeration from a 'Fractional' number in steps up to a+-- given limit.  @enumerateFromThenToFractional from then to@ generates a+-- finite stream whose first element is @from@, the second element is @then@+-- and the successive elements are in increments of @then - from@ up to @to@.+--+-- This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For+-- example:+--+-- @+-- >>> Stream.toList $ Stream.enumerateFromThenToFractional 0.1 2 6+-- [0.1,2.0,3.9,5.799999999999999]+--+-- >>> Stream.toList $ Stream.enumerateFromThenToFractional 0.1 (-2) (-6)+-- [0.1,-2.0,-4.1000000000000005,-6.200000000000001]+--+-- @+--+--+-- @since 0.6.0+{-# INLINE enumerateFromThenToFractional #-}+enumerateFromThenToFractional+    :: (IsStream t, Monad m, Fractional a, Ord a)+    => a -> a -> a -> t m a+enumerateFromThenToFractional from next to =+    fromStreamD $ D.enumerateFromThenToFractional from next to++-------------------------------------------------------------------------------+-- Enumeration of Enum types not larger than Int+-------------------------------------------------------------------------------+--+-- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'.+--+-- @since 0.6.0+{-# INLINE enumerateFromToSmall #-}+enumerateFromToSmall :: (IsStream t, Monad m, Enum a) => a -> a -> t m a+enumerateFromToSmall from to =+    IsStream.fromSerial+        $ Serial.map toEnum+        $ enumerateFromToIntegral (fromEnum from) (fromEnum to)++-- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'.+--+-- @since 0.6.0+{-# INLINE enumerateFromThenToSmall #-}+enumerateFromThenToSmall :: (IsStream t, Monad m, Enum a)+    => a -> a -> a -> t m a+enumerateFromThenToSmall from next to =+    IsStream.fromSerial+        $ Serial.map toEnum+        $ enumerateFromThenToIntegral+            (fromEnum from) (fromEnum next) (fromEnum to)++-- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'.+--+-- Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a+-- type is bounded but does not have a 'Bounded' instance then we can go on+-- enumerating it beyond the legal values of the type, resulting in the failure+-- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded'+-- instance for this function to be safely used.+--+-- @since 0.6.0+{-# INLINE enumerateFromThenSmallBounded #-}+enumerateFromThenSmallBounded :: (IsStream t, Monad m, Enumerable a, Bounded a)+    => a -> a -> t m a+enumerateFromThenSmallBounded from next =+    if fromEnum next >= fromEnum from+    then enumerateFromThenTo from next maxBound+    else enumerateFromThenTo from next minBound++-------------------------------------------------------------------------------+-- Enumerable type class+-------------------------------------------------------------------------------+--+-- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream+-- enumerations like this:+--+-- {-# RULES "fromList enumFrom" [1]+--     forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-}+--+-- But this does not work because enumFrom is a class method and GHC rewrites+-- it quickly, so we do not get a chance to have our rule fired.++-- | Types that can be enumerated as a stream. The operations in this type+-- class are equivalent to those in the 'Enum' type class, except that these+-- generate a stream instead of a list. Use the functions in+-- "Streamly.Internal.Data.Stream.Enumeration" module to define new instances.+--+-- @since 0.6.0+class Enum a => Enumerable a where+    -- | @enumerateFrom from@ generates a stream starting with the element+    -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or+    -- generating an infinite stream when the type is not 'Bounded'.+    --+    -- @+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFrom (0 :: Int)+    -- [0,1,2,3]+    --+    -- @+    --+    -- For 'Fractional' types, enumeration is numerically stable. However, no+    -- overflow or underflow checks are performed.+    --+    -- @+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFrom 1.1+    -- [1.1,2.1,3.1,4.1]+    --+    -- @+    --+    -- @since 0.6.0+    enumerateFrom :: (IsStream t, Monad m) => a -> t m a++    -- | Generate a finite stream starting with the element @from@, enumerating+    -- the type up to the value @to@. If @to@ is smaller than @from@ then an+    -- empty stream is returned.+    --+    -- @+    -- >>> Stream.toList $ Stream.enumerateFromTo 0 4+    -- [0,1,2,3,4]+    --+    -- @+    --+    -- For 'Fractional' types, the last element is equal to the specified @to@+    -- value after rounding to the nearest integral value.+    --+    -- @+    -- >>> Stream.toList $ Stream.enumerateFromTo 1.1 4+    -- [1.1,2.1,3.1,4.1]+    --+    -- >>> Stream.toList $ Stream.enumerateFromTo 1.1 4.6+    -- [1.1,2.1,3.1,4.1,5.1]+    --+    -- @+    --+    -- @since 0.6.0+    enumerateFromTo :: (IsStream t, Monad m) => a -> a -> t m a++    -- | @enumerateFromThen from then@ generates a stream whose first element+    -- is @from@, the second element is @then@ and the successive elements are+    -- in increments of @then - from@.  Enumeration can occur downwards or+    -- upwards depending on whether @then@ comes before or after @from@. For+    -- 'Bounded' types the stream ends when 'maxBound' is reached, for+    -- unbounded types it keeps enumerating infinitely.+    --+    -- @+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 2+    -- [0,2,4,6]+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 (-2)+    -- [0,-2,-4,-6]+    --+    -- @+    --+    -- @since 0.6.0+    enumerateFromThen :: (IsStream t, Monad m) => a -> a -> t m a++    -- | @enumerateFromThenTo from then to@ generates a finite stream whose+    -- first element is @from@, the second element is @then@ and the successive+    -- elements are in increments of @then - from@ up to @to@. Enumeration can+    -- occur downwards or upwards depending on whether @then@ comes before or+    -- after @from@.+    --+    -- @+    -- >>> Stream.toList $ Stream.enumerateFromThenTo 0 2 6+    -- [0,2,4,6]+    --+    -- >>> Stream.toList $ Stream.enumerateFromThenTo 0 (-2) (-6)+    -- [0,-2,-4,-6]+    --+    -- @+    --+    -- @since 0.6.0+    enumerateFromThenTo :: (IsStream t, Monad m) => a -> a -> a -> t m a++-- MAYBE: Sometimes it is more convenient to know the count rather then the+-- ending or starting element. For those cases we can define the folllowing+-- APIs. All of these will work only for bounded types if we represent the+-- count by Int.+--+-- enumerateN+-- enumerateFromN+-- enumerateToN+-- enumerateFromStep+-- enumerateFromStepN++-------------------------------------------------------------------------------+-- Convenient functions for bounded types+-------------------------------------------------------------------------------+--+-- |+-- > enumerate = enumerateFrom minBound+--+-- Enumerate a 'Bounded' type from its 'minBound' to 'maxBound'+--+-- @since 0.6.0+{-# INLINE enumerate #-}+enumerate :: (IsStream t, Monad m, Bounded a, Enumerable a) => t m a+enumerate = enumerateFrom minBound++-- |+-- > enumerateTo = enumerateFromTo minBound+--+-- Enumerate a 'Bounded' type from its 'minBound' to specified value.+--+-- @since 0.6.0+{-# INLINE enumerateTo #-}+enumerateTo :: (IsStream t, Monad m, Bounded a, Enumerable a) => a -> t m a+enumerateTo = enumerateFromTo minBound++-- |+-- > enumerateFromBounded = enumerateFromTo from maxBound+--+-- 'enumerateFrom' for 'Bounded' 'Enum' types.+--+-- @since 0.6.0+{-# INLINE enumerateFromBounded #-}+enumerateFromBounded :: (IsStream t, Monad m, Enumerable a, Bounded a)+    => a -> t m a+enumerateFromBounded from = enumerateFromTo from maxBound++-------------------------------------------------------------------------------+-- Enumerable Instances+-------------------------------------------------------------------------------+--+-- For Enum types smaller than or equal to Int size.+#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE)           \+instance Enumerable SMALL_TYPE where {                 \+    {-# INLINE enumerateFrom #-};                      \+    enumerateFrom = enumerateFromBounded;              \+    {-# INLINE enumerateFromThen #-};                  \+    enumerateFromThen = enumerateFromThenSmallBounded; \+    {-# INLINE enumerateFromTo #-};                    \+    enumerateFromTo = enumerateFromToSmall;            \+    {-# INLINE enumerateFromThenTo #-};                \+    enumerateFromThenTo = enumerateFromThenToSmall }+++ENUMERABLE_BOUNDED_SMALL(())+ENUMERABLE_BOUNDED_SMALL(Bool)+ENUMERABLE_BOUNDED_SMALL(Ordering)+ENUMERABLE_BOUNDED_SMALL(Char)++-- For bounded Integral Enum types, may be larger than Int.+#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE)  \+instance Enumerable INTEGRAL_TYPE where {           \+    {-# INLINE enumerateFrom #-};                   \+    enumerateFrom = enumerateFromIntegral;          \+    {-# INLINE enumerateFromThen #-};               \+    enumerateFromThen = enumerateFromThenIntegral;  \+    {-# INLINE enumerateFromTo #-};                 \+    enumerateFromTo = enumerateFromToIntegral;      \+    {-# INLINE enumerateFromThenTo #-};             \+    enumerateFromThenTo = enumerateFromThenToIntegral }++ENUMERABLE_BOUNDED_INTEGRAL(Int)+ENUMERABLE_BOUNDED_INTEGRAL(Int8)+ENUMERABLE_BOUNDED_INTEGRAL(Int16)+ENUMERABLE_BOUNDED_INTEGRAL(Int32)+ENUMERABLE_BOUNDED_INTEGRAL(Int64)+ENUMERABLE_BOUNDED_INTEGRAL(Word)+ENUMERABLE_BOUNDED_INTEGRAL(Word8)+ENUMERABLE_BOUNDED_INTEGRAL(Word16)+ENUMERABLE_BOUNDED_INTEGRAL(Word32)+ENUMERABLE_BOUNDED_INTEGRAL(Word64)++-- For unbounded Integral Enum types.+#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE)              \+instance Enumerable INTEGRAL_TYPE where {                         \+    {-# INLINE enumerateFrom #-};                                 \+    enumerateFrom from = enumerateFromStepIntegral from 1;        \+    {-# INLINE enumerateFromThen #-};                             \+    enumerateFromThen from next =                                 \+        enumerateFromStepIntegral from (next - from);             \+    {-# INLINE enumerateFromTo #-};                               \+    enumerateFromTo = enumerateFromToIntegral;                    \+    {-# INLINE enumerateFromThenTo #-};                           \+    enumerateFromThenTo = enumerateFromThenToIntegral }++ENUMERABLE_UNBOUNDED_INTEGRAL(Integer)+ENUMERABLE_UNBOUNDED_INTEGRAL(Natural)++#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT)         \+instance (CONSTRAINT) => Enumerable FRACTIONAL_TYPE where {     \+    {-# INLINE enumerateFrom #-};                                 \+    enumerateFrom = enumerateFromFractional;                      \+    {-# INLINE enumerateFromThen #-};                             \+    enumerateFromThen = enumerateFromThenFractional;              \+    {-# INLINE enumerateFromTo #-};                               \+    enumerateFromTo = enumerateFromToFractional;                  \+    {-# INLINE enumerateFromThenTo #-};                           \+    enumerateFromThenTo = enumerateFromThenToFractional }++ENUMERABLE_FRACTIONAL(Float,)+ENUMERABLE_FRACTIONAL(Double,)+ENUMERABLE_FRACTIONAL((Fixed a),HasResolution a)+ENUMERABLE_FRACTIONAL((Ratio a),Integral a)++instance Enumerable a => Enumerable (Identity a) where+    {-# INLINE enumerateFrom #-}+    enumerateFrom (Identity from) =+        IsStream.fromSerial $ Serial.map Identity $ enumerateFrom from+    {-# INLINE enumerateFromThen #-}+    enumerateFromThen (Identity from) (Identity next) =+        IsStream.fromSerial $ Serial.map Identity $ enumerateFromThen from next+    {-# INLINE enumerateFromTo #-}+    enumerateFromTo (Identity from) (Identity to) =+        IsStream.fromSerial $ Serial.map Identity $ enumerateFromTo from to+    {-# INLINE enumerateFromThenTo #-}+    enumerateFromThenTo (Identity from) (Identity next) (Identity to) =+        IsStream.fromSerial+            $ Serial.map Identity+            $ enumerateFromThenTo from next to++-- TODO+{-+instance Enumerable a => Enumerable (Last a)+instance Enumerable a => Enumerable (First a)+instance Enumerable a => Enumerable (Max a)+instance Enumerable a => Enumerable (Min a)+instance Enumerable a => Enumerable (Const a b)+instance Enumerable (f a) => Enumerable (Alt f a)+instance Enumerable (f a) => Enumerable (Ap f a)+-}
+ src/Streamly/Internal/Data/Stream/IsStream/Exception.hs view
@@ -0,0 +1,284 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.IsStream.Exception+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.IsStream.Exception {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+      before+    , after_+    , after+    , bracket_+    , bracket+    , bracket'+    , onException+    , finally_+    , finally+    , ghandle+    , handle+    , retry+    )+where++import Control.Exception (Exception)+import Control.Monad.Catch (MonadCatch)+import Data.Map.Strict (Map)+import Streamly.Internal.Control.Concurrent (MonadRunInIO, MonadAsync)+import Streamly.Internal.Data.Stream.IsStream.Type+    (IsStream(..), fromStreamD, toStreamD)++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)++------------------------------------------------------------------------------+-- Exceptions+------------------------------------------------------------------------------++-- | Run the action @m b@ before the stream yields its first element.+--+-- Same as the following but more efficient due to fusion:+--+-- >>> before action xs = Stream.nilM action <> xs+-- >>> before action xs = Stream.concatMap (const xs) (Stream.fromEffect action)+--+-- @since 0.7.0+{-# INLINE before #-}+before :: (IsStream t, Monad m) => m b -> t m a -> t m a+before action xs = fromStreamD $ D.before action $ toStreamD xs++-- | Like 'after', with following differences:+--+-- * action @m b@ won't run if the stream is garbage collected+--   after partial evaluation.+-- * Monad @m@ does not require any other constraints.+-- * has slightly better performance than 'after'.+--+-- Same as the following, but with stream fusion:+--+-- > after_ action xs = xs <> 'nilM' action+--+-- /Pre-release/+--+{-# INLINE after_ #-}+after_ :: (IsStream t, Monad m) => m b -> t m a -> t m a+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.+--+-- The semantics of the action @m b@ are similar to the semantics of cleanup+-- action in 'bracket'.+--+-- /See also 'after_'/+--+-- @since 0.7.0+--+{-# INLINE after #-}+after :: (IsStream t, MonadRunInIO m)+    => m b -> t m a -> t m a+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.+--+-- /Inhibits stream fusion/+--+-- @since 0.7.0+{-# INLINE onException #-}+onException :: (IsStream t, MonadCatch m) => m b -> t m a -> t m a+onException action xs = fromStreamD $ D.onException action $ toStreamD xs++-- | Like 'finally' with following differences:+--+-- * action @m b@ won't run if the stream is garbage collected+--   after partial evaluation.+-- * does not require a 'MonadAsync' constraint.+-- * has slightly better performance than 'finally'.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+--+{-# INLINE finally_ #-}+finally_ :: (IsStream t, MonadCatch m) => m b -> t m a -> t m a+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+-- evaluation.+--+-- The semantics of running the action @m b@ are similar to the cleanup action+-- semantics described in 'bracket'.+--+-- /See also 'finally_'/+--+-- /Inhibits stream fusion/+--+-- @since 0.7.0+--+{-# INLINE finally #-}+finally :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> t m a -> t m a+finally action xs = bracket (return ()) (const action) (const xs)++-- | Like 'bracket' but with following differences:+--+-- * alloc action @m b@ runs with async exceptions enabled+-- * cleanup action @b -> m c@ won't run if the stream is garbage collected+--   after partial evaluation.+-- * does not require a 'MonadAsync' constraint.+-- * has slightly better performance than 'bracket'.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+--+{-# INLINE bracket_ #-}+bracket_ :: (IsStream t, MonadCatch m)+    => m b -> (b -> m c) -> (b -> t m a) -> t m a+bracket_ bef aft bet = fromStreamD $+    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+-- output @b@ as input to @b -> t m a@ to generate an output stream.+--+-- @b@ is usually a resource under the state of monad @m@, e.g. a file+-- handle, that requires a cleanup after use. The cleanup action @b -> m c@,+-- runs whenever the stream ends normally, due to a sync or async exception or+-- if it gets garbage collected after a partial lazy evaluation.+--+-- '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/+--+-- @since 0.7.0+--+{-# INLINE bracket #-}+bracket :: (IsStream t, MonadAsync m, MonadCatch m)+    => m b -> (b -> m c) -> (b -> t m a) -> t m a+bracket bef aft = bracket' bef aft aft aft++-- For a use case of this see the "streamly-process" package. It needs to kill+-- the process in case of exception or garbage collection, but waits for the+-- process to terminate in normal cases.+--+-- | Like 'bracket' but can use separate cleanup actions depending on the mode+-- of termination.  @bracket' 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.+--+-- /Pre-release/+{-# INLINE bracket' #-}+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.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+-- re-evaluate the stream to retry the action that failed. The exception+-- handler can again call 'ghandle' on it to retry the action multiple times.+--+-- This is highly experimental. In a stream of actions we can map the stream+-- with a retry combinator to retry each action on failure.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+--+{-# INLINE ghandle #-}+ghandle :: (IsStream t, MonadCatch m, Exception e)+    => (e -> t m a -> t m a) -> t m a -> t m a+ghandle handler =+      fromStreamD+    . D.ghandle (\e xs -> return $ toStreamD $ handler e (fromStreamD xs))+    . toStreamD++-- | When evaluating a stream if an exception occurs, stream evaluation aborts+-- and the specified exception handler is run with the exception as argument.+--+-- /Inhibits stream fusion/+--+-- @since 0.7.0+{-# INLINE handle #-}+handle :: (IsStream t, MonadCatch m, Exception e)+    => (e -> t m a) -> t m a -> t m a+handle handler xs =+    fromStreamD $ D.handle (return . toStreamD . handler) $ toStreamD xs+++-- | @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 :: (IsStream t, MonadCatch m, Exception e, Ord e)+    => Map e Int+       -- ^ map from exception to retry count+    -> (e -> t m a)+       -- ^ default handler for those exceptions that are not in the map+    -> t m a+    -> t m a+retry emap handler inp =+    fromStreamD $ D.retryD emap (toStreamD . handler) $ toStreamD inp
+ src/Streamly/Internal/Data/Stream/IsStream/Expand.hs view
@@ -0,0 +1,1160 @@+{-# 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+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Expand a stream by combining two or more streams or by combining streams+-- with unfolds.++module Streamly.Internal.Data.Stream.IsStream.Expand {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * Binary Combinators (Linear)+    -- | Functions ending in the shape:+    --+    -- @t m a -> t m a -> t m a@.+    --+    -- The functions in this section have a linear or flat n-ary combining+    -- characterstics. It means that when combined @n@ times (e.g. @a `serial`+    -- b `serial` c ...@) the resulting expression will have an @O(n)@+    -- complexity (instead O(n^2) for pair wise combinators described in the+    -- next section. These functions can be used efficiently with+    -- 'concatMapWith' et. al.  combinators that combine streams in a linear+    -- fashion (contrast with 'concatPairsWith' which combines streams as a+    -- binary tree).++      serial+    , ahead+    , async+    , wAsync+    , parallel+    , parallelFst+    , parallelMin++    -- * Binary Combinators (Pair Wise)+    -- | Like the functions in the section above these functions also combine+    -- two streams into a single stream but when used @n@ times linearly they+    -- exhibit O(n^2) complexity. They are best combined in a binary tree+    -- fashion using 'concatPairsWith' giving a @n * log n@ complexity.  Avoid+    -- using these with 'concatMapWith' when combining a large or infinite+    -- number of streams.++    -- ** Append+    , append++    -- ** wSerial+    -- | 'wSerial' is a CPS based stream interleaving functions. Use+    -- 'concatPairsWith wSerial' to interleave @n@ streams uniformly. It can be+    -- used with 'concatMapWith' as well, however, the interleaving behavior of+    -- @n@ streams would be asymmetric giving exponentially more weightage to+    -- streams that come earlier in the composition.+    --+    , wSerial+    , Serial.wSerialFst+    , Serial.wSerialMin++    -- ** Interleave+    -- | 'interleave' is like 'wSerial'  but using a direct style+    -- implementation instead of CPS. It is faster than 'wSerial' due to stream+    -- fusion but has worse efficiency when used with 'concatMapWith' for large+    -- number of streams.+    , interleave+    , interleaveMin+    , interleaveSuffix+    , interleaveInfix++    -- ** Round Robin+    , roundrobin++    -- ** Zip+    , zipWith+    , zipWithM+    , zipAsyncWith+    , zipAsyncWithM++    -- ** Merge+    , merge+    , mergeBy+    , mergeByM+    , mergeByMFused+    , mergeAsyncBy+    , mergeAsyncByM+    , mergeMinBy+    , mergeFstBy++    -- * Combine Streams and Unfolds+    -- |+    -- Expand a stream by repeatedly using an unfold and merging the resulting+    -- streams.  Functions generally ending in the shape:+    --+    -- @Unfold m a b -> t m a -> t m b@++    -- ** Append Many (Unfold)+    -- | Unfold and flatten streams.+    , unfoldMany+    , unfoldManyInterleave+    , unfoldManyRoundRobin++    -- ** Interpose+    -- | Insert effects between streams. Like unfoldMany but intersperses an+    -- effect between the streams. A special case of gintercalate.+    , interpose+    , interposeSuffix+    -- , interposeBy++    -- ** Intercalate+    -- | Insert Streams between Streams.+    -- Like unfoldMany but intersperses streams from another source between+    -- the streams from the first source.+    , intercalate+    , intercalateSuffix+    , gintercalate+    , gintercalateSuffix++    -- * Append Many (concatMap)+    -- | Map and serially append streams. 'concatMapM' is a generalization of+    -- the binary append operation to append many streams.+    , concatMapM+    , concatMap+    , concatM+    , concat++    -- * Flatten Containers+    -- | Flatten 'Foldable' containers using the binary stream merging+    -- operations.+    , IsStream.concatFoldableWith+    , IsStream.concatMapFoldableWith+    , IsStream.concatForFoldableWith++    -- * ConcatMapWith+    -- | Map and flatten a stream like 'concatMap' but using a custom binary+    -- stream merging combinator instead of just appending the streams.  The+    -- merging occurs sequentially, it works efficiently for 'serial', 'async',+    -- 'ahead' like merge operations where we consume one stream before the+    -- next or in case of 'wAsync' or 'parallel' where we consume all streams+    -- simultaneously anyway.+    --+    -- However, in cases where the merging consumes streams in a round robin+    -- fashion, a pair wise merging using 'concatPairsWith' would be more+    -- efficient. These cases include operations like 'mergeBy' or 'zipWith'.++    , IsStream.concatMapWith+    , IsStream.bindWith+    , concatSmapMWith++    -- * ConcatPairsWith+    -- | See the notes about suitable merge functions in the 'concatMapWith'+    -- section.+    , concatPairsWith++    -- * IterateMap+    -- | Map and flatten Trees of Streams+    , iterateMapWith+    , iterateSmapMWith+    , iterateMapLeftsWith+    , iterateUnfold++    -- * Deprecated+    , concatUnfold+    )+where++#include "inline.hs"++import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Stream.Ahead (aheadK)+import Streamly.Internal.Data.Stream.Async (asyncK, wAsyncK)+import Streamly.Internal.Data.Stream.IsStream.Common+    ( concatM, concatMapM, concatMap, smapM, fromPure, fromEffect, parallelFst+    , zipWith, zipWithM)+import Streamly.Internal.Data.Stream.IsStream.Type+    (IsStream(..), fromStreamD, toStreamD)+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 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)+-- >>> 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.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold+-- >>> import qualified Streamly.Internal.Data.Parser as Parser+-- >>> import qualified Streamly.Data.Array as Array+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}+--++-------------------------------------------------------------------------------+-- Appending+-------------------------------------------------------------------------------++-- XXX Reconcile the names "serial" and "append".+--+-- | Append the outputs of two streams, yielding all the elements from the+-- first stream and then yielding all the elements from the second stream.+--+-- IMPORTANT NOTE: This could be 100x faster than @serial/<>@ for appending a+-- few (say 100) streams because it can fuse via stream fusion. However, it+-- does not scale for a large number of streams (say 1000s) and becomes+-- qudartically slow. Therefore use this for custom appending of a few streams+-- but use 'concatMap' or 'concatMapWith serial' for appending @n@ streams or+-- infinite containers of streams.+--+-- /Pre-release/+{-# INLINE append #-}+append ::(IsStream t, Monad m) => t m b -> t m b -> t m b+append m1 m2 = fromStreamD $ D.append (toStreamD m1) (toStreamD m2)++infixr 6 `serial`++-- | Appends two streams sequentially, yielding all elements from the first+-- stream, and then all elements from the second stream.+--+-- >>> import Streamly.Prelude (serial)+-- >>> stream1 = Stream.fromList [1,2]+-- >>> stream2 = Stream.fromList [3,4]+-- >>> Stream.toList $ stream1 `serial` stream2+-- [1,2,3,4]+--+-- This operation can be used to fold an infinite lazy container of streams.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE serial #-}+serial :: IsStream t => t m a -> t m a -> t m a+serial m1 m2 = fromStream $ K.append (toStream m1) (toStream m2)++-------------------------------------------------------------------------------+-- Interleaving+-------------------------------------------------------------------------------++infixr 6 `wSerial`++-- XXX doc duplicated from Stream.Serial module.+--+-- | 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.+--+-- >>> import Streamly.Prelude (wSerial)+-- >>> stream1 = Stream.fromList [1,2]+-- >>> stream2 = Stream.fromList [3,4]+-- >>> Stream.toList $ Stream.fromWSerial $ stream1 `wSerial` stream2+-- [1,3,2,4]+--+-- Note, for singleton streams 'wSerial' and 'serial' are identical.+--+-- Note that this operation cannot be used to fold a container of infinite+-- streams but it can be used for very large streams as the state that it needs+-- to maintain is proportional to the logarithm of the number of streams.+--+-- @since 0.8.0+--+-- /Since: 0.2.0 ("Streamly")/++-- Scheduling Notes:+--+-- 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+-- \`wSerial` (b \`wSerial` c)@, therefore, it fairly interleaves @a@ with the+-- result of @b \`wSerial` c@.  For example, @Stream.fromList [1,2] \`wSerial`+-- Stream.fromList [3,4] \`wSerial` Stream.fromList [5,6]@ would result in+-- [1,3,2,5,4,6].  In other words, the leftmost stream gets the same scheduling+-- priority as the rest of the streams taken together. The same is true for+-- each subexpression on the right.+--+{-# INLINE wSerial #-}+wSerial :: IsStream t => t m a -> t m a -> t m a+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+-- interleaving combinators.+-- XXX Write time-domain equivalents of these. In the time domain we can+-- interleave two streams such that the value of second stream is always taken+-- from its last value even if no new value is being yielded, like+-- zipWithLatest. It would be something like interleaveWithLatest.+--+-- | Interleaves the outputs of two streams, yielding elements from each stream+-- alternately, starting from the first stream. If any of the streams finishes+-- early the other stream continues alone until it too finishes.+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Functor.Identity (Identity)+-- >>> Stream.interleave "ab" ",,,," :: Stream.SerialT Identity Char+-- fromList "a,b,,,"+--+-- >>> Stream.interleave "abcd" ",," :: Stream.SerialT Identity Char+-- fromList "a,b,cd"+--+-- 'interleave' is dual to 'interleaveMin', it can be called @interleaveMax@.+--+-- Do not use at scale in concatMapWith.+--+-- /Pre-release/+{-# INLINE interleave #-}+interleave ::(IsStream t, Monad m) => t m b -> t m b -> t m b+interleave m1 m2 = fromStreamD $ D.interleave (toStreamD m1) (toStreamD m2)++-- | Interleaves the outputs of two streams, yielding elements from each stream+-- alternately, starting from the first stream. As soon as the first stream+-- finishes, the output stops, discarding the remaining part of the second+-- stream. In this case, the last element in the resulting stream would be from+-- the second stream. If the second stream finishes early then the first stream+-- still continues to yield elements until it finishes.+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Functor.Identity (Identity)+-- >>> Stream.interleaveSuffix "abc" ",,,," :: Stream.SerialT Identity Char+-- fromList "a,b,c,"+-- >>> Stream.interleaveSuffix "abc" "," :: Stream.SerialT Identity Char+-- fromList "a,bc"+--+-- 'interleaveSuffix' is a dual of 'interleaveInfix'.+--+-- Do not use at scale in concatMapWith.+--+-- /Pre-release/+{-# INLINE interleaveSuffix #-}+interleaveSuffix ::(IsStream t, Monad m) => t m b -> t m b -> t m b+interleaveSuffix m1 m2 =+    fromStreamD $ D.interleaveFstSuffix (toStreamD m1) (toStreamD m2)++-- | Interleaves the outputs of two streams, yielding elements from each stream+-- alternately, starting from the first stream and ending at the first stream.+-- If the second stream is longer than the first, elements from the second+-- stream are infixed with elements from the first stream. If the first stream+-- is longer then it continues yielding elements even after the second stream+-- has finished.+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Functor.Identity (Identity)+-- >>> Stream.interleaveInfix "abc" ",,,," :: Stream.SerialT Identity Char+-- fromList "a,b,c"+-- >>> Stream.interleaveInfix "abc" "," :: Stream.SerialT Identity Char+-- fromList "a,bc"+--+-- 'interleaveInfix' is a dual of 'interleaveSuffix'.+--+-- Do not use at scale in concatMapWith.+--+-- /Pre-release/+{-# INLINE interleaveInfix #-}+interleaveInfix ::(IsStream t, Monad m) => t m b -> t m b -> t m b+interleaveInfix m1 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+-- of the two streams finishes, discarding the remaining part of the other+-- stream. The last element of the resulting stream would be from the longer+-- stream.+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Functor.Identity (Identity)+-- >>> Stream.interleaveMin "ab" ",,,," :: Stream.SerialT Identity Char+-- fromList "a,b,"+-- >>> Stream.interleaveMin "abcd" ",," :: Stream.SerialT Identity Char+-- fromList "a,b,c"+--+-- 'interleaveMin' is dual to 'interleave'.+--+-- Do not use at scale in concatMapWith.+--+-- /Pre-release/+{-# INLINE interleaveMin #-}+interleaveMin ::(IsStream t, Monad m) => t m b -> t m b -> t m b+interleaveMin m1 m2 = fromStreamD $ D.interleaveMin (toStreamD m1) (toStreamD m2)++-------------------------------------------------------------------------------+-- Scheduling+-------------------------------------------------------------------------------++-- | Schedule the execution of two streams in a fair round-robin manner,+-- executing each stream once, alternately. Execution of a stream may not+-- necessarily result in an output, a stream may chose to @Skip@ producing an+-- element until later giving the other stream a chance to run. Therefore, this+-- combinator fairly interleaves the execution of two streams rather than+-- fairly interleaving the output of the two streams. This can be useful in+-- co-operative multitasking without using explicit threads. This can be used+-- as an alternative to `async`.+--+-- Do not use at scale in concatMapWith.+--+-- /Pre-release/+{-# INLINE roundrobin #-}+roundrobin ::(IsStream t, Monad m) => t m b -> t m b -> t m b+roundrobin m1 m2 = fromStreamD $ D.roundRobin (toStreamD m1) (toStreamD m2)++infixr 6 `async`++-- | Merges two streams, both the streams may be evaluated concurrently,+-- outputs from both are used as they arrive:+--+-- >>> import Streamly.Prelude (async)+-- >>> stream1 = Stream.fromEffect (delay 4)+-- >>> stream2 = Stream.fromEffect (delay 2)+-- >>> Stream.toList $ stream1 `async` stream2+-- 2 sec+-- 4 sec+-- [2,4]+--+-- Multiple streams can be combined. With enough threads, all of them can be+-- scheduled simultaneously:+--+-- >>> stream3 = Stream.fromEffect (delay 1)+-- >>> Stream.toList $ stream1 `async` stream2 `async` stream3+-- ...+-- [1,2,4]+--+-- With 2 threads, only two can be scheduled at a time, when one of those+-- finishes, the third one gets scheduled:+--+-- >>> Stream.toList $ Stream.maxThreads 2 $ stream1 `async` stream2 `async` stream3+-- ...+-- [2,1,4]+--+-- With a single thread, it becomes serial:+--+-- >>> Stream.toList $ Stream.maxThreads 1 $ stream1 `async` stream2 `async` stream3+-- ...+-- [4,2,1]+--+-- Only streams are scheduled for async evaluation, how actions within a+-- stream are evaluated depends on the stream type. If it is a concurrent+-- stream they will be evaluated concurrently.+--+-- In the following example, both the streams are scheduled for concurrent+-- evaluation but each individual stream is evaluated serially:+--+-- >>> stream1 = Stream.fromListM $ Prelude.map delay [3,3] -- SerialT IO Int+-- >>> stream2 = Stream.fromListM $ Prelude.map delay [1,1] -- SerialT IO Int+-- >>> Stream.toList $ stream1 `async` stream2 -- IO [Int]+-- ...+-- [1,1,3,3]+--+-- If total threads are 2, the third stream is scheduled only after one of the+-- first two has finished:+--+-- > stream3 = Stream.fromListM $ Prelude.map delay [2,2] -- SerialT IO Int+-- > Stream.toList $ Stream.maxThreads 2 $ stream1 `async` stream2 `async` stream3 -- IO [Int]+-- ...+-- [1,1,3,2,3,2]+--+-- Thus 'async' goes deep in first few streams rather than going wide in all+-- streams. It prefers to evaluate the leftmost streams as much as possible.+-- Because of this behavior, 'async' can be safely used to fold an infinite+-- lazy container of streams.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE async #-}+async :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+async m1 m2 = fromStream $ asyncK (toStream m1) (toStream m2)++infixr 6 `wAsync`++-- | For singleton streams, 'wAsync' is the same as 'async'.  See 'async' for+-- singleton stream behavior. For multi-element streams, while 'async' is left+-- biased i.e. it tries to evaluate the left side stream as much as possible,+-- 'wAsync' tries to schedule them both fairly. In other words, 'async' goes+-- deep while 'wAsync' goes wide. However, outputs are always used as they+-- arrive.+--+-- With a single thread, 'async' starts behaving like 'serial' while 'wAsync'+-- starts behaving like 'wSerial'.+--+-- >>> import Streamly.Prelude (async, wAsync)+-- >>> stream1 = Stream.fromList [1,2,3]+-- >>> stream2 = Stream.fromList [4,5,6]+-- >>> Stream.toList $ Stream.fromAsync $ Stream.maxThreads 1 $ stream1 `async` stream2+-- [1,2,3,4,5,6]+--+-- >>> Stream.toList $ Stream.fromWAsync $ Stream.maxThreads 1 $ stream1 `wAsync` stream2+-- [1,4,2,5,3,6]+--+-- With two threads available, and combining three streams:+--+-- >>> stream3 = Stream.fromList [7,8,9]+-- >>> Stream.toList $ Stream.fromAsync $ Stream.maxThreads 2 $ stream1 `async` stream2 `async` stream3+-- [1,2,3,4,5,6,7,8,9]+--+-- >>> Stream.toList $ Stream.fromWAsync $ Stream.maxThreads 2 $ stream1 `wAsync` stream2 `wAsync` stream3+-- [1,4,2,7,5,3,8,6,9]+--+-- This operation cannot be used to fold an infinite lazy container of streams,+-- because it schedules all the streams in a round robin manner.+--+-- Note that 'WSerialT' and single threaded 'WAsyncT' both interleave streams+-- but the exact scheduling is slightly different in both cases.+--+-- @since 0.8.0+--+-- /Since: 0.2.0 ("Streamly")/++-- Scheduling details:+--+-- This is how the execution of the above example proceeds:+--+-- 1. The scheduler queue is initialized with @[S.fromList [1,2,3],+-- (S.fromList [4,5,6]) \<> (S.fromList [7,8,9])]@ assuming the head of the+-- queue is represented by the  rightmost item.+-- 2. @S.fromList [1,2,3]@ is executed, yielding the element @1@ and putting+-- @[2,3]@ at the back of the scheduler queue. The scheduler queue now looks+-- like @[(S.fromList [4,5,6]) \<> (S.fromList [7,8,9]), S.fromList [2,3]]@.+-- 3. Now @(S.fromList [4,5,6]) \<> (S.fromList [7,8,9])@ is picked up for+-- execution, @S.fromList [7,8,9]@ is added at the back of the queue and+-- @S.fromList [4,5,6]@ is executed, yielding the element @4@ and adding+-- @S.fromList [5,6]@ at the back of the queue. The queue now looks like+-- @[S.fromList [2,3], S.fromList [7,8,9], S.fromList [5,6]]@.+-- 4. Note that the scheduler queue expands by one more stream component in+-- every pass because one more @<>@ is broken down into two components. At this+-- point there are no more @<>@ operations to be broken down further and the+-- queue has reached its maximum size. Now these streams are scheduled in+-- round-robin fashion yielding @[2,7,5,3,8,6,9]@.+--+-- As we see above, in a right associated expression composed with @<>@, only+-- one @<>@ operation is broken down into two components in one execution,+-- therefore, if we have @n@ streams composed using @<>@ it will take @n@+-- scheduler passes to expand the whole expression.  By the time @n-th@+-- component is added to the scheduler queue, the first component would have+-- received @n@ scheduler passes.+--+{-# INLINE wAsync #-}+wAsync :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+wAsync m1 m2 = fromStream $ wAsyncK (toStream m1) (toStream m2)++infixr 6 `ahead`++-- | Appends two streams, both the streams may be evaluated concurrently but+-- the outputs are used in the same order as the corresponding actions in the+-- original streams, side effects will happen in the order in which the streams+-- are evaluated:+--+-- >>> import Streamly.Prelude (ahead, SerialT)+-- >>> stream1 = Stream.fromEffect (delay 4) :: SerialT IO Int+-- >>> stream2 = Stream.fromEffect (delay 2) :: SerialT IO Int+-- >>> Stream.toList $ stream1 `ahead` stream2 :: IO [Int]+-- 2 sec+-- 4 sec+-- [4,2]+--+-- Multiple streams can be combined. With enough threads, all of them can be+-- scheduled simultaneously:+--+-- >>> stream3 = Stream.fromEffect (delay 1)+-- >>> Stream.toList $ stream1 `ahead` stream2 `ahead` stream3+-- 1 sec+-- 2 sec+-- 4 sec+-- [4,2,1]+--+-- With 2 threads, only two can be scheduled at a time, when one of those+-- finishes, the third one gets scheduled:+--+-- >>> Stream.toList $ Stream.maxThreads 2 $ stream1 `ahead` stream2 `ahead` stream3+-- 2 sec+-- 1 sec+-- 4 sec+-- [4,2,1]+--+-- Only streams are scheduled for ahead evaluation, how actions within a stream+-- are evaluated depends on the stream type. If it is a concurrent stream they+-- will be evaluated concurrently. It may not make much sense combining serial+-- streams using 'ahead'.+--+-- 'ahead' can be safely used to fold an infinite lazy container of streams.+--+-- /Since: 0.3.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE ahead #-}+ahead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+ahead m1 m2 = fromStream $ aheadK (toStream m1) (toStream m2)++infixr 6 `parallel`++-- | Like 'Streamly.Prelude.async' except that the execution is much more+-- strict. There is no limit on the number of threads. While+-- 'Streamly.Prelude.async' may not schedule a stream if there is no demand+-- from the consumer, 'parallel' always evaluates both the streams immediately.+-- The only limit that applies to 'parallel' is 'Streamly.Prelude.maxBuffer'.+-- Evaluation may block if the output buffer becomes full.+--+-- >>> import Streamly.Prelude (parallel)+-- >>> stream = Stream.fromEffect (delay 2) `parallel` Stream.fromEffect (delay 1)+-- >>> Stream.toList stream -- IO [Int]+-- 1 sec+-- 2 sec+-- [1,2]+--+-- 'parallel' guarantees that all the streams are scheduled for execution+-- immediately, therefore, we could use things like starting timers inside the+-- streams and relying on the fact that all timers were started at the same+-- time.+--+-- Unlike 'async' this operation cannot be used to fold an infinite lazy+-- container of streams, because it schedules all the streams strictly+-- concurrently.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE parallel #-}+parallel :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+parallel m1 m2 = fromStream $ Par.parallelK (toStream m1) (toStream m2)++-- This is a race like combinator for streams.+--+-- | Like `parallel` but stops the output as soon as any of the two streams+-- stops.+--+-- /Pre-release/+{-# INLINE parallelMin #-}+parallelMin :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+parallelMin m1 m2 = fromStream $ Par.parallelMinK (toStream m1) (toStream m2)++------------------------------------------------------------------------------+-- Zipping+------------------------------------------------------------------------------++-- | Like 'zipAsyncWith' but with a monadic zipping function.+--+-- @since 0.4.0+{-# INLINE zipAsyncWithM #-}+zipAsyncWithM :: (IsStream t, MonadAsync m)+    => (a -> b -> m c) -> t m a -> t m b -> t m c+zipAsyncWithM f m1 m2 =+    fromStream $ ZipAsync.zipAsyncWithMK f (toStream m1) (toStream m2)++-- XXX Should we rename this to zipParWith or zipParallelWith? This can happen+-- along with the change of behvaior to end the stream concurrently.+--+-- | Like 'zipWith' but zips concurrently i.e. both the streams being zipped+-- are evaluated concurrently using the 'ParallelT' concurrent evaluation+-- style. The maximum number of elements of each stream evaluated in advance+-- can be controlled by 'maxBuffer'.+--+-- The stream ends if stream @a@ or stream @b@ ends. However, if stream @b@+-- ends while we are still evaluating stream @a@ and waiting for a result then+-- stream will not end until after the evaluation of stream @a@ finishes. This+-- behavior can potentially be changed in future to end the stream immediately+-- as soon as any of the stream end is detected.+--+-- @since 0.1.0+{-# INLINE zipAsyncWith #-}+zipAsyncWith :: (IsStream t, MonadAsync m)+    => (a -> b -> c) -> t m a -> t m b -> t m c+zipAsyncWith f = zipAsyncWithM (\a b -> return (f a b))++------------------------------------------------------------------------------+-- Merging (sorted streams)+------------------------------------------------------------------------------++-- | Merge two streams using a comparison function. The head elements of both+-- the streams are compared and the smaller of the two elements is emitted, if+-- both elements are equal then the element from the first stream is used+-- first.+--+-- If the streams are sorted in ascending order, the resulting stream would+-- also remain sorted in ascending order.+--+-- @+-- >>> Stream.toList $ Stream.mergeBy compare (Stream.fromList [1,3,5]) (Stream.fromList [2,4,6,8])+-- [1,2,3,4,5,6,8]+--+-- @+--+-- See also: 'mergeByMFused'+--+-- @since 0.6.0+{-# INLINE mergeBy #-}+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.+--+-- Merge two streams randomly:+--+-- @+-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT+-- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])+-- [2,1,2,2,2,1,1,1]+-- @+--+-- Merge two streams in a proportion of 2:1:+--+-- @+-- >>> :{+-- do+--  let proportionately m n = do+--       ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]+--       return $ \_ _ -> do+--          r <- readIORef ref+--          writeIORef ref $ Prelude.tail r+--          return $ Prelude.head r+--  f <- proportionately 2 1+--  xs <- Stream.toList $ Stream.mergeByM f (Stream.fromList [1,1,1,1,1,1]) (Stream.fromList [2,2,2])+--  print xs+-- :}+-- [1,1,2,1,1,2,1,1,2]+--+-- @+--+-- See also: 'mergeByMFused'+--+-- @since 0.6.0+{-# INLINE mergeByM #-}+mergeByM+    :: (IsStream t, Monad m)+    => (a -> a -> m Ordering) -> t m a -> t m a -> t m a+mergeByM f m1 m2 = fromStream $ K.mergeByM f (toStream m1) (toStream m2)++-- XXX Fused versions should probably go to a separate module using the same+-- names for the combinators.+--+-- | Like 'mergeByM' but much faster, works best when merging statically known+-- number of streams. When merging more than two streams try to merge pairs and+-- pair pf pairs in a tree like structure.'mergeByM' works better with variable+-- number of streams being merged using 'concatPairsWith'.+--+-- /Internal/+{-# INLINE mergeByMFused #-}+mergeByMFused+    :: (IsStream t, Monad m)+    => (a -> a -> m Ordering) -> t m a -> t m a -> t m a+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.+--+-- /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.+--+-- /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)++-- 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]+--+-- /Internal/+--+{-# INLINABLE merge #-}+merge ::+       (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).+--+-- @since 0.6.0+{-# INLINE mergeAsyncBy #-}+mergeAsyncBy :: (IsStream t, MonadAsync m)+    => (a -> a -> Ordering) -> t m a -> t m a -> t m a+mergeAsyncBy f = mergeAsyncByM (\a b -> return $ f a b)++-- | Like 'mergeByM' but merges concurrently (i.e. both the elements being+-- merged are generated concurrently).+--+-- @since 0.6.0+{-# INLINE mergeAsyncByM #-}+mergeAsyncByM :: (IsStream t, MonadAsync m)+    => (a -> a -> m Ordering) -> t m a -> t m a -> t m a+mergeAsyncByM f m1 m2 =+    fromStreamD $+        let par = Par.mkParallelD . toStreamD+        in D.mergeByM f (par m1) (par m2)+++-- @since 0.7.0+{-# DEPRECATED concatUnfold "Please use unfoldMany instead." #-}+{-# INLINE concatUnfold #-}+concatUnfold ::(IsStream t, Monad m) => Unfold m a b -> t m a -> t m b+concatUnfold u m = fromStreamD $ D.unfoldMany u (toStreamD m)++------------------------------------------------------------------------------+-- Combine N Streams - unfoldMany+------------------------------------------------------------------------------++-- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike+-- 'concatMap' this can fuse the 'Unfold' code with the inner loop and+-- therefore provide many times better performance.+--+-- @since 0.8.0+{-# INLINE unfoldMany #-}+unfoldMany ::(IsStream t, Monad m) => Unfold m a b -> t m a -> t m b+unfoldMany u m = fromStreamD $ D.unfoldMany u (toStreamD m)++-- | Like 'unfoldMany' but interleaves the streams in the same way as+-- 'interleave' behaves instead of appending them.+--+-- /Pre-release/+{-# INLINE unfoldManyInterleave #-}+unfoldManyInterleave ::(IsStream t, Monad m)+    => Unfold m a b -> t m a -> t m b+unfoldManyInterleave u m =+    fromStreamD $ D.unfoldInterleave u (toStreamD m)++-- | Like 'unfoldMany' but executes the streams in the same way as+-- 'roundrobin'.+--+-- /Pre-release/+{-# INLINE unfoldManyRoundRobin #-}+unfoldManyRoundRobin ::(IsStream t, Monad m)+    => Unfold m a b -> t m a -> t m b+unfoldManyRoundRobin u m =+    fromStreamD $ D.unfoldRoundRobin u (toStreamD m)++------------------------------------------------------------------------------+-- Combine N Streams - interpose+------------------------------------------------------------------------------++-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)+--+-- | Unfold the elements of a stream, intersperse the given element between the+-- unfolded streams and then concat them into a single stream.+--+-- > unwords = S.interpose ' '+--+-- /Pre-release/+{-# INLINE interpose #-}+interpose :: (IsStream t, Monad m)+    => c -> Unfold m b c -> t m b -> t m c+interpose x unf str =+    fromStreamD $ D.interpose x unf (toStreamD str)++-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)+--+-- | Unfold the elements of a stream, append the given element after each+-- unfolded stream and then concat them into a single stream.+--+-- > unlines = S.interposeSuffix '\n'+--+-- /Pre-release/+{-# INLINE interposeSuffix #-}+interposeSuffix :: (IsStream t, Monad m)+    => c -> Unfold m b c -> t m b -> t m c+interposeSuffix x unf str =+    fromStreamD $ D.interposeSuffix x unf (toStreamD str)++------------------------------------------------------------------------------+-- Combine N Streams - intercalate+------------------------------------------------------------------------------++-- XXX we can swap the order of arguments to gintercalate so that the+-- definition of unfoldMany becomes simpler? The first stream should be+-- infixed inside the second one. However, if we change the order in+-- "interleave" as well similarly, then that will make it a bit unintuitive.+--+-- > unfoldMany unf str =+-- >     gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())+--+-- | 'interleaveInfix' followed by unfold and concat.+--+-- /Pre-release/+{-# INLINE gintercalate #-}+gintercalate+    :: (IsStream t, Monad m)+    => Unfold m a c -> t m a -> Unfold m b c -> t m b -> t m c+gintercalate unf1 str1 unf2 str2 =+    fromStreamD $ D.gintercalate+        unf1 (toStreamD str1)+        unf2 (toStreamD str2)++-- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)+--+-- | 'intersperse' followed by unfold and concat.+--+-- > intercalate unf a str = unfoldMany unf $ intersperse a str+-- > intersperse = intercalate (Unfold.function id)+-- > unwords = intercalate Unfold.fromList " "+--+-- >>> Stream.toList $ Stream.intercalate Unfold.fromList " " $ Stream.fromList ["abc", "def", "ghi"]+-- "abc def ghi"+--+-- @since 0.8.0+{-# INLINE intercalate #-}+intercalate :: (IsStream t, Monad m)+    => Unfold m b c -> b -> t m b -> t m c+intercalate unf seed str = fromStreamD $+    D.unfoldMany unf $ D.intersperse seed (toStreamD str)++-- | 'interleaveSuffix' followed by unfold and concat.+--+-- /Pre-release/+{-# INLINE gintercalateSuffix #-}+gintercalateSuffix+    :: (IsStream t, Monad m)+    => Unfold m a c -> t m a -> Unfold m b c -> t m b -> t m c+gintercalateSuffix unf1 str1 unf2 str2 =+    fromStreamD $ D.gintercalateSuffix+        unf1 (toStreamD str1)+        unf2 (toStreamD str2)++-- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)+--+-- | 'intersperseMSuffix' followed by unfold and concat.+--+-- > intercalateSuffix 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"]+-- "abc\ndef\nghi\n"+--+-- @since 0.8.0+{-# INLINE intercalateSuffix #-}+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.intersperseMSuffix (return seed) (toStreamD str)++------------------------------------------------------------------------------+-- Combine N Streams - concatMap+------------------------------------------------------------------------------++-- | Flatten a stream of streams to a single stream.+--+-- @+-- concat = concatMap id+-- @+--+-- /Pre-release/+{-# INLINE concat #-}+concat :: (IsStream t, Monad m) => t m (t m a) -> t m a+concat = concatMap id++------------------------------------------------------------------------------+-- Combine N Streams - concatMap+------------------------------------------------------------------------------++-- | Like 'concatMapWith' but carries a state which can be used to share+-- information across multiple steps of concat.+--+-- @+-- concatSmapMWith combine f initial = concatMapWith combine id . smapM f initial+-- @+--+-- /Pre-release/+--+{-# INLINE concatSmapMWith #-}+concatSmapMWith+    :: (IsStream t, Monad m)+    => (t m b -> t m b -> t m b)+    -> (s -> a -> m (s, t m b))+    -> m s+    -> t m a+    -> t m b+concatSmapMWith combine f initial =+    IsStream.concatMapWith combine id . smapM f initial++-- XXX Implement a StreamD version for fusion.+--+-- | Combine streams in pairs using a binary stream combinator, then combine+-- the resulting streams in pairs recursively until we get to a single combined+-- stream.+--+-- For example, you can sort a stream using merge sort like this:+--+-- >>> Stream.toList $ Stream.concatPairsWith (Stream.mergeBy compare) Stream.fromPure $ Stream.fromList [5,1,7,9,2]+-- [1,2,5,7,9]+--+-- /Caution: the stream of streams must be finite/+--+-- /Pre-release/+--+{-# INLINE concatPairsWith #-}+concatPairsWith :: IsStream t =>+       (t m b -> t m b -> t m b)+    -> (a -> t m b)+    -> t m a+    -> t m b+concatPairsWith par f m =+    fromStream+        $ K.mergeMapWith+            (\s1 s2 -> toStream $ fromStream s1 `par` fromStream s2)+            (toStream . f)+            (toStream m)++------------------------------------------------------------------------------+-- IterateMap - Map and flatten Trees of Streams+------------------------------------------------------------------------------++-- | Like 'iterateM' but iterates after mapping a stream generator on the+-- output.+--+-- Yield an input element in the output stream, map a stream generator on it+-- and then do the same on the resulting stream. This can be used for a depth+-- first traversal of a tree like structure.+--+-- Note that 'iterateM' is a special case of 'iterateMapWith':+--+-- @+-- iterateM f = iterateMapWith serial (fromEffect . f) . fromEffect+-- @+--+-- It can be used to traverse a tree structure.  For example, to list a+-- directory tree:+--+-- @+-- Stream.iterateMapWith Stream.serial+--     (either Dir.toEither (const nil))+--     (fromPure (Left "tmp"))+-- @+--+-- /Pre-release/+--+{-# INLINE iterateMapWith #-}+iterateMapWith+    :: IsStream t+    => (t m a -> t m a -> t m a)+    -> (a -> t m a)+    -> t m a+    -> t m a+iterateMapWith combine f = IsStream.concatMapWith combine go+    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 = undefined++------------------------------------------------------------------------------+-- Flattening Graphs+------------------------------------------------------------------------------++-- To traverse graphs we need a state to be carried around in the traversal.+-- For example, we can use a hashmap to store the visited status of nodes.++-- | Like 'iterateMap' but carries a state in the stream generation function.+-- This can be used to traverse graph like structures, we can remember the+-- visited nodes in the state to avoid cycles.+--+-- Note that a combination of 'iterateMap' and 'usingState' can also be used to+-- traverse graphs. However, this function provides a more localized state+-- instead of using a global state.+--+-- See also: 'mfix'+--+-- /Pre-release/+--+{-# INLINE iterateSmapMWith #-}+iterateSmapMWith+    :: (IsStream t, Monad m)+    => (t m a -> t m a -> t m a)+    -> (b -> a -> m (b, t m a))+    -> m b+    -> t m a+    -> t m a+iterateSmapMWith combine f initial stream =+    concatMap+        (\b -> IsStream.concatMapWith combine (go b) stream)+        (fromEffect initial)++    where++    go b a = fromPure a `combine` feedback b a++    feedback b a =+        concatMap+            (\(b1, s) -> IsStream.concatMapWith combine (go b1) s)+            (fromEffect $ f b a)++------------------------------------------------------------------------------+-- 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':+--+-- @+-- iterateMapLeftsWith combine f = iterateMapWith combine (either f (const nil))+-- @+--+-- To traverse a directory tree:+--+-- @+-- iterateMapLeftsWith serial Dir.toEither (fromPure (Left "tmp"))+-- @+--+-- /Pre-release/+--+{-# INLINE iterateMapLeftsWith #-}+iterateMapLeftsWith+    :: (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
@@ -0,0 +1,642 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.IsStream.Generate+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Most of the combinators in this module can be implemented as unfolds. Some+-- of them however can only be expressed in terms StreamK e.g. cons/consM,+-- fromFoldable, mfix. We can possibly remove those from this module which can+-- be expressed as unfolds. Unless we want to use rewrite rules to rewrite them+-- 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 {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * Primitives+      IsStream.nil+    , IsStream.nilM+    , IsStream.cons+    , (IsStream..:)++    , consM+    , (|:)++    -- * From 'Unfold'+    , unfold+    , unfold0++    -- * Unfolding+    , unfoldr+    , unfoldrM++    -- * From Values+    , fromPure+    , fromEffect+    , repeat+    , repeatM+    , replicate+    , replicateM++    -- * Enumeration+    , Enumerable (..)+    , enumerate+    , enumerateTo++    -- * Time Enumeration+    , times+    , absTimes+    , absTimesWith+    , relTimes+    , relTimesWith+    , durations+    , ticks+    , timeout++    -- * From Generators+    , fromIndices+    , fromIndicesM+    -- , generate+    -- , generateM++    -- * Iteration+    , iterate+    , iterateM++    -- * Cyclic Elements+    , mfix++    -- * From Containers+    , IsStream.fromList+    , fromListM+    , fromFoldable+    , fromFoldableM+    , fromCallback+    , fromPrimIORef++    -- * Deprecated+    , yield+    , yieldM+    , fromHandle+    , currentTime+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(..))+import Data.Void (Void)+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Unfold (Unfold)+import Streamly.Internal.Data.SVar (Rate (..))+import Streamly.Internal.Data.Stream.IsStream.Enumeration+    (Enumerable(..), enumerate, enumerateTo)+import Streamly.Internal.Data.Stream.IsStream.Common+    ( absTimesWith, concatM, relTimesWith, timesWith, fromPure, fromEffect+    , yield, yieldM, repeatM)+import Streamly.Internal.Data.Stream.IsStream.Type+    (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.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 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+-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream+-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold+-- >>> import Control.Concurrent (threadDelay)+-- >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))+--+-- >>> hSetBuffering stdout LineBuffering++------------------------------------------------------------------------------+-- From Unfold+------------------------------------------------------------------------------++-- | Convert an 'Unfold' into a stream by supplying it an input seed.+--+-- >>> Stream.drain $ Stream.unfold Unfold.replicateM (3, putStrLn "hello")+-- hello+-- hello+-- hello+--+-- /Since: 0.7.0/+{-# INLINE unfold #-}+unfold :: (IsStream t, Monad m) => Unfold m a b -> a -> t m b+unfold unf x = fromStreamD $ D.unfold unf x++-- | Convert an 'Unfold' with a closed input end into a stream.+--+-- /Pre-release/+{-# INLINE unfold0 #-}+unfold0 :: (IsStream t, Monad m) => Unfold m Void b -> t m b+unfold0 unf = unfold unf (error "unfold0: unexpected void evaluation")++------------------------------------------------------------------------------+-- Generation by Unfolding+------------------------------------------------------------------------------++-- |+-- >>> :{+-- unfoldr step s =+--     case step s of+--         Nothing -> Stream.nil+--         Just (a, b) -> a `Stream.cons` unfoldr step b+-- :}+--+-- Build a stream by unfolding a /pure/ step function @step@ starting from a+-- seed @s@.  The step function returns the next element in the stream and the+-- next seed value. When it is done it returns 'Nothing' and the stream ends.+-- For example,+--+-- >>> :{+-- let f b =+--         if b > 2+--         then Nothing+--         else Just (b, b + 1)+-- in Stream.toList $ Stream.unfoldr f 0+-- :}+-- [0,1,2]+--+-- @since 0.1.0+{-# INLINE_EARLY unfoldr #-}+unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a+unfoldr step seed = fromStreamD (D.unfoldr step seed)+{-# RULES "unfoldr fallback to StreamK" [1]+    forall a b. D.toStreamK (D.unfoldr a b) = K.unfoldr a b #-}++-- | Build a stream by unfolding a /monadic/ step function starting from a+-- seed.  The step function returns the next element in the stream and the next+-- seed value. When it is done it returns 'Nothing' and the stream ends. For+-- example,+--+-- >>> :{+-- let f b =+--         if b > 2+--         then return Nothing+--         else return (Just (b, b + 1))+-- in Stream.toList $ Stream.unfoldrM f 0+-- :}+-- [0,1,2]+--+-- When run concurrently, the next unfold step can run concurrently with the+-- processing of the output of the previous step.  Note that more than one step+-- cannot run concurrently as the next step depends on the output of the+-- previous step.+--+-- >>> :{+-- let f b =+--         if b > 2+--         then return Nothing+--         else threadDelay 1000000 >> return (Just (b, b + 1))+-- in Stream.toList $ Stream.delay 1 $ Stream.fromAsync $ Stream.unfoldrM f 0+-- :}+-- [0,1,2]+--+-- /Concurrent/+--+-- /Since: 0.1.0/+{-# INLINE_EARLY unfoldrM #-}+unfoldrM :: forall t m b a. (IsStream t, MonadAsync m) =>+    (b -> m (Maybe (a, b))) -> b -> t m a+unfoldrM step = fromStream . K.unfoldrMWith (IsStream.toConsK (consM @t)) step++{-# RULES "unfoldrM serial" unfoldrM = unfoldrMSerial #-}+{-# INLINE_EARLY unfoldrMSerial #-}+unfoldrMSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> SerialT m a+unfoldrMSerial = Serial.unfoldrM++{-# RULES "unfoldrM wSerial" unfoldrM = unfoldrMWSerial #-}+{-# INLINE_EARLY unfoldrMWSerial #-}+unfoldrMWSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> WSerialT m a+unfoldrMWSerial f = fromSerial . Serial.unfoldrM f++{-# RULES "unfoldrM zipSerial" unfoldrM = unfoldrMZipSerial #-}+{-# INLINE_EARLY unfoldrMZipSerial #-}+unfoldrMZipSerial :: MonadAsync m =>+    (b -> m (Maybe (a, b))) -> b -> IsStream.ZipSerialM m a+unfoldrMZipSerial f = fromSerial . Serial.unfoldrM f++------------------------------------------------------------------------------+-- From Values+------------------------------------------------------------------------------++-- |+-- Generate an infinite stream by repeating a pure value.+--+-- @since 0.4.0+{-# INLINE_NORMAL repeat #-}+repeat :: (IsStream t, Monad m) => a -> t m a+repeat = fromStreamD . D.repeat++-- |+-- >>> replicate n = Stream.take n . Stream.repeat+--+-- Generate a stream of length @n@ by repeating a value @n@ times.+--+-- @since 0.6.0+{-# INLINE_NORMAL replicate #-}+replicate :: (IsStream t, Monad m) => Int -> a -> t m a+replicate n = fromStreamD . D.replicate n++-- |+-- >>> replicateM n = Stream.take n . Stream.repeatM+--+-- Generate a stream by performing a monadic action @n@ times. Same as:+--+-- >>> pr n = threadDelay 1000000 >> print n+--+-- This runs serially and takes 3 seconds:+--+-- >>> Stream.drain $ Stream.fromSerial $ Stream.replicateM 3 $ pr 1+-- 1+-- 1+-- 1+--+-- This runs concurrently and takes just 1 second:+--+-- >>> Stream.drain $ Stream.fromAsync  $ Stream.replicateM 3 $ pr 1+-- 1+-- 1+-- 1+--+-- /Concurrent/+--+-- @since 0.1.1+{-# INLINE_EARLY replicateM #-}+replicateM :: forall t m a. (IsStream t, MonadAsync m) => Int -> m a -> t m a+replicateM count =+    fromStream . K.replicateMWith (IsStream.toConsK (consM @t)) count++{-# RULES "replicateM serial" replicateM = replicateMSerial #-}+{-# INLINE replicateMSerial #-}+replicateMSerial :: MonadAsync m => Int -> m a -> SerialT m a+replicateMSerial n = fromStreamD . D.replicateM n++------------------------------------------------------------------------------+-- Time Enumeration+------------------------------------------------------------------------------++-- | @times@ returns a stream of time value tuples with clock of 10 ms+-- granularity. The first component of the tuple is an absolute time reference+-- (epoch) denoting the start of the stream and the second component is a time+-- relative to the reference.+--+-- >>> Stream.mapM_ (\x -> print x >> threadDelay 1000000) $ Stream.take 3 $ Stream.times+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE times #-}+times :: (IsStream t, MonadAsync m) => t m (AbsTime, RelTime64)+times = timesWith 0.01++-- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms+-- granularity.+--+-- >>> Stream.mapM_ print $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE absTimes #-}+absTimes :: (IsStream t, MonadAsync m, Functor (t m)) => t m AbsTime+absTimes = fmap (uncurry addToAbsTime64) times++{-# DEPRECATED currentTime "Please use absTimes instead" #-}+{-# INLINE currentTime #-}+currentTime :: (IsStream t, MonadAsync m, Functor (t m))+    => Double -> t m AbsTime+currentTime = absTimesWith++-- | @relTimes@ returns a stream of relative time values starting from 0,+-- using a clock of granularity 10 ms.+--+-- >>> Stream.mapM_ print $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE relTimes #-}+relTimes :: (IsStream t, MonadAsync m, Functor (t m)) => t m RelTime64+relTimes = fmap snd times++-- | @durations g@ returns a stream of relative time values measuring the time+-- elapsed since the immediate predecessor element of the stream was generated.+-- The first element of the stream is always 0. @durations@ uses a clock of+-- granularity @g@ specified in seconds. A low granularity clock is more+-- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.+-- Durations lower than 1 ms will be 0.+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Unimplemented/+--+{-# INLINE durations #-}+durations :: -- (IsStream t, MonadAsync m) =>+    Double -> t m RelTime64+durations = undefined++-- | Generate ticks 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.+--+-- /Unimplemented/+--+{-# INLINE ticks #-}+ticks :: -- (IsStream t, MonadAsync m) =>+    Rate -> t m ()+ticks = undefined++-- | Generate a singleton event at or after the specified absolute time. Note+-- that this is different from a threadDelay, a threadDelay starts from the+-- time when the action is evaluated, whereas if we use AbsTime based timeout+-- it will immediately expire if the action is evaluated too late.+--+-- /Unimplemented/+--+{-# INLINE timeout #-}+timeout :: -- (IsStream t, MonadAsync m) =>+    AbsTime -> t m ()+timeout = undefined++------------------------------------------------------------------------------+-- From Generator functions+------------------------------------------------------------------------------++-- XXX we can remove it and recommend the definition in terms of enumerate and+-- map. Check performance equivalence.+--+-- |+-- >>> fromIndices f = fmap f $ Stream.enumerateFrom 0+-- >>> fromIndices f = let g i = f i `Stream.cons` g (i + 1) in g 0+--+-- Generate an infinite stream, whose values are the output of a function @f@+-- applied on the corresponding index.  Index starts at 0.+--+-- >>> Stream.toList $ Stream.take 5 $ Stream.fromIndices id+-- [0,1,2,3,4]+--+-- @since 0.6.0+{-# INLINE fromIndices #-}+fromIndices :: (IsStream t, Monad m) => (Int -> a) -> t m a+fromIndices = fromStreamD . D.fromIndices++--+-- |+-- >>> fromIndicesM f = Stream.mapM f $ Stream.enumerateFrom 0+-- >>> fromIndicesM f = let g i = f i `Stream.consM` g (i + 1) in g 0+--+-- Generate an infinite stream, whose values are the output of a monadic+-- function @f@ applied on the corresponding index. Index starts at 0.+--+-- /Concurrent/+--+-- @since 0.6.0+{-# INLINE_EARLY fromIndicesM #-}+fromIndicesM :: forall t m a. (IsStream t, MonadAsync m) =>+    (Int -> m a) -> t m a+fromIndicesM = fromStream . K.fromIndicesMWith (IsStream.toConsK (consM @t))++{-# RULES "fromIndicesM serial" fromIndicesM = fromIndicesMSerial #-}+{-# INLINE fromIndicesMSerial #-}+fromIndicesMSerial :: MonadAsync m => (Int -> m a) -> SerialT m a+fromIndicesMSerial = fromStreamD . D.fromIndicesM++------------------------------------------------------------------------------+-- Iterating functions+------------------------------------------------------------------------------++-- |+-- >>> iterate f x = x `Stream.cons` iterate f x+--+-- Generate an infinite stream with @x@ as the first element and each+-- successive element derived by applying the function @f@ on the previous+-- element.+--+-- >>> Stream.toList $ Stream.take 5 $ Stream.iterate (+1) 1+-- [1,2,3,4,5]+--+-- @since 0.1.2+{-# INLINE_NORMAL iterate #-}+iterate :: (IsStream t, Monad m) => (a -> a) -> a -> t m a+iterate step = fromStreamD . D.iterate step++-- |+-- >>> iterateM f m = m >>= \a -> return a `Stream.consM` iterateM f (f a)+--+-- Generate an infinite stream with the first element generated by the action+-- @m@ and each successive element derived by applying the monadic function+-- @f@ on the previous element.+--+-- >>> pr n = threadDelay 1000000 >> print n+-- >>> :{+-- Stream.iterateM (\x -> pr x >> return (x + 1)) (return 0)+--     & Stream.take 3+--     & Stream.fromSerial+--     & Stream.toList+-- :}+-- 0+-- 1+-- [0,1,2]+--+-- When run concurrently, the next iteration can run concurrently with the+-- processing of the previous iteration. Note that more than one iteration+-- cannot run concurrently as the next iteration depends on the output of the+-- previous iteration.+--+-- >>> :{+-- Stream.iterateM (\x -> pr x >> return (x + 1)) (return 0)+--     & Stream.delay 1+--     & Stream.take 3+--     & Stream.fromAsync+--     & Stream.toList+-- :}+-- 0+-- 1+-- ...+--+-- /Concurrent/+--+-- /Since: 0.1.2/+--+-- /Since: 0.7.0 (signature change)/+{-# INLINE_EARLY iterateM #-}+iterateM :: forall t m a. (IsStream t, MonadAsync m) =>+    (a -> m a) -> m a -> t m a+iterateM f = fromStream . K.iterateMWith (IsStream.toConsK (consM @t))  f++{-# RULES "iterateM serial" iterateM = iterateMSerial #-}+{-# INLINE iterateMSerial #-}+iterateMSerial :: MonadAsync m => (a -> m a) -> m a -> SerialT m a+iterateMSerial step = fromStreamD . D.iterateM step++-- | We can define cyclic structures using @let@:+--+-- >>> let (a, b) = ([1, b], head a) in (a, b)+-- ([1,1],1)+--+-- The function @fix@ defined as:+--+-- >>> fix f = let x = f x in x+--+-- ensures that the argument of a function and its output refer to the same+-- lazy value @x@ i.e.  the same location in memory.  Thus @x@ can be defined+-- in terms of itself, creating structures with cyclic references.+--+-- >>> f ~(a, b) = ([1, b], head a)+-- >>> fix f+-- ([1,1],1)+--+-- 'Control.Monad.mfix' is essentially the same as @fix@ but for monadic+-- values.+--+-- Using 'mfix' for streams we can construct a stream in which each element of+-- the stream is defined in a cyclic fashion. The argument of the function+-- being fixed represents the current element of the stream which is being+-- returned by the stream monad. Thus, we can use the argument to construct+-- itself.+--+-- /Pre-release/+{-# INLINE mfix #-}+mfix :: (IsStream t, Monad m) => (m a -> t m a) -> t m a+mfix f = fromStream $ K.mfix (toStream . f)++------------------------------------------------------------------------------+-- Conversions+------------------------------------------------------------------------------++-- |+-- >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil+--+-- Construct a stream from a 'Foldable' containing pure values:+--+-- @since 0.2.0+{-# INLINE fromFoldable #-}+fromFoldable :: (IsStream t, Foldable f) => f a -> t m a+fromFoldable = fromStream . K.fromFoldable++-- |+-- >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil+--+-- Construct a stream from a 'Foldable' containing monadic actions.+--+-- >>> pr n = threadDelay 1000000 >> print n+-- >>> Stream.drain $ Stream.fromSerial $ Stream.fromFoldableM $ map pr [1,2,3]+-- 1+-- 2+-- 3+--+-- >>> Stream.drain $ Stream.fromAsync $ Stream.fromFoldableM $ map pr [1,2,3]+-- ...+-- ...+-- ...+--+-- /Concurrent (do not use with 'fromParallel' on infinite containers)/+--+-- @since 0.3.0+{-# INLINE fromFoldableM #-}+fromFoldableM :: (IsStream t, MonadAsync m, Foldable f) => f (m a) -> t m a+fromFoldableM = Prelude.foldr consM IsStream.nil++-- |+-- >>> fromListM = Stream.fromFoldableM+-- >>> fromListM = Stream.sequence . Stream.fromList+-- >>> fromListM = Stream.mapM id . Stream.fromList+-- >>> fromListM = Prelude.foldr Stream.consM Stream.nil+--+-- Construct a stream from a list of monadic actions. This is more efficient+-- than 'fromFoldableM' for serial streams.+--+-- @since 0.4.0+{-# INLINE_EARLY fromListM #-}+fromListM :: (MonadAsync m, IsStream t) => [m a] -> t m a+fromListM = fromFoldableM+{-# RULES "fromListM fallback to StreamK" [1]+    forall a. D.toStreamK (D.fromListM a) = K.fromFoldableM a #-}++{-# RULES "fromListM serial" fromListM = fromListMSerial #-}+{-# INLINE_EARLY fromListMSerial #-}+fromListMSerial :: MonadAsync m => [m a] -> SerialT m a+fromListMSerial = fromStreamD . D.fromListM++-- | Read lines from an IO Handle into a stream of Strings.+--+-- @since 0.1.0+{-# DEPRECATED fromHandle+   "Please use Streamly.FileSystem.Handle module (see the changelog)" #-}+fromHandle :: (IsStream t, MonadIO m) => IO.Handle -> t m String+fromHandle h = go+  where+  go = IsStream.mkStream $ \_ yld _ stp -> do+        eof <- liftIO $ IO.hIsEOF h+        if eof+        then stp+        else do+            str <- liftIO $ IO.hGetLine h+            yld str go++-- XXX This should perhaps be moved to Parallel+--+-- | Takes a callback setter function and provides it with a callback.  The+-- callback when invoked adds a value at the tail of the stream. Returns a+-- stream of values generated by the callback.+--+-- /Pre-release/+--+{-# INLINE fromCallback #-}+fromCallback :: MonadAsync m => ((a -> m ()) -> m ()) -> SerialT m a+fromCallback setCallback = concatM $ do+    (callback, stream) <- Par.newCallbackStream+    setCallback callback+    return $ Stream.fromStreamK stream++-- | Construct a stream by reading an 'Unboxed' 'IORef' repeatedly.+--+-- /Pre-release/+--+{-# INLINE fromPrimIORef #-}+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
@@ -0,0 +1,150 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.IsStream.Lift+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.IsStream.Lift {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * Generalize Inner Monad+      hoist+    , generally++    -- * Transform Inner Monad+    , liftInner+    , usingReaderT+    , runReaderT+    , evalStateT+    , usingStateT+    , runStateT+    )+where++#include "inline.hs"++import Control.Monad.Trans.Reader (ReaderT)+import Control.Monad.Trans.State.Strict (StateT)+import Control.Monad.Trans.Class (MonadTrans(..))+import Data.Functor.Identity (Identity (..))+import Streamly.Internal.Data.Stream.IsStream.Type+    (IsStream(..), fromStreamD, toStreamD)+import Streamly.Internal.Data.Stream.Serial (SerialT)++import qualified Streamly.Internal.Data.Stream as D+    (morphInner, liftInner, runReaderT, evalStateT, runStateT)++------------------------------------------------------------------------------+-- Generalize the underlying monad+------------------------------------------------------------------------------++-- | Transform the inner monad of a stream using a natural transformation.+--+-- / Internal/+--+{-# INLINE hoist #-}+hoist :: (Monad m, Monad n)+    => (forall x. m x -> n x) -> SerialT m a -> SerialT n a+hoist f xs = fromStreamD $ D.morphInner f (toStreamD xs)++-- | Generalize the inner monad of the stream from 'Identity' to any monad.+--+-- / Internal/+--+{-# INLINE generally #-}+generally :: (IsStream t, Monad m) => t Identity a -> t m a+generally xs = fromStreamD $ D.morphInner (return . runIdentity) (toStreamD xs)++------------------------------------------------------------------------------+-- Add and remove a monad transformer+------------------------------------------------------------------------------++-- | Lift the inner monad @m@ of a stream @t m a@ to @tr m@ using the monad+-- transformer @tr@.+--+-- @since 0.8.0+--+{-# INLINE liftInner #-}+liftInner :: (Monad m, IsStream t, MonadTrans tr, Monad (tr m))+    => t m a -> t (tr m) a+liftInner xs = fromStreamD $ D.liftInner (toStreamD xs)++------------------------------------------------------------------------------+-- Sharing read only state in a stream+------------------------------------------------------------------------------++-- | Evaluate the inner monad of a stream as 'ReaderT'.+--+-- @since 0.8.0+--+{-# INLINE runReaderT #-}+runReaderT :: (IsStream t, Monad m) => m s -> t (ReaderT s m) a -> t m a+runReaderT s xs = fromStreamD $ D.runReaderT s (toStreamD xs)++-- | Run a stream transformation using a given environment.+--+-- See also: 'Serial.map'+--+-- / Internal/+--+{-# INLINE usingReaderT #-}+usingReaderT+    :: (Monad m, IsStream t)+    => m r+    -> (t (ReaderT r m) a -> t (ReaderT r m) a)+    -> t m a+    -> t m a+usingReaderT r f xs = runReaderT r $ f $ liftInner xs++------------------------------------------------------------------------------+-- Sharing read write state in a stream+------------------------------------------------------------------------------++-- | Evaluate the inner monad of a stream as 'StateT'.+--+-- This is supported only for 'SerialT' as concurrent state updation may not be+-- safe.+--+-- > evalStateT s = Stream.map snd . Stream.runStateT s+--+-- / Internal/+--+{-# INLINE evalStateT #-}+evalStateT ::  Monad m => m s -> SerialT (StateT s m) a -> SerialT m a+-- evalStateT s = fmap snd . runStateT s+evalStateT s xs = fromStreamD $ D.evalStateT s (toStreamD xs)++-- | Run a stateful (StateT) stream transformation using a given state.+--+-- This is supported only for 'SerialT' as concurrent state updation may not be+-- safe.+--+-- > usingStateT s f = evalStateT s . f . liftInner+--+-- See also: 'scanl''+--+-- / Internal/+--+{-# INLINE usingStateT #-}+usingStateT+    :: Monad m+    => m s+    -> (SerialT (StateT s m) a -> SerialT (StateT s m) a)+    -> SerialT m a+    -> SerialT m a+usingStateT s f = evalStateT s . f . liftInner++-- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting+-- state and value pair after each step.+--+-- This is supported only for 'SerialT' as concurrent state updation may not be+-- safe.+--+-- @since 0.8.0+--+{-# INLINE runStateT #-}+runStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m (s, a)+runStateT s xs = fromStreamD $ D.runStateT s (toStreamD xs)
+ src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs view
@@ -0,0 +1,1627 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.IsStream.Reduce+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Reduce streams by streams, folds or parsers.++module Streamly.Internal.Data.Stream.IsStream.Reduce {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * Reduce By Streams+      dropPrefix+    , dropInfix+    , dropSuffix++    -- * Reduce By Folds+    -- |+    -- Reduce a stream by folding or parsing chunks of the stream.  Functions+    -- generally ending in these shapes:+    --+    -- @+    -- f (Fold m a b) -> t m a -> t m b+    -- f (Parser a m b) -> t m a -> t m b+    -- @++    -- ** Generic Folding+    -- | Apply folds on a stream.+    , foldMany+    , foldManyPost+    , refoldMany+    , foldSequence+    , foldIterateM+    , refoldIterateM++    -- ** Chunking+    -- | Element unaware grouping.+    , chunksOf+    , arraysOf+    , intervalsOf+    , chunksOfTimeout++    -- ** Splitting+    -- | Streams can be sliced 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).++    -- -- *** Using Element Separators+    , splitOn+    , splitOnSuffix+    , splitOnPrefix+    , splitOnAny++    -- , splitBy+    , splitWithSuffix+    -- , splitByPrefix++    -- -- *** Splitting By Sequences+    , splitBySeq+    , splitOnSeq+    , splitOnSuffixSeq+    -- , splitOnPrefixSeq++    -- Keeping the delimiters+    , splitWithSuffixSeq+    -- , splitByPrefixSeq+    -- , wordsBySeq++    -- Splitting using multiple sequence separators+    -- , splitOnAnySeq+    , splitOnSuffixSeqAny+    -- , splitOnAnyPrefixSeq++    -- -- *** Splitting By Streams+    -- -- | Splitting a stream using another stream as separator.++    -- ** Keyed Window Classification++    -- | Split the stream into chunks or windows by position 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+    -- window termination can be dynamically controlled by the fold.+    --+    -- The term "chunk" is used for a window defined by position of elements+    -- and the term "session" is used for a time window.++    -- *** Tumbling Windows+    -- | A new window starts after the previous window is finished.++    -- , classifyChunksOf+    , classifySessionsByGeneric+    , classifySessionsBy+    , 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+    -}++    -- * Reduce By Parsers+    -- ** Generic Parsing+    -- | Apply parsers on a stream.+    , parseMany+    , parseManyD+    , parseManyTill+    , parseSequence+    , parseIterate++    -- ** Grouping+    -- 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.++    , wordsBy -- stripAndCompactBy+    , wordsOn+    , groups+    , groupsBy+    , groupsByRolling++    -- -- *** Searching Sequences+    -- , seqIndices -- search a sequence in the stream++    -- -- *** Searching Multiple Sequences+    -- , seqIndicesAny -- search any of the given sequence in the stream++    -- -- -- ** Searching Streams+    -- -- | Finding a stream within another stream.++    -- * Nested splitting+    , splitInnerBy+    , splitInnerBySuffix+    )+where++#include "inline.hs"++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 Foreign.Storable (Storable)+import Streamly.Internal.Control.Concurrent (MonadAsync)+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 (..), ParseError)+import Streamly.Internal.Data.Array (Array)+import Streamly.Internal.Data.Stream.IsStream.Common+    ( fold+    , interjectSuffix+    , intersperseM+    , map+    , 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 Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Array as A+    (chunksOf, read)+import qualified Streamly.Internal.Data.Fold as FL+    (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 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+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold+-- >>> import qualified Streamly.Internal.Data.Parser as Parser+-- >>> import qualified Streamly.Data.Array as Array++------------------------------------------------------------------------------+-- Trimming+------------------------------------------------------------------------------++-- | Drop prefix from the input stream if present.+--+-- Space: @O(1)@+--+-- /Unimplemented/+{-# INLINE dropPrefix #-}+dropPrefix ::+    -- (Eq a, IsStream t, Monad m) =>+    t m a -> t m a -> t m a+dropPrefix = error "Not implemented yet!"++-- | Drop all matching infix from the input stream if present. Infix stream+-- may be consumed multiple times.+--+-- Space: @O(n)@ where n is the length of the infix.+--+-- /Unimplemented/+{-# INLINE dropInfix #-}+dropInfix ::+    -- (Eq a, IsStream t, Monad m) =>+    t m a -> t m a -> t m a+dropInfix = error "Not implemented yet!"++-- | Drop suffix from the input stream if present. Suffix stream may be+-- consumed multiple times.+--+-- Space: @O(n)@ where n is the length of the suffix.+--+-- /Unimplemented/+{-# INLINE dropSuffix #-}+dropSuffix ::+    -- (Eq a, IsStream t, Monad m) =>+    t m a -> t m a -> t m a+dropSuffix = error "Not implemented yet!"++------------------------------------------------------------------------------+-- Folding+------------------------------------------------------------------------------++-- Splitting operations that take a predicate and a Fold can be+-- expressed using parseMany. Operations like chunksOf, intervalsOf, split*,+-- can be expressed using parseMany when used with an appropriate Parser.+--+-- XXX We need takeGE/takeBetween to implement "some" using "many".++-- | Apply a 'Fold' repeatedly on a stream and emit the fold outputs in the+-- output stream.+--+-- To sum every two contiguous elements in a stream:+--+-- >>> f = Fold.take 2 Fold.sum+-- >>> Stream.toList $ Stream.foldMany f $ Stream.fromList [1..10]+-- [3,7,11,15,19]+--+-- On an empty stream the output is empty:+--+-- >>> Stream.toList $ Stream.foldMany f $ Stream.fromList []+-- []+--+-- Note @Stream.foldMany (Fold.take 0)@ would result in an infinite loop in a+-- non-empty stream.+--+-- @since 0.8.0+--+{-# INLINE foldMany #-}+foldMany+    :: (IsStream t, Monad m)+    => Fold m a b+    -> t m a+    -> t m b+foldMany f m = fromStreamD $ D.foldMany f (toStreamD m)++-- | Like 'foldMany' but using the 'Refold' type instead of 'Fold'.+--+-- /Pre-release/+{-# INLINE refoldMany #-}+refoldMany :: (IsStream t, Monad m) =>+    Refold m c a b -> m c -> t m a -> t m b+refoldMany f action = fromStreamD . D.refoldMany f action . toStreamD++-- | Apply a stream of folds to an input stream and emit the results in the+-- output stream.+--+-- /Unimplemented/+--+{-# INLINE foldSequence #-}+foldSequence+       :: -- (IsStream t, Monad m) =>+       t m (Fold m a b)+    -> t m a+    -> t m b+foldSequence _f _m = undefined++-- | Iterate a fold generator on a stream. The initial value @b@ is used to+-- generate the first fold, the fold is applied on the stream and the result of+-- the fold is used to generate the next fold and so on.+--+-- @+-- >>> import Data.Monoid (Sum(..))+-- >>> f x = return (Fold.take 2 (Fold.sconcat x))+-- >>> s = Stream.map Sum $ Stream.fromList [1..10]+-- >>> Stream.toList $ Stream.map getSum $ Stream.foldIterateM f (pure 0) s+-- [3,10,21,36,55,55]+--+-- @+--+-- This is the streaming equivalent of monad like sequenced application of+-- folds where next fold is dependent on the previous fold.+--+-- /Pre-release/+--+{-# INLINE foldIterateM #-}+foldIterateM ::+       (IsStream t, Monad m) => (b -> m (Fold m a b)) -> m b -> t m a -> t m b+foldIterateM f i m = fromStreamD $ D.foldIterateM f i (toStreamD m)++-- | Like 'foldIterateM' but using the 'Refold' type instead. This could be+-- much more efficient due to stream fusion.+--+-- /Internal/+{-# INLINE refoldIterateM #-}+refoldIterateM :: (IsStream t, Monad m) =>+    Refold m b a b -> m b -> t m a -> t m b+refoldIterateM c i m = fromStreamD $ D.refoldIterateM c i (toStreamD m)++------------------------------------------------------------------------------+-- Parsing+------------------------------------------------------------------------------++-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the+-- output stream.+--+-- This is the streaming equivalent of the 'Streamly.Internal.Data.Parser.many'+-- parse combinator.+--+-- >>> Stream.toList $ Stream.parseMany (Parser.takeBetween 0 2 Fold.sum) $ Stream.fromList [1..10]+-- [Right 3,Right 7,Right 11,Right 15,Right 19]+--+-- @+-- > Stream.toList $ Stream.parseMany (Parser.line Fold.toList) $ Stream.fromList "hello\\nworld"+-- ["hello\\n","world"]+--+-- @+--+-- @+-- foldMany f = parseMany (fromFold f)+-- @+--+-- Known Issues: When the parser fails there is no way to get the remaining+-- stream.+--+-- /Pre-release/+--+{-# INLINE parseMany #-}+parseMany+    :: (IsStream t, Monad m)+    => Parser a m b+    -> t m a+    -> t m (Either ParseError b)+parseMany p m =+    fromStreamD $ D.parseManyD p (toStreamD m)++-- | Same as parseMany but for StreamD streams.+--+-- /Internal/+--+{-# INLINE parseManyD #-}+parseManyD+    :: (IsStream t, Monad m)+    => PRD.Parser a m b+    -> t m a+    -> t m (Either ParseError b)+parseManyD p m =+    fromStreamD $ D.parseManyD p (toStreamD m)++-- | Apply a stream of parsers to an input stream and emit the results in the+-- output stream.+--+-- /Unimplemented/+--+{-# INLINE parseSequence #-}+parseSequence+       :: -- (IsStream t, Monad m) =>+       t m (Parser a m b)+    -> t m a+    -> t m b+parseSequence _f _m = undefined++-- XXX Change the parser arguments' order+--+-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,+-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds+-- @test@ is tried again and so on. The parser stops when @test@ succeeds.  The+-- output of @test@ is discarded and the output of @collect@ is emitted in the+-- output stream. The parser fails if @collect@ fails.+--+-- /Unimplemented/+--+{-# INLINE parseManyTill #-}+parseManyTill ::+    -- (IsStream t, MonadThrow m) =>+       Parser a m b+    -> Parser a m x+    -> t m a+    -> t m b+parseManyTill = undefined++-- | Iterate a parser generating function on a stream. The initial value @b@ is+-- used to generate the first parser, the parser is applied on the stream and+-- the result is used to generate the next parser and so on.+--+-- >>> import Data.Monoid (Sum(..))+-- >>> 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+-- parsers where next parser is dependent on the previous parser.+--+-- /Pre-release/+--+{-# INLINE parseIterate #-}+parseIterate+    :: (IsStream t, Monad m)+    => (b -> Parser a m b)+    -> b+    -> t m a+    -> t m (Either ParseError b)+parseIterate f i m = fromStreamD $+    D.parseIterateD f i (toStreamD m)++------------------------------------------------------------------------------+-- Grouping+------------------------------------------------------------------------------++-- | @groupsBy cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the+-- first group, if @b \`cmp` a@ is 'True' then @b@ is also assigned to the same+-- group.  If @c \`cmp` a@ 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@ and the result of the fold is emitted in+-- the output stream.+--+-- >>> Stream.toList $ Stream.groupsBy (>) Fold.toList $ Stream.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 = fromStreamD $ D.groupsBy cmp f (toStreamD m)++-- | Unlike @groupsBy@ this function performs a rolling comparison of two+-- successive elements in the input stream. @groupsByRolling 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@.+--+-- >>> Stream.toList $ Stream.groupsByRolling (\a b -> a + 1 == b) Fold.toList $ Stream.fromList [1,2,3,7,8,9]+-- [[1,2,3],[7,8,9]]+--+-- @since 0.7.0+{-# INLINE groupsByRolling #-}+groupsByRolling+    :: (IsStream t, Monad m)+    => (a -> a -> Bool)+    -> Fold m a b+    -> t m a+    -> t m b+groupsByRolling cmp f m =  fromStreamD $ D.groupsRollingBy cmp f (toStreamD m)++-- |+-- > groups = groupsBy (==)+-- > groups = groupsByRolling (==)+--+-- Groups contiguous spans of equal elements together in individual groups.+--+-- >>> Stream.toList $ Stream.groups Fold.toList $ Stream.fromList [1,1,2,2]+-- [[1,1],[2,2]]+--+-- @since 0.7.0+{-# INLINE groups #-}+groups :: (IsStream t, Monad m, Eq a) => Fold m a b -> t m a -> t m b+groups = groupsBy (==)++------------------------------------------------------------------------------+-- Splitting - by a predicate+------------------------------------------------------------------------------++-- In general we can use deintercalate for splitting.  Then we can also use+-- uniqBy to condense the separators.  One way to generalize splitting is to+-- output:+--+-- data Segment a b = Empty | Segment b | Separator a+--+-- XXX splitOn and splitOnSuffix have a different behavior on an empty stream,+-- is that desirable?++-- | Split on an infixed separator element, dropping the separator.  The+-- supplied 'Fold' is applied on the split segments.  Splits the stream on+-- separator elements determined by the supplied predicate, separator is+-- considered as infixed between two segments:+--+-- >>> splitOn' p xs = Stream.toList $ Stream.splitOn p Fold.toList (Stream.fromList xs)+-- >>> splitOn' (== '.') "a.b"+-- ["a","b"]+--+-- An empty stream is folded to the default value of the fold:+--+-- >>> splitOn' (== '.') ""+-- [""]+--+-- If one or both sides of the separator are missing then the empty segment on+-- that side is folded to the default output of the fold:+--+-- >>> splitOn' (== '.') "."+-- ["",""]+--+-- >>> splitOn' (== '.') ".a"+-- ["","a"]+--+-- >>> splitOn' (== '.') "a."+-- ["a",""]+--+-- >>> splitOn' (== '.') "a..b"+-- ["a","","b"]+--+-- splitOn is an inverse of intercalating single element:+--+-- > Stream.intercalate (Stream.fromPure '.') Unfold.fromList . Stream.splitOn (== '.') Fold.toList === id+--+-- Assuming the input stream does not contain the separator:+--+-- > Stream.splitOn (== '.') Fold.toList . Stream.intercalate (Stream.fromPure '.') Unfold.fromList === id+--+-- @since 0.7.0++{-# INLINE splitOn #-}+splitOn+    :: (IsStream t, Monad m)+    => (a -> Bool) -> Fold m a b -> t m a -> t m b+splitOn predicate f =+    -- We can express the infix splitting in terms of optional suffix split+    -- fold.  After applying a suffix split fold repeatedly if the last segment+    -- ends with a suffix then we need to return the default output of the fold+    -- after that to make it an infix split.+    --+    -- Alternately, we can also express it using an optional prefix split fold.+    -- If the first segment starts with a prefix then we need to emit the+    -- default output of the fold before that to make it an infix split, and+    -- then apply prefix split fold repeatedly.+    --+    -- Since a suffix split fold can be easily expressed using a+    -- non-backtracking fold, we use that.+    foldManyPost (FL.takeEndBy_ predicate f)++-- | Split on a suffixed separator element, dropping the separator.  The+-- supplied 'Fold' is applied on the split segments.+--+-- >>> splitOnSuffix' p xs = Stream.toList $ Stream.splitOnSuffix p Fold.toList (Stream.fromList xs)+-- >>> splitOnSuffix' (== '.') "a.b."+-- ["a","b"]+--+-- >>> splitOnSuffix' (== '.') "a."+-- ["a"]+--+-- An empty stream results in an empty output stream:+--+-- >>> splitOnSuffix' (== '.') ""+-- []+--+-- An empty segment consisting of only a suffix is folded to the default output+-- of the fold:+--+-- >>> splitOnSuffix' (== '.') "."+-- [""]+--+-- >>> splitOnSuffix' (== '.') "a..b.."+-- ["a","","b",""]+--+-- A suffix is optional at the end of the stream:+--+-- >>> splitOnSuffix' (== '.') "a"+-- ["a"]+--+-- >>> splitOnSuffix' (== '.') ".a"+-- ["","a"]+--+-- >>> splitOnSuffix' (== '.') "a.b"+-- ["a","b"]+--+-- > lines = splitOnSuffix (== '\n')+--+-- 'splitOnSuffix' is an inverse of 'intercalateSuffix' with a single element:+--+-- > Stream.intercalateSuffix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnSuffix (== '.') Fold.toList === id+--+-- Assuming the input stream does not contain the separator:+--+-- > Stream.splitOnSuffix (== '.') Fold.toList . Stream.intercalateSuffix (Stream.fromPure '.') Unfold.fromList === id+--+-- @since 0.7.0++{-# INLINE splitOnSuffix #-}+splitOnSuffix+    :: (IsStream t, Monad m)+    => (a -> Bool) -> Fold m a b -> t m a -> t m b+splitOnSuffix predicate f = foldMany (FL.takeEndBy_ predicate f)++-- | Split on a prefixed separator element, dropping the separator.  The+-- supplied 'Fold' is applied on the split segments.+--+-- @+-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)+-- > splitOnPrefix' (== '.') ".a.b"+-- ["a","b"]+-- @+--+-- An empty stream results in an empty output stream:+-- @+-- > splitOnPrefix' (== '.') ""+-- []+-- @+--+-- An empty segment consisting of only a prefix is folded to the default output+-- of the fold:+--+-- @+-- > splitOnPrefix' (== '.') "."+-- [""]+--+-- > splitOnPrefix' (== '.') ".a.b."+-- ["a","b",""]+--+-- > splitOnPrefix' (== '.') ".a..b"+-- ["a","","b"]+--+-- @+--+-- A prefix is optional at the beginning of the stream:+--+-- @+-- > splitOnPrefix' (== '.') "a"+-- ["a"]+--+-- > splitOnPrefix' (== '.') "a.b"+-- ["a","b"]+-- @+--+-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:+--+-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id+--+-- Assuming the input stream does not contain the separator:+--+-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id+--+-- /Unimplemented/++{-# INLINE splitOnPrefix #-}+splitOnPrefix :: -- (IsStream t, MonadCatch m) =>+    (a -> Bool) -> Fold m a b -> t m a -> t m b+splitOnPrefix _predicate _f = undefined+    -- parseMany (Parser.sliceBeginBy predicate f)++-- | Like 'splitOn' after stripping leading, trailing, and repeated separators.+-- Therefore, @".a..b."@ with '.' as the separator would be parsed as+-- @["a","b"]@.  In other words, its like parsing words from whitespace+-- separated text.+--+-- >>> wordsBy' p xs = Stream.toList $ Stream.wordsBy p Fold.toList (Stream.fromList xs)+--+-- >>> wordsBy' (== ',') ""+-- []+--+-- >>> wordsBy' (== ',') ","+-- []+--+-- >>> wordsBy' (== ',') ",a,,b,"+-- ["a","b"]+--+-- > words = wordsBy isSpace+--+-- @since 0.7.0++-- It is equivalent to splitting in any of the infix/prefix/suffix styles+-- followed by removal of empty segments.+{-# INLINE wordsBy #-}+wordsBy+    :: (IsStream t, Monad m)+    => (a -> Bool) -> Fold m a b -> t m a -> t m b+wordsBy predicate f m =+    fromStreamD $ D.wordsBy predicate f (toStreamD m)++-- | Like 'splitOnSuffix' but keeps the suffix attached to the resulting+-- splits.+--+-- >>> splitWithSuffix' p xs = Stream.toList $ splitWithSuffix p Fold.toList (Stream.fromList xs)+--+-- >>> splitWithSuffix' (== '.') ""+-- []+--+-- >>> splitWithSuffix' (== '.') "."+-- ["."]+--+-- >>> splitWithSuffix' (== '.') "a"+-- ["a"]+--+-- >>> splitWithSuffix' (== '.') ".a"+-- [".","a"]+--+-- >>> splitWithSuffix' (== '.') "a."+-- ["a."]+--+-- >>> splitWithSuffix' (== '.') "a.b"+-- ["a.","b"]+--+-- >>> splitWithSuffix' (== '.') "a.b."+-- ["a.","b."]+--+-- >>> splitWithSuffix' (== '.') "a..b.."+-- ["a.",".","b.","."]+--+-- @since 0.7.0++{-# INLINE splitWithSuffix #-}+splitWithSuffix+    :: (IsStream t, Monad m)+    => (a -> Bool) -> Fold m a b -> t m a -> t m b+splitWithSuffix predicate f = foldMany (FL.takeEndBy predicate f)++------------------------------------------------------------------------------+-- Splitting - 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]+-- > [[],[]]++-- This can be implemented easily using Rabin Karp+-- | Split on any one of the given patterns.+--+-- /Unimplemented/+--+{-# INLINE splitOnAny #-}+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+-- split consumer fold. The input is fed to the ring fold first and the+-- rejected input is fed to the split fold. If the separator matches, the ring+-- fold would consume all.+--+-- | Like 'splitOnSeq' but splits the separator as well, as an infix token.+--+-- >>> splitOn'_ pat xs = Stream.toList $ Stream.splitBySeq (Array.fromList pat) Fold.toList (Stream.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"]+--+-- /Pre-release/+{-# INLINE splitBySeq #-}+splitBySeq+    :: (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 (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.+--+-- >>> splitOnSuffixSeq_ pat xs = Stream.toList $ Stream.splitOnSuffixSeq (Array.fromList pat) Fold.toList (Stream.fromList xs)+--+-- >>> splitOnSuffixSeq_ "." ""+-- []+--+-- >>> splitOnSuffixSeq_ "." "."+-- [""]+--+-- >>> splitOnSuffixSeq_ "." "a"+-- ["a"]+--+-- >>> splitOnSuffixSeq_ "." ".a"+-- ["","a"]+--+-- >>> splitOnSuffixSeq_ "." "a."+-- ["a"]+--+-- >>> splitOnSuffixSeq_ "." "a.b"+-- ["a","b"]+--+-- >>> splitOnSuffixSeq_ "." "a.b."+-- ["a","b"]+--+-- >>> splitOnSuffixSeq_ "." "a..b.."+-- ["a","","b",""]+--+-- > lines = splitOnSuffixSeq "\n"+--+-- 'splitOnSuffixSeq' is an inverse of 'intercalateSuffix'. The following law+-- always holds:+--+-- > intercalateSuffix . splitOnSuffixSeq == id+--+-- The following law holds when the separator is non-empty and contains none of+-- the elements present in the input lists:+--+-- > splitSuffixOn . intercalateSuffix == id+--+-- >>> splitOnSuffixSeq pat f = Stream.foldMany (Fold.takeEndBySeq_ pat f)+--+-- /Pre-release/+{-# INLINE splitOnSuffixSeq #-}+splitOnSuffixSeq+    :: (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, 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.+--+-- >>> splitWithSuffixSeq' pat xs = Stream.toList $ Stream.splitWithSuffixSeq (Array.fromList pat) Fold.toList (Stream.fromList xs)+--+-- >>> splitWithSuffixSeq' "." ""+-- []+--+-- >>> splitWithSuffixSeq' "." "."+-- ["."]+--+-- >>> splitWithSuffixSeq' "." "a"+-- ["a"]+--+-- >>> splitWithSuffixSeq' "." ".a"+-- [".","a"]+--+-- >>> splitWithSuffixSeq' "." "a."+-- ["a."]+--+-- >>> splitWithSuffixSeq' "." "a.b"+-- ["a.","b"]+--+-- >>> splitWithSuffixSeq' "." "a.b."+-- ["a.","b."]+--+-- >>> 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, 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, 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+------------------------------------------------------------------------------++-- | Group the input stream into groups of @n@ elements each and then fold each+-- group using the provided fold function.+--+-- >>> Stream.toList $ Stream.chunksOf 2 Fold.sum (Stream.enumerateFromTo 1 10)+-- [3,7,11,15,19]+--+-- This can be considered as an n-fold version of 'take' where we apply+-- 'take' repeatedly on the leftover stream until the stream exhausts.+--+-- @chunksOf n f = foldMany (FL.take n f)@+--+-- @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 = fromStreamD . D.groupsOf n f . toStreamD++-- | @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 (A.writeN n)+--+-- /Pre-release/+{-# INLINE arraysOf #-}+arraysOf :: (IsStream t, MonadIO m, Unbox a)+    => Int -> t m a -> t m (Array a)+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+--+-- | Group the input stream into windows of @n@ second each and then fold each+-- group using the provided fold function.+--+-- >>> Stream.toList $ Stream.take 5 $ Stream.intervalsOf 1 Fold.sum $ Stream.constRate 2 $ Stream.enumerateFrom 1+-- [...,...,...,...,...]+--+-- @since 0.7.0+{-# INLINE intervalsOf #-}+intervalsOf+    :: (IsStream t, MonadAsync m)+    => Double -> Fold m a b -> t m a -> t m b+intervalsOf n f xs =+    splitWithSuffix isNothing (FL.catMaybes f)+        (interjectSuffix n (return Nothing) (map Just xs))++-- XXX This can be implemented more efficiently by sharing a Clock.Timer across+-- parallel threads and resetting it whenever a span is emitted.+--+-- | 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. 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+--+-- /Pre-release/+{-# INLINE chunksOfTimeout #-}+chunksOfTimeout :: (IsStream t, MonadAsync m, Functor (t m))+    => Int -> Double -> FL.Fold m a b -> t m a -> t m b+chunksOfTimeout n timeout f =+      map snd+    . classifySessionsBy+        0.1 False (const (return False)) timeout (FL.take n f)+    . Transform.timestamped+    . map ((),)++------------------------------------------------------------------------------+-- 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, Unbox 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, Unbox 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, 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, (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++    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 = IsStream.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 = fromPure (key, fb)+                    }+            partial fs1 = do+                let expiry = addToAbsTime timestamp timeoutMs+                (hp1, mp1, out1, cnt1) <- do+                        let vars = (sessionTimerHeap, sessionKeyValueMap,+                                           IsStream.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 $ FL.Partial acc+                _ -> initial+        case res0 of+            FL.Done _ ->+                error $ "classifySessionsBy: "+                    ++ "The supplied fold must consume at least one input"+            FL.Partial fs -> do+                res <- step fs value+                case res of+                    FL.Done fb -> done fb+                    FL.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.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'.+--+-- @+-- classifyKeepAliveSessions = classifySessionsBy 1 True+-- @+--+-- /Pre-release/+--+{-# INLINE classifyKeepAliveSessions #-}+classifyKeepAliveSessions ::+       (IsStream t, 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+    -> t m (AbsTime, (k, a)) -- ^ timestamp, (session key, session data)+    -> t 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 = classifySessionsBy 1 False+-- @+--+-- /Pre-release/+--+{-# INLINE classifySessionsOf #-}+classifySessionsOf ::+       (IsStream t, 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+    -> t m (AbsTime, (k, a)) -- ^ timestamp, (session key, session data)+    -> t m (k, b)+classifySessionsOf = classifySessionsBy 1 False++------------------------------------------------------------------------------+-- Nested Split+------------------------------------------------------------------------------++-- | @splitInnerBy splitter joiner stream@ splits the inner containers @f a@ of+-- an input stream @t m (f a)@ using the @splitter@ function. Container+-- elements @f a@ are collected until a split occurs, then all the elements+-- before the split are joined using the @joiner@ function.+--+-- For example, if we have a stream of @Array Word8@, we may want to split the+-- stream into arrays representing lines separated by '\n' byte such that the+-- resulting stream after a split would be one array for each line.+--+-- CAUTION! This is not a true streaming function as the container size after+-- the split and merge may not be bounded.+--+-- /Pre-release/+{-# INLINE splitInnerBy #-}+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)+    -> t m (f a)+splitInnerBy splitter joiner xs =+    fromStreamD $ D.splitInnerBy splitter joiner $ toStreamD xs++-- | Like 'splitInnerBy' but splits assuming the separator joins the segment in+-- a suffix style.+--+-- /Pre-release/+{-# INLINE splitInnerBySuffix #-}+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 (== mempty) splitter joiner $ toStreamD xs
+ src/Streamly/Internal/Data/Stream/IsStream/Top.hs view
@@ -0,0 +1,749 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.IsStream.Top+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Top level IsStream module that can use all other lower level IsStream+-- modules.++module Streamly.Internal.Data.Stream.IsStream.Top {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * Transformation+    -- ** Sampling+    -- | Value agnostic filtering.+      sampleFromThen+    , sampleIntervalStart+    , sampleIntervalEnd+    , sampleBurstStart+    , sampleBurstEnd++    -- ** Reordering+    , sortBy++    -- * Nesting+    -- ** Set like operations+    -- | These are not exactly set operations because streams are not+    -- necessarily sets, they may have duplicated elements.+    , intersectBy+    , intersectBySorted+    , differenceBy+    , mergeDifferenceBy+    , unionBy+    , mergeUnionBy++    -- ** Join operations+    , crossJoin+    , joinInner+    , joinInnerMap+    , joinInnerMerge+    -- , joinLeft+    , mergeLeftJoin+    , joinLeftMap+    -- , joinOuter+    , mergeOuterJoin+    , joinOuterMap+    )+where++#include "inline.hs"++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.Function ((&))+import Data.IORef (newIORef, readIORef, modifyIORef')+import Data.Kind (Type)+-- 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+    (IsStream(..), adapt, foldl', fromList)+import Streamly.Internal.Data.Stream.Serial (SerialT)+import Streamly.Internal.Data.Time.Units (NanoSecond64(..), toRelTime64)++import qualified Data.List as List+import qualified Data.Map.Strict as Map+-- 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+    (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 as StreamD++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++------------------------------------------------------------------------------+-- Sampling+------------------------------------------------------------------------------++-- XXX We can implement this using addition instead of "mod" to make it more+-- efficient.+--+-- | @sampleFromthen offset stride@ samples the element at @offset@ index and+-- then every element at strides of @stride@.+--+-- >>> Stream.toList $ Stream.sampleFromThen 2 3 $ Stream.enumerateFromTo 0 10+-- [2,5,8]+--+-- /Pre-release/+--+{-# INLINE sampleFromThen #-}+sampleFromThen :: (IsStream t, Monad m, Functor (t m)) =>+    Int -> Int -> t m a -> t m a+sampleFromThen offset stride =+    Stream.with Stream.indexed Stream.filter+        (\(i, _) -> i >= offset && (i - offset) `mod` stride == 0)++-- | Continuously evaluate the input stream and sample the last event in time+-- window of @n@ seconds.+--+-- This is also known as @throttle@ in some libraries.+--+-- @+-- sampleIntervalEnd n = Stream.catMaybes . Stream.intervalsOf n Fold.last+-- @+--+-- /Pre-release/+--+{-# INLINE sampleIntervalEnd #-}+sampleIntervalEnd :: (IsStream t, MonadAsync m, Functor (t m)) =>+    Double -> t m a -> t m a+sampleIntervalEnd n = Stream.catMaybes . Stream.intervalsOf n Fold.last++-- | Like 'sampleInterval' but samples at the beginning of the time window.+--+-- @+-- sampleIntervalStart n = Stream.catMaybes . Stream.intervalsOf n Fold.one+-- @+--+-- /Pre-release/+--+{-# 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.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 (in seconds) from the previous event.+--+-- This is known as @debounce@ in some libraries.+--+-- The clock granularity is 10 ms.+--+-- /Pre-release/+--+{-# INLINE sampleBurstEnd #-}+sampleBurstEnd :: (IsStream t, MonadAsync m, Functor (t m)) =>+    Double -> t m a -> t m a+sampleBurstEnd = sampleBurst True++-- | Like 'sampleBurstEnd' but samples the event at the beginning of the burst+-- instead of at the end of it.+--+-- /Pre-release/+--+{-# INLINE sampleBurstStart #-}+sampleBurstStart :: (IsStream t, MonadAsync m, Functor (t m)) =>+    Double -> t m a -> t m a+sampleBurstStart = sampleBurst False++------------------------------------------------------------------------------+-- Reordering+------------------------------------------------------------------------------+--+-- We could possibly choose different algorithms depending on whether the+-- input stream is almost sorted (ascending/descending) or random. We could+-- serialize the stream to an array and use quicksort.+--+-- | Sort the input stream using a supplied comparison function.+--+-- /O(n) space/+--+-- Note: this is not the fastest possible implementation as of now.+--+-- /Pre-release/+--+{-# INLINE sortBy #-}+sortBy :: MonadCatch m => (a -> a -> Ordering) -> SerialT m a -> SerialT m a+-- sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure+sortBy cmp =+    let p =+            Parser.groupByRollingEither+                (\x -> (< GT) . cmp x)+                (fmap fromStream Fold.toStreamKRev)+                (fmap fromStream Fold.toStreamK)+     in   Stream.concatPairsWith (Stream.mergeBy cmp) id+        . Stream.rights . Stream.parseMany (fmap (either id id) p)++------------------------------------------------------------------------------+-- SQL Joins+------------------------------------------------------------------------------+--+-- Some references:+-- * https://en.wikipedia.org/wiki/Relational_algebra+-- * https://en.wikipedia.org/wiki/Join_(SQL)++-- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only+-- constraint, the best would be to use an Array with linear search. If the+-- second stream is sorted we can also use a binary search, using Ord+-- constraint or an ordering function.+--+-- For Storables we can cache the second stream into an unboxed array for+-- possibly faster access/compact representation?+--+-- If we do not want to keep the stream in memory but always read it from the+-- source (disk/network) every time we iterate through it then we can do that+-- too by reading the stream every time, the stream must have immutable state+-- in that case and the user is responsible for the behavior if the stream+-- source changes during iterations. We can also use an Unfold instead of+-- stream. We probably need a way to distinguish streams that can be read+-- mutliple times without any interference (e.g. unfolding a stream using an+-- immutable handle would work i.e. using pread/pwrite instead of maintianing+-- an offset in the handle).++-- XXX We can do this concurrently.+--+-- | This is the same as 'Streamly.Internal.Data.Unfold.outerProduct' but less+-- efficient.+--+-- The second stream is evaluated multiple times. If the second stream is+-- consume-once stream then it can be cached in an 'Data.Array.Array' before+-- calling this function. Caching may also improve performance if the stream is+-- expensive to evaluate.+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE crossJoin #-}+crossJoin :: Monad (t m) => t m a -> t m b -> t m (a, b)+crossJoin s1 s2 = do+    -- XXX use concatMap instead?+    a <- s1+    b <- s2+    return (a, b)++-- XXX We can do this concurrently.+-- XXX If the second stream is sorted and passed as an Array we could use+-- binary search if we have an Ord instance or Ordering returning function. The+-- time complexity would then become (m x log n).+--+-- | For all elements in @t m a@, for all elements in @t m b@ if @a@ and @b@+-- are equal by the given equality pedicate then return the tuple (a, b).+--+-- The second stream is evaluated multiple times. If the stream is a+-- consume-once stream then the caller should cache it (e.g. in a+-- 'Data.Array.Array') before calling this function. Caching may also improve+-- performance if the stream is expensive to evaluate.+--+-- For space efficiency use the smaller stream as the second stream.+--+-- You should almost always use joinInnerMap instead of joinInner. joinInnerMap+-- is an order of magnitude faster. joinInner may be used when the second+-- stream is generated from a seed, therefore, need not be stored in memory and+-- the amount of memory it takes is a concern.+--+-- Space: O(n) assuming the second stream is cached in memory.+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE joinInner #-}+joinInner ::+    forall (t :: (Type -> Type) -> Type -> Type) m a b.+    (IsStream t, Monad m) =>+        (a -> b -> Bool) -> t m a -> t m b -> t m (a, b)+joinInner eq s1 s2 = do+    -- ConcatMap works faster than bind+    Stream.concatMap (\a ->+        Stream.concatMap (\b ->+            if a `eq` b+            then Stream.fromPure (a, b)+            else Stream.nil+            ) s2+        ) s1++-- XXX Generate error if a duplicate insertion is attempted?+toMap ::  (Monad m, Ord k) => IsStream.SerialT m (k, v) -> m (Map.Map k v)+toMap = Stream.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty++-- If the second stream is too big it can be partitioned based on hashes and+-- then we can process one parition at a time.+--+-- XXX An IntMap may be faster when the keys are Int.+-- XXX Use hashmap instead of map?+--+-- | Like 'joinInner' but uses a 'Map' for efficiency.+--+-- If the input streams have duplicate keys, the behavior is undefined.+--+-- For space efficiency use the smaller stream as the second stream.+--+-- Space: O(n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE joinInnerMap #-}+joinInnerMap :: (IsStream t, Monad m, Ord k) =>+    t m (k, a) -> t m (k, b) -> t m (k, a, b)+joinInnerMap s1 s2 =+    Stream.concatM $ do+        km <- toMap $ IsStream.adapt s2+        pure $ Stream.mapMaybe (joinAB km) s1++    where++    joinAB kvm (k, a) =+        case k `Map.lookup` kvm of+            Just b -> Just (k, a, b)+            Nothing -> Nothing++-- | Like 'joinInner' but works only on sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE joinInnerMerge #-}+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+-- Ordering returning function. The time complexity would then become (m x log+-- n).+--+-- | For all elements in @t m a@, for all elements in @t m b@ if @a@ and @b@+-- are equal then return the tuple @(a, Just b)@.  If @a@ is not present in @t+-- m b@ then return @(a, Nothing)@.+--+-- The second stream is evaluated multiple times. If the stream is a+-- consume-once stream then the caller should cache it in an 'Data.Array.Array'+-- before calling this function. Caching may also improve performance if the+-- stream is expensive to evaluate.+--+-- @+-- rightJoin = flip joinLeft+-- @+--+-- Space: O(n) assuming the second stream is cached in memory.+--+-- Time: O(m x n)+--+-- /Unimplemented/+{-# INLINE joinLeft #-}+joinLeft :: Monad m =>+    (a -> b -> Bool) -> SerialT m a -> SerialT m b -> SerialT m (a, Maybe b)+joinLeft eq s1 s2 = 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+    -- iteration?+    lift $ put False+    let final = do+            r <- lift get+            if r+            then Stream.nil+            else Stream.fromPure Nothing+    b <- fmap Just (Stream.liftInner s2) <> final+    case b of+        Just b1 ->+            if a `eq` b1+            then do+                lift $ put True+                return (a, Just b1)+            else Stream.nil+        Nothing -> return (a, Nothing)+-}++-- | Like 'joinLeft' but uses a hashmap for efficiency.+--+-- Space: O(n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE joinLeftMap #-}+joinLeftMap :: (IsStream t, Ord k, Monad m) =>+    t m (k, a) -> t m (k, b) -> t m (k, a, Maybe b)+joinLeftMap s1 s2 =+    Stream.concatM $ do+        km <- toMap $ IsStream.adapt s2+        return $ Stream.map (joinAB km) s1++            where++            joinAB km (k, a) =+                case k `Map.lookup` km of+                    Just b -> (k, a, Just b)+                    Nothing -> (k, a, Nothing)++-- | Like 'joinLeft' but works only on sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE mergeLeftJoin #-}+mergeLeftJoin :: -- Monad m =>+    (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@+-- are equal by the given equality pedicate then return the tuple (Just a, Just+-- b).  If @a@ is not found in @t m b@ then return (a, Nothing), return+-- (Nothing, b) for vice-versa.+--+-- For space efficiency use the smaller stream as the second stream.+--+-- Space: O(n)+--+-- Time: O(m x n)+--+-- /Unimplemented/+{-# INLINE joinOuter #-}+joinOuter :: MonadIO m =>+       (a -> b -> Bool)+    -> SerialT m a+    -> SerialT m b+    -> SerialT m (Maybe a, Maybe b)+joinOuter eq s1 s =+    Stream.concatM $ do+        inputArr <- Array.fromStream s+        let len = Array.length inputArr+        foundArr <-+            Stream.fold+            (MA.writeN len)+            (Stream.fromList (Prelude.replicate len False))+        return $ go inputArr foundArr <> leftOver inputArr foundArr++    where++    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 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+        -- iteration?+        lift $ put False+        let final = do+                r <- lift get+                if r+                then Stream.nil+                else Stream.fromPure Nothing+        (i, b) <-+            let stream = IsStream.fromSerial $ Array.read inputArr+             in Stream.indexed $ fmap Just (Stream.liftInner stream) <> final++        case b of+            Just b1 ->+                if a `eq` b1+                then do+                    lift $ put 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+-- hash to return (Nothing, b).+--+-- | Like 'joinOuter' but uses a 'Map' for efficiency.+--+-- Space: O(m + n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE joinOuterMap #-}+joinOuterMap ::+    (IsStream t, Ord k, MonadIO m) =>+    t m (k, a) -> t m (k, b) -> t m (k, Maybe a, Maybe b)+joinOuterMap s1 s2 =+    Stream.concatM $ do+        km1 <- kvFold $ IsStream.adapt s1+        km2 <- kvFold $ IsStream.adapt s2++        -- XXX Not sure if toList/fromList would fuse optimally. We may have to+        -- create a fused Map.toStream function.+        let res1 = Stream.map (joinAB km2) $ Stream.fromList $ Map.toList km1+                    where+                    joinAB km (k, a) =+                        case k `Map.lookup` km of+                            Just b -> (k, Just a, Just b)+                            Nothing -> (k, Just a, Nothing)++        -- XXX We can take advantage of the lookups in the first pass above to+        -- reduce the number of lookups in this pass. If we keep mutable cells+        -- in the second Map, we can flag it in the first pass and not do any+        -- lookup in the second pass if it is flagged.+        let res2 = Stream.mapMaybe (joinAB km1) $ Stream.fromList $ Map.toList km2+                    where+                    joinAB km (k, b) =+                        case k `Map.lookup` km of+                            Just _ -> Nothing+                            Nothing -> Just (k, Nothing, Just b)++        return $ Stream.serial res1 res2++        where++        -- XXX Generate error if a duplicate insertion is attempted?+        kvFold = Stream.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty++-- | Like 'joinOuter' but works only on sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE mergeOuterJoin #-}+mergeOuterJoin :: -- Monad m =>+    (a -> b -> Ordering) -> t m a -> t m b -> t m (Maybe a, Maybe b)+mergeOuterJoin _eq _s1 _s2 = undefined++------------------------------------------------------------------------------+-- Set operations (special joins)+------------------------------------------------------------------------------+--+-- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only constraint+-- the best would be to use an Array with linear search. If the second stream+-- is sorted we can also use a binary search, using Ord constraint.++-- | 'intersectBy' is essentially a filtering operation that retains only those+-- elements in the first stream that are present in the second stream.+--+-- >>> Stream.toList $ Stream.intersectBy (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [2,1,1,3])+-- [1,2,2]+--+-- >>> Stream.toList $ Stream.intersectBy (==) (Stream.fromList [2,1,1,3]) (Stream.fromList [1,2,2,4])+-- [2,1,1]+--+-- 'intersectBy' is similar to but not the same as 'joinInner':+--+-- >>> Stream.toList $ fmap fst $ Stream.joinInner (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [2,1,1,3])+-- [1,1,2,2]+--+-- Space: O(n) where @n@ is the number of elements in the second stream.+--+-- Time: O(m x n) where @m@ is the number of elements in the first stream and+-- @n@ is the number of elements in the second stream.+--+-- /Pre-release/+{-# INLINE intersectBy #-}+intersectBy :: (IsStream t, Monad m) =>+    (a -> a -> Bool) -> t m a -> t m a -> t m a+intersectBy eq s1 s2 =+    concatM+        $ do+            -- This may work well when s2 is small+            xs <- Stream.toListRev $ Stream.uniqBy eq $ adapt s2+            return $ Stream.filter (\x -> List.any (eq x) xs) s1++-- | Like 'intersectBy' but works only on streams sorted in ascending order.+--+-- Space: O(1)+--+-- Time: O(m+n)+--+-- /Pre-release/+{-# INLINE intersectBySorted #-}+intersectBySorted :: (IsStream t, Monad m) =>+    (a -> a -> Ordering) -> t m a -> t m a -> t m a+intersectBySorted eq s1 =+      IsStream.fromStreamD+    . StreamD.sortedIntersectBy eq (IsStream.toStreamD s1)+    . IsStream.toStreamD++-- Roughly joinLeft s1 s2 = s1 `difference` s2 + s1 `intersection` s2++-- | Delete first occurrences of those elements from the first stream that are+-- present in the second stream. If an element occurs multiple times in the+-- second stream as many occurrences of it are deleted from the first stream.+--+-- >>> Stream.toList $ Stream.differenceBy (==) (Stream.fromList [1,2,2]) (Stream.fromList [1,2,3])+-- [2]+--+-- The following laws hold:+--+-- @+-- (s1 `serial` s2) `differenceBy eq` s1 === s2+-- (s1 `wSerial` s2) `differenceBy eq` s1 === s2+-- @+--+-- Same as the list 'Data.List.//' operation.+--+-- Space: O(m) where @m@ is the number of elements in the first stream.+--+-- Time: O(m x n) where @m@ is the number of elements in the first stream and+-- @n@ is the number of elements in the second stream.+--+-- /Pre-release/+{-# INLINE differenceBy #-}+differenceBy :: (IsStream t, Monad m) =>+    (a -> a -> Bool) -> t m a -> t m a -> t m a+differenceBy eq s1 s2 =+    concatM+        $ do+            -- This may work well if s1 is small+            -- If s1 is big we can go through s1, deleting elements from s2 and+            -- not emitting an element if it was successfully deleted from s2.+            -- we will need a deleteBy that can return whether the element was+            -- deleted or not.+            xs <- Stream.toList $ adapt s1+            fmap fromList $ foldl' (flip (List.deleteBy eq)) xs s2++-- | Like 'differenceBy' but works only on sorted streams.+--+-- Space: O(1)+--+-- /Unimplemented/+{-# INLINE mergeDifferenceBy #-}+mergeDifferenceBy :: -- (IsStream t, Monad m) =>+    (a -> a -> Ordering) -> t m a -> t m a -> t m a+mergeDifferenceBy _eq _s1 _s2 = undefined++-- | This is essentially an append operation that appends all the extra+-- occurrences of elements from the second stream that are not already present+-- in the first stream.+--+-- >>> Stream.toList $ Stream.unionBy (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [1,1,2,3])+-- [1,2,2,4,3]+--+-- Equivalent to the following except that @s1@ is evaluated only once:+--+-- @+-- unionBy eq s1 s2 = s1 \`serial` (s2 `differenceBy eq` s1)+-- @+--+-- Similar to 'joinOuter' but not the same.+--+-- Space: O(n)+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE unionBy #-}+unionBy :: (IsStream t, MonadAsync m, Semigroup (t m a)) =>+    (a -> a -> Bool) -> t m a -> t m a -> t m a+unionBy eq s1 s2 =+    concatM+        $ do+            xs <- Stream.toList $ adapt s2+            -- XXX we can use postscanlMAfter' instead of IORef+            ref <- liftIO $ newIORef $! List.nubBy eq xs+            let f x = do+                    liftIO $ modifyIORef' ref (List.deleteBy eq x)+                    return x+                s3 = concatM+                        $ do+                            xs1 <- liftIO $ readIORef ref+                            return $ fromList xs1+            return $ Stream.mapM f s1 <> s3++-- | Like 'unionBy' but works only on sorted streams.+--+-- Space: O(1)+--+-- /Unimplemented/+{-# INLINE mergeUnionBy #-}+mergeUnionBy :: -- (IsStream t, Monad m) =>+    (a -> a -> Ordering) -> t m a -> t m a -> t m a+mergeUnionBy _eq _s1 _s2 = undefined
+ src/Streamly/Internal/Data/Stream/IsStream/Transform.hs view
@@ -0,0 +1,1595 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.IsStream.Transform+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.IsStream.Transform {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * Piping+    -- | Pass through a 'Pipe'.+      transform++    -- * Folding+    , foldrS+    , foldrSShared+    , foldrT++    -- * Mapping+    -- | Stateless one-to-one maps.+    , map+    , sequence+    , mapM+    , smapM++    -- * Mapping Side Effects (Observation)+    -- | See also the intersperse*_ combinators.+    , trace+    , trace_+    , tap+    , tapOffsetEvery+    , tapAsync+    , tapAsyncK+    , distributeAsync_+    , pollCounts++    -- * Scanning By 'Fold'+    , scan+    , scanMany+    , postscan++    -- * Scanning+    -- | Left scans. Stateful, mostly one-to-one maps.+    , scanl'+    , scanlM'+    , scanlMAfter'+    , postscanlMAfter'+    , postscanl'+    , postscanlM'+    , prescanl'+    , prescanlM'+    , scanl1'+    , scanl1M'++    -- XXX Once we have pipes the contravariant transformations can be+    -- represented by attaching pipes before a transformation.+    --+    -- , lscanl'+    -- , lscanlM'+    -- , lscanl1'+    -- , lscanl1M'+    --+    -- , lpostscanl'+    -- , lpostscanlM'+    -- , lprescanl'+    -- , lprescanlM'++    -- * Filtering+    -- | Produce a subset of the stream using criteria based on the values of+    -- the elements. We can use a concatMap and scan for filtering but these+    -- combinators are more efficient and convenient.++    , with+    , deleteBy+    , filter+    , filterM+    , uniq+    , uniqBy+    , nubBy+    , prune+    , repeated++    -- * Trimming+    -- | Produce a subset of the stream trimmed at ends.++    , take+    , takeLast+    , takeLastInterval+    , takeWhile+    , takeWhileM+    , takeWhileLast+    , takeWhileAround+    , drop+    , dropLast+    , dropLastInterval+    , dropWhile+    , dropWhileM+    , dropWhileLast+    , dropWhileAround++    -- * Inserting Elements+    -- | Produce a superset of the stream. This is the opposite of+    -- filtering/sampling.  We can always use concatMap and scan for inserting+    -- but these combinators are more efficient and convenient.++    -- Element agnostic (Opposite of sampling)+    , intersperse+    , intersperseM -- XXX naming+    , intersperseMWith++    , intersperseMSuffix+    , intersperseMSuffixWith+    , interjectSuffix++    -- , interspersePrefix+    -- , interspersePrefixBySpan++    -- * Inserting Side Effects/Time+    , intersperseM_ -- XXX naming+    , delay+    , intersperseMSuffix_+    , delayPost+    , intersperseMPrefix_+    , delayPre++    -- * Element Aware Insertion+    -- | Opposite of filtering+    , insertBy+    -- , intersperseByBefore+    -- , intersperseByAfter++    -- * Reordering+    , reverse+    , reverse'+    , reassembleBy++    -- * Position Indexing+    , indexed+    , indexedR++    -- * Time Indexing+    , timestamped+    , timestampWith+    -- , timestampedR -- timer+    , timeIndexed+    , timeIndexWith++    -- * Searching+    , findIndices -- XXX indicesBy+    , elemIndices -- XXX indicesOf++    -- * Rolling map+    -- | Map using the previous element.+    , rollingMapM+    , rollingMap+    , rollingMap2++    -- * Maybe Streams+    -- Move these to Streamly.Data.Maybe.Stream?+    , catMaybes -- XXX justs (like lefts/rights)+    , mapMaybe+    , mapMaybeM++    -- * Either Streams+    -- Move these to Streamly.Data.Either.Stream?+    , lefts+    , rights+    , both++    -- * Concurrent Evaluation+    -- ** Concurrent Pipelines+    -- | Run streaming stages concurrently.++    , mkAsync+    , mkParallel+    , applyAsync+    , (|$)+    , (|&)++    -- ** Concurrency Control+    , maxThreads++    -- ** Buffering and Sampling+    -- | 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 or keep dropping elements uniformly to match+    -- the rate of the consumer.+    , maxBuffer+    , sampleOld+    , sampleNew+    , sampleRate++    -- ** Rate Limiting+    -- | Evaluate the stream at uniform intervals to maintain a specified+    -- evaluation rate.+    , Rate (..)+    , rate+    , avgRate+    , minRate+    , maxRate+    , constRate++    -- * Diagnostics+    , inspectMode++    -- * Deprecated+    , scanx+    )+where++#include "inline.hs"++import Control.Concurrent (threadDelay)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Trans.Class (MonadTrans(..))+import Data.Either (isLeft, isRight, fromLeft, fromRight)+import Data.Kind (Type)+import Data.Maybe (isJust, fromJust)+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)+import Streamly.Internal.Data.Stream.IsStream.Common+    ( absTimesWith+    , drop+    , findIndices+    , map+    , postscanlM'+    , relTimesWith+    , reverse+    , reverse'+    , scanlMAfter'+    , postscanlMAfter'+    , smapM+    , take+    , takeWhile+    , interjectSuffix+    , intersperseM+    , mkAsync+    , mkParallel+    , zipWith+    )+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Stream.IsStream.Type+    (IsStream(..), fromStreamD, toStreamD, toConsK)+import Streamly.Internal.Data.Stream.Serial (SerialT)+import Streamly.Internal.Data.SVar (Rate(..))+import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64)++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 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+       ( filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence+       , reverse, foldr1 , scanl, scanl1, zipWith)++--+-- $setup+-- >>> :m+-- >>> :set -fno-warn-deprecations+-- >>> import Control.Concurrent (threadDelay)+-- >>> import Data.Function ((&))+-- >>> import Streamly.Prelude ((|$))+-- >>> import Prelude hiding ( filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence, reverse, foldr1 , scanl, scanl1)+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Streamly.Internal.Data.Stream.IsStream as Stream+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Fold as Fold+-- >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))+--+-- >>> hSetBuffering stdout LineBuffering++------------------------------------------------------------------------------+-- Piping+------------------------------------------------------------------------------++-- | Use a 'Pipe' to transform a stream.+--+-- /Pre-release/+--+{-# INLINE transform #-}+transform :: (IsStream t, Monad m) => Pipe m a b -> t m a -> t m b+transform p xs = fromStreamD $ D.pipe p (toStreamD xs)++------------------------------------------------------------------------------+-- Transformation Folds+------------------------------------------------------------------------------++-- | Right fold to a streaming monad.+--+-- > foldrS Stream.cons Stream.nil === id+--+-- 'foldrS' can be used to perform stateless stream to stream transformations+-- like map and filter in general. It can be coupled with a scan to perform+-- stateful transformations. However, note that the custom map and filter+-- routines can be much more efficient than this due to better stream fusion.+--+-- >>> Stream.toList $ Stream.foldrS Stream.cons Stream.nil $ Stream.fromList [1..5]+-- [1,2,3,4,5]+--+-- Find if any element in the stream is 'True':+--+-- >>> 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:+--+-- >>> Stream.toList $ Stream.foldrS (\x xs -> if odd x then (x + 2) `Stream.cons` xs else xs) Stream.nil $ (Stream.fromList [1..5] :: Stream.SerialT IO Int)+-- [3,5,7]+--+-- 'foldrM' can also be represented in terms of 'foldrS', however, the former+-- is much more efficient:+--+-- > foldrM f z s = runIdentityT $ foldrS (\x xs -> lift $ f x (runIdentityT xs)) (lift z) s+--+-- /Pre-release/+{-# INLINE foldrS #-}+foldrS :: IsStream t => (a -> t m b -> t m b) -> t m b -> t m a -> t m b+foldrS f z xs =+    fromStream+        $ K.foldrS+            (\y ys -> toStream $ f y (fromStream ys))+            (toStream z)+            (toStream xs)++{-# INLINE foldrSShared #-}+foldrSShared :: IsStream t => (a -> t m b -> t m b) -> t m b -> t m a -> t m b+foldrSShared f z xs =+    fromStream+        $ K.foldrSShared+            (\y ys -> toStream $ f y (fromStream ys))+            (toStream z)+            (toStream xs)++-- | Right fold to a transformer monad.  This is the most general right fold+-- function. 'foldrS' is a special case of 'foldrT', however 'foldrS'+-- implementation can be more efficient:+--+-- > foldrS = foldrT+-- > foldrM f z s = runIdentityT $ foldrT (\x xs -> lift $ f x (runIdentityT xs)) (lift z) s+--+-- 'foldrT' can be used to translate streamly streams to other transformer+-- monads e.g.  to a different streaming type.+--+-- /Pre-release/+{-# INLINE foldrT #-}+foldrT :: (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 = D.foldrT f z (toStreamD s)++------------------------------------------------------------------------------+-- Transformation by Mapping+------------------------------------------------------------------------------++-- |+-- @+-- mapM f = sequence . map f+-- @+--+-- Apply a monadic function to each element of the stream and replace it with+-- the output of the resulting action.+--+-- @+-- >>> drain $ Stream.mapM putStr $ Stream.fromList ["a", "b", "c"]+-- abc+--+-- >>> :{+--    drain $ Stream.replicateM 10 (return 1)+--      & (fromSerial . Stream.mapM (\x -> threadDelay 1000000 >> print x))+-- :}+-- 1+-- ...+-- 1+--+-- > drain $ Stream.replicateM 10 (return 1)+--  & (fromAsync . Stream.mapM (\x -> threadDelay 1000000 >> print x))+-- @+--+-- /Concurrent (do not use with 'fromParallel' on infinite streams)/+--+-- @since 0.1.0+{-# INLINE_EARLY mapM #-}+mapM :: forall t m a b. (IsStream t, MonadAsync m) =>+    (a -> m b) -> t m a -> t m b+mapM f = fromStream . K.mapMWith (toConsK (consM @t)) f . toStream++{-# RULES "mapM serial" mapM = mapMSerial #-}+{-# INLINE mapMSerial #-}+mapMSerial :: Monad m => (a -> m b) -> SerialT m a -> SerialT m b+mapMSerial = Serial.mapM++-- |+-- @+-- sequence = mapM id+-- @+--+-- Replace the elements of a stream of monadic actions with the outputs of+-- those actions.+--+-- @+-- >>> drain $ Stream.sequence $ Stream.fromList [putStr "a", putStr "b", putStrLn "c"]+-- abc+--+-- >>> :{+-- drain $ Stream.replicateM 3 (return $ threadDelay 1000000 >> print 1)+--  & (fromSerial . Stream.sequence)+-- :}+-- 1+-- 1+-- 1+--+-- >>> :{+-- drain $ Stream.replicateM 3 (return $ threadDelay 1000000 >> print 1)+--  & (fromAsync . Stream.sequence)+-- :}+-- 1+-- 1+-- 1+--+-- @+--+-- /Concurrent (do not use with 'fromParallel' on infinite streams)/+--+-- @since 0.1.0+{-# INLINE sequence #-}+sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a+sequence = mapM id++------------------------------------------------------------------------------+-- Mapping side effects+------------------------------------------------------------------------------++-- | Tap the data flowing through a stream into a 'Fold'. For example, you may+-- add a tap to log the contents flowing through the stream. The fold is used+-- only for effects, its result is discarded.+--+-- @+--                   Fold m a b+--                       |+-- -----stream m a ---------------stream m a-----+--+-- @+--+-- >>> Stream.drain $ Stream.tap (Fold.drainBy print) (Stream.enumerateFromTo 1 2)+-- 1+-- 2+--+-- Compare with 'trace'.+--+-- @since 0.7.0+{-# INLINE tap #-}+tap :: (IsStream t, Monad m) => FL.Fold m a b -> t m a -> t m a+tap f xs = fromStreamD $ D.tap f (toStreamD xs)++-- XXX Remove this. It can be expressed in terms of Fold.sampleFromThen.+--+-- | @tapOffsetEvery offset n@ taps every @n@th element in the stream+-- starting at @offset@. @offset@ can be between @0@ and @n - 1@. Offset 0+-- means start at the first element in the stream. If the offset is outside+-- this range then @offset `mod` n@ is used as offset.+--+-- >>> Stream.drain $ Stream.tapOffsetEvery 0 2 (Fold.rmapM print Fold.toList) $ Stream.enumerateFromTo 0 10+-- [0,2,4,6,8,10]++--+-- /Pre-release/+--+{-# INLINE tapOffsetEvery #-}+tapOffsetEvery :: (IsStream t, Monad m)+    => Int -> Int -> FL.Fold m a b -> t m a -> t m a+tapOffsetEvery offset n f xs =+    fromStreamD $ D.tapOffsetEvery offset n 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 'maxBuffer' setting.+--+-- @+--               Stream m a -> m b+--                       |+-- -----stream m a ---------------stream m a-----+--+-- @+--+-- @+-- >>> Stream.drain $ Stream.tapAsync (Fold.drainBy print) (Stream.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.+--+-- >>> tapAsync f = Stream.tapAsyncK (Stream.fold f . Stream.adapt)+--+-- Compare with 'tap'.+--+-- /Pre-release/+{-# INLINE tapAsync #-}+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)++-- 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.+--+-- @+-- > Stream.drain $ Stream.distributeAsync_ [Stream.mapM_ print, Stream.mapM_ print] (Stream.enumerateFromTo 1 2)+-- 1+-- 2+-- 1+-- 2+--+-- @+--+-- @+-- distributeAsync_ = flip (foldr tapAsync)+-- @+--+-- /Pre-release/+--+{-# INLINE distributeAsync_ #-}+distributeAsync_ :: (Foldable f, IsStream t, MonadAsync m)+    => f (t m a -> m b) -> t m a -> t m a+distributeAsync_ = flip (Prelude.foldr tapAsyncK)++-- | @pollCounts predicate transform fold stream@ counts those elements in the+-- stream that pass the @predicate@. The resulting count stream is sent to+-- another thread which transforms it using @transform@ and then folds it using+-- @fold@.  The thread is automatically cleaned up if the stream stops or+-- aborts due to exception.+--+-- For example, to print the count of elements processed every second:+--+-- @+-- > Stream.drain $ Stream.pollCounts (const True) (Stream.rollingMap (-) . Stream.delayPost 1) (FLold.drainBy print)+--           $ Stream.enumerateFrom 0+-- @+--+-- Note: This may not work correctly on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE pollCounts #-}+pollCounts ::+       (IsStream t, MonadAsync m)+    => (a -> Bool)+    -> (t m Int -> m b)+    -> t m a+    -> t m a+pollCounts predicate f xs =+      fromStreamD+    $ Concur.parTapCount predicate (f . fromStreamD)+    $ 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+{-# INLINE trace #-}+trace :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m a+trace f = mapM (\x -> void (f x) >> return x)++-- | Perform a side effect before yielding each element of the stream and+-- discard the results.+--+-- @+-- >>> Stream.drain $ Stream.trace_ (print "got here") (Stream.enumerateFromTo 1 2)+-- "got here"+-- "got here"+--+-- @+--+-- Same as 'intersperseMPrefix_' but always serial.+--+-- See also: 'trace'+--+-- /Pre-release/+{-# INLINE trace_ #-}+trace_ :: (IsStream t, Monad m) => m b -> t m a -> t m a+trace_ eff = fromStreamD . D.mapM (\x -> eff >> return x) . toStreamD++------------------------------------------------------------------------------+-- Scanning with a Fold+------------------------------------------------------------------------------++-- | Scan a stream using the given monadic fold.+--+-- >>> Stream.toList $ Stream.takeWhile (< 10) $ Stream.scan Fold.sum (Stream.fromList [1..10])+-- [0,1,3,6]+--+-- @since 0.7.0+{-# INLINE scan #-}+scan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b+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+-- running average of elements is no more than 10:+--+-- >>> import Data.Maybe (fromJust)+-- >>> let avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)+-- >>> :{+--  Stream.toList+--   $ Stream.map (fromJust . fst)+--   $ Stream.takeWhile (\(_,x) -> x <= 10)+--   $ Stream.postscan (Fold.tee Fold.last avg) (Stream.enumerateFromTo 1.0 100.0)+-- :}+-- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0]+--+-- @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.postscan fld . toStreamD++------------------------------------------------------------------------------+-- Scanning - Transformation by Folding+------------------------------------------------------------------------------++-- XXX It may be useful to have a version of scan where we can keep the+-- accumulator independent of the value emitted. So that we do not necessarily+-- have to keep a value in the accumulator which we are not using. We can pass+-- an extraction function that will take the accumulator and the current value+-- of the element and emit the next value in the stream. That will also make it+-- possible to modify the accumulator after using it. In fact, the step function+-- can return new accumulator and the value to be emitted. The signature would+-- be more like mapAccumL. Or we can change the signature of scanx to+-- accommodate this.+--+-- | Strict left scan with an extraction function. Like 'scanl'', but applies a+-- user supplied extraction function (the third argument) at each step. This is+-- designed to work with the @foldl@ library. The suffix @x@ is a mnemonic for+-- extraction.+--+-- /Since 0.2.0/+--+-- /Since: 0.7.0 (Monad m constraint)/+{-# 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 = 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+-- complexity when iterated over a stream. We should use StreamK style scanlM'+-- for linear performance on iteration.+--+-- | Like 'scanl'' but with a monadic step function and a monadic seed.+--+-- /Since: 0.4.0/+--+-- /Since: 0.8.0 (signature change)/+{-# INLINE scanlM' #-}+scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b+scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m++-- XXX because of the use of D.cons for appending, scanl' has quadratic+-- complexity when iterated over a stream. We should use StreamK style scanlM'+-- for linear performance on iteration.++-- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,+-- however it adds an extra element.+--+-- @+-- >>> Stream.toList $ Stream.scanl' (+) 0 $ fromList [1,2,3,4]+-- [0,1,3,6,10]+--+-- @+--+-- @+-- >>> Stream.toList $ Stream.scanl' (flip (:)) [] $ Stream.fromList [1,2,3,4]+-- [[],[1],[2,1],[3,2,1],[4,3,2,1]]+--+-- @+--+-- The output of 'scanl'' is the initial value of the accumulator followed by+-- all the intermediate steps and the final result of 'foldl''.+--+-- By streaming the accumulated state after each fold step, we can share the+-- state across multiple stages of stream composition. Each stage can modify or+-- extend the state, do some processing with it and emit it for the next stage,+-- thus modularizing the stream processing. This can be useful in+-- stateful or event-driven programming.+--+-- Consider the following monolithic example, computing the sum and the product+-- of the elements in a stream in one go using a @foldl'@:+--+-- @+-- >>> Stream.foldl' (\(s, p) x -> (s + x, p * x)) (0,1) $ Stream.fromList [1,2,3,4]+-- (10,24)+--+-- @+--+-- Using @scanl'@ we can make it modular by computing the sum in the first+-- stage and passing it down to the next stage for computing the product:+--+-- @+-- >>> :{+--   Stream.foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1)+--   $ Stream.scanl' (\(s, _) x -> (s + x, x)) (0,1)+--   $ Stream.fromList [1,2,3,4]+-- :}+-- (10,24)+--+-- @+--+-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building+-- lazy expressions inside the accumulator, it is recommended that a strict+-- data structure is used for accumulator.+--+-- >>> scanl' step z = 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+--+-- See also: 'usingStateT'+--+-- @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 = 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+--+-- @since 0.7.0+{-# INLINE postscanl' #-}+postscanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b+postscanl' step z m = fromStreamD $ D.postscanl' step z $ toStreamD m++-- XXX prescanl does not sound very useful, enable only if there is a+-- compelling use case.+--+-- | Like scanl' but does not stream the final value of the accumulator.+--+-- /Pre-release/+{-# INLINE prescanl' #-}+prescanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b+prescanl' step z m = fromStreamD $ D.prescanl' step z $ toStreamD m++-- XXX this needs to be concurrent+-- | Like prescanl' but with a monadic step function and a monadic seed.+--+-- /Pre-release/+{-# INLINE prescanlM' #-}+prescanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b+prescanlM' step z m = fromStreamD $ D.prescanlM' step z $ toStreamD m++-- XXX this needs to be concurrent+-- | Like 'scanl1'' but with a monadic step function.+--+-- @since 0.6.0+{-# INLINE scanl1M' #-}+scanl1M' :: (IsStream t, Monad m) => (a -> a -> m a) -> t m a -> t m a+scanl1M' step m = fromStreamD $ D.scanl1M' step $ toStreamD m++-- | Like 'scanl'' but for a non-empty stream. The first element of the stream+-- is used as the initial value of the accumulator. Does nothing if the stream+-- is empty.+--+-- @+-- >>> Stream.toList $ Stream.scanl1' (+) $ fromList [1,2,3,4]+-- [1,3,6,10]+--+-- @+--+-- @since 0.6.0+{-# INLINE scanl1' #-}+scanl1' :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> t m a+scanl1' step m = fromStreamD $ D.scanl1' step $ toStreamD m++------------------------------------------------------------------------------+-- Filtering+------------------------------------------------------------------------------++-- | Modify a @t m a -> t m a@ stream transformation that accepts a predicate+-- @(a -> b)@ to accept @((s, a) -> b)@ instead, provided a transformation @t m+-- a -> t m (s, a)@. Convenient to filter with index or time.+--+-- @+-- filterWithIndex = with indexed filter+-- filterWithAbsTime = with timestamped filter+-- filterWithRelTime = with timeIndexed filter+-- @+--+-- /Pre-release/+{-# INLINE with #-}+with :: forall (t :: (Type -> Type) -> Type -> Type) m a b s. Functor (t m) =>+       (t m a -> t m (s, a))+    -> (((s, a) -> b) -> t m (s, a) -> t m (s, a))+    -> (((s, a) -> b) -> t m a -> t m a)+with f comb g = fmap snd . comb g . f++-- | Include only those elements that pass a predicate.+--+-- @since 0.1.0+{-# INLINE filter #-}+filter :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a+filter p m = fromStreamD $ D.filter p $ toStreamD m++-- | Same as 'filter' but with a monadic predicate.+--+-- @since 0.4.0+{-# INLINE filterM #-}+filterM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a+filterM p m = fromStreamD $ D.filterM p $ toStreamD m++-- | Drop repeated elements that are adjacent to each other using the supplied+-- comparison function.+--+-- @uniq = uniqBy (==)+--+-- To strip duplicate path separators:+--+-- @+-- f x y = x == '/' && x == y+-- Stream.toList $ Stream.uniqBy f $ Stream.fromList "//a//b"+-- "/a/b"+-- @+--+-- Space: @O(1)@+--+-- See also: 'nubBy'.+--+-- /Pre-release/+--+{-# INLINE uniqBy #-}+uniqBy :: (IsStream t, Monad m, Functor (t m)) =>+    (a -> a -> Bool) -> t m a -> t m a+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+{-# INLINE uniq #-}+uniq :: (Eq a, IsStream t, Monad m) => t m a -> t m a+uniq = fromStreamD . D.uniq . toStreamD++-- | Strip all leading and trailing occurrences of an element passing a+-- predicate and make all other consecutive occurrences uniq.+--+-- @+-- prune p = dropWhileAround p $ uniqBy (x y -> p x && p y)+-- @+--+-- @+-- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")+-- "hello world!"+--+-- @+--+-- Space: @O(1)@+--+-- /Unimplemented/+{-# INLINE prune #-}+prune ::+    -- (IsStream t, Monad m, Eq a) =>+    (a -> Bool) -> t m a -> t m a+prune = error "Not implemented yet!"++-- Possible implementation:+-- @repeated =+--      Stream.catMaybes . Stream.parseMany (Parser.groupBy (==) Fold.repeated)@+--+-- 'Fold.repeated' should return 'Just' when repeated, and 'Nothing' for a+-- single element.+--+-- | Emit only repeated elements, once.+--+-- /Unimplemented/+repeated :: -- (IsStream t, Monad m, Eq a) =>+    t m a -> t m a+repeated = undefined++-- We can have more efficient implementations for nubOrd and nubInt by using+-- Set and IntSet to find/remove duplication. For Hashable we can use a+-- hashmap. Use rewrite rules to specialize to more efficient impls.+--+-- | Drop repeated elements anywhere in the stream.+--+-- /Caution: not scalable for infinite streams/+--+-- /See also: nubWindowBy/+--+-- /Unimplemented/+--+{-# INLINE nubBy #-}+nubBy :: -- (IsStream t, Monad m) =>+    (a -> a -> Bool) -> t m a -> t m a+nubBy = undefined -- fromStreamD . D.nubBy . toStreamD++-- | Deletes the first occurrence of the element in the stream that satisfies+-- the given equality predicate.+--+-- @+-- >>> Stream.toList $ Stream.deleteBy (==) 3 $ Stream.fromList [1,3,3,5]+-- [1,3,5]+--+-- @+--+-- @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 = fromStreamD $ D.deleteBy cmp x (toStreamD m)++------------------------------------------------------------------------------+-- 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.++-- | 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 it consumes the values from the buffer in a+-- FIFO manner.+--+-- /Unimplemented/+--+{-# INLINE sampleOld #-}+sampleOld :: -- (IsStream t, Monad m) =>+    Int -> t m a -> t m a+sampleOld = 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 it consumes the values+-- from the buffer in a FIFO manner.+--+-- /Unimplemented/+--+{-# INLINE sampleNew #-}+sampleNew :: -- (IsStream t, Monad m) =>+    Int -> t m a -> t m a+sampleNew = undefined++-- | Like 'sampleNew' but samples at uniform intervals to match the consumer+-- rate. Note that 'sampleNew' leads to non-uniform sampling depending on the+-- consumer pattern.+--+-- /Unimplemented/+--+{-# INLINE sampleRate #-}+sampleRate :: -- (IsStream t, Monad m) =>+    Double -> t m a -> t m a+sampleRate = undefined++------------------------------------------------------------------------------+-- Trimming+------------------------------------------------------------------------------++-- | Same as 'takeWhile' but with a monadic predicate.+--+-- @since 0.4.0+{-# INLINE takeWhileM #-}+takeWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a+takeWhileM p m = fromStreamD $ D.takeWhileM p $ toStreamD m++-- See the lastN fold for impl hints. Use a Data.Array based ring buffer.+--+-- takeLast n = Stream.concatM . fmap Array.toStream . fold Fold.lastN+--+-- | Take @n@ elements at the end of the stream.+--+-- O(n) space, where n is the number elements taken.+--+-- /Unimplemented/+{-# INLINE takeLast #-}+takeLast :: -- (IsStream t, Monad m) =>+    Int -> t m a -> t m a+takeLast = undefined -- fromStreamD $ D.takeLast n $ toStreamD m++-- | 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 :: -- (IsStream t, Monad m) =>+    Double -> t m a -> t m a+takeLastInterval = undefined -- fromStreamD $ D.takeLast n $ toStreamD m++-- | Take all consecutive elements at the end of the stream for which the+-- predicate is true.+--+-- O(n) space, where n is the number elements taken.+--+-- /Unimplemented/+{-# INLINE takeWhileLast #-}+takeWhileLast :: -- (IsStream t, Monad m) =>+    (a -> Bool) -> t m a -> t m a+takeWhileLast = undefined -- fromStreamD $ D.takeWhileLast n $ toStreamD m++-- | Like 'takeWhile' and 'takeWhileLast' combined.+--+-- O(n) space, where n is the number elements taken from the end.+--+-- /Unimplemented/+{-# INLINE takeWhileAround #-}+takeWhileAround :: -- (IsStream t, Monad m) =>+    (a -> Bool) -> t m a -> t m a+takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m++-- | Drop elements in the stream as long as the predicate succeeds and then+-- take the rest of the stream.+--+-- @since 0.1.0+{-# INLINE dropWhile #-}+dropWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a+dropWhile p m = fromStreamD $ D.dropWhile p $ toStreamD m++-- | Same as 'dropWhile' but with a monadic predicate.+--+-- @since 0.4.0+{-# INLINE dropWhileM #-}+dropWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a+dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m++-- | Drop @n@ elements at the end of the stream.+--+-- O(n) space, where n is the number elements dropped.+--+-- /Unimplemented/+{-# INLINE dropLast #-}+dropLast :: -- (IsStream t, Monad m) =>+    Int -> t m a -> t m a+dropLast = undefined -- fromStreamD $ D.dropLast n $ toStreamD m++-- | 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 :: -- (IsStream t, Monad m) =>+    Int -> t m a -> t m a+dropLastInterval = undefined++-- | Drop all consecutive elements at the end of the stream for which the+-- predicate is true.+--+-- O(n) space, where n is the number elements dropped.+--+-- /Unimplemented/+{-# INLINE dropWhileLast #-}+dropWhileLast :: -- (IsStream t, Monad m) =>+    (a -> Bool) -> t m a -> t m a+dropWhileLast = undefined -- fromStreamD $ D.dropWhileLast n $ toStreamD m++-- | Like 'dropWhile' and 'dropWhileLast' combined.+--+-- O(n) space, where n is the number elements dropped from the end.+--+-- /Unimplemented/+{-# INLINE dropWhileAround #-}+dropWhileAround :: -- (IsStream t, Monad m) =>+    (a -> Bool) -> t m a -> t m a+dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m++------------------------------------------------------------------------------+-- Inserting Elements+------------------------------------------------------------------------------++-- | @insertBy cmp elem stream@ inserts @elem@ before the first element in+-- @stream@ that is less than @elem@ when compared using @cmp@.+--+-- @+-- insertBy cmp x = 'mergeBy' cmp ('fromPure' x)+-- @+--+-- @+-- >>> Stream.toList $ Stream.insertBy compare 2 $ Stream.fromList [1,3,5]+-- [1,2,3,5]+--+-- @+--+-- @since 0.6.0+{-# INLINE insertBy #-}+insertBy ::+       (IsStream t, Monad m) => (a -> a -> Ordering) -> a -> t m a -> t m a+insertBy cmp x m = fromStreamD $ D.insertBy cmp x (toStreamD m)++-- | Insert a pure value between successive elements of a stream.+--+-- >>> Stream.toList $ Stream.intersperse ',' $ Stream.fromList "hello"+-- "h,e,l,l,o"+--+-- @since 0.7.0+{-# INLINE intersperse #-}+intersperse :: (IsStream t, MonadAsync m) => a -> t m a -> t m a+intersperse a = fromStreamD . D.intersperse a . toStreamD++-- | Insert a side effect before consuming an element of a stream except the+-- first one.+--+-- >>> Stream.drain $ Stream.trace putChar $ Stream.intersperseM_ (putChar '.') $ Stream.fromList "hello"+-- h.e.l.l.o+--+-- /Pre-release/+{-# INLINE intersperseM_ #-}+intersperseM_ :: (IsStream t, Monad m) => m b -> t m a -> t m a+intersperseM_ m = fromStreamD . D.intersperseM_ m . toStreamD++-- | Intersperse a monadic action into the input stream after every @n@+-- elements.+--+-- @+-- > Stream.toList $ Stream.intersperseMWith 2 (return ',') $ Stream.fromList "hello"+-- "he,ll,o"+--+-- @+--+-- /Unimplemented/+{-# INLINE intersperseMWith #-}+intersperseMWith :: -- IsStream t =>+    Int -> m a -> t m a -> t m a+intersperseMWith _n _f _xs = undefined++-- | Insert an effect and its output after consuming an element of a stream.+--+-- >>> Stream.toList $ Stream.trace putChar $ intersperseMSuffix (putChar '.' >> return ',') $ Stream.fromList "hello"+-- h.,e.,l.,l.,o.,"h,e,l,l,o,"+--+-- /Pre-release/+{-# 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.intersperseMSuffix_ (threadDelay 1000000) $ Stream.fromList "hello"+-- hello+--+-- @+--+-- /Pre-release/+--+{-# 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 'intersperseMSuffix' but intersperses an effectful action into the+-- input stream after every @n@ elements and after the last element.+--+-- >>> Stream.toList $ Stream.intersperseMSuffixWith 2 (return ',') $ Stream.fromList "hello"+-- "he,ll,o,"+--+-- /Pre-release/+--+{-# INLINE intersperseMSuffixWith #-}+intersperseMSuffixWith :: (IsStream t, Monad m)+    => Int -> m a -> t m a -> t m a+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.intersperseMPrefix_ (putChar '.' >> return ',') $ Stream.fromList "hello"+-- .h.e.l.l.o"hello"+--+-- Same as 'trace_' but may be concurrent.+--+-- /Concurrent/+--+-- /Pre-release/+--+{-# 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+------------------------------------------------------------------------------++-- Note: delay must be serial.+--+-- | Introduce a delay of specified seconds before consuming an element of the+-- stream except the first one.+--+-- >>> Stream.mapM_ print $ Stream.timestamped $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),1)+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),2)+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),3)+--+-- @since 0.8.0+--+{-# INLINE delay #-}+delay :: (IsStream t, MonadIO m) => Double -> t m a -> t m a+delay n = intersperseM_ $ liftIO $ threadDelay $ round $ n * 1000000++-- Note: delay must be serial.+--+-- | Introduce a delay of specified seconds after consuming an element of a+-- stream.+--+-- >>> Stream.mapM_ print $ Stream.timestamped $ Stream.delayPost 1 $ Stream.enumerateFromTo 1 3+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),1)+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),2)+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),3)+--+-- /Pre-release/+--+{-# INLINE delayPost #-}+delayPost :: (IsStream t, MonadIO m) => Double -> t m a -> t m a+delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000++-- Note: delay must be serial, that's why 'trace_' is used.+--+-- | Introduce a delay of specified seconds before consuming an element of a+-- stream.+--+-- >>> Stream.mapM_ print $ Stream.timestamped $ Stream.delayPre 1 $ Stream.enumerateFromTo 1 3+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),1)+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),2)+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),3)+--+-- /Pre-release/+--+{-# INLINE delayPre #-}+delayPre :: (IsStream t, MonadIO m) => Double -> t m a -> t m a+delayPre n = trace_ $ liftIO $ threadDelay $ round $ n * 1000000++------------------------------------------------------------------------------+-- Reorder in sequence+------------------------------------------------------------------------------++-- | Buffer until the next element in sequence arrives. The function argument+-- determines the difference in sequence numbers. This could be useful in+-- implementing sequenced streams, for example, TCP reassembly.+--+-- /Unimplemented/+--+{-# INLINE reassembleBy #-}+reassembleBy+    :: -- (IsStream t, Monad m) =>+       Fold m a b+    -> (a -> a -> Int)+    -> t m a+    -> t m b+reassembleBy = undefined++------------------------------------------------------------------------------+-- Position Indexing+------------------------------------------------------------------------------++-- |+-- > indexed = Stream.postscanl' (\(i, _) x -> (i + 1, x)) (-1,undefined)+-- > indexed = Stream.zipWith (,) (Stream.enumerateFrom 0)+--+-- Pair each element in a stream with its index, starting from index 0.+--+-- >>> Stream.toList $ Stream.indexed $ Stream.fromList "hello"+-- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]+--+-- @since 0.6.0+{-# INLINE indexed #-}+indexed :: (IsStream t, Monad m) => t m a -> t m (Int, a)+indexed = fromStreamD . D.indexed . toStreamD++-- |+-- > indexedR n = Stream.postscanl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)+-- > indexedR n = Stream.zipWith (,) (Stream.enumerateFromThen n (n - 1))+--+-- Pair each element in a stream with its index, starting from the+-- given index @n@ and counting down.+--+-- >>> Stream.toList $ Stream.indexedR 10 $ Stream.fromList "hello"+-- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]+--+-- @since 0.6.0+{-# INLINE indexedR #-}+indexedR :: (IsStream t, Monad m) => Int -> t m a -> t m (Int, a)+indexedR n = fromStreamD . D.indexedR n . toStreamD++-------------------------------------------------------------------------------+-- Time Indexing+-------------------------------------------------------------------------------++-- Note: The timestamp stream must be the second stream in the zip so that the+-- timestamp is generated after generating the stream element and not before.+-- If we do not do that then the following example will generate the same+-- timestamp for first two elements:+--+-- Stream.mapM_ print $ Stream.timestamped $ Stream.delay $ Stream.enumerateFromTo 1 3+--+-- | Pair each element in a stream with an absolute timestamp, using a clock of+-- specified granularity.  The timestamp is generated just before the element+-- is consumed.+--+-- >>> Stream.mapM_ print $ Stream.timestampWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),1)+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),2)+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),3)+--+-- /Pre-release/+--+{-# INLINE timestampWith #-}+timestampWith :: (IsStream t, MonadAsync m, Functor (t m))+    => Double -> t m a -> t m (AbsTime, a)+timestampWith g stream = zipWith (flip (,)) stream (absTimesWith g)++-- TBD: check performance vs a custom implementation without using zipWith.+--+-- /Pre-release/+--+{-# INLINE timestamped #-}+timestamped :: (IsStream t, MonadAsync m, Functor (t m))+    => t m a -> t m (AbsTime, a)+timestamped = timestampWith 0.01++-- | Pair each element in a stream with relative times starting from 0, using a+-- clock with the specified granularity. The time is measured just before the+-- element is consumed.+--+-- >>> Stream.mapM_ print $ Stream.timeIndexWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- (RelTime64 (NanoSecond64 ...),1)+-- (RelTime64 (NanoSecond64 ...),2)+-- (RelTime64 (NanoSecond64 ...),3)+--+-- /Pre-release/+--+{-# INLINE timeIndexWith #-}+timeIndexWith :: (IsStream t, MonadAsync m, Functor (t m))+    => Double -> t m a -> t m (RelTime64, a)+timeIndexWith g stream = zipWith (flip (,)) stream (relTimesWith g)++-- | Pair each element in a stream with relative times starting from 0, using a+-- 10 ms granularity clock. The time is measured just before the element is+-- consumed.+--+-- >>> Stream.mapM_ print $ Stream.timeIndexed $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- (RelTime64 (NanoSecond64 ...),1)+-- (RelTime64 (NanoSecond64 ...),2)+-- (RelTime64 (NanoSecond64 ...),3)+--+-- /Pre-release/+--+{-# INLINE timeIndexed #-}+timeIndexed :: (IsStream t, MonadAsync m, Functor (t m))+    => t m a -> t m (RelTime64, a)+timeIndexed = timeIndexWith 0.01++------------------------------------------------------------------------------+-- Searching+------------------------------------------------------------------------------++-- | Find all the indices where the value of the element in the stream is equal+-- to the given value.+--+-- > elemIndices a = findIndices (== a)+--+-- @since 0.5.0+{-# INLINE elemIndices #-}+elemIndices :: (IsStream t, Eq a, Monad m) => a -> t m a -> t m Int+elemIndices a = findIndices (== a)++------------------------------------------------------------------------------+-- Rolling map+------------------------------------------------------------------------------++-- XXX this is not a one-to-one map so calling it map may not be right.+-- We can perhaps call it zipWithTail or rollWith.+--+-- | Apply a function on every two successive elements of a stream. The first+-- argument of the map function is the previous element and the second argument+-- is the current element. When the current element is the first element, the+-- previous element is 'Nothing'.+--+-- /Pre-release/+--+{-# INLINE rollingMap #-}+rollingMap :: (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.+--+-- /Pre-release/+--+{-# INLINE rollingMapM #-}+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+------------------------------------------------------------------------------++-- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'+-- elements, and return a stream of values extracted from 'Just'.+--+-- Equivalent to:+--+-- @+-- mapMaybe f = Stream.map 'fromJust' . Stream.filter 'isJust' . Stream.map f+-- @+--+-- @since 0.3.0+{-# INLINE mapMaybe #-}+mapMaybe :: (IsStream t, Monad m) => (a -> Maybe b) -> t m a -> t m b+mapMaybe f m = fromStreamD $ D.mapMaybe f $ toStreamD m++-- | Like 'mapMaybe' but maps a monadic function.+--+-- Equivalent to:+--+-- @+-- mapMaybeM f = Stream.map 'fromJust' . Stream.filter 'isJust' . Stream.mapM f+-- @+--+-- /Concurrent (do not use with 'fromParallel' on infinite streams)/+--+-- @since 0.3.0+{-# INLINE_EARLY mapMaybeM #-}+mapMaybeM :: (IsStream t, MonadAsync m, Functor (t m))+          => (a -> m (Maybe b)) -> t m a -> t m b+mapMaybeM f = fmap fromJust . filter isJust . mapM f++{-# RULES "mapMaybeM serial" mapMaybeM = mapMaybeMSerial #-}+{-# INLINE mapMaybeMSerial #-}+mapMaybeMSerial :: Monad m => (a -> m (Maybe b)) -> SerialT m a -> SerialT m b+mapMaybeMSerial f m = fromStreamD $ D.mapMaybeM f $ toStreamD m++-- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.+--+-- /Pre-release/+--+{-# INLINE catMaybes #-}+catMaybes :: (IsStream t, Monad m, Functor (t m)) => t m (Maybe a) -> t m a+catMaybes = fmap fromJust . filter isJust++------------------------------------------------------------------------------+-- Either streams+------------------------------------------------------------------------------++-- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.+--+-- /Pre-release/+--+{-# INLINE lefts #-}+lefts :: (IsStream t, Monad m, Functor (t m)) => t m (Either a b) -> t m a+lefts = fmap (fromLeft undefined) . filter isLeft++-- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.+--+-- /Pre-release/+--+{-# INLINE rights #-}+rights :: (IsStream t, Monad m, Functor (t m)) => t m (Either a b) -> t m b+rights = fmap (fromRight undefined) . filter isRight++-- | Remove the either wrapper and flatten both lefts and as well as rights in+-- the output stream.+--+-- /Pre-release/+--+{-# INLINE both #-}+both :: Functor (t m) => t m (Either a a) -> t m a+both = fmap (either id id)++------------------------------------------------------------------------------+-- Concurrent Application+------------------------------------------------------------------------------++-- | Parallel transform application operator; applies a stream transformation+-- function @t m a -> t m b@ to a stream @t m a@ concurrently; the input stream+-- is evaluated asynchronously in an independent thread yielding elements to a+-- buffer and the transformation function runs in another thread consuming the+-- input from the buffer.  '|$' is just like regular function application+-- operator '$' except that it is concurrent.+--+-- If you read the signature as @(t m a -> t m b) -> (t m a -> t m b)@ you can+-- look at it as a transformation that converts a transform function to a+-- buffered concurrent transform function.+--+-- The following code prints a value every second even though each stage adds a+-- 1 second delay.+--+--+-- >>> :{+-- Stream.drain $+--    Stream.mapM (\x -> threadDelay 1000000 >> print x)+--      |$ Stream.replicateM 3 (threadDelay 1000000 >> return 1)+-- :}+-- 1+-- 1+-- 1+--+-- /Concurrent/+--+-- /Since: 0.3.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE (|$) #-}+(|$) :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> (t m a -> t m b)+-- (|$) f = f . mkAsync+(|$) f = f . mkParallel++infixr 0 |$++-- | Same as '|$'.+--+--  /Internal/+--+{-# INLINE applyAsync #-}+applyAsync :: (IsStream t, MonadAsync m)+    => (t m a -> t m b) -> (t m a -> t m b)+applyAsync = (|$)++-- | Same as '|$' but with arguments reversed.+--+-- (|&) = flip (|$)+--+-- /Concurrent/+--+-- /Since: 0.3.0 ("Streamly")/+--+-- @since 0.8.0+{-# INLINE (|&) #-}+(|&) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> t m b) -> t m b+x |& f = f |$ x++infixl 1 |&
+ src/Streamly/Internal/Data/Stream/IsStream/Type.hs view
@@ -0,0 +1,783 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.Type+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.Stream.IsStream.Type {-# DEPRECATED "Please use \"Streamly.Data.Stream.*\" instead." #-}+    (+    -- * IsStream Type Class+      IsStream (..)+    , K.StreamK (..)++    -- * Type Conversion+    , fromStreamD+    , toStreamD+    , toStreamK+    , fromStreamK+    , adapt+    , toConsK++    -- * Building a stream+    , mkStream+    , foldStreamShared+    , foldStream++    -- * Stream Types+    , SerialT+    , Serial+    , fromSerial++    , WSerialT+    , WSerial+    , fromWSerial++    , AsyncT+    , Async+    , fromAsync++    , WAsyncT+    , WAsync+    , fromWAsync++    , AheadT+    , Ahead+    , fromAhead++    , ParallelT+    , Parallel+    , fromParallel++    , ZipSerialM+    , ZipSerial+    , fromZipSerial++    , ZipAsyncM+    , ZipAsync+    , fromZipAsync++    -- * Construction+    , cons+    , (.:)+    , nil+    , nilM+    , fromPure+    , fromEffect+    , repeat++    -- * Bind/Concat+    , bindWith+    , concatMapWith++    -- * Fold Utilities+    , concatFoldableWith+    , concatMapFoldableWith+    , concatForFoldableWith++    -- * Running Effects+    , drain++    -- * Conversion operations+    , fromList+    , toList++    -- * Fold operations+    , foldrMx++    , foldlx'+    , foldlMx'+    , foldl'+    , fold++    -- * Zip style operations+    , eqBy+    , cmpBy+    )+where++import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Fold (Fold (..))+import Streamly.Internal.Data.Stream.Serial+    (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.ZipAsync (ZipAsyncM(..), ZipAsync)+import Streamly.Internal.Data.SVar.Type (State, adaptState)++import qualified Prelude+import qualified Streamly.Internal.Data.Stream.Ahead as Ahead+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 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 (Foldable(..), repeat)+import Data.Foldable (Foldable)++#include "inline.hs"++------------------------------------------------------------------------------+-- Types that can behave as a Stream+------------------------------------------------------------------------------++infixr 5 `consM`+infixr 5 |:++-- XXX Use a different SVar based on the stream type. But we need to make sure+-- that we do not lose performance due to polymorphism.+--+-- | Class of types that can represent a stream of elements of some type 'a' in+-- some monad 'm'.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+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 where+    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:+    --+    -- @+    -- > toList $ getLine \`consM` getLine \`consM` nil+    -- hello+    -- world+    -- ["hello","world"]+    -- @+    --+    -- /Concurrent (do not use 'fromParallel' to construct infinite streams)/+    --+    -- @since 0.2.0+    consM :: MonadAsync m => m a -> t m a -> t m a+    -- | Operator equivalent of 'consM'. We can read it as "@parallel colon@"+    -- to remember that @|@ comes before ':'.+    --+    -- @+    -- > toList $ getLine |: getLine |: nil+    -- hello+    -- world+    -- ["hello","world"]+    -- @+    --+    -- @+    -- let delay = threadDelay 1000000 >> print 1+    -- drain $ fromSerial  $ delay |: delay |: delay |: nil+    -- drain $ fromParallel $ delay |: delay |: delay |: nil+    -- @+    --+    -- /Concurrent (do not use 'fromParallel' to construct infinite streams)/+    --+    -- @since 0.2.0+    (|:) :: MonadAsync m => m a -> t m a -> t m a+    -- We can define (|:) just as 'consM' but it is defined explicitly for each+    -- type because we want to use SPECIALIZE pragma on the definition.++-------------------------------------------------------------------------------+-- 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+-- unShare when the stream type is the same.+--+-- | Adapt any specific stream type to any other specific stream type.+--+-- /Since: 0.1.0 ("Streamly")/+--+-- @since 0.8.0+adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a+adapt = fromStream . toStream++{-# INLINE fromStreamD #-}+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.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+------------------------------------------------------------------------------++-- XXX The State is always parameterized by "Stream" which means State is not+-- different for different stream types. So we have to manually make sure that+-- when converting from one stream to another we migrate the state correctly.+-- This can be fixed if we use a different SVar type for different streams.+-- Currently we always use "SVar Stream" and therefore a different State type+-- parameterized by that stream.+--+-- XXX Since t is coercible we should be able to coerce k+-- mkStream k = fromStream $ MkStream $ coerce k+--+-- | Build a stream from an 'SVar', a stop continuation, a singleton stream+-- continuation and a yield continuation.+{-# INLINE_EARLY mkStream #-}+mkStream :: IsStream t+    => (forall r. State K.StreamK m a+        -> (a -> t m a -> m r)+        -> (a -> m r)+        -> m r+        -> m r)+    -> t m a+mkStream k = fromStream $ K.MkStream $ \st yld sng stp ->+    let yieldk a r = yld a (toStream r)+     in k st yieldk sng stp++{-# RULES "mkStream from stream" mkStream = mkStreamFromStream #-}+mkStreamFromStream :: IsStream t+    => (forall r. State K.StreamK m a+        -> (a -> K.StreamK m a -> m r)+        -> (a -> m r)+        -> m r+        -> m r)+    -> t m a+mkStreamFromStream k = fromStream $ K.MkStream k++{-# RULES "mkStream stream" mkStream = mkStreamStream #-}+mkStreamStream+    :: (forall r. State K.StreamK m a+        -> (a -> K.StreamK m a -> m r)+        -> (a -> m r)+        -> m r+        -> m r)+    -> 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+------------------------------------------------------------------------------++-- | 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+    :: IsStream t+    => State K.StreamK m a+    -> (a -> t m a -> m r)+    -> (a -> m r)+    -> m r+    -> t m a+    -> m r+foldStreamShared st yld sng stp m =+    let yieldk a x = yld a (fromStream x)+        K.MkStream k = toStream m+     in k st yieldk sng stp++-- XXX write a similar rule for foldStream as well?+{-# RULES "foldStreamShared from stream"+   foldStreamShared = foldStreamSharedStream #-}+foldStreamSharedStream+    :: State K.StreamK m a+    -> (a -> K.StreamK m a -> m r)+    -> (a -> m r)+    -> m r+    -> K.StreamK m a+    -> m r+foldStreamSharedStream st yld sng stp m =+    let K.MkStream k = m+     in k st yld sng stp++-- | 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+    :: IsStream t+    => State K.StreamK m a+    -> (a -> t m a -> m r)+    -> (a -> m r)+    -> m r+    -> t m a+    -> m r+foldStream st yld sng stp m =+    let yieldk a x = yld a (fromStream x)+        K.MkStream k = toStream m+     in k (adaptState st) yieldk sng stp++-------------------------------------------------------------------------------+-- Serial+-------------------------------------------------------------------------------++-- | Fix the type of a polymorphic stream as 'SerialT'.+--+-- /Since: 0.1.0 ("Streamly")/+--+-- @since 0.8.0+fromSerial :: IsStream t => SerialT m a -> t m a+fromSerial = adapt++instance IsStream SerialT where+    toStream = Stream.toStreamK+    fromStream = Stream.fromStreamK++    {-# INLINE consM #-}+    {-# SPECIALIZE consM :: IO a -> SerialT IO a -> SerialT IO a #-}+    consM = Serial.consM++    {-# INLINE (|:) #-}+    {-# SPECIALIZE (|:) :: IO a -> SerialT IO a -> SerialT IO a #-}+    (|:) = Serial.consM++-- | Fix the type of a polymorphic stream as 'WSerialT'.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+fromWSerial :: IsStream t => WSerialT m a -> t m a+fromWSerial = adapt++instance IsStream WSerialT where+    toStream = getWSerialT+    fromStream = WSerialT++    {-# INLINE consM #-}+    {-# SPECIALIZE consM :: IO a -> WSerialT IO a -> WSerialT IO a #-}+    consM :: Monad m => m a -> WSerialT m a -> WSerialT m a+    consM = Serial.consMWSerial++    {-# INLINE (|:) #-}+    {-# SPECIALIZE (|:) :: IO a -> WSerialT IO a -> WSerialT IO a #-}+    (|:) :: Monad m => m a -> WSerialT m a -> WSerialT m a+    (|:) = Serial.consMWSerial++-------------------------------------------------------------------------------+-- Async+-------------------------------------------------------------------------------++-- | Fix the type of a polymorphic stream as 'AsyncT'.+--+-- /Since: 0.1.0 ("Streamly")/+--+-- @since 0.8.0+fromAsync :: IsStream t => AsyncT m a -> t m a+fromAsync = adapt++instance IsStream AsyncT where+    toStream = getAsyncT+    fromStream = AsyncT++    {-# INLINE consM #-}+    {-# SPECIALIZE consM :: IO a -> AsyncT IO a -> AsyncT IO a #-}+    consM = Async.consMAsync++    {-# INLINE (|:) #-}+    {-# SPECIALIZE (|:) :: IO a -> AsyncT IO a -> AsyncT IO a #-}+    (|:) = Async.consMAsync++-- | Fix the type of a polymorphic stream as 'WAsyncT'.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+fromWAsync :: IsStream t => WAsyncT m a -> t m a+fromWAsync = adapt++instance IsStream WAsyncT where+    toStream = getWAsyncT+    fromStream = WAsyncT++    {-# INLINE consM #-}+    {-# SPECIALIZE consM :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}+    consM = Async.consMWAsync++    {-# INLINE (|:) #-}+    {-# SPECIALIZE (|:) :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}+    (|:) = Async.consMWAsync++-------------------------------------------------------------------------------+-- Ahead+-------------------------------------------------------------------------------++-- | Fix the type of a polymorphic stream as 'AheadT'.+--+-- /Since: 0.3.0 ("Streamly")/+--+-- @since 0.8.0+fromAhead :: IsStream t => AheadT m a -> t m a+fromAhead = adapt++instance IsStream AheadT where+    toStream = getAheadT+    fromStream = AheadT++    {-# INLINE consM #-}+    {-# SPECIALIZE consM :: IO a -> AheadT IO a -> AheadT IO a #-}+    consM = Ahead.consM++    {-# INLINE (|:) #-}+    {-# SPECIALIZE (|:) :: IO a -> AheadT IO a -> AheadT IO a #-}+    (|:) = Ahead.consM++-------------------------------------------------------------------------------+-- Parallel+-------------------------------------------------------------------------------++-- | Fix the type of a polymorphic stream as 'ParallelT'.+--+-- /Since: 0.1.0 ("Streamly")/+--+-- @since 0.8.0+fromParallel :: IsStream t => ParallelT m a -> t m a+fromParallel = adapt++instance IsStream ParallelT where+    toStream = getParallelT+    fromStream = ParallelT++    {-# INLINE consM #-}+    {-# SPECIALIZE consM :: IO a -> ParallelT IO a -> ParallelT IO a #-}+    consM = Parallel.consM++    {-# INLINE (|:) #-}+    {-# SPECIALIZE (|:) :: IO a -> ParallelT IO a -> ParallelT IO a #-}+    (|:) = Parallel.consM++-------------------------------------------------------------------------------+-- 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")/+--+-- @since 0.8.0+fromZipSerial :: IsStream t => ZipSerialM m a -> t m a+fromZipSerial = adapt+instance IsStream ZipSerialM where+    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 = consMZip++    {-# INLINE (|:) #-}+    {-# SPECIALIZE (|:) :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}+    (|:) :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a+    (|:) = consMZip++-- | Fix the type of a polymorphic stream as 'ZipAsyncM'.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+fromZipAsync :: IsStream t => ZipAsyncM m a -> t m a+fromZipAsync = adapt++instance IsStream ZipAsyncM where+    toStream = getZipAsyncM+    fromStream = ZipAsyncM++    {-# INLINE consM #-}+    {-# SPECIALIZE consM :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-}+    consM :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a+    consM = ZipAsync.consMZipAsync++    {-# INLINE (|:) #-}+    {-# SPECIALIZE (|:) :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-}+    (|:) :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a+    (|:) = ZipAsync.consMZipAsync++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++infixr 5 `cons`++-- | 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 :: IsStream t => a -> t m a -> t m a+cons a r = fromStream $ K.cons a (toStream r)++infixr 5 .:++-- | Operator equivalent of 'cons'.+--+-- @+-- > toList $ 1 .: 2 .: 3 .: nil+-- [1,2,3]+-- @+--+-- @since 0.1.1+{-# INLINE (.:) #-}+(.:) :: IsStream t => a -> t m a -> t m a+(.:) = cons++{-# INLINE_NORMAL nil #-}+nil :: IsStream t => t m a+nil = fromStream K.nil++{-# INLINE_NORMAL nilM #-}+nilM :: (IsStream t, Monad m) => m b -> t m a+nilM = fromStream . K.nilM++{-# INLINE_NORMAL fromPure #-}+fromPure :: IsStream t => a -> t m a+fromPure = fromStream . K.fromPure++{-# INLINE_NORMAL fromEffect #-}+fromEffect :: (Monad m, IsStream t) => m a -> t m a+fromEffect = fromStream . K.fromEffect++{-# INLINE repeat #-}+repeat :: IsStream t => a -> t m a+repeat = fromStream . K.repeat++-------------------------------------------------------------------------------+-- Bind/Concat+-------------------------------------------------------------------------------++{-# INLINE bindWith #-}+bindWith+    :: IsStream t+    => (t m b -> t m b -> t m b)+    -> t m a+    -> (a -> t m b)+    -> t m b+bindWith par m1 f =+    fromStream+        $ K.bindWith+            (\s1 s2 -> toStream $ par (fromStream s1) (fromStream s2))+            (toStream m1)+            (toStream . f)++-- | @concatMapWith mixer generator stream@ is a two dimensional looping+-- combinator.  The @generator@ function is used to generate streams from the+-- elements in the input @stream@ and the @mixer@ function is used to merge+-- those streams.+--+-- Note we can merge streams concurrently by using a concurrent merge function.+--+-- /Since: 0.7.0/+--+-- /Since: 0.8.0 (signature change)/+{-# INLINE concatMapWith #-}+concatMapWith+    :: IsStream t+    => (t m b -> t m b -> t m b)+    -> (a -> t m b)+    -> t m a+    -> t m b+concatMapWith par f xs = bindWith par xs f++-- | A variant of 'foldMap' that allows you to map a monadic streaming action+-- on a 'Foldable' container and then fold it using the specified stream merge+-- operation.+--+-- @concatMapFoldableWith 'async' return [1..3]@+--+-- Equivalent to:+--+-- @+-- concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil+-- concatMapFoldableWith f g xs = S.concatMapWith f g (S.fromFoldable xs)+-- @+--+-- /Since: 0.8.0 (Renamed foldMapWith to concatMapFoldableWith)/+--+-- /Since: 0.1.0 ("Streamly")/+{-# INLINE concatMapFoldableWith #-}+concatMapFoldableWith :: (IsStream t, Foldable f)+    => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b+concatMapFoldableWith f g = Prelude.foldr (f . g) nil++-- | Like 'concatMapFoldableWith' but with the last two arguments reversed i.e. the+-- monadic streaming function is the last argument.+--+-- Equivalent to:+--+-- @+-- 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)/+--+-- /Since: 0.1.0 ("Streamly")/+{-# INLINE concatForFoldableWith #-}+concatForFoldableWith :: (IsStream t, Foldable f)+    => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b+concatForFoldableWith f = flip (concatMapFoldableWith f)++-- | A variant of 'Data.Foldable.fold' that allows you to fold a 'Foldable'+-- container of streams using the specified stream sum operation.+--+-- @concatFoldableWith 'async' $ map return [1..3]@+--+-- Equivalent to:+--+-- @+-- concatFoldableWith f = Prelude.foldr f D.nil+-- concatFoldableWith f = D.concatMapFoldableWith f id+-- @+--+-- /Since: 0.8.0 (Renamed foldWith to concatFoldableWith)/+--+-- /Since: 0.1.0 ("Streamly")/+{-# INLINE concatFoldableWith #-}+concatFoldableWith :: (IsStream t, Foldable f)+    => (t m a -> t m a -> t m a) -> f (t m a) -> t m a+concatFoldableWith f = concatMapFoldableWith f id
+ 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
@@ -0,0 +1,552 @@+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.Parallel+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- To run examples in this module:+--+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Control.Concurrent (threadDelay)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}+--+module Streamly.Internal.Data.Stream.Parallel {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream.Concurrent\" instead." #-}+    (+    -- * Parallel Stream Type+      ParallelT(..)+    , Parallel+    , consM++    -- * Merge Concurrently+    , parallelK+    , parallelFstK+    , parallelMinK++    -- * Evaluate Concurrently+    , mkParallelD+    , mkParallelK++    -- * Tap Concurrently+    , tapAsyncK+    , tapAsyncF++    -- * Callbacks+    , newCallbackStream+    )+where++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)++import Streamly.Data.Fold (Fold)+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Stream (Step(..))++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"++--+-- $setup+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Control.Concurrent (threadDelay)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      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+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- StreamK based worker routines+-------------------------------------------------------------------------------++{-# NOINLINE runOne #-}+runOne+    :: MonadIO m+    => State K.StreamK m a -> K.StreamK m a -> Maybe WorkerInfo -> m ()+runOne st m0 winfo =+    case getYieldLimit st of+        Nothing -> go m0+        Just _  -> runOneLimited st m0 winfo++    where++    go m = do+        liftIO $ decrementBufferLimit sv+        K.foldStreamShared st yieldk single stop m++    sv = fromJust $ streamVar st++    stop = liftIO $ do+        incrementBufferLimit sv+        sendStop sv winfo+    sendit a = liftIO $ void $ send sv (ChildYield a)+    single a = sendit a >> liftIO (sendStop sv winfo)+    yieldk a r = sendit a >> go r++runOneLimited+    :: MonadIO m+    => State K.StreamK m a -> K.StreamK m a -> Maybe WorkerInfo -> m ()+runOneLimited st m0 winfo = go m0++    where++    go m = do+        yieldLimitOk <- liftIO $ decrementYieldLimit sv+        if yieldLimitOk+        then do+            liftIO $ decrementBufferLimit sv+            K.foldStreamShared st yieldk single stop m+        else do+            liftIO $ cleanupSVarFromWorker sv+            liftIO $ sendStop sv winfo++    sv = fromJust $ streamVar st++    stop = liftIO $ do+        incrementBufferLimit sv+        incrementYieldLimit sv+        sendStop sv winfo+    sendit a = liftIO $ void $ send sv (ChildYield a)+    single a = sendit a >> liftIO (sendStop sv winfo)+    yieldk a r = sendit a >> go r++-------------------------------------------------------------------------------+-- Consing and appending a stream in parallel style+-------------------------------------------------------------------------------++-- Note that consing and appending requires StreamK as it would not scale well+-- with StreamD unless we are only consing a very small number of streams or+-- elements in a stream. StreamK allows us to manipulate control flow in a way+-- which StreamD cannot allow. StreamK can make a jump without having to+-- remember the past state.++{-# NOINLINE forkSVarPar #-}+forkSVarPar :: MonadAsync m+    => 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)+    case ss of+        StopBy -> liftIO $ do+            set <- readIORef (workerThreads sv)+            writeIORef (svarStopBy sv) $ Set.elemAt 0 set+        _ -> return ()+    pushWorkerPar sv (runOne st{streamVar = Just sv} r)+    K.foldStream st yld sng stp $ Stream.toStreamK (SVar.fromSVar sv)++{-# INLINE joinStreamVarPar #-}+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+            -- Here, WE ARE IN THE WORKER/PRODUCER THREAD, we know that because+            -- the SVar exists. We are running under runOne and the output we+            -- produce ultimately will be sent to the SVar by runOne.+            --+            -- If we came here the worker/runOne is evaluating a `parallel`+            -- combinator. In this case, we always fork a new worker for the+            -- first component (m1) in the parallel composition and continue to+            -- evaluate the second component (m2) in the current worker thread.+            --+            -- When m1 is serially composed, the worker would evaluate it+            -- without any further forks and the resulting output is sent to+            -- the SVar and the evaluation terminates. If m1 is a `parallel`+            -- composition of two streams the worker would again recurses here.+            --+            -- Similarly, when m2 is serially composed it gets evaluated here+            -- and the resulting output is sent to the SVar by the runOne+            -- wrapper. When m2 is composed with `parallel` it will again+            -- recurse here and so on until it finally terminates.+            --+            -- When we create a right associated expression using `parallel`,+            -- then m1 would always terminate without further forks or+            -- recursion into this routine, therefore, the worker returns+            -- immediately after evaluating it. And m2 would continue to+            -- fork/recurse, therefore, the current thread always recurses and+            -- forks new workers one after the other.  This is a tail recursive+            -- style execution, m2, the recursive expression always executed at+            -- the tail.+            --+            -- When the expression is left associated, the worker spawned would+            -- get the forking/recursing responsibility and then again the+            -- worker spawned by that worker would fork, thus creating layer+            -- over layer of workers and a chain of threads leading to a very+            -- inefficient execution.+            pushWorkerPar sv (runOne st m1)+            K.foldStreamShared st yld sng stp m2+        _ ->+            -- Here WE ARE IN THE CONSUMER THREAD, we create a new SVar, fork+            -- worker threads to execute m1 and m2 and this thread starts+            -- pulling the stream from the SVar.+            K.foldStreamShared st yld sng stp (forkSVarPar ss m1 m2)++-------------------------------------------------------------------------------+-- User facing APIs+-------------------------------------------------------------------------------++{-# INLINE parallelK #-}+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+-- of combining streams using parallel.+{-# INLINE consM #-}+{-# SPECIALIZE consM :: IO a -> ParallelT IO a -> ParallelT IO a #-}+consM :: MonadAsync m => m a -> ParallelT m a -> ParallelT m a+consM m (ParallelT r) = ParallelT $ parallelK (K.fromEffect m) r++-- This is a co-parallel like combinator for streams, where first stream is the+-- main stream and the rest are just supporting it, when the first ends+-- everything ends.+--+-- | Like `parallel` but stops the output as soon as the first stream stops.+--+-- /Pre-release/+{-# INLINE parallelFstK #-}+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.+--+-- | Like `parallel` but stops the output as soon as any of the two streams+-- stops.+--+-- /Pre-release/+{-# INLINE parallelMinK #-}+parallelMinK :: MonadAsync m => K.StreamK m a -> K.StreamK m a -> K.StreamK m a+parallelMinK = joinStreamVarPar ParallelVar StopAny++------------------------------------------------------------------------------+-- Convert a stream to parallel+------------------------------------------------------------------------------++-- | Like 'mkParallel' but uses StreamK internally.+--+-- /Pre-release/+--+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 $ Stream.toStreamK $ SVar.fromSVar sv++-- | Same as 'mkParallel' but for StreamD stream.+--+{-# INLINE_NORMAL mkParallelD #-}+mkParallelD :: MonadAsync m => D.Stream m a -> D.Stream m a+mkParallelD m = D.Stream step Nothing+    where++    step gst Nothing = do+        sv <- newParallelVar StopNone gst+        SVar.toSVarParallel gst sv m+        -- XXX use unfold instead?+        return $ Skip $ Just $ SVar.fromSVarD sv++    step gst (Just (D.UnStream step1 st)) = do+        r <- step1 gst st+        return $ case r of+            Yield a s -> Yield a (Just $ D.Stream step1 s)+            Skip s    -> Skip (Just $ D.Stream step1 s)+            Stop      -> Stop++-------------------------------------------------------------------------------+-- Concurrent tap+-------------------------------------------------------------------------------++-- NOTE: In regular pull style streams, the consumer stream is pulling elements+-- from the SVar and we have several workers producing elements and pushing to+-- SVar. In case of folds, we, the parent stream driving the fold, are the+-- stream producing worker, we start an SVar and start pushing to the SVar, the+-- fold on the other side of the SVar is the consumer stream.+--+-- In the pull stream case exceptions are propagated from the producing workers+-- to the consumer stream, the exceptions are propagated on the same channel as+-- the produced stream elements. However, in case of push style folds the+-- current stream itself is the worker and the fold is the consumer, in this+-- case we have to propagate the exceptions from the consumer to the producer.+-- This is reverse of the pull case and we need a reverse direction channel+-- to propagate the exception.+--+-- | 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.+--+-- @+--               StreamK 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'.+--+-- /Pre-release/+{-# INLINE tapAsyncK #-}+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 . Stream.toStreamK)+    K.foldStreamShared st yld sng stp+        $ 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.+--+{-# INLINE_NORMAL tapAsyncF #-}+tapAsyncF :: MonadAsync m => Fold m a b -> D.Stream m a -> D.Stream m a+tapAsyncF f (D.Stream step1 state1) = D.Stream step TapInit+    where++    drainFold svr = do+            -- In general, a Stop event would come equipped with the result+            -- of the fold. It is not used here but it would be useful in+            -- applicative and distribute.+            done <- SVar.fromConsumer svr+            when (not done) $ do+                liftIO $ withDiagMVar svr "teeToSVar: waiting to drain"+                       $ takeMVar (outputDoorBellFromConsumer svr)+                drainFold svr++    stopFold svr = do+            liftIO $ sendStop svr Nothing+            -- drain/wait until a stop event arrives from the fold.+            drainFold svr++    {-# INLINE_LATE step #-}+    step gst TapInit = do+        sv <- SVar.newFoldSVarF gst f+        return $ Skip (Tapping sv state1)++    step gst (Tapping sv st) = do+        r <- step1 gst st+        case r of+            Yield a s ->  do+                done <- SVar.pushToFold sv a+                if done+                then do+                    -- XXX we do not need to wait synchronously here+                    stopFold sv+                    return $ Yield a (TapDone s)+                else return $ Yield a (Tapping sv s)+            Skip s -> return $ Skip (Tapping sv s)+            Stop -> do+                stopFold sv+                return Stop++    step gst (TapDone st) = do+        r <- step1 gst st+        return $ case r of+            Yield a s -> Yield a (TapDone s)+            Skip s    -> Skip (TapDone s)+            Stop      -> Stop++------------------------------------------------------------------------------+-- ParallelT+------------------------------------------------------------------------------++-- | For 'ParallelT' streams:+--+-- @+-- (<>) = 'Streamly.Prelude.parallel'+-- (>>=) = flip . 'Streamly.Prelude.concatMapWith' 'Streamly.Prelude.parallel'+-- @+--+-- See 'Streamly.Prelude.AsyncT', 'ParallelT' is similar except that all+-- iterations are strictly concurrent while in 'AsyncT' it depends on the+-- consumer demand and available threads. See 'parallel' for more details.+--+-- /Since: 0.1.0 ("Streamly")/+--+-- /Since: 0.7.0 (maxBuffer applies to ParallelT streams)/+--+-- @since 0.8.0+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.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+type Parallel = ParallelT IO++------------------------------------------------------------------------------+-- Semigroup+------------------------------------------------------------------------------++{-# INLINE append #-}+{-# SPECIALIZE append :: ParallelT IO a -> ParallelT IO a -> ParallelT IO a #-}+append :: MonadAsync m => ParallelT m a -> ParallelT m a -> ParallelT m a+append (ParallelT m1) (ParallelT m2) = ParallelT $ parallelK m1 m2++instance MonadAsync m => Semigroup (ParallelT m a) where+    (<>) = append++------------------------------------------------------------------------------+-- Monoid+------------------------------------------------------------------------------++instance MonadAsync m => Monoid (ParallelT m a) where+    mempty = ParallelT K.nil+    mappend = (<>)++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++{-# INLINE apParallel #-}+{-# SPECIALIZE apParallel ::+    ParallelT IO (a -> b) -> ParallelT IO a -> ParallelT IO b #-}+apParallel :: MonadAsync m =>+    ParallelT m (a -> b) -> ParallelT m a -> ParallelT m b+apParallel (ParallelT m1) (ParallelT 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+    {-# INLINE pure #-}+    pure = ParallelT . K.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = apParallel++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++{-# INLINE bind #-}+{-# SPECIALIZE bind ::+    ParallelT IO a -> (a -> ParallelT IO b) -> ParallelT IO b #-}+bind :: MonadAsync m => ParallelT m a -> (a -> ParallelT m b) -> ParallelT m b+bind (ParallelT m) f = ParallelT $ K.bindWith parallelK m (getParallelT . f)++instance MonadAsync m => Monad (ParallelT m) where+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = bind++------------------------------------------------------------------------------+-- 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)++-------------------------------------------------------------------------------+-- From callback+-------------------------------------------------------------------------------++-- 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.+--+-- | Generates a callback and a stream pair. The callback returned is used to+-- queue values to the stream.  The stream is infinite, there is no way for the+-- callback to indicate that it is done now.+--+-- /Pre-release/+--+{-# INLINE_NORMAL newCallbackStream #-}+newCallbackStream :: MonadAsync m => m (a -> m (), K.StreamK m a)+newCallbackStream = do+    sv <- newParallelVar StopNone defState++    -- 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.+    liftIO myThreadId >>= modifyThread sv++    let callback a = liftIO $ void $ send sv (ChildYield a)+    -- XXX we can return an SVar and then the consumer can unfold from the+    -- SVar?+    return (callback, D.toStreamK (SVar.fromSVarD sv))
+ src/Streamly/Internal/Data/Stream/Prelude.hs view
@@ -0,0 +1,25 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Prelude+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Stream.Prelude+    (+      -- * 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++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/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
@@ -0,0 +1,406 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.SVar.Eliminate+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- 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++    -- * Concurrent folds+    -- $concurrentFolds+    , newFoldSVar+    , newFoldSVarF++    , fromConsumer+    , pushToFold+    , teeToSVar+    )+where++#include "inline.hs"++import Control.Concurrent (myThreadId, takeMVar)+import Control.Monad (when, void)+import Control.Monad.Catch (throwM)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (newIORef, readIORef, writeIORef)+import Streamly.Internal.Control.Concurrent (MonadAsync)+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 (Fold(..))+import Streamly.Internal.Data.Stream.Serial (SerialT)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)++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++-------------------------------------------------------------------------------+-- Concurrent function application+-------------------------------------------------------------------------------++-- Using StreamD the worker stream producing code can fuse with the code to+-- queue output to the SVar giving some perf boost.+--+-- Note that StreamD can only be used in limited situations, specifically, we+-- cannot implement joinStreamVarPar using this.+--+-- XXX make sure that the SVar passed is a Parallel style SVar.++-- | Fold the supplied stream to the SVar asynchronously using Parallel+-- concurrency style.+-- {-# INLINE_NORMAL toSVarParallel #-}+{-# INLINE toSVarParallel #-}+toSVarParallel :: MonadAsync m+    => State t m a -> SVar t m a -> D.Stream m a -> m ()+toSVarParallel st sv xs =+    if svarInspectMode sv+    then forkWithDiag+    else do+        tid <-+                case getYieldLimit st of+                    Nothing -> doFork (work Nothing)+                                      (svarMrun sv)+                                      (handleChildException sv)+                    Just _  -> doFork (workLim Nothing)+                                      (svarMrun sv)+                                      (handleChildException sv)+        modifyThread sv tid++    where++    {-# NOINLINE work #-}+    work info = D.fold (write sv info) xs++    {-# NOINLINE workLim #-}+    workLim info = D.fold (writeLimited sv info) xs++    {-# NOINLINE forkWithDiag #-}+    forkWithDiag = do+        -- We do not use workerCount in case of ParallelVar but still there is+        -- no harm in maintaining it correctly.+        liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1+        recordMaxWorkers sv+        -- This allocation matters when significant number of workers are being+        -- sent. We allocate it only when needed. The overhead increases by 4x.+        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 = 0+                        , workerYieldCount = cntRef+                        , workerLatencyStart = lat+                        }+        tid <-+            case getYieldLimit st of+                Nothing -> doFork (work winfo)+                                  (svarMrun sv)+                                  (handleChildException sv)+                Just _  -> doFork (workLim winfo)+                                  (svarMrun sv)+                                  (handleChildException sv)+        modifyThread sv tid++-------------------------------------------------------------------------------+-- 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 <------SVar<------input stream+--     |  exceptions  |+--     --------------->+--+-- @+--+-- We need a channel for pushing exceptions from the fold worker to the stream+-- pusher. The stream may be pushed to multiple folds at the same time. For+-- that we need one SVar per fold:+--+-- @+--+-- Fold worker <------SVar<---+--                    |       |+-- Fold worker <------SVar<------input stream+--                    |       |+-- Fold worker <------SVar<---+--+-- @+--+-- Unlike in case concurrent stream evaluation, the puller does not drive the+-- scheduling and concurrent execution of the stream. The stream is simply+-- pushed by the stream producer at its own rate. The fold worker just pulls it+-- and folds it.+--+-- 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 consumer from a stream producer+-------------------------------------------------------------------------------++-- | Pull a stream from an SVar to fold it. Like 'fromSVar' except that it does+-- not drive the evaluation of the stream. It just pulls whatever is available+-- on the SVar. Also, when the fold stops it sends a notification to the stream+-- pusher/producer. No exceptions are expected to be propagated from the stream+-- pusher to the fold puller.+--+{-# NOINLINE fromProducer #-}+fromProducer :: forall m a . MonadAsync m => SVar K.Stream m a -> K.Stream m a+fromProducer 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++    allDone :: m r -> m r+    allDone stp = do+        when (svarInspectMode sv) $ do+            t <- liftIO $ getTime Monotonic+            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)+            liftIO $ printSVar sv "SVar Done"+        sendStopToProducer sv+        stp++    {-# INLINE processEvents #-}+    processEvents :: [ChildEvent a] -> K.Stream m a+    processEvents [] = K.mkStream $ \st yld sng stp -> do+        K.foldStream st yld sng stp $ fromProducer sv++    processEvents (ev : es) = K.mkStream $ \_ yld _ stp -> do+        let rest = processEvents es+        case ev of+            ChildYield a -> yld a rest+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> allDone stp+                    Just _ -> error "Bug: fromProducer: received exception"++-- | Create a Fold style SVar that runs a supplied fold function as the+-- consumer.  Any elements sent to the SVar are consumed by the supplied fold+-- function.+--+{-# INLINE newFoldSVar #-}+newFoldSVar :: MonadAsync m+    => State K.Stream m a -> (SerialT m a -> m b) -> m (SVar K.Stream m a)+newFoldSVar stt f = do+    -- Buffer size for the SVar is derived from the current state+    sv <- newParallelVar StopAny (adaptState stt)++    -- Add the producer thread-id to the SVar.+    liftIO myThreadId >>= modifyThread sv++    void $ doFork (void $ f $ Stream.fromStreamK $ fromProducer sv)+                  (svarMrun sv)+                  (handleFoldException sv)+    return sv++data FromSVarState t m a =+      FromSVarInit+    | FromSVarRead (SVar t m a)+    | FromSVarLoop (SVar t m a) [ChildEvent a]+    | FromSVarDone (SVar t m a)++-- | Like 'fromProducer' but generates a StreamD style stream instead of+-- StreamK.+--+{-# INLINE_NORMAL fromProducerD #-}+fromProducerD :: (MonadAsync m) => SVar t m a -> D.Stream m a+fromProducerD svar = D.Stream step (FromSVarRead svar)+    where++    {-# INLINE_LATE step #-}+    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 []) = return $ D.Skip $ FromSVarRead sv+    step _ (FromSVarLoop sv (ev : es)) = do+        case ev of+            ChildYield a -> return $ D.Yield a (FromSVarLoop sv es)+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> do+                        sendStopToProducer sv+                        return $ D.Skip (FromSVarDone sv)+                    Just _ -> error "Bug: fromProducer: received exception"++    step _ (FromSVarDone sv) = do+        when (svarInspectMode sv) $ do+            t <- liftIO $ getTime Monotonic+            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)+            liftIO $ printSVar sv "SVar Done"+        return D.Stop++    step _ FromSVarInit = undefined++-- | Like 'newFoldSVar' except that it uses a 'Fold' instead of a fold+-- function.+--+{-# INLINE newFoldSVarF #-}+newFoldSVarF :: MonadAsync m => State t m a -> Fold m a b -> m (SVar t m a)+newFoldSVarF stt f = do+    -- Buffer size for the SVar is derived from the current state+    sv <- newParallelVar StopAny (adaptState stt)+    -- Add the producer thread-id to the SVar.+    liftIO myThreadId >>= modifyThread sv+    void $ doFork (work sv) (svarMrun sv) (handleFoldException sv)+    return sv++    where++    {-# NOINLINE work #-}+    work sv = void $ D.fold f $ fromProducerD sv++-------------------------------------------------------------------------------+-- Process events received by the producer thread from the consumer 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.+--+-- | Poll for events sent by the fold consumer to the stream pusher. 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 fromConsumer #-}+fromConsumer :: MonadAsync m => SVar K.Stream m a -> m Bool+fromConsumer sv = do+    (list, _) <- liftIO $ readOutputQBasic (outputQueueFromConsumer 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 False+    processEvents (ev : _) = do+        case ev of+            ChildStop _ e -> do+                case e of+                    Nothing -> return True+                    Just ex -> throwM ex+            ChildYield _ -> error "Bug: fromConsumer: invalid ChildYield event"++-- | Push values from a stream to a fold worker via an SVar. Before pushing a+-- value to the SVar it polls for events received from the fold consumer.  If a+-- stop event is received then it returns 'True' otherwise false.  Propagates+-- exceptions received from the fold consumer.+--+{-# INLINE pushToFold #-}+pushToFold :: MonadAsync m => SVar K.Stream m a -> a -> m Bool+pushToFold sv a = do+    -- Check for exceptions before decrement so that we do not+    -- block forever if the child already exited with an exception.+    --+    -- We avoid a race between the consumer fold sending an event and we+    -- blocking on decrementBufferLimit by waking up the producer thread in+    -- sendToProducer before any event is sent by the fold to the producer+    -- stream.+    let qref = outputQueueFromConsumer sv+    done <- do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then fromConsumer sv+        else return False+    if done+    then return True+    else liftIO $ do+        decrementBufferLimit sv+        void $ send sv (ChildYield a)+        return False++------------------------------------------------------------------------------+-- Clone and distribute a stream in parallel+------------------------------------------------------------------------------++-- XXX this could be written in StreamD style for better efficiency with fusion.+--+-- | Tap a stream and send the elements to the specified SVar in addition to+-- yielding them again. The SVar runs a fold consumer. Elements are tapped and+-- sent to the SVar until the fold finishes. Any exceptions from the fold+-- evaluation are propagated in the current thread.+--+-- @+--+-- ------input stream---------output stream----->+--                    /|\\   |+--         exceptions  |    |  input+--                     |   \\|/+--                     ----SVar+--                          |+--                         Fold+--+-- @+--+{-# INLINE teeToSVar #-}+teeToSVar :: MonadAsync m =>+    SVar K.Stream m a -> SerialT m a -> SerialT m a+teeToSVar svr m = Stream.fromStreamK $ K.mkStream $ \st yld sng stp -> do+    K.foldStreamShared st yld sng stp (go False $ Stream.toStreamK m)++    where++    go False m0 = K.mkStream $ \st yld _ stp -> do+        let drain = do+                -- In general, a Stop event would come equipped with the result+                -- of the fold. It is not used here but it would be useful in+                -- applicative and distribute.+                done <- fromConsumer svr+                when (not done) $ do+                    liftIO $ withDiagMVar svr "teeToSVar: waiting to drain"+                           $ takeMVar (outputDoorBellFromConsumer svr)+                    drain++            stopFold = do+                liftIO $ sendStop svr Nothing+                -- drain/wait until a stop event arrives from the fold.+                drain++            stop       = stopFold >> stp+            single a   = do+                done <- pushToFold svr a+                yld a (go done (K.nilM stopFold))+            yieldk a r = pushToFold svr a >>= \done -> yld a (go done r)+         in K.foldStreamShared st yieldk single stop m0++    go True m0 = m0
+ src/Streamly/Internal/Data/Stream/SVar/Generate.hs view
@@ -0,0 +1,296 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}+#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++-- |+-- Module      : Streamly.Internal.Data.Stream.SVar.Generate+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.Stream.SVar.Generate+    {-# DEPRECATED "SVar is replaced by Channel." #-}+    (+    -- * Write to SVar+      toSVar++    -- * Read from SVar+    -- $concurrentEval+    , fromSVar+    , fromSVarD+    -- , fromStreamVar+    )+where++#include "inline.hs"++import Control.Exception (fromException)+import Control.Monad (when)+import Control.Monad.Catch (throwM)+import Control.Monad.IO.Class (MonadIO(liftIO))+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.Time.Clock (Clock(Monotonic), getTime)+import System.Mem (performMajorGC)++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++#ifdef INSPECTION+import Control.Exception (Exception)+import Control.Monad.Catch (MonadThrow)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Typeable (Typeable)+import Test.Inspection (inspect, hasNoTypeClassesExcept)+#endif+++------------------------------------------------------------------------------+-- Generating streams from SVar+------------------------------------------------------------------------------++-- $concurrentEval+--+-- Usually the SVar is used to concurrently evaluate multiple actions in a+-- stream using many worker threads that push the results to the SVar and a+-- single puller that pulls them from SVar generating the evaluated stream.+--+-- @+--                  input stream+--                       |+--     <-----------------|<--------worker+--     |  exceptions     |+-- output stream <------SVar<------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 an SVar+-------------------------------------------------------------------------------++-- XXX this errors out for Parallel/Ahead SVars+-- | Write a stream to an 'SVar' in a non-blocking manner. The stream can then+-- be read back from the SVar using 'fromSVar'.+toSVar :: MonadAsync m => SVar SerialT m a -> SerialT m a -> m ()+toSVar sv m = do+    runIn <- askRunInIO+    liftIO $ enqueue sv (runIn, m)+    done <- allThreadsDone sv+    -- XXX This is safe only when called from the consumer thread or when no+    -- consumer is present.  There may be a race if we are not running in the+    -- consumer thread.+    -- XXX do this only if the work queue is not empty. The work may have been+    -- carried out by existing workers.+    when done $+        case yieldRateInfo sv of+            Nothing -> pushWorker 0 sv+            Just _  -> pushWorker 1 sv++-------------------------------------------------------------------------------+-- Read a stream from an SVar+-------------------------------------------------------------------------------++-- | Pull a stream from an SVar.+{-# NOINLINE fromStreamVar #-}+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+    -- streams.+    K.foldStream st yld sng stp $ processEvents $ reverse list++    where++    allDone :: forall r. m r -> m r+    allDone stp = do+        when (svarInspectMode sv) $ do+            t <- liftIO $ getTime Monotonic+            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)+            liftIO $ printSVar sv "SVar Done"+        stp++    {-# INLINE processEvents #-}+    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+        let rest = processEvents es+        case ev of+            ChildYield a -> yld a rest+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> do+                        stop <- shouldStop tid+                        if stop+                        then liftIO (cleanupSVar sv) >> allDone stp+                        else K.foldStream st yld sng stp rest+                    Just ex ->+                        case fromException ex of+                            Just ThreadAbort ->+                                K.foldStream st yld sng stp rest+                            Nothing -> liftIO (cleanupSVar sv) >> throwM ex+    shouldStop tid =+        case svarStopStyle sv of+            StopNone -> return False+            StopAny -> return True+            StopBy -> do+                sid <- liftIO $ readIORef (svarStopBy sv)+                return $ tid == sid++#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+-- that we do not use the constraint tuple type class.+--+inspect $ hasNoTypeClassesExcept 'fromStreamVar+    [ ''Monad+    , ''Applicative+    , ''MonadThrow+    , ''Exception+    , ''MonadIO+    , ''MonadBaseControl+    , ''Typeable+    , ''Functor+    ]+#endif+#endif++-- | Generate a stream from an SVar.  An unevaluated stream can be pushed to an+-- SVar using 'toSVar'.  As we pull a stream from the SVar the input stream+-- gets evaluated concurrently. The evaluation depends on the SVar style and+-- the configuration parameters e.g. using the maxBuffer/maxThreads+-- combinators.+--+{-# INLINE fromSVar #-}+fromSVar :: MonadAsync m => SVar K.Stream m a -> SerialT m a+fromSVar sv =+    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+        -- no other references, when that copy gets garbage collected "ref"+        -- will get garbage collected and our hook will be called.+        K.foldStreamShared st yld sng stp $+            fromStreamVar sv{svarRef = Just ref}+    where++    hook = do+        when (svarInspectMode sv) $ do+            r <- liftIO $ readIORef (svarStopTime (svarStats sv))+            when (isNothing r) $+                printSVar sv "SVar Garbage Collected"+        cleanupSVar sv+        -- If there are any SVars referenced by this SVar a GC will prompt+        -- them to be cleaned up quickly.+        when (svarInspectMode sv) performMajorGC++data FromSVarState t m a =+      FromSVarInit+    | FromSVarRead (SVar t m a)+    | FromSVarLoop (SVar t m a) [ChildEvent a]+    | FromSVarDone (SVar t m a)++-- | Like 'fromSVar' but generates a StreamD style stream instead of CPS.+--+{-# INLINE_NORMAL fromSVarD #-}+fromSVarD :: (MonadAsync m) => SVar t m a -> D.Stream m a+fromSVarD svar = D.Stream step FromSVarInit+    where++    {-# INLINE_LATE step #-}+    step _ FromSVarInit = do+        ref <- liftIO $ newIORef ()+        _ <- liftIO $ mkWeakIORef ref hook+        -- 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)++        where++        {-# NOINLINE hook #-}+        hook = do+            when (svarInspectMode svar) $ do+                r <- liftIO $ readIORef (svarStopTime (svarStats svar))+                when (isNothing r) $+                    printSVar svar "SVar Garbage Collected"+            cleanupSVar svar+            -- If there are any SVars referenced by this SVar a GC will prompt+            -- them to be cleaned up quickly.+            when (svarInspectMode svar) performMajorGC++    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)+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> do+                        stop <- shouldStop tid+                        if stop+                        then do+                            liftIO (cleanupSVar sv)+                            return $ D.Skip (FromSVarDone sv)+                        else return $ D.Skip (FromSVarLoop sv es)+                    Just ex ->+                        case fromException ex of+                            Just ThreadAbort ->+                                return $ D.Skip (FromSVarLoop sv es)+                            Nothing -> liftIO (cleanupSVar sv) >> throwM ex+        where++        shouldStop tid =+            case svarStopStyle sv of+                StopNone -> return False+                StopAny -> return True+                StopBy -> do+                    sid <- liftIO $ readIORef (svarStopBy sv)+                    return $ tid == sid++    step _ (FromSVarDone sv) = do+        when (svarInspectMode sv) $ do+            t <- liftIO $ getTime Monotonic+            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)+            liftIO $ printSVar sv "SVar Done"+        return D.Stop
+ src/Streamly/Internal/Data/Stream/Serial.hs view
@@ -0,0 +1,457 @@+{-# 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+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- To run examples in this module:+--+-- >>> import qualified Streamly.Prelude as Stream+--+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+    , wSerial+    , wSerialFst+    , wSerialMin+    , consMWSerial++    -- * Construction+    , cons+    , consM+    , repeat+    , unfoldrM+    , fromList++    -- * Elimination+    , toList++    -- * Transformation+    , map+    , mapM+    )+where++#if !(MIN_VERSION_base(4,18,0))+import Control.Applicative (liftA2)+#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(..))+import Control.Monad.State.Class (MonadState(..))+import Control.Monad.Trans.Class (MonadTrans(lift))+import Data.Foldable (Foldable(foldl'), fold)+import Data.Functor.Identity (Identity(..), runIdentity)+import Data.Maybe (fromMaybe)+import Data.Semigroup (Endo(..))+import GHC.Exts (IsList(..), IsString(..), oneShot)+import Text.Read+       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec+       , readListPrecDefault)+import Streamly.Internal.BaseCompat ((#.))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.StreamK (Stream)++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, repeat, filter)++#include "Instances.hs"+#include "inline.hs"++-- $setup+-- >>> :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+------------------------------------------------------------------------------++-- | For 'SerialT' streams:+--+-- @+-- (<>) = 'Streamly.Prelude.serial'                       -- 'Semigroup'+-- (>>=) = flip . 'Streamly.Prelude.concatMapWith' 'Streamly.Prelude.serial' -- 'Monad'+-- @+--+-- A single 'Monad' bind behaves like a @for@ loop:+--+-- >>> :{+-- IsStream.toList $ do+--      x <- IsStream.fromList [1,2] -- foreach x in stream+--      return x+-- :}+-- [1,2]+--+-- Nested monad binds behave like nested @for@ loops:+--+-- >>> :{+-- 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)]+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+newtype SerialT m a = SerialT {getSerialT :: Stream m a}+    -- XXX when deriving do we inherit an INLINE?+    deriving (Semigroup, Monoid)++-- | A serial IO stream of elements of type @a@. See 'SerialT' documentation+-- for more details.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+type Serial = SerialT IO++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+consM m (SerialT ms) = SerialT $ K.consM m ms++-- |+-- Generate an infinite stream by repeating a pure value.+--+{-# INLINE_NORMAL repeat #-}+repeat :: Monad m => a -> SerialT m a+repeat = SerialT . D.toStreamK . D.repeat++------------------------------------------------------------------------------+-- Combining+------------------------------------------------------------------------------++{-# INLINE serial #-}+serial :: SerialT m a -> SerialT m a -> SerialT m a+serial = (<>)++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++instance Monad m => Monad (SerialT m) where+    return = pure++    -- Benchmarks better with StreamD bind and pure:+    -- toList, filterAllout, *>, *<, >> (~2x)+    --+    -- pure = SerialT . D.fromStreamD . D.fromPure+    -- m >>= f = D.fromStreamD $ D.concatMap (D.toStreamD . f) (D.toStreamD m)++    -- Benchmarks better with CPS bind and pure:+    -- Prime sieve (25x)+    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)+    --+    {-# INLINE (>>=) #-}+    (>>=) (SerialT m) f = SerialT $ K.bindWith K.append m (getSerialT . f)++    {-# INLINE (>>) #-}+    (>>) = (*>)++instance MonadTrans SerialT where+    {-# INLINE lift #-}+    lift = SerialT . K.fromEffect++------------------------------------------------------------------------------+-- Other instances+------------------------------------------------------------------------------++{-# INLINE mapM #-}+mapM :: Monad m => (a -> m b) -> SerialT m a -> SerialT m b+mapM f (SerialT m) = SerialT $ D.toStreamK $ D.mapM f $ D.fromStreamK m++-- |+-- @+-- map = fmap+-- @+--+-- Same as 'fmap'.+--+-- @+-- > S.toList $ S.map (+1) $ S.fromList [1,2,3]+-- [2,3,4]+-- @+--+-- @since 0.4.0+{-# INLINE map #-}+map :: Monad m => (a -> b) -> SerialT m a -> SerialT m b+map f = mapM (return . f)++{-# 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.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.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.crossApplyFst` D.fromStreamK m2++-- Note: we need to define all the typeclass operations because we want to+-- INLINE them.+instance Monad m => Applicative (SerialT m) where+    {-# INLINE pure #-}+    pure = SerialT . K.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = apSerial+    -- (<*>) = K.apSerial++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>)  = apSequence+    -- (*>)  = K.apSerialDiscardFst++    {-# INLINE (<*) #-}+    (<*) = apDiscardSnd+    -- (<*)  = K.apSerialDiscardSnd++MONAD_COMMON_INSTANCES(SerialT,)+LIST_INSTANCES(SerialT)+NFDATA1_INSTANCE(SerialT)+FOLDABLE_INSTANCE(SerialT)+TRAVERSABLE_INSTANCE(SerialT)++------------------------------------------------------------------------------+-- WSerialT+------------------------------------------------------------------------------++-- | For 'WSerialT' streams:+--+-- @+-- (<>) = 'Streamly.Prelude.wSerial'                       -- 'Semigroup'+-- (>>=) = flip . 'Streamly.Prelude.concatMapWith' 'Streamly.Prelude.wSerial' -- 'Monad'+-- @+--+-- Note that '<>' is associative only if we disregard the ordering of elements+-- in the resulting stream.+--+-- A single 'Monad' bind behaves like a @for@ loop:+--+-- >>> :{+-- IsStream.toList $ IsStream.fromWSerial $ do+--      x <- IsStream.fromList [1,2] -- foreach x in stream+--      return x+-- :}+-- [1,2]+--+-- Nested monad binds behave like interleaved nested @for@ loops:+--+-- >>> :{+-- 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)]+--+-- It is a result of interleaving all the nested iterations corresponding to+-- element @1@ in the first stream with all the nested iterations of element+-- @2@:+--+-- >>> import Streamly.Prelude (wSerial)+-- >>> 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+-- contrast to the depth wise scheduling behavior of 'SerialT'.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+newtype WSerialT m a = WSerialT {getWSerialT :: Stream m a}++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.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+type WSerial = WSerialT IO++{-# INLINE consMWSerial #-}+{-# SPECIALIZE consMWSerial :: IO a -> WSerialT IO a -> WSerialT IO a #-}+consMWSerial :: Monad m => m a -> WSerialT m a -> WSerialT m a+consMWSerial m (WSerialT ms) = WSerialT $ K.consM m ms++------------------------------------------------------------------------------+-- Semigroup+------------------------------------------------------------------------------++infixr 6 `wSerial`++-- | 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/++-- 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+-- \`wSerial` (b \`wSerial` c)@, therefore, it fairly interleaves @a@ with the+-- result of @b \`wSerial` c@.  For example, @Stream.fromList [1,2] \`wSerial`+-- Stream.fromList [3,4] \`wSerial` Stream.fromList [5,6]@ would result in+-- [1,3,2,5,4,6].  In other words, the leftmost stream gets the same scheduling+-- priority as the rest of the streams taken together. The same is true for+-- each subexpression on the right.+--+{-# INLINE wSerial #-}+wSerial :: WSerialT m a -> WSerialT m a -> WSerialT m a+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 $ K.interleaveFst m1 m2++{-# INLINE wSerialMin #-}+wSerialMin :: WSerialT m a -> WSerialT m a -> WSerialT m a+wSerialMin (WSerialT m1) (WSerialT m2) = WSerialT $ K.interleaveMin m1 m2++instance Semigroup (WSerialT m a) where+    (<>) = wSerial++------------------------------------------------------------------------------+-- Monoid+------------------------------------------------------------------------------++instance Monoid (WSerialT m a) where+    mempty = WSerialT K.nil+    mappend = (<>)++{-# INLINE apWSerial #-}+apWSerial :: WSerialT m (a -> b) -> WSerialT m a -> WSerialT m b+apWSerial (WSerialT m1) (WSerialT m2) =+    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 #-}+    pure = WSerialT . K.fromPure+    {-# INLINE (<*>) #-}+    (<*>) = apWSerial++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++instance Monad m => Monad (WSerialT m) where+    return = pure+    {-# INLINE (>>=) #-}+    (>>=) (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)+NFDATA1_INSTANCE(WSerialT)+FOLDABLE_INSTANCE(WSerialT)+TRAVERSABLE_INSTANCE(WSerialT)++------------------------------------------------------------------------------+-- Construction+------------------------------------------------------------------------------++-- | Build a stream by unfolding a /monadic/ step function starting from a+-- seed.  The step function returns the next element in the stream and the next+-- seed value. When it is done it returns 'Nothing' and the stream ends. For+-- example,+--+-- @+-- let f b =+--         if b > 3+--         then return Nothing+--         else print b >> return (Just (b, b + 1))+-- in drain $ unfoldrM f 0+-- @+-- @+--  0+--  1+--  2+--  3+-- @+--+-- /Pre-release/+--+{-# INLINE unfoldrM #-}+unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> SerialT m a+unfoldrM step seed = SerialT $ D.toStreamK (D.unfoldrM step seed)
+ 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
@@ -0,0 +1,175 @@+{-# 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+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- 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+    , consMZip+    , 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(..))+#endif+import Data.Foldable (Foldable(foldl'), fold)+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(..), oneShot)+import Text.Read+       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec+       , readListPrecDefault)+import Streamly.Internal.BaseCompat ((#.))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.Stream.Serial (SerialT(..))+import Streamly.Internal.Data.StreamK (Stream)+import Streamly.Internal.Data.Stream.Concurrent (MonadAsync, parZipWith)++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)++#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+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}++{-# INLINE zipWithMK #-}+zipWithMK :: Monad m =>+    (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+zipWithMK f m1 m2 =+    D.toStreamK $ D.zipWithM f (D.fromStreamK m1) (D.fromStreamK m2)++{-# INLINE zipWithK #-}+zipWithK :: Monad m+    => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+zipWithK f = zipWithMK (\a b -> return (f a b))++------------------------------------------------------------------------------+-- Serially Zipping Streams+------------------------------------------------------------------------------++-- | For 'ZipSerialM' streams:+--+-- @+-- (<>) = 'Streamly.Prelude.serial'+-- (<*>) = 'Streamly.Prelude.serial.zipWith' id+-- @+--+-- Applicative evaluates the streams being zipped serially:+--+-- >>> s1 = Stream.fromFoldable [1, 2]+-- >>> s2 = Stream.fromFoldable [3, 4]+-- >>> s3 = Stream.fromFoldable [5, 6]+-- >>> Stream.toList $ Stream.fromZipSerial $ (,,) <$> s1 <*> s2 <*> s3+-- [(1,3,5),(2,4,6)]+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+newtype ZipSerialM m a = ZipSerialM {getZipSerialM :: Stream m a}+        deriving (Semigroup, Monoid)++-- |+-- @since 0.1.0+{-# DEPRECATED ZipStream "Please use 'ZipSerialM' instead." #-}+type ZipStream = ZipSerialM++-- | An IO stream whose applicative instance zips streams serially.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+type ZipSerial = ZipSerialM IO++consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a+consMZip m (ZipSerialM r) = ZipSerialM $ K.consM m r++LIST_INSTANCES(ZipSerialM)+NFDATA1_INSTANCE(ZipSerialM)++instance Monad m => Functor (ZipSerialM m) where+    {-# INLINE fmap #-}+    fmap f (ZipSerialM m) = ZipSerialM $ getSerialT $ fmap f (SerialT m)++instance Monad m => Applicative (ZipSerialM m) where+    pure = ZipSerialM . getSerialT . Serial.repeat++    {-# INLINE (<*>) #-}+    ZipSerialM m1 <*> ZipSerialM m2 = ZipSerialM $ zipWithK id m1 m2++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
@@ -0,0 +1,134 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.ZipAsync+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- To run examples in this module:+--+-- >>> import qualified Streamly.Prelude as Stream+--+module Streamly.Internal.Data.Stream.ZipAsync+    {-# DEPRECATED "Use \"Streamly.Data.Stream.MkType\" instead." #-}+    ( ZipAsyncM(..)+    , ZipAsync+    , consMZipAsync+    , zipAsyncWithK+    , zipAsyncWithMK+    )+where++import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.StreamK (Stream)++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)++#include "Instances.hs"++-- $setup+-- >>> :set -fno-warn-deprecations+-- >>> import qualified Streamly.Prelude as Stream+-- >>> import Control.Concurrent (threadDelay)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}++------------------------------------------------------------------------------+-- Parallel Zipping+------------------------------------------------------------------------------++-- | Like 'zipAsyncWith' but with a monadic zipping function.+--+-- @since 0.4.0+{-# INLINE zipAsyncWithMK #-}+zipAsyncWithMK :: MonadAsync m+    => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+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 (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.+--+-- | Like 'zipWith' but zips concurrently i.e. both the streams being zipped+-- are evaluated concurrently using the 'ParallelT' concurrent evaluation+-- style. The maximum number of elements of each stream evaluated in advance+-- can be controlled by 'maxBuffer'.+--+-- The stream ends if stream @a@ or stream @b@ ends. However, if stream @b@+-- ends while we are still evaluating stream @a@ and waiting for a result then+-- stream will not end until after the evaluation of stream @a@ finishes. This+-- behavior can potentially be changed in future to end the stream immediately+-- as soon as any of the stream end is detected.+--+-- @since 0.1.0+{-# INLINE zipAsyncWithK #-}+zipAsyncWithK :: MonadAsync m+    => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+zipAsyncWithK f = zipAsyncWithMK (\a b -> return (f a b))++------------------------------------------------------------------------------+-- Parallely Zipping Streams+------------------------------------------------------------------------------+--+-- | For 'ZipAsyncM' streams:+--+-- @+-- (<>) = 'Streamly.Prelude.serial'+-- (<*>) = 'Streamly.Prelude.serial.zipAsyncWith' id+-- @+--+-- Applicative evaluates the streams being zipped concurrently, the following+-- would take half the time that it would take in serial zipping:+--+-- >>> s = Stream.fromFoldableM $ Prelude.map delay [1, 1, 1]+-- >>> Stream.toList $ Stream.fromZipAsync $ (,) <$> s <*> s+-- ...+-- [(1,1),(1,1),(1,1)]+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+newtype ZipAsyncM m a = ZipAsyncM {getZipAsyncM :: Stream m a}+        deriving (Semigroup, Monoid)++-- | An IO stream whose applicative instance zips streams wAsyncly.+--+-- /Since: 0.2.0 ("Streamly")/+--+-- @since 0.8.0+type ZipAsync = ZipAsyncM IO++consMZipAsync :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a+consMZipAsync m (ZipAsyncM r) = ZipAsyncM $ K.consM m r++instance Monad m => Functor (ZipAsyncM m) where+    {-# INLINE fmap #-}+    fmap f (ZipAsyncM m) =+        ZipAsyncM $ Stream.toStreamK $ fmap f (Stream.fromStreamK m)++instance MonadAsync m => Applicative (ZipAsyncM m) where+    pure = ZipAsyncM . Stream.toStreamK . Serial.repeat++    {-# INLINE (<*>) #-}+    ZipAsyncM m1 <*> ZipAsyncM m2 = ZipAsyncM $ zipAsyncWithK id m1 m2
+ 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
@@ -0,0 +1,162 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+-- |+-- Module      : Streamly.Internal.Data.Unfold.SVar+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Unfold.SVar+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}+    (+      fromSVar+    , fromProducer+    )+where++#include "inline.hs"++import Control.Exception (fromException)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef)+import Data.Maybe (isNothing)+import Streamly.Internal.Control.Concurrent (MonadAsync)+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+-------------------------------------------------------------------------------+-- Generation from SVar+-------------------------------------------------------------------------------++data FromSVarState t m a =+      FromSVarInit (SVar t m a)+    | FromSVarRead (SVar t m a)+    | FromSVarLoop (SVar t m a) [ChildEvent a]+    | FromSVarDone (SVar t m a)++-- | /Internal/+--+{-# INLINE_NORMAL fromSVar #-}+fromSVar :: MonadAsync m => Unfold m (SVar t m a) a+fromSVar = Unfold step (return . FromSVarInit)+    where++    {-# INLINE_LATE step #-}+    step (FromSVarInit svar) = do+        ref <- liftIO $ newIORef ()+        _ <- liftIO $ mkWeakIORef ref hook+        -- 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 $ Skip (FromSVarRead sv)++        where++        {-# NOINLINE hook #-}+        hook = do+            when (svarInspectMode svar) $ do+                r <- liftIO $ readIORef (svarStopTime (svarStats svar))+                when (isNothing r) $+                    printSVar svar "SVar Garbage Collected"+            cleanupSVar svar+            -- If there are any SVars referenced by this SVar a GC will prompt+            -- them to be cleaned up quickly.+            when (svarInspectMode svar) performMajorGC++    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 $ Skip $ FromSVarLoop sv (Prelude.reverse list)++    step (FromSVarLoop sv []) = do+        done <- postProcess sv+        return $ Skip $ if done+                      then FromSVarDone sv+                      else FromSVarRead sv++    step (FromSVarLoop sv (ev : es)) = do+        case ev of+            ChildYield a -> return $ Yield a (FromSVarLoop sv es)+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> do+                        stop <- shouldStop tid+                        if stop+                        then do+                            liftIO (cleanupSVar sv)+                            return $ Skip (FromSVarDone sv)+                        else return $ Skip (FromSVarLoop sv es)+                    Just ex ->+                        case fromException ex of+                            Just ThreadAbort ->+                                return $ Skip (FromSVarLoop sv es)+                            Nothing -> liftIO (cleanupSVar sv) >> MC.throwM ex+        where++        shouldStop tid =+            case svarStopStyle sv of+                StopNone -> return False+                StopAny -> return True+                StopBy -> do+                    sid <- liftIO $ readIORef (svarStopBy sv)+                    return $ tid == sid++    step (FromSVarDone sv) = do+        when (svarInspectMode sv) $ do+            t <- liftIO $ getTime Monotonic+            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)+            liftIO $ printSVar sv "SVar Done"+        return Stop++-------------------------------------------------------------------------------+-- Process events received by a fold consumer from a stream producer+-------------------------------------------------------------------------------++-- XXX Have an error for "FromSVarInit" instead of undefined. The error can+-- redirect the user to report the failure to the developers.+-- | /Internal/+--+{-# INLINE_NORMAL fromProducer #-}+fromProducer :: MonadAsync m => Unfold m (SVar t m a) a+fromProducer = Unfold step (return . FromSVarRead)+    where++    {-# INLINE_LATE step #-}+    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 $ Skip $ FromSVarLoop sv (Prelude.reverse list)++    step (FromSVarLoop sv []) = return $ Skip $ FromSVarRead sv+    step (FromSVarLoop sv (ev : es)) = do+        case ev of+            ChildYield a -> return $ Yield a (FromSVarLoop sv es)+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> do+                        sendStopToProducer sv+                        return $ Skip (FromSVarDone sv)+                    Just _ -> error "Bug: fromProducer: received exception"++    step (FromSVarDone sv) = do+        when (svarInspectMode sv) $ do+            t <- liftIO $ getTime Monotonic+            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)+            liftIO $ printSVar sv "SVar Done"+        return Stop++    step (FromSVarInit _) = undefined
+ src/Streamly/Internal/FileSystem/Event.hs view
@@ -0,0 +1,249 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.FileSystem.Event+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC+--+-- File system event notification API portable across Linux, macOS and Windows+-- platforms.+--+-- Note that recursive directory tree watch does not work reliably on Linux+-- (see notes in the Linux module), therefore, recursive watch API is not+-- provided in this module. However, you can use it from the platform specific+-- modules.+--+-- For platform specific APIs please see the following modules:+--+-- * "Streamly.Internal.FileSystem.Event.Darwin"+-- * "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++      watch+    -- , watchRecursive++    -- * Handling Events+    , Event+    , getAbsPath++    -- ** Item CRUD events+    , isCreated+    , isDeleted+    , isMoved+    , isModified++    -- ** Exception Conditions+    , isEventsLost++    -- ** Debugging+    , showEvent+    )+where++import Data.List.NonEmpty (NonEmpty)+import Data.Word (Word8)+import Streamly.Data.Array (Array)+import Streamly.Data.Stream (Stream)++#if defined(CABAL_OS_DARWIN)+import Streamly.Internal.FileSystem.Event.Darwin (Event)+import qualified Streamly.Internal.FileSystem.Event.Darwin as Event+#elif defined(CABAL_OS_LINUX)+import Streamly.Internal.FileSystem.Event.Linux (Event)+import qualified Streamly.Internal.FileSystem.Event.Linux as Event+#elif defined(CABAL_OS_WINDOWS)+import Streamly.Internal.FileSystem.Event.Windows (Event)+import qualified Streamly.Internal.FileSystem.Event.Windows as Event+#else+#error "FS Events not supported on this platform"+#endif++-- XXX Ensure that defaultConfig is the same for all platforms.+--+-- XXX Ensure that equivalent events are generated on all platforms when same+-- operations are done. Document any differences in behavior on different+-- platforms. Any events that are not common to all platforms should be+-- filtered out.+--+-- XXX Only need to set common event types for macOS/Linux/Windows+-- XXX write a test, that generates all types of events that can possibly+-- occur on each platform. Then create a common test that only checks+-- for the common subset of those.++-------------------------------------------------------------------------------+-- Creating a watch+-------------------------------------------------------------------------------++-- macOS and Windows seem to do a path level watch i.e. they watch the path+-- rather than the underlying inode, possibly they can map the inode back to a+-- path?.  On Linux we cannot keep watching a watch root if the inode it is+-- pointing to has moved. However, the inode continues to be watched in this+-- case instead of the path, which is not the case for macOS.+--+-- To make the behavior same for all platforms, for the Linux case we will have+-- to stop watching the inode if it moves from under the path+-- (setUnwatchMoved).  And on macOS we can stop watching  a path if the inode+-- under it changes i.e. just filter out events for that path.+--+-- Also, to make the behavior of Linux same as macOS we need to set+-- setFollowSymLinks on Linux.++-- XXX Verify all the cases mentioned below using test cases.+-- XXX Make it fail if the watch root is a file. It works on macOS and Linux+-- but does not work on Windows.++-- | Start monitoring a list of directories or symbolic links to directories+-- for file system events.  Monitoring starts from the current time onwards.+-- The paths are specified as UTF-8 encoded 'Array' of 'Word8'.+--+-- If a watch root is a symbolic link then the target of the link is watched.+-- Fails if the watched path does not exist. If the user does not have+-- permissions (read and execute?) on the watch root then no events are+-- generated.  No events are generated if the watch root itself is renamed or+-- deleted.+--+-- This API watches for changes in the watch root directory only, any changes+-- in the subdirectories of the watch root are not watched. However, on macOS+-- the watch is always recursive, but do not rely on that behavior, it may+-- change without notice in future. If you want to use recursive watch please+-- use platform specific modules.+--+-- /Pre-release/+--+watch :: NonEmpty (Array Word8) -> Stream IO Event+#if defined(CABAL_OS_DARWIN)+watch = Event.watchRecursive+#else+watch = Event.watch+#endif++-- | Like 'watch' except that if a watched path is a directory the whole+-- directory tree under it is watched recursively.+--+-- On Linux 'watchRecursive' may be more expensive than 'watch'.+--+-- /Pre-release/+--+_watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event+_watchRecursive = Event.watchRecursive++-------------------------------------------------------------------------------+-- Handling Events+-------------------------------------------------------------------------------++-- XXX Ensure that on all paltforms the path has same conventions. That is do+-- not have a trailing path separator on one platfrom and not on another.+--+-- XXX We should use getRelPath instead so that the behavior when the root is a+-- symlink becomes platform independent.+--+-- | Get the absolute path of the file system object for which the event is+-- generated. The path is a UTF-8 encoded array of bytes.+--+-- When the watch root is a symlink the behavior is different on different+-- platforms:+--+-- * On Linux and Windows, the absolute path returned is via the original+-- symlink.+--+-- * On macOS the absolute path returned is via the real path of the root after+-- resolving the symlink.+--+-- This API is subject to removal in future, to be replaced by a platform+-- independent @getRelPath@.+--+-- /Pre-release/+--+getAbsPath :: Event -> Array Word8+getAbsPath = Event.getAbsPath++-- | Determine whether the event indicates creation of an object within the+-- monitored path. This event is generated when any file system object is+-- created.+--+-- For hard links the behavior is different on different operating systems. On+-- macOS hard linking does not generate a create event, it generates an+-- 'isInodeAttrsChanged' event on the directory instead (see the Darwin+-- module). On Linux and Windows hard linking generates a create event.+--+-- /Pre-release/+--+isCreated :: Event -> Bool+isCreated = Event.isCreated++-- XXX To make the behavior consistent, can we block the event on watch root on+-- macOS?+--+-- | Determine whether the event indicates deletion of an object within the+-- monitored path. On Linux and Windows hard link deletion generates a delete+-- event.+--+-- On Linux and Windows, this event does not occur when the watch root itself+-- is deleted. On macOS it occurs on deleting the watch root when it is not a+-- symbolic link.+--+-- See also 'isRootDeleted' event for Linux.+--+-- /Pre-release/+--+isDeleted :: Event -> Bool+isDeleted = Event.isDeleted++-- | Determine whether the event indicates rename of an object within the+-- monitored path. This event is generated when an object is renamed within the+-- watched directory or if it is moved out of or in the watched directory.+-- Moving hard links is no different than other types of objects.+--+-- /Pre-release/+--+isMoved :: Event -> Bool+isMoved = Event.isMoved++-- XXX Make the Windows behavior consistent with other platforms by removing+-- the event from directories.+--+-- | Determine whether the event indicates modification of an object within the+-- monitored path. This event is generated on file modification on all+-- platforms.+--+-- On Linux and macOS this event is never generated for directories.  On+-- Windows (in recursive watch mode) this event is generated for directories as+-- well when an object is created in or deleted from the directory.+--+-- /Pre-release/+--+isModified :: Event -> Bool+isModified = Event.isModified++-- | An event that indicates that some events before this may have been lost,+-- therefore, we need to take some recovery action.+--+-- /Pre-release/+--+isEventsLost :: Event -> Bool+isEventsLost = Event.isEventsLost++-------------------------------------------------------------------------------+-- Debugging+-------------------------------------------------------------------------------++-- | Convert an 'Event' record to a String representation. Note that the output+-- of this function may be different on different platforms because it may+-- contain platform specific details.+--+-- /Internal/+--+showEvent :: Event -> String+showEvent = Event.showEvent
+ 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.h view
@@ -0,0 +1,63 @@+#include <config.h>++struct watch;++struct pathName {+    const UInt8 *pathBytes;+    size_t pathLen;+};++int createWatch+    ( struct pathName* folders+    , int n  /* number of entries in "folders" */+    , UInt32 createFlags+    , UInt64 since+    , double latency+    , int* fd+    , void** wp+    );++void destroyWatch(struct watch* w);++/******************************************************************************+ * Create Flags+ *****************************************************************************/++UInt32 FSEventStreamCreateFlagNoDefer ();+UInt32 FSEventStreamCreateFlagWatchRoot ();+UInt32 FSEventStreamCreateFlagFileEvents ();+UInt32 FSEventStreamCreateFlagIgnoreSelf ();+#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY+UInt32 FSEventStreamCreateFlagFullHistory;+#endif++/******************************************************************************+ * Event Flags+ *****************************************************************************/++UInt32 FSEventStreamEventFlagEventIdsWrapped ();+UInt32 FSEventStreamEventFlagMustScanSubDirs ();+UInt32 FSEventStreamEventFlagKernelDropped ();+UInt32 FSEventStreamEventFlagUserDropped ();+UInt32 FSEventStreamEventFlagHistoryDone ();+UInt32 FSEventStreamEventFlagRootChanged ();+UInt32 FSEventStreamEventFlagMount ();+UInt32 FSEventStreamEventFlagUnmount ();+UInt32 FSEventStreamEventFlagItemChangeOwner ();+UInt32 FSEventStreamEventFlagItemInodeMetaMod ();+UInt32 FSEventStreamEventFlagItemFinderInfoMod ();+UInt32 FSEventStreamEventFlagItemXattrMod ();+UInt32 FSEventStreamEventFlagItemCreated ();+UInt32 FSEventStreamEventFlagItemRemoved ();+UInt32 FSEventStreamEventFlagItemRenamed ();+UInt32 FSEventStreamEventFlagItemModified ();+#if HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMCLONED+UInt32 FSEventStreamEventFlagItemCloned ();+#endif+UInt32 FSEventStreamEventFlagItemIsDir ();+UInt32 FSEventStreamEventFlagItemIsFile ();+UInt32 FSEventStreamEventFlagItemIsSymlink ();+#if HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK+UInt32 FSEventStreamEventFlagItemIsHardlink ();+#endif+UInt32 FSEventStreamEventFlagItemIsLastHardlink ();
+ src/Streamly/Internal/FileSystem/Event/Darwin.hs view
@@ -0,0 +1,1087 @@+-- |+-- Module      : Streamly.Internal.FileSystem.Event.Darwin+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC+--+-- =Overview+--+-- Use 'watchRecursive' with a list of file system paths you want to watch as+-- argument. It returns a stream of 'Event' representing the file system events+-- occurring under the watched paths.+--+-- @+-- {-\# LANGUAGE MagicHash #-}+-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchRecursive' [Array.fromList "path"]+-- @+--+-- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)+-- provided in this module are used to determine the attributes of the event.+--+-- =Design notes+--+-- For reference documentation see:+--+-- * "<https://developer.apple.com/library/archive/documentation/Darwin/Conceptual/FSEvents_ProgGuide/UsingtheFSEventsFramework/UsingtheFSEventsFramework.html Apple FS Events Programming Guide>"+-- * "<https://developer.apple.com/documentation/coreservices/file_system_events?language=objc Apple FS Events Reference>"+--+-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults+-- semantically and syntactically as close as possible.+--+-- =BUGS+--+-- XXX Check the behavior for Windows/Linux where applicable. Mention these in+-- the common module so that users are aware of the portability issues.+--+-- There may be some idiosyncrasies in event reporting.+--+-- 1. Multiple events may be coalesced into a single event having multiple+-- flags set.  For example, on macOS 10.15.6, "touch x; rm x" or "touch x; mv x+-- y" produces an event with both "Created" and "Deleted/Moved" flags set.+--+-- 2. The same event can occur multiple times. For example, "touch x; sleep 1;+-- rm x" generates a "Created" event followed by an event with both "Created"+-- and "Deleted" flags set. Similarly, a cloned event can also occur multiple+-- times.+--+-- 3. Some events can go missing and only the latest one is reported. See+-- 'isCreated' for one such case.+--+-- XXX write a test case for this, and check on all platforms.+--+-- 4. When @rm -rf@ is used on the watched root directory, only one 'isDeleted'+-- event occurs and that is for the root. However, @rm -rf@ on a directory+-- inside the watch root produces 'isDeleted' events for all files.+--+-- XXX write a test case for this, and check on all platforms.+--+-- 5. When a file is moved, a move event occurs for both the source and the+-- destination files. There seems to be no way to distinguish the source and+-- the destination. Perhaps the lower eventId can be considered as source.+--+-- XXX cloned event is specific to macOS.  Translate it to the same events as+-- on copying.+--+-- 6. When a file is cloned both source and destination generate a cloned+-- event, however the source has lower eventId and destination may have+-- OwnerGroupModeChanged, InodeAttrsChanged, Created flags as well.+--+-- You may have to stat the path of the event to know more information about+-- what might have happened.  It may be a good idea to watch the behavior of+-- events you are handling before you can rely on it. See the individual event+-- APIs for some of the known issues marked with `BUGS`. Also see the "Handling+-- Events" section in the "Apple FS Events Programming Guide".+--+-- * "<https://stackoverflow.com/questions/18415285/osx-fseventstreameventflags-not-working-correctly Stack overflow question on event coalescing>"+--+-- =TODO+--+-- APIs for persistent event-id related functionality, to get events from+-- specific event-id etc are not implemented.++#include <config.h>++-- macOS 10.7++#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS++module Streamly.Internal.FileSystem.Event.Darwin+    {-# DEPRECATED "Use the streamly-fsevents package." #-}+    (+    -- * Creating a Watch++    -- ** Default configuration+      Config (..)+    , defaultConfig++    -- ** Watch Behavior+    , BatchInfo (..)+    , setEventBatching++    -- ** Events of Interest+    , setRootPathEvents+    , setFileEvents+    , setIgnoreSelf+#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY+    , setFullHistory+#endif+    , setAllEvents++    -- ** Watch APIs+    , watch+    , watchRecursive+    , watchWith++    -- * Handling Events+    , Event+    , getEventId+    , getAbsPath++    -- ** Root Level Events+    -- | Events that belong to the root path as a whole and not to specific+    -- items contained in it.+    , isMounted+    , isUnmounted+    , isHistoryDone+    , isRootPathEvent++    -- ** Item Level Metadata change+    , isAttrsModified+    , isSecurityModified+    , isXAttrsModified+    , isFinderInfoModified++    -- ** Item Level CRUD events+    , isCreated+    , isDeleted+    , isMoved+    , isModified+#if HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMCLONED+    , isCloned+#endif++    -- ** Item Path info+    , isDir+    , isFile+    , isSymLink+#if HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK+    , isHardLink+    , isLastHardLink+#endif++    -- ** Exception Conditions+    , isEventIdWrapped+    , isEventsLost+    , isKernelDropped+    , isUserDropped++    -- * Debugging+    , showEvent+    )+where++import Control.Concurrent (MVar, newMVar, takeMVar, putMVar)+import Control.Monad (when)+import Data.Bits ((.|.), (.&.), complement)+import Data.Functor.Identity (runIdentity)+import Data.List.NonEmpty (NonEmpty)+import Data.Word (Word8, Word32, Word64)+import Foreign.C.Types (CInt(..), CDouble(..), CSize(..), CUChar(..))+import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Array (withArray)+import Foreign.Ptr (Ptr, castPtr)+import Foreign.Storable (Storable(..))+import GHC.IO.Handle.FD (fdToHandle)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Cont (contListMap)+import Streamly.Internal.Data.Parser (Parser)+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 as S+import qualified Streamly.Internal.Unicode.Stream as U+import qualified Streamly.Internal.FileSystem.Handle as FH+import qualified Streamly.Internal.Data.Array as A++-------------------------------------------------------------------------------+-- Subscription to events+-------------------------------------------------------------------------------++-- XXX Add a recursive option to Config+-- 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.+--+-- /Pre-release/+--+data Config = Config+    { latency :: Double+    , createFlags   :: Word32+    }++-------------------------------------------------------------------------------+-- Batching Events+-------------------------------------------------------------------------------++foreign import ccall safe+    "FileSystem/Event/Darwin.h FSEventStreamCreateFlagNoDefer"+    kFSEventStreamCreateFlagNoDefer :: Word32++-- | Determines how multiple events are batched or throttled.+data BatchInfo =+      Throttle Double -- ^ Deliver an event immediately but suppress the+                      -- following events upto the specified time.+    | Batch Double    -- ^ Collapse all events that occurred in the specified+                      -- time window (in seconds) and deliver them as a single+                      -- batch.++-- | Set how the events should be batched. See 'BatchInfo' for details.  A+-- negative value for time is treated as 0.+--+-- /default: Batch 0.0/+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+setEventBatching :: BatchInfo -> Config -> Config+setEventBatching batchInfo cfg =+    let (t, status) =+            case batchInfo of+                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+-------------------------------------------------------------------------------++setFlag :: Word32 -> Bool -> Config -> Config+setFlag mask status cfg@Config{..} =+    let flags =+            if status+            then createFlags .|. mask+            else createFlags .&. complement mask+    in cfg {createFlags = flags}++foreign import ccall safe+    "FSEventStreamCreateFlagWatchRoot"+    kFSEventStreamCreateFlagWatchRoot :: Word32++-- XXX write a test case for this, and check on all platforms. The behavior on+-- macOS is slightly different as a create event is also generated.+--+-- | 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 '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: False/+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+setRootPathEvents :: Bool -> Config -> Config+setRootPathEvents = setFlag kFSEventStreamCreateFlagWatchRoot++foreign import ccall safe+    "FSEventStreamCreateFlagFileEvents"+    kFSEventStreamCreateFlagFileEvents :: Word32++-- | 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+-- distinguished based on the type of event.  For example, we cannot determine+-- if an event is a "create" or "delete", we only know that some event ocurred+-- under the watched directory hierarchy.+--+-- 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: True/+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+setFileEvents :: Bool -> Config -> Config+setFileEvents = setFlag kFSEventStreamCreateFlagFileEvents++foreign import ccall safe+    "FSEventStreamCreateFlagIgnoreSelf"+    kFSEventStreamCreateFlagIgnoreSelf :: Word32++-- | When this is 'True' events generated by the current process are not+-- reported.+--+-- /default: False/+--+-- /macOS 10.6+/+--+-- /Pre-release/+--+setIgnoreSelf :: Bool -> Config -> Config+setIgnoreSelf = setFlag kFSEventStreamCreateFlagIgnoreSelf++#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY+foreign import ccall safe+    "FSEventStreamCreateFlagFullHistory"+    kFSEventStreamCreateFlagFullHistory :: Word32++-- | When this is 'True' all events since the beginning of time are reported.+--+-- /default: False/+--+-- /macOS 10.15+/+--+-- /Pre-release/+--+setFullHistory :: Bool -> Config -> Config+setFullHistory = setFlag kFSEventStreamCreateFlagFullHistory+#endif++-- | Set all tunable events 'True' or 'False'. Equivalent to setting:+--+-- * setRootPathEvents+-- * setFileEvents+--+-- /Pre-release/+--+setAllEvents :: Bool -> Config -> Config+setAllEvents s =+      setRootPathEvents s+    . setFileEvents s++-------------------------------------------------------------------------------+-- Default config+-------------------------------------------------------------------------------++-- | The default settings are:+--+-- * 'setEventBatching' ('Batch' 0.0)+-- * 'setFileEvents' 'True'+-- * 'setRootPathEvents' 'False'+-- * 'setIgnoreSelf' 'False'+#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFULLHISTORY+-- * 'setFullHistory' 'False'+#endif+--+-- /Pre-release/+--+defaultConfig :: Config+defaultConfig = setFileEvents True $ Config+    { latency = 0.0+    , createFlags = 0+    }++-------------------------------------------------------------------------------+-- Open an event stream (C FFI)+-------------------------------------------------------------------------------++-- See FileSystem/Event/Darwin.h++data CWatch++-- Representation of "struct pathName" in "FileSystem/Event/Darwin.h"+data PathName = PathName+    { pathBytes :: Ptr CUChar+    , pathLen :: CSize+    }++instance Storable PathName where+    alignment _ = sizeOf (undefined :: Ptr a)+    sizeOf _ = sizeOf (undefined :: Ptr CUChar) + sizeOf (undefined :: CSize)+    peek ptr = do+        bptr <- peekByteOff ptr 0+        len <- peekByteOff ptr (sizeOf (undefined :: Ptr CUChar))+        return $ PathName bptr len+    poke ptr PathName{..} = do+        pokeByteOff ptr 0 pathBytes+        pokeByteOff ptr (sizeOf (undefined :: Ptr CUChar)) pathLen++foreign import ccall safe "FileSystem/Event/Darwin.h createWatch" createWatch+    :: Ptr PathName+    -> CInt+    -> Word32+    -> Word64+    -> CDouble+    -> Ptr CInt+    -> Ptr (Ptr CWatch)+    -> IO CInt++foreign import ccall safe "FileSystem/Event/Darwin.h destroyWatch" destroyWatch+    :: Ptr CWatch -> IO ()++-------------------------------------------------------------------------------+-- Open an event stream+-------------------------------------------------------------------------------++-- | A handle for a watch.+data Watch = Watch Handle (Ptr CWatch) (MVar Bool)++-- | Given a 'Config' and @paths@ start monitoring the paths for file system+-- events. Returns a 'Watch' handle which can then be used to read the event+-- stream or to close the watch.+--+-- Implementation Note: This API creates an OS level thread where an event loop+-- runs and writes the events to the write side fd of a POSIX pipe. Event+-- stream APIs read the events from the read end of this pipe.  Since an OS+-- level thread is forked, creating a new watch stream is expensive. It is+-- advised to minimize the number of watches.+--+-- /Pre-release/+--+openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch+openWatch Config{..} paths = do+    -- XXX write a test case when path does not exist+    -- XXX write a test case when there are no permissions+    -- XXX check whether the path exists. If the path does not exist and+    -- is created later it cannot be properly monitored. Also a user may+    -- inadvertently provide a path for which the user may not have permission+    -- and then later wonder why events are not being reported.+    withPathNames (NonEmpty.toList paths) $ \arraysPtr ->+        alloca $ \fdPtr -> do+        alloca $ \watchPPtr -> do+            let nArrays = fromIntegral (NonEmpty.length paths)+                seconds = realToFrac latency+            r <- createWatch+                    arraysPtr nArrays createFlags 0 seconds fdPtr watchPPtr+            when (r /= 0) $+                ioError (userError "openWatch: failed to create watch.")+            fd <- peek fdPtr+            h <- fdToHandle fd+            watchPtr <- peek watchPPtr+            closeLock <- newMVar False+            return $ Watch h watchPtr closeLock++    where++    withPathName :: Array Word8 -> (PathName -> IO a) -> IO a+    withPathName arr act = do+        A.unsafePinnedAsPtr arr $ \ptr byteLen ->+            let pname = PathName (castPtr ptr) (fromIntegral byteLen)+            in act pname++    withPathNames = contListMap withPathName withArray++-- | Close a 'Watch' handle.+--+-- /Pre-release/+--+closeWatch :: Watch -> IO ()+closeWatch (Watch h watchPtr mvar) = do+    hClose h+    closed <- takeMVar mvar+    when (not closed) $ destroyWatch watchPtr+    putMVar mvar True++-------------------------------------------------------------------------------+-- Raw events read from the watch file handle+-------------------------------------------------------------------------------++-- | An Event generated by the file system. Use the accessor functions to+-- examine the event.+--+-- /Pre-release/+--+data Event = Event+   { eventId :: Word64+   , eventFlags :: Word32+   , eventAbsPath :: Array Word8+   } deriving (Show, Ord, Eq)++-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need+-- to measure the perf.+--+-- XXX should we use a magic in the header to avoid any issues due to+-- misalignment of records? Can that ever happen?+--+readOneEvent :: Parser Word8 IO Event+readOneEvent = do+    arr <- PR.takeEQ 24 (A.createOf 24)+    let arr1 = A.unsafeCast arr :: Array Word64+        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 -> Stream IO Event+watchToStream (Watch handle _ _) =+    S.catRights $ S.parseMany readOneEvent $ S.unfold FH.reader handle++-- XXX Write tests for all the points in macOS specific behavior.+--+-- | Start monitoring a list of file system paths for file system events with+-- the supplied configuration operation over the 'defaultConfig'. The paths+-- could be files or directories.  When the path is a directory and recursive+-- mode is set, the whole directory tree under it is watched recursively.+-- Monitoring starts from the current time onwards. The paths are specified as+-- UTF-8 encoded 'Array' of 'Word8'.+--+-- Important notes for macOS specific behavior:+--+-- From the observed behavior it seems macOS watches the paths, whatever they+-- are pointing to at any given point of time:+--+-- /Watch root deletion:/ If the the watch root is deleted and then recreated,+-- the newly created file or directory is automatically watched.+--+-- /Watch root moved:/ If the watch root is moved to a new path, the object+-- will no longer be watched unless the new path is also being watched and was+-- pointing to an existing file at the time of starting the watch (see notes+-- about non-existing paths below).+--+-- /Symbolic link watch root:/ If the path name to be watched is a symbolic+-- link then the target of the link is watched instead of the symbolic link+-- itself. It is equivalent to as if the target of the symbolic link itself was+-- directly added to the watch API. That is, the symbolic link is resolved at+-- the time of adding the watch.+--+-- Note that if a watched path is deleted and recreated as a symbolic link+-- pointing to another path then the symbolic link file itself is watched, it+-- won't be resolved. The symbolic link resolution happens only at the time of+-- adding the watch.+--+-- /Non-existing Paths:/ If a watch is started on a non-existing path then the+-- path is not watched even if it is created later.  The macOS API does not+-- fail for a non-existing path.+--+-- If a non-existing path is watched with 'setRootPathEvents' then an+-- 'isRootPathEvent' event is reported if the path is created later and the+-- "path" field in the event is set to the dirname of the path rather than the+-- full absolute path. This is the observed behavior on macOS 10.15.1.+--+-- @+-- {-\# LANGUAGE MagicHash #-}+-- watchWith+--      ('setIgnoreSelf' 'True' . 'setRootPathEvents' 'True')+--      [Array.fromList "path"]+-- @+--+-- /Pre-release/+--+watchWith ::+    (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event+watchWith f paths = S.bracketIO before after watchToStream++    where++    before = openWatch (f defaultConfig) paths+    after = closeWatch++-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.+--+-- >>> watchRecursive = watchWith id+--+watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event+watchRecursive = watchWith id++-- | Same as 'watchWith' using defaultConfig and non-recursive mode.+--+-- /Unimplemented/+--+watch :: NonEmpty (Array Word8) -> Stream IO Event+watch _paths = undefined++-------------------------------------------------------------------------------+-- Examine the event stream+-------------------------------------------------------------------------------++-- | Get the event id of an 'Event'.  Event-id is a monotonically increasing+-- 64-bit integer identifying an event uniquely.+--+-- /Pre-release/+--+getEventId :: Event -> Word64+getEventId Event{..} = eventId++foreign import ccall safe+    "FSEventStreamEventFlagEventIdsWrapped"+    kFSEventStreamEventFlagEventIdsWrapped :: Word32++-- | Determine whether the event id has wrapped. This is impossible on any+-- traditional hardware in any reasonable amount of time unless the event-id+-- starts from a very high value, because the event-id is a 64-bit integer.+-- However, apple still recommends to check and handle this flag.+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+isEventIdWrapped :: Event -> Bool+isEventIdWrapped = getFlag kFSEventStreamEventFlagEventIdsWrapped++-- | Get the absolute path of the file system object for which the event is+-- generated. The path is a UTF-8 encoded array of bytes.+--+-- When the watch root is a symlink, the absolute path returned is via the real+-- path of the root after resolving the symlink.+--+-- /Pre-release/+--+getAbsPath :: Event -> Array Word8+getAbsPath Event{..} = eventAbsPath++-------------------------------------------------------------------------------+-- Event types+-------------------------------------------------------------------------------++getFlag :: Word32 -> Event -> Bool+getFlag mask Event{..} = eventFlags .&. mask /= 0++-------------------------------------------------------------------------------+-- Error events+-------------------------------------------------------------------------------++foreign import ccall safe+    "FSEventStreamEventFlagMustScanSubDirs"+    kFSEventStreamEventFlagMustScanSubDirs :: Word32++-- | Apple documentation says that "If an event in a directory occurs at about+-- the same time as one or more events in a subdirectory of that directory, the+-- events may be coalesced into a single event." In that case you will recieve+-- 'isEventsLost' event. In that case the path listed in the event is+-- invalidated and you must rescan it to know the current state.+--+-- This event can also occur if a communication error (overflow) occurs in+-- sending the event and the event gets dropped. In that case 'isKernelDropped'+-- and/or 'isUserDropped' attributes will also be set.+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+isEventsLost :: Event -> Bool+isEventsLost = getFlag kFSEventStreamEventFlagMustScanSubDirs++foreign import ccall safe+    "FSEventStreamEventFlagKernelDropped"+    kFSEventStreamEventFlagKernelDropped :: Word32++-- | Did an event get dropped due to a kernel processing issue? Set only when+-- 'isEventsLost' is also true.+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+isKernelDropped :: Event -> Bool+isKernelDropped = getFlag kFSEventStreamEventFlagKernelDropped++foreign import ccall safe+    "FSEventStreamEventFlagUserDropped"+    kFSEventStreamEventFlagUserDropped :: Word32++-- | Did an event get dropped due to a user process issue? Set only when+-- 'isEventsLost' is also true.+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+isUserDropped :: Event -> Bool+isUserDropped = getFlag kFSEventStreamEventFlagUserDropped++-------------------------------------------------------------------------------+-- Global Sentinel Events+-------------------------------------------------------------------------------++foreign import ccall safe+    "FSEventStreamEventFlagHistoryDone"+    kFSEventStreamEventFlagHistoryDone :: Word32++-- | Determine whether the event is a history done marker event. A history done+-- event is generated when the historical events from before the current time+-- are done. Historical events are generated when the "since" parameter in the+-- watch config is set to before the current time.+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+isHistoryDone :: Event -> Bool+isHistoryDone = getFlag kFSEventStreamEventFlagHistoryDone++-------------------------------------------------------------------------------+-- Events affecting the watched path only+-------------------------------------------------------------------------------++foreign import ccall safe+    "FSEventStreamEventFlagRootChanged"+    kFSEventStreamEventFlagRootChanged :: Word32++-- | Determine whether the event indicates a change of path of the monitored+-- object itself. Note that the object may become unreachable or deleted after+-- a change of path.+--+-- /Applicable only when 'setRootPathEvents' is 'True'/+--+-- /Occurs only for the watched path/+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+isRootPathEvent :: Event -> Bool+isRootPathEvent = getFlag kFSEventStreamEventFlagRootChanged++-------------------------------------------------------------------------------+-- Global events under the watched path+-------------------------------------------------------------------------------++foreign import ccall safe+    "FSEventStreamEventFlagMount"+    kFSEventStreamEventFlagMount :: Word32++-- | Determine whether the event is a mount event. A mount event is generated+-- if a volume is mounted under the path being watched.+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+isMounted :: Event -> Bool+isMounted = getFlag kFSEventStreamEventFlagMount++foreign import ccall safe+    "FSEventStreamEventFlagUnmount"+    kFSEventStreamEventFlagUnmount :: Word32++-- | Determine whether the event is an unmount event. An unmount event is+-- generated if a volume mounted under the path being watched is unmounted.+--+-- /macOS 10.5+/+--+-- /Pre-release/+--+isUnmounted :: Event -> Bool+isUnmounted = getFlag kFSEventStreamEventFlagUnmount++-------------------------------------------------------------------------------+-- Metadata change Events (applicable only when 'setFileEvents' is 'True')+-------------------------------------------------------------------------------++foreign import ccall safe+    "FSEventStreamEventFlagItemChangeOwner"+    kFSEventStreamEventFlagItemChangeOwner :: Word32++-- | Determine whether the event is ownership, group, permissions or ACL change+-- event of an object contained within the monitored path.+--+-- Note that this event may be generated even if the metadata is changed to the+-- same value again.+--+-- /Applicable only when 'setFileEvents' is 'True'/+--+-- /Can occur for watched path or a file inside it/+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isSecurityModified :: Event -> Bool+isSecurityModified = getFlag kFSEventStreamEventFlagItemChangeOwner++foreign import ccall safe+    "FSEventStreamEventFlagItemInodeMetaMod"+    kFSEventStreamEventFlagItemInodeMetaMod :: Word32++-- | Determine whether the event indicates inode metadata change for an object+-- contained within the monitored path. This event is generated when inode+-- attributes other than the owner, group or permissions are changed e.g. file+-- 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 'True'/+--+-- /Can occur for watched path or a file inside it/+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isAttrsModified :: Event -> Bool+isAttrsModified = getFlag kFSEventStreamEventFlagItemInodeMetaMod++foreign import ccall safe+    "FSEventStreamEventFlagItemFinderInfoMod"+    kFSEventStreamEventFlagItemFinderInfoMod :: Word32++-- | Determine whether the event indicates finder information metadata change+-- for an object contained within the monitored path.+--+-- /Applicable only when 'setFileEvents' is 'True'/+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isFinderInfoModified :: Event -> Bool+isFinderInfoModified = getFlag kFSEventStreamEventFlagItemFinderInfoMod++foreign import ccall safe+    "FSEventStreamEventFlagItemXattrMod"+    kFSEventStreamEventFlagItemXattrMod :: Word32++-- | Determine whether the event indicates extended attributes metadata change+-- for an object contained within the monitored path.+--+-- /Applicable only when 'setFileEvents' is 'True'/+--+-- /Can occur for watched path or a file inside it/+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isXAttrsModified :: Event -> Bool+isXAttrsModified = getFlag kFSEventStreamEventFlagItemXattrMod++-------------------------------------------------------------------------------+-- CRUD Events (applicable only when 'setFileEvents' is 'True')+-------------------------------------------------------------------------------++foreign import ccall safe+    "FSEventStreamEventFlagItemCreated"+    kFSEventStreamEventFlagItemCreated :: Word32++-- | Determine whether the event indicates creation of an object within the+-- monitored path. This event is generated when any file system object other+-- than a hard link is created.  On hard linking only an 'isAttrsModified'+-- event on the directory is generated, it is not a create event. However, when+-- a hard link is deleted 'isDeleted' and 'isHardLink' both are true.+--+-- This event can occur for the watched path if the path was deleted/moved and+-- created again (tested on macOS 10.15.1). However, if a watch is started on a+-- non-existing path and the path is created later, then this event is not+-- generated, the path is not watched.+--+-- BUGS: On 10.15.1 when we use a "touch x" to create a file for the first time+-- 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 'True'/+--+-- /Can occur for watched path or a file inside it/+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isCreated :: Event -> Bool+isCreated = getFlag kFSEventStreamEventFlagItemCreated++foreign import ccall safe+    "FSEventStreamEventFlagItemRemoved"+    kFSEventStreamEventFlagItemRemoved :: Word32++-- | 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 'True'.+--+-- /Can occur for watched path or a file inside it/+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isDeleted :: Event -> Bool+isDeleted = getFlag kFSEventStreamEventFlagItemRemoved++foreign import ccall safe+    "FSEventStreamEventFlagItemRenamed"+    kFSEventStreamEventFlagItemRenamed :: Word32++-- | Determine whether the event indicates rename of an object within the+-- 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 'True'/+--+-- /Can occur for watched path or a file inside it/+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isMoved :: Event -> Bool+isMoved = getFlag kFSEventStreamEventFlagItemRenamed++foreign import ccall safe+    "FSEventStreamEventFlagItemModified"+    kFSEventStreamEventFlagItemModified :: Word32++-- | 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 'True'.+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isModified :: Event -> Bool+isModified = getFlag kFSEventStreamEventFlagItemModified++#if HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMCLONED+foreign import ccall safe+    "FSEventStreamEventFlagItemCloned"+    kFSEventStreamEventFlagItemCloned :: Word32++-- | Determine whether the event indicates cloning of an object within the+-- monitored path. The "Duplicate" command in the "File" menu of the "Finder"+-- application generates a "clone" event.+--+-- Applicable only when 'setFileEvents' is 'True'.+--+-- /macOS 10.13+/+--+-- /Pre-release/+--+isCloned :: Event -> Bool+isCloned = getFlag kFSEventStreamEventFlagItemCloned+#endif++-------------------------------------------------------------------------------+-- Information about path type (applicable only when 'setFileEvents' is 'True')+-------------------------------------------------------------------------------++foreign import ccall safe+    "FSEventStreamEventFlagItemIsDir"+    kFSEventStreamEventFlagItemIsDir :: Word32++-- | Determine whether the event is for a directory path.+--+-- Applicable only when 'setFileEvents' is 'True'.+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isDir :: Event -> Bool+isDir = getFlag kFSEventStreamEventFlagItemIsDir++foreign import ccall safe+    "FSEventStreamEventFlagItemIsFile"+    kFSEventStreamEventFlagItemIsFile :: Word32++-- | Determine whether the event is for a file path.+--+-- Applicable only when 'setFileEvents' is 'True'.+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isFile :: Event -> Bool+isFile = getFlag kFSEventStreamEventFlagItemIsFile++foreign import ccall safe+    "FSEventStreamEventFlagItemIsSymlink"+    kFSEventStreamEventFlagItemIsSymlink :: Word32++-- | Determine whether the event is for a symbolic link path.+--+-- Applicable only when 'setFileEvents' is 'True'.+--+-- /macOS 10.7+/+--+-- /Pre-release/+--+isSymLink :: Event -> Bool+isSymLink = getFlag kFSEventStreamEventFlagItemIsSymlink++#if HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK+foreign import ccall safe+    "FSEventStreamEventFlagItemIsHardlink"+    kFSEventStreamEventFlagItemIsHardlink :: Word32++-- | Determine whether the event is for a file with more than one hard link.+-- When 'isFile' is true we can check for 'isHardLink'. Note that 'isHardLink'+-- is not true when a hard link is created, however, it is true when a file+-- 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 'True'.+--+-- /macOS 10.10+/+--+-- /Pre-release/+--+isHardLink :: Event -> Bool+isHardLink = getFlag kFSEventStreamEventFlagItemIsHardlink++foreign import ccall safe+    "FSEventStreamEventFlagItemIsLastHardlink"+     kFSEventStreamEventFlagItemIsLastHardlink :: Word32++-- | Determine whether the event is for a hard link path with only one hard+-- link.  If 'isHardLink' is true then we can check for 'isLastHardLink'.  This+-- 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 'True'.+--+-- /macOS 10.10+/+--+-- /Pre-release/+--+isLastHardLink :: Event -> Bool+isLastHardLink = getFlag kFSEventStreamEventFlagItemIsLastHardlink+#endif++-------------------------------------------------------------------------------+-- Debugging+-------------------------------------------------------------------------------++-- | Convert an 'Event' record to a String representation.+showEvent :: Event -> String+showEvent ev@Event{..} =+    let path = runIdentity $ S.fold FL.toList $ U.decodeUtf8' $ A.read eventAbsPath+    in "--------------------------"+        ++ "\nId = " ++ show eventId+        ++ "\nPath = " ++ show path+        ++ "\nFlags " ++ show eventFlags++        ++ showev isEventsLost "MustScanSubdirs"+        ++ showev isKernelDropped "KernelDropped"+        ++ showev isUserDropped "UserDropped"++        ++ showev isRootPathEvent "RootPathEvent"+        ++ showev isMounted "Mounted"+        ++ showev isUnmounted "Unmounted"+        ++ showev isHistoryDone "HistoryDone"++        ++ showev isSecurityModified "SecurityModified"+        ++ showev isAttrsModified "AttrsModified"+        ++ showev isFinderInfoModified "FinderInfoChanged"+        ++ showev isXAttrsModified "XAttrsModified"++        ++ showev isCreated "Created"+        ++ showev isDeleted "Deleted"+        ++ showev isModified "Modified"+        ++ showev isMoved "Moved"+#if HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMCLONED+        ++ showev isCloned "Cloned"+#endif++        ++ showev isDir "Dir"+        ++ showev isFile "File"+        ++ showev isSymLink "SymLink"+#if HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK+        ++ showev isHardLink "HardLink"+        ++ showev isLastHardLink "LastHardLink"+#endif+        ++ "\n"++        where showev f str = if f ev then "\n" ++ str else ""+#else+module Streamly.Internal.FileSystem.Event.Darwin () where+#warning "Autoconf did not find the definition \+kFSEventStreamCreateFlagFileEvents in Darwin header files.\+Do you have Cocoa framework header files installed?\+Not compiling the Streamly.Internal.FileSystem.Event.Darwin module. \+Programs depending on this module may not compile. \+Check if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS is defined in config.h \+generated from src/config.h.in"+#endif
+ src/Streamly/Internal/FileSystem/Event/Linux.hs view
@@ -0,0 +1,1312 @@+-- |+-- Module      : Streamly.Internal.FileSystem.Event.Linux+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- =Overview+--+-- Use 'watchPaths' with a list of file system paths you want to watch as+-- argument. It returns a stream of 'Event' representing the file system events+-- occurring under the watched paths.+--+-- @+-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchPaths' [Array.fromList "dir"]+-- @+--+-- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)+-- provided in this module are used to determine the attributes of the event.+--+-- Identical successive events may be coalesced into a single event.+--+-- =Design notes+--+-- For reference documentation see:+--+-- * <https://man7.org/linux/man-pages/man7/inotify.7.html inotify man page>+--+-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults+-- semantically and syntactically as close as possible.+--+-- =BUGs+--+-- When testing on Linux Kernel version @5.3.0-53-generic #47-Ubuntu@, the last+-- event for the root path seems to be delayed until one more event occurs.+--+-- = Differences between macOS and Linux APIs:+--+-- 1. macOS watch is based on the path provided to it, if the path is+-- deleted and recreated it will still be watched, if the path moves to another+-- path it won't be watched anymore. Whereas Linux watch is based on a handle+-- to the path, if the path is deleted and recreated it won't be watched, if+-- the path moves to another it can still be watched (though this is+-- configurable).+--+-- 2. macOS watches the directory hierarchy recursively, Linux watches only one+-- level of dir, recursive watch has to be built in user space by watching for+-- create events and adding the new directories to the watch. Not sure how this+-- will scale for too many paths.+--+-- 3. In macOS the path of the subject of the event is absolute, in Linux the+-- path is the name of the object inside the dir being watched.+--+-- 4. On Linux 'watchPaths' fails if a path does not exist, on macOS it does+-- not fail.++#include "config.h"++#if HAVE_DECL_IN_EXCL_UNLINK+module Streamly.Internal.FileSystem.Event.Linux+    {-# DEPRECATED "Use the streamly-fsevents package." #-}+    (+    -- * Subscribing to events++    -- ** Default configuration+      Config (..)+    , defaultConfig++    -- ** Watch Behavior+    , setRecursiveMode+    , setFollowSymLinks+    , setUnwatchMoved+    , setOneShot+    , setOnlyDir+    , WhenExists (..)+    , setWhenExists++    -- ** Events of Interest+    -- *** Root Path Events+    , setRootDeleted+    , setRootMoved+    , setRootPathEvents++    -- *** Item Level Metadata change+    , setAttrsModified++    -- *** Item Level Access+    , setAccessed+    , setOpened+    , setWriteClosed+    , setNonWriteClosed++    -- *** Item CRUD events+    , setCreated+    , setDeleted+    , setMovedFrom+    , setMovedTo+    , setModified++    , setAllEvents++    -- ** Watch APIs+    , watch+    , watchRecursive+    , watchWith++    -- Low level watch APIs+    , addToWatch+    , removeFromWatch++    -- * Handling Events+    , Event(..)+    , getRoot+    , getRelPath+    , getAbsPath+    , getCookie++    -- ** Root Level Events+    , isRootPathEvent+    , isRootUnwatched+    , isRootDeleted+    , isRootMoved+    , isRootUnmounted++    -- ** Item Level Metadata change+    , isAttrsModified++    -- ** Item Level Access+    , isAccessed+    , isOpened+    , isWriteClosed+    , isNonWriteClosed++    -- ** Item Level CRUD events+    , isCreated+    , isDeleted+    , isMovedFrom+    , isMovedTo+    , isMoved+    , isModified++    -- ** Item Path info+    , isDir++    -- ** Exception Conditions+    , isEventsLost++    -- * Debugging+    , showEvent+    )+where++import Control.Monad (void, when)+import Control.Monad.IO.Class (MonadIO)+import Data.Bits ((.|.), (.&.), complement)+import Data.Char (ord)+import Data.Foldable (foldlM)+import Data.Functor.Identity (runIdentity)+import Data.IntMap.Lazy (IntMap)+import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)+import Data.List.NonEmpty (NonEmpty)+#if !(MIN_VERSION_base(4,13,0))+import Data.Semigroup (Semigroup(..))+#endif+import Data.Word (Word8, Word32)+import Foreign.C.Error (throwErrnoIfMinus1)+import Foreign.C.String (CString)+import Foreign.C.Types (CInt(..), CUInt(..))+import Foreign.Ptr (Ptr)+import Foreign.Storable (peek, peekByteOff, sizeOf)+import GHC.IO.Device (IODeviceType(Stream))+import GHC.IO.FD (fdFD, FD(..))+import GHC.IO.Handle.FD (mkHandleFromFD)+import Streamly.Data.Stream (Stream)+import Streamly.Data.Parser (Parser)+import System.Directory (doesDirectoryExist)+import System.IO (Handle, hClose, IOMode(ReadMode))+import GHC.IO.Handle.FD (handleToFd)++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.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+    (takeEQ, fromEffect, fromFold)++-------------------------------------------------------------------------------+-- Subscription to events+-------------------------------------------------------------------------------++-- | Watch configuration, used to specify the events of interest and the+-- behavior of the watch.+--+-- /Pre-release/+--+data Config = Config+    { watchRec :: Bool+    , createFlags :: Word32+    }++-------------------------------------------------------------------------------+-- Boolean settings+-------------------------------------------------------------------------------++setFlag :: Word32 -> Bool -> Config -> Config+setFlag mask status cfg@Config{..} =+    let flags =+            if status+            then createFlags .|. mask+            else createFlags .&. complement mask+    in cfg {createFlags = flags}++-------------------------------------------------------------------------------+-- Settings+-------------------------------------------------------------------------------++-- | Watch the whole directory tree recursively instead of watching just one+-- level of directory.+--+-- /default: False/+--+-- /Pre-release/+--+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++-- | If the pathname to be watched is a symbolic link then watch the target of+-- the symbolic link instead of the symbolic link itself.+--+-- Note that the path location in the events is through the original symbolic+-- link path rather than the resolved path.+--+-- /default: True/+--+-- /Pre-release/+--+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++-- | If an object moves out of the directory being watched then stop watching+-- it.+--+-- /default: True/+--+-- /Pre-release/+--+setUnwatchMoved :: Bool -> Config -> Config+setUnwatchMoved = setFlag iN_EXCL_UNLINK++#if HAVE_DECL_IN_MASK_CREATE+foreign import capi+    "sys/inotify.h value IN_MASK_CREATE" iN_MASK_CREATE :: Word32+#endif++foreign import capi+    "sys/inotify.h value IN_MASK_ADD" iN_MASK_ADD :: Word32++-- | What to do if a watch already exists when 'openWatch' or 'addToWatch' is+-- called for a path.+--+-- /Pre-release/+--+data WhenExists =+      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+#endif++-- | When adding a new path to the watch, specify what to do if a watch already+-- exists on that path.+--+-- /default: FailIfExists/+--+-- /Pre-release/+--+setWhenExists :: WhenExists -> Config -> Config+setWhenExists val cfg =+    case val of+        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 True cfg+#endif++foreign import capi+    "sys/inotify.h value IN_ONESHOT" iN_ONESHOT :: Word32++-- | Watch the object only for one event and then remove it from the watch.+--+-- /default: False/+--+-- /Pre-release/+--+setOneShot :: Bool -> Config -> Config+setOneShot = setFlag iN_ONESHOT++foreign import capi+    "sys/inotify.h value IN_ONLYDIR" iN_ONLYDIR :: Word32++-- | 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: False/+--+-- /Pre-release/+--+setOnlyDir :: Bool -> Config -> Config+setOnlyDir = setFlag iN_ONLYDIR++-------------------------------------------------------------------------------+-- Event types that can occur+-------------------------------------------------------------------------------++foreign import capi+    "sys/inotify.h value IN_DELETE_SELF" iN_DELETE_SELF :: Word32++-- | Report when the watched path itself gets deleted.+--+-- /default: True/+--+-- /Pre-release/+--+setRootDeleted :: Bool -> Config -> Config+setRootDeleted = setFlag iN_DELETE_SELF++foreign import capi+    "sys/inotify.h value IN_MOVE_SELF" iN_MOVE_SELF :: Word32++-- | Report when the watched root path itself gets renamed.+--+-- /default: True/+--+-- /Pre-release/+--+setRootMoved :: Bool -> Config -> Config+setRootMoved = setFlag iN_MOVE_SELF++-- | Report when the watched root path itself gets deleted or renamed.+--+-- /default: True/+--+-- /Pre-release/+--+setRootPathEvents :: Bool -> Config -> Config+setRootPathEvents = setFlag (iN_DELETE_SELF .|. iN_MOVE_SELF)++foreign import capi+    "sys/inotify.h value IN_ATTRIB" iN_ATTRIB :: Word32++-- | Report when the metadata e.g. owner, permission modes, modifications times+-- of an object changes.+--+-- /default: True/+--+-- /Pre-release/+--+setAttrsModified :: Bool -> Config -> Config+setAttrsModified = setFlag iN_ATTRIB++foreign import capi+    "sys/inotify.h value IN_ACCESS" iN_ACCESS :: Word32++-- | Report when a file is accessed.+--+-- /default: True/+--+-- /Pre-release/+--+setAccessed :: Bool -> Config -> Config+setAccessed = setFlag iN_ACCESS++foreign import capi+    "sys/inotify.h value IN_OPEN" iN_OPEN :: Word32++-- | Report when a file is opened.+--+-- /default: True/+--+-- /Pre-release/+--+setOpened :: Bool -> Config -> Config+setOpened = setFlag iN_OPEN++foreign import capi+    "sys/inotify.h value IN_CLOSE_WRITE" iN_CLOSE_WRITE :: Word32++-- | Report when a file that was opened for writes is closed.+--+-- /default: True/+--+-- /Pre-release/+--+setWriteClosed :: Bool -> Config -> Config+setWriteClosed = setFlag iN_CLOSE_WRITE++foreign import capi+    "sys/inotify.h value IN_CLOSE_NOWRITE" iN_CLOSE_NOWRITE :: Word32++-- | Report when a file that was opened for not writing is closed.+--+-- /default: True/+--+-- /Pre-release/+--+setNonWriteClosed :: Bool -> Config -> Config+setNonWriteClosed = setFlag iN_CLOSE_NOWRITE++foreign import capi+    "sys/inotify.h value IN_CREATE" iN_CREATE :: Word32++-- | Report when a file is created.+--+-- /default: True/+--+-- /Pre-release/+--+setCreated :: Bool -> Config -> Config+setCreated = setFlag iN_CREATE++foreign import capi+    "sys/inotify.h value IN_DELETE" iN_DELETE :: Word32++-- | Report when a file is deleted.+--+-- /default: True/+--+-- /Pre-release/+--+setDeleted :: Bool -> Config -> Config+setDeleted = setFlag iN_DELETE++foreign import capi+    "sys/inotify.h value IN_MOVED_FROM" iN_MOVED_FROM :: Word32++-- | Report the source of a move.+--+-- /default: True/+--+-- /Pre-release/+--+setMovedFrom :: Bool -> Config -> Config+setMovedFrom = setFlag iN_MOVED_FROM++foreign import capi+    "sys/inotify.h value IN_MOVED_TO" iN_MOVED_TO :: Word32++-- | Report the target of a move.+--+-- /default: True/+--+-- /Pre-release/+--+setMovedTo :: Bool -> Config -> Config+setMovedTo = setFlag iN_MOVED_TO++foreign import capi+    "sys/inotify.h value IN_MODIFY" iN_MODIFY :: Word32++-- | Report when a file is modified.+--+-- /default: True/+--+-- /Pre-release/+--+setModified :: Bool -> Config -> Config+setModified = setFlag iN_MODIFY++-- | Set all tunable events 'True' or 'False'. Equivalent to setting:+--+-- * setRootDeleted+-- * setRootMoved+-- * setAttrsModified+-- * setAccessed+-- * setOpened+-- * setWriteClosed+-- * setNonWriteClosed+-- * setCreated+-- * setDeleted+-- * setMovedFrom+-- * setMovedTo+-- * setModified+--+-- /Pre-release/+--+setAllEvents :: Bool -> Config -> Config+setAllEvents s =+      setRootDeleted s+    . setRootMoved s+    . setAttrsModified s+    . setAccessed s+    . setOpened s+    . setWriteClosed s+    . setNonWriteClosed s+    . setCreated s+    . setDeleted s+    . setMovedFrom s+    . setMovedTo s+    . setModified s++-------------------------------------------------------------------------------+-- Default config+-------------------------------------------------------------------------------++-- The defaults are set in such a way that the behavior on macOS and Linux is+-- as much compatible as possible.+--+-- | The default configuration settings are:+--+-- * 'setFollowSymLinks' 'True'+-- * 'setUnwatchMoved' 'True'+-- * 'setOneShot' 'False'+-- * 'setOnlyDir' 'False'+-- * 'setWhenExists' 'AddIfExists'+--+-- The tunable events enabled by default are:+--+-- * setCreated True+-- * setDeleted True+-- * setMovedFrom True+-- * setMovedTo True+-- * setModified True+--+-- /Pre-release/+--+defaultConfig :: Config+defaultConfig =+      setWhenExists AddIfExists+    $ setCreated True+    $ setDeleted True+    $ setMovedFrom True+    $ setMovedTo True+    $ setModified True+    $ Config+        { watchRec = False+        , createFlags = 0+        }++-------------------------------------------------------------------------------+-- Open an event stream+-------------------------------------------------------------------------------++-- | A handle for a watch.+data Watch =+    Watch+        Handle                  -- File handle for the watch+        (IORef+            (IntMap             -- Key is the watch descriptor+                ( Array Word8   -- Absolute path of the watch root+                , Array Word8   -- Path of subdir relative to watch root+                )+            )+        )++-- Instead of using the watch descriptor we can provide APIs that use the path+-- itself to identify the watch. That will require us to maintain a map from wd+-- to path in the Watch handle.++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++-- | Create a 'Watch' handle. 'addToWatch' can be used to add paths being+-- monitored by this watch.+--+-- /Pre-release/+--+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 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+           Stream+           ("<createWatch fd: " ++ show fd ++ ">")+           ReadMode+           False    -- use non-blocking IO+           Nothing -- TextEncoding (binary)+    emptyMapRef <- newIORef Map.empty+    return $ Watch h emptyMapRef++foreign import ccall unsafe+    "sys/inotify.h inotify_add_watch" c_inotify_add_watch+        :: CInt -> CString -> CUInt -> IO CInt++-- XXX we really do not know the path encoding, all we know is that it is "/"+-- 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 => Path -> m (Array Word8)+toUtf8 path = pure $ Path.toArray path++utf8ToString :: Array Word8 -> String+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.+--+ensureTrailingSlash :: Array Word8 -> Array Word8+ensureTrailingSlash path =+    if byteLength path /= 0+    then+        let mx = A.getIndex (byteLength path - 1) path+         in case mx of+            Nothing -> error "ensureTrailingSlash: Bug: Invalid index"+            Just x ->+                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 n path+         in case mx of+            Nothing -> error "removeTrailingSlash: Bug: Invalid index"+            Just x ->+                if x == fromIntegral (ord '/')+                then A.unsafeSliceOffLen 0 n path+                else path+    else path++appendPaths :: Array Word8 -> Array Word8 -> Array Word8+appendPaths a b+  | byteLength a == 0 = b+  | byteLength b == 0 = a+  | otherwise = ensureTrailingSlash a <> b++-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths+-- being monitored under @root@ via the watch handle @watch@.  @root@ must be+-- an absolute path and @subpath@ must be relative to @root@.+--+-- /Pre-release/+--+addToWatch :: Config -> Watch -> Array Word8 -> Array Word8 -> IO ()+addToWatch cfg@Config{..} watch0@(Watch handle wdMap) root0 path0 = do+    -- XXX do not add if the path is already added+    -- XXX if the watch is added by the scan and not via an event we can+    -- generate a create event assuming that the create may have been lost. We+    -- can also mark in the map that this entry was added by the scan. So if an+    -- actual create event later comes and tries to add this again then we can+    -- ignore that and drop the create event to avoid duplicate create, because+    -- we have already emitted it.+    --+    -- When a directory is added by the scan we should also emit create events+    -- for files that may have got added to the dir. However, such create+    -- events may get duplicated because of a race between the scan generated+    -- versus real events.+    --+    -- Or we may distinguish between scan generated events and real events so+    -- that the application can assume that other events may been lost and+    -- handle it. For example, if it is a dir create the application can read+    -- the dir to scan the files in it.+    --+    let root = removeTrailingSlash root0+        path = removeTrailingSlash path0+        absPath = appendPaths root path+    putStrLn $ "root = " ++ utf8ToString root ++ " path = " ++ utf8ToString path ++ " absPath = " ++ utf8ToString absPath++    fd <- handleToFd handle++    -- XXX we need to tolerate an error where we are adding a watch for a+    -- non-existing file because the file may have got deleted by the time we+    -- added the watch. Perhaps we can have a flag in config for this and keep+    -- the default value to tolerate the error.+    --+    -- XXX The file may have even got deleted and then recreated which we will+    -- never get to know, document this.+    wd <- A.asCStringUnsafe absPath $ \pathPtr ->+            throwErrnoIfMinus1 ("addToWatch: " ++ utf8ToString absPath) $+                c_inotify_add_watch (fdFD fd) pathPtr (CUInt createFlags)++    -- We add the parent first so that we start getting events for any new+    -- creates and add the new subdirectories on creates while we are adding+    -- the children.+    modifyIORef wdMap (Map.insert (fromIntegral wd) (root, path))++    -- Now add the children. If we missed any creates while we were adding the+    -- parent, this will make sure they are added too.+    --+    -- XXX Ensure that we generate events that we may have missed while we were+    -- adding the dirs. That may generate spurious events though.+    --+    -- XXX readDirs currently uses paths as String, we need to convert it+    -- to "/" separated by byte arrays.+    let p = Path.unsafeFromArray absPath+    -- XXX Need a FileSystem.Stat module to remove this+    pathIsDir <- doesDirectoryExist (Path.toString p)+    when (watchRec && pathIsDir) $ do+        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+        :: CInt -> CInt -> IO CInt++-- | Remove an absolute root path from a 'Watch', if a path was moved after+-- adding you need to provide the original path which was used to add the+-- Watch.+--+-- /Pre-release/+--+removeFromWatch :: Watch -> Array Word8 -> IO ()+removeFromWatch (Watch handle wdMap) path = do+    fd <- handleToFd handle+    km <- readIORef wdMap+    wdMap1 <- foldlM (step fd) Map.empty (Map.toList km)+    writeIORef wdMap wdMap1++    where++    step fd newMap (wd, v) = do+        if fst v == path+        then do+            let err = "removeFromWatch: " ++ show (utf8ToString path)+                rm = c_inotify_rm_watch (fdFD fd) (fromIntegral wd)+            void $ throwErrnoIfMinus1 err rm+            return newMap+        else return $ Map.insert wd v newMap++-- | Given a 'Config' and list of @paths@ ("/" separated byte arrays) start+-- monitoring the paths for file system events. Returns a 'Watch' handle which+-- can then be used to read the event stream or to close the watch.+--+-- /Pre-release/+--+openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch+openWatch cfg paths = do+    w <- createWatch+    mapM_+        (\root -> addToWatch cfg w root (A.fromList []))+        $ NonEmpty.toList paths+    return w++-- | Close a 'Watch' handle.+--+-- /Pre-release/+--+closeWatch :: Watch -> IO ()+closeWatch (Watch h _) = hClose h++-------------------------------------------------------------------------------+-- Raw events read from the watch file handle+-------------------------------------------------------------------------------++newtype Cookie = Cookie Word32 deriving (Show, Eq)++-- | An Event generated by the file system. Use the accessor functions to+-- examine the event.+--+-- /Pre-release/+--+data Event = Event+   { eventWd :: CInt+   , eventFlags :: Word32+   , eventCookie :: Word32+   , eventRelPath :: Array Word8+   , eventMap :: IntMap (Array Word8, Array Word8)+   } deriving (Show, Ord, Eq)++-- The inotify event struct from the man page/header file:+--+--            struct inotify_event {+--                int      wd;       /* Watch descriptor */+--                uint32_t mask;     /* Mask describing event */+--                uint32_t cookie;   /* Unique cookie associating related+--                                      events (for rename(2)) */+--                uint32_t len;      /* Size of name field */+--                char     name[];   /* Optional null-terminated name */+--            };+--+-- XXX We can perhaps use parseD monad instance for fusing with parseMany? Need+-- to measure the perf.+--+readOneEvent :: Config -> Watch -> Parser Word8 IO Event+readOneEvent cfg  wt@(Watch _ wdMap) = do+    let headerLen = sizeOf (undefined :: CInt) + 12+    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.+    path <-+        if pathLen /= 0+        then do+            -- XXX takeEndBy_ drops the separator so assumes a null+            -- terminated path, we should use a takeWhile nested inside a+            -- takeP+            pth <-+                PR.fromFold+                    $ FL.takeEndBy_ (== 0)+                    $ FL.take pathLen (A.createOf pathLen)+            let remaining = pathLen - byteLength pth - 1+            when (remaining /= 0) $ PR.takeEQ remaining FL.drain+            return pth+        else return $ A.fromList []+    wdm <- PR.fromEffect $ readIORef wdMap+    let (root, sub) =+            case Map.lookup (fromIntegral ewd) wdm of+                    Just pair -> pair+                    Nothing ->+                        error $ "readOneEvent: "+                                  <> "Unknown watch descriptor: "+                                  <> show ewd+    let sub1 = appendPaths sub path+        -- Check for "ISDIR" first because it is less likely+        isDirCreate = eflags .&. iN_ISDIR /= 0 && eflags .&. iN_CREATE /= 0+    when (watchRec cfg && isDirCreate)+        $ PR.fromEffect $ addToWatch cfg wt root sub1+    -- XXX Handle IN_DELETE, IN_DELETE_SELF, IN_MOVE_SELF, IN_MOVED_FROM,+    -- IN_MOVED_TO+    -- What if a large dir tree gets moved in to our hierarchy? Do we get a+    -- single event for the top level dir in this case?+    return $ Event+        { eventWd = fromIntegral ewd+        , eventFlags = eflags+        , eventCookie = cookie+        , eventRelPath = sub1+        , eventMap = wdm+        }++    where++    readHeader (ptr :: Ptr Word8) _ = do+        let len = sizeOf (undefined :: CInt)+        ewd <- peek ptr+        eflags <- peekByteOff ptr len+        cookie <- peekByteOff ptr (len + 4)+        pathLen :: Word32 <- peekByteOff ptr (len + 8)+        return (ewd, eflags, cookie, fromIntegral pathLen)++watchToStream :: Config -> Watch -> Stream IO Event+watchToStream cfg wt@(Watch handle _) = do+    -- Do not use too small a buffer. As per inotify man page:+    --+    -- The behavior when the buffer given to read(2) is too small to return+    -- information about the next event depends on the kernel version: in+    -- kernels before 2.6.21, read(2) returns 0; since kernel 2.6.21, read(2)+    -- fails with the error EINVAL.  Specifying a buffer of size+    --+    --          sizeof(struct inotify_event) + NAME_MAX + 1+    --+    -- will be sufficient to read at least one event.+    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.+--+-- | Start monitoring a list of file system paths for file system events with+-- the supplied configuration operation over the 'defaultConfig'. The+-- paths could be files or directories.  When recursive mode is set and the+-- path is a directory, the whole directory tree under it is watched+-- recursively. Monitoring starts from the current time onwards.  The paths are+-- specified as UTF-8 encoded 'Array' of 'Word8'.+--+-- /Non-existing Paths:/ the API fails if a watch is started on a non-exsting+-- path.+--+-- /Performance:/ Note that recursive watch on a large directory tree could be+-- expensive. When starting a watch, the whole tree must be read and watches+-- are started on each directory in the tree. The initial time to start the+-- watch as well as the memory required is proportional to the number of+-- directories in the tree.+--+-- /Bugs:/ When new directories are created under the tree they are added to+-- the watch on receiving the directory create event. However, the creation of+-- a dir and adding a watch for it is not atomic.  The implementation takes+-- care of this and makes sure that watches are added for all directories.+-- However, In the mean time, the directory may have received more events which+-- may get lost.  Handling of any such lost events is yet to be implemented.+--+-- See the Linux __inotify__ man page for more details.+--+-- @+-- watchwith+--      ('setFollowSymLinks' True . 'setUnwatchMoved' False)+--      [Array.fromList "dir"]+-- @+--+-- /Pre-release/+--+watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event+watchWith f paths = S.bracketIO before after (watchToStream cfg)++    where++    cfg = f defaultConfig+    before = openWatch cfg paths+    after = closeWatch++-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.+--+-- >>> watchRecursive = watchWith (setRecursiveMode True)+--+-- See 'watchWith' for pitfalls and bugs when using recursive watch on Linux.+--+-- /Pre-release/+--+watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event+watchRecursive = watchWith (setRecursiveMode True)++-- | Same as 'watchWith' using defaultConfig and non-recursive mode.+--+-- >>> watch = watchWith id+--+-- /Pre-release/+--+watch :: NonEmpty (Array Word8) -> Stream IO Event+watch = watchWith id++-------------------------------------------------------------------------------+-- Examine event stream+-------------------------------------------------------------------------------++-- | Get the watch root corresponding to the 'Event'.+--+-- Note that if a path was moved after adding to the watch, this will give the+-- original path and not the new path after moving.+--+-- TBD: we can possibly update the watch root on a move self event.+--+-- /Pre-release/+--+getRoot :: Event -> Array Word8+getRoot Event{..} =+    if eventWd >= 1+    then+        case Map.lookup (fromIntegral eventWd) eventMap of+            Just path -> fst path+            Nothing ->+                error $ "Bug: getRoot: No path found corresponding to the "+                    ++ "watch descriptor " ++ show eventWd+    else A.fromList []++-- XXX should we use a Maybe here?+-- | Get the file system object path for which the event is generated, relative+-- to the watched root. The path is a "/" separated array of bytes.+--+-- /Pre-release/+--+getRelPath :: Event -> Array Word8+getRelPath Event{..} = eventRelPath++-- | Get the absolute file system object path for which the event is generated.+--+-- When the watch root is a symlink, the absolute path returned is via the+-- original symlink and not through the resolved path.+--+-- /Pre-release/+--+getAbsPath :: Event -> Array Word8+getAbsPath ev =+    let relpath = getRelPath ev+        root = getRoot ev+    in  if byteLength relpath /= 0+        then ensureTrailingSlash root <> relpath+        else removeTrailingSlash root++-- XXX should we use a Maybe?+-- | Cookie is set when a rename occurs. The cookie value can be used to+-- connect the 'isMovedFrom' and 'isMovedTo' events, if both the events belong+-- to the same move operation then they will have the same cookie value.+--+-- /Pre-release/+--+getCookie :: Event -> Cookie+getCookie Event{..} = Cookie eventCookie++-------------------------------------------------------------------------------+-- Event types+-------------------------------------------------------------------------------++getFlag :: Word32 -> Event -> Bool+getFlag mask Event{..} = eventFlags .&. mask /= 0++-------------------------------------------------------------------------------+-- Error events+-------------------------------------------------------------------------------++foreign import capi+    "sys/inotify.h value IN_Q_OVERFLOW" iN_Q_OVERFLOW :: Word32++-- XXX rename to isQOverflowed or hasOverflowed?+--+-- macOS overflow API is more specific, it tells which paths have lost the+-- events due to overflow.+--+-- | Event queue overflowed (WD is invalid for this event) and we may have lost+-- some events..  The user application must scan everything under the watched+-- paths to know the current state.+--+-- /Pre-release/+--+isEventsLost :: Event -> Bool+isEventsLost = getFlag iN_Q_OVERFLOW++-------------------------------------------------------------------------------+-- Events affecting the watched path only+-------------------------------------------------------------------------------++foreign import capi+    "sys/inotify.h value IN_IGNORED" iN_IGNORED :: Word32++-- Compare with isRootChanged on macOS. isRootChanged includes all these cases.+--+-- | A path was removed from the watch explicitly using 'removeFromWatch' or+-- automatically (file was deleted, or filesystem was unmounted).+--+-- Note that in recursive watch mode all the subdirectories are watch roots,+-- therefore, they will all generate this event.+--+-- /Occurs only for a watched path/+--+-- /Pre-release/+--+isRootUnwatched :: Event -> Bool+isRootUnwatched = getFlag iN_IGNORED++-- | Watched file/directory was itself deleted.  (This event also occurs if an+-- object is moved to another filesystem, since mv(1) in effect copies the file+-- to the other filesystem and then deletes it from the original filesystem.)+-- In addition, an 'isRootUnwatched' event will subsequently be generated+-- for the watch descriptor.+--+-- Note that in recursive watch mode all the subdirectories are watch roots,+-- therefore, they will all generate this event.+--+-- /Occurs only for a watched path/+--+-- /Pre-release/+--+isRootDeleted :: Event -> Bool+isRootDeleted = getFlag iN_DELETE_SELF++-- | Watched file/directory was itself moved within the file system.+--+-- Note that in recursive watch mode all the subdirectories are watch roots,+-- therefore, they will all generate this event.+--+-- /Occurs only for a watched path/+--+-- /Pre-release/+--+isRootMoved :: Event -> Bool+isRootMoved = getFlag iN_MOVE_SELF++foreign import capi+    "sys/inotify.h value IN_UNMOUNT" iN_UNMOUNT :: Word32++-- | Filesystem containing watched object was unmounted.  In addition, an+-- 'isRootUnwatched' event will subsequently be generated for the watch+-- descriptor.+--+-- /Occurs only for a watched path/+--+-- /Pre-release/+--+isRootUnmounted :: Event -> Bool+isRootUnmounted = getFlag iN_UNMOUNT++-- | Determine whether the event indicates a change of path of the monitored+-- object itself. Note that the object may become unreachable or deleted after+-- a change of path.+--+-- /Occurs only for a watched path/+--+-- /Pre-release/+--+isRootPathEvent :: Event -> Bool+isRootPathEvent = getFlag (iN_DELETE_SELF .|. iN_MOVE_SELF .|. iN_UNMOUNT)++-------------------------------------------------------------------------------+-- Metadata change Events+-------------------------------------------------------------------------------++-- macOS has multiple APIs for metadata change for different metadata.+--+-- | Determine whether the event indicates inode metadata change for an object+-- contained within the monitored path.+--+-- Metadata change may include, permissions (e.g., chmod(2)), timestamps+-- (e.g., utimensat(2)), extended attributes (setxattr(2)), link count (since+-- Linux 2.6.25; e.g., for the target of link(2) and for unlink(2)), and+-- user/group ID (e.g., chown(2)).+--+-- /Can occur for watched path or a file inside it/+--+-- /Pre-release/+--+isAttrsModified :: Event -> Bool+isAttrsModified = getFlag iN_ATTRIB++-------------------------------------------------------------------------------+-- Access+-------------------------------------------------------------------------------++-- | File was accessed (e.g. read, execve).+--+-- /Occurs only for a file inside the watched directory/+--+-- /Pre-release/+--+isAccessed :: Event -> Bool+isAccessed = getFlag iN_ACCESS++-- | File or directory was opened.+--+-- /Occurs only for a file inside the watched directory/+--+-- /Pre-release/+--+isOpened :: Event -> Bool+isOpened = getFlag iN_OPEN++-- | File opened for writing was closed.+--+-- /Occurs only for a file inside the watched directory/+--+-- /Pre-release/+--+isWriteClosed :: Event -> Bool+isWriteClosed = getFlag iN_CLOSE_WRITE++-- XXX what if it was opened for append? Does NOWRITE mean all cases where the+-- mode was not write? A dir open comes in this category?+--+-- | File or directory opened for read but not write was closed.+--+-- /Can occur for watched path or a file inside it/+--+-- /Pre-release/+--+isNonWriteClosed :: Event -> Bool+isNonWriteClosed = getFlag iN_CLOSE_NOWRITE++-------------------------------------------------------------------------------+-- CRUD Events+-------------------------------------------------------------------------------++-- On macOS this is not generated on hard linking but on Linux it is.+--+-- | File/directory created in watched directory (e.g., open(2) O_CREAT,+-- mkdir(2), link(2), symlink(2), bind(2) on a UNIX domain socket).+--+-- /Occurs only for an object inside the watched directory/+--+-- /Pre-release/+--+isCreated :: Event -> Bool+isCreated = getFlag iN_CREATE++-- | File/directory deleted from watched directory.+--+-- /Occurs only for an object inside the watched directory/+--+-- /Pre-release/+--+isDeleted :: Event -> Bool+isDeleted = getFlag iN_DELETE++-- XXX what if an object is moved in from outside or moved out of the monitored+-- dir?+--+-- | Generated for the original path when an object is moved from under a+-- monitored directory.+--+-- /Occurs only for an object inside the watched directory/+--+-- /Pre-release/+--+isMovedFrom :: Event -> Bool+isMovedFrom = getFlag iN_MOVED_FROM++-- | Generated for the new path when an object is moved under a monitored+-- directory.+--+-- /Occurs only for an object inside the watched directory/+--+-- /Pre-release/+--+isMovedTo :: Event -> Bool+isMovedTo = getFlag iN_MOVED_TO++-- | Generated for a path that is moved from or moved to the monitored+-- directory.+--+-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev+--+-- /Occurs only for an object inside the watched directory/+--+-- /Pre-release/+--+isMoved :: Event -> Bool+isMoved ev = isMovedFrom ev || isMovedTo ev++-- | Determine whether the event indicates modification of an object within the+-- monitored path. This event is generated only for files and not directories.+--+-- /Occurs only for an object inside the watched directory/+--+-- /Pre-release/+--+isModified :: Event -> Bool+isModified = getFlag iN_MODIFY++-------------------------------------------------------------------------------+-- Information about path type (applicable only when 'setFileEvents' is 'True')+-------------------------------------------------------------------------------++foreign import capi+    "sys/inotify.h value IN_ISDIR" iN_ISDIR :: Word32++-- | Determine whether the event is for a directory path.+--+-- /Pre-release/+--+isDir :: Event -> Bool+isDir = getFlag iN_ISDIR++-------------------------------------------------------------------------------+-- Debugging+-------------------------------------------------------------------------------++-- | Convert an 'Event' record to a String representation.+showEvent :: Event -> String+showEvent ev@Event{..} =+       "--------------------------"+    ++ "\nWd = " ++ show eventWd+    ++ "\nRoot = " ++ show (utf8ToString $ getRoot ev)+    ++ "\nPath = " ++ show (utf8ToString $ getRelPath ev)+    ++ "\nCookie = " ++ show (getCookie ev)+    ++ "\nFlags " ++ show eventFlags++    ++ showev isEventsLost "Overflow"++    ++ showev isRootUnwatched "RootUnwatched"+    ++ showev isRootDeleted "RootDeleted"+    ++ showev isRootMoved "RootMoved"+    ++ showev isRootUnmounted "RootUnmounted"++    ++ showev isAttrsModified "AttrsModified"++    ++ showev isAccessed "Accessed"+    ++ showev isOpened "Opened"+    ++ showev isWriteClosed "WriteClosed"+    ++ showev isNonWriteClosed "NonWriteClosed"++    ++ showev isCreated "Created"+    ++ showev isDeleted "Deleted"+    ++ showev isModified "Modified"+    ++ showev isMovedFrom "MovedFrom"+    ++ showev isMovedTo "MovedTo"++    ++ showev isDir "Dir"+    ++ "\n"++        where showev f str = if f ev then "\n" ++ str else ""+#else+#warning "Disabling module Streamly.Internal.FileSystem.Event.Linux. Does not support kernels older than 2.6.36."+module Streamly.Internal.FileSystem.Event.Linux () where+#endif
+ src/Streamly/Internal/FileSystem/Event/Windows.hs view
@@ -0,0 +1,641 @@+-- Some code snippets are adapted from the fsnotify package.+-- http://hackage.haskell.org/package/fsnotify-0.3.0.1/+--+-- |+-- Module      : Streamly.Internal.FileSystem.Event.Windows+-- Copyright   : (c) 2020 Composewell Technologies+--               (c) 2012, Mark Dittmer+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC+--+-- =Overview+--+-- Use 'watchRecursive'or 'watch' with a list of file system dir paths you+-- want to watch as argument. It returns a stream of 'Event' representing the+-- file system events occurring under the watched paths.+--+-- @+-- {-\# LANGUAGE MagicHash #-}+-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchRecursive' [Array.fromList "path"]+-- @+--+-- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)+-- provided in this module are used to determine the attributes of the event.+--+-- =Design notes+--+-- For Windows reference documentation see:+--+-- * <https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information file notify information>+-- * <https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw read directory changes>+--+-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults+-- semantically and syntactically as close as possible.+--+-- =Availability+--+-- As per the Windows reference docs, the fs event notification API is+-- available in:+--+-- * Minimum supported client: Windows XP [desktop apps | UWP apps]+-- * 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+    , defaultConfig++    -- ** Watch Behavior+    , setRecursiveMode++    -- ** Events of Interest+    , setFileNameEvents+    , setDirNameEvents+    , setAttrsModified+    , setSecurityModified+    , setSizeModified+    , setLastWriteTimeModified+    , setAllEvents++    -- ** Watch APIs+    , watch+    , watchRecursive+    , watchWith++    -- * Handling Events+    , Event(..)+    , getRoot+    , getRelPath+    , getAbsPath++    -- ** Item CRUD events+    , isCreated+    , isDeleted+    , isModified+    , isMoved+    , isMovedFrom+    , isMovedTo++    -- ** Exception Conditions+    , isEventsLost++    -- * Debugging+    , showEvent+    )+where++import Data.Bits ((.|.), (.&.), complement)+import Data.Char (ord)+import Data.Functor.Identity (runIdentity)+import Data.List.NonEmpty (NonEmpty)+import Data.Word (Word8)+import Foreign.C.String (peekCWStringLen)+import Foreign.Marshal.Alloc (alloca, allocaBytes)+import Foreign.Storable (peekByteOff)+import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)+import System.Win32.File+    ( FileNotificationFlag+    , LPOVERLAPPED+    , closeHandle+    , createFile+    , fILE_FLAG_BACKUP_SEMANTICS+    , fILE_LIST_DIRECTORY+    , fILE_NOTIFY_CHANGE_FILE_NAME+    , fILE_NOTIFY_CHANGE_DIR_NAME+    , fILE_NOTIFY_CHANGE_ATTRIBUTES+    , fILE_NOTIFY_CHANGE_SIZE+    , fILE_NOTIFY_CHANGE_LAST_WRITE+    , fILE_NOTIFY_CHANGE_SECURITY+    , fILE_SHARE_READ+    , fILE_SHARE_WRITE+    , 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.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.+--+-- /Pre-release/+--+data Config = Config+    { watchRec :: BOOL+    , createFlags :: DWORD+    }++-------------------------------------------------------------------------------+-- Boolean settings+-------------------------------------------------------------------------------++setFlag :: DWORD -> Bool -> Config -> Config+setFlag mask status cfg@Config{..} =+    let flags =+            if status+            then createFlags .|. mask+            else createFlags .&. complement mask+    in cfg {createFlags = flags}++-- | Set watch event on directory recursively.+--+-- /default: False/+--+-- /Pre-release/+--+setRecursiveMode :: Bool -> Config -> Config+setRecursiveMode recursive cfg@Config{} = cfg {watchRec = recursive}++-- | Generate notify events on file create, rename or delete.+--+-- From Windows API documentation: Any file name change in the watched+-- directory or subtree causes a change notification wait operation to return.+-- Changes include renaming, creating, or deleting a file.+--+-- /default: True/+--+-- /Pre-release/+--+setFileNameEvents :: Bool -> Config -> Config+setFileNameEvents = setFlag fILE_NOTIFY_CHANGE_FILE_NAME++-- | Generate notify events on directory create, rename or delete.+--+-- From Windows API documentaiton: Any directory-name change in the watched+-- directory or subtree causes a change notification wait operation to return.+-- Changes include creating or deleting a directory.+--+-- /default: True/+--+-- /Pre-release/+--+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: False/+--+-- /Pre-release/+--+setAttrsModified :: Bool -> Config -> Config+setAttrsModified = setFlag fILE_NOTIFY_CHANGE_ATTRIBUTES++-- | Generate an 'isModified' event when the file size is changed.+--+-- From Windows API documentation: Any file-size change in the watched+-- directory or subtree causes a change notification wait operation to return.+-- The operating system detects a change in file size only when the file is+-- written to the disk. For operating systems that use extensive caching,+-- detection occurs only when the cache is sufficiently flushed.+--+-- /default: False/+--+-- /Pre-release/+--+setSizeModified :: Bool -> Config -> Config+setSizeModified = setFlag fILE_NOTIFY_CHANGE_SIZE++-- | Generate an 'isModified' event when the last write timestamp of the file+-- inode is changed.+--+-- From Windows API documentation: Any change to the last write-time of files+-- in the watched directory or subtree causes a change notification wait+-- operation to return. The operating system detects a change to the last+-- write-time only when the file is written to the disk. For operating systems+-- that use extensive caching, detection occurs only when the cache is+-- sufficiently flushed.+--+-- /default: False/+--+-- /Pre-release/+--+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: False/+--+-- /Pre-release/+--+setSecurityModified :: Bool -> Config -> Config+setSecurityModified = setFlag fILE_NOTIFY_CHANGE_SECURITY++-- | Set all tunable events 'True' or 'False'. Equivalent to setting:+--+-- * setFileNameEvents+-- * setDirNameEvents+-- * setAttrsModified+-- * setSizeModified+-- * setLastWriteTimeModified+-- * setSecurityModified+--+-- /Pre-release/+--+setAllEvents :: Bool -> Config -> Config+setAllEvents s =+      setFileNameEvents s+    . setDirNameEvents s+    . setAttrsModified s+    . setSizeModified s+    . setLastWriteTimeModified s+    . setSecurityModified s++-- | The tunable events that are enabled by default are:+--+-- * setFileNameEvents True+-- * setDirNameEvents True+-- * setSizeModified True+-- * setLastWriteTimeModified True+--+-- /Pre-release/+--+defaultConfig :: Config+defaultConfig =+      setFileNameEvents True+    $ setDirNameEvents True+    $ setSizeModified True+    $ setLastWriteTimeModified True+    $ Config {watchRec = False, createFlags = 0}++getConfigFlag :: Config -> DWORD+getConfigFlag Config{..} = createFlags++getConfigRecMode :: Config -> BOOL+getConfigRecMode Config{..} = watchRec++data Event = Event+    { eventFlags :: DWORD+    , eventRelPath :: String+    , eventRootPath :: String+    , totalBytes :: DWORD+    } deriving (Show, Ord, Eq)++-- For reference documentation see:+--+-- See https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information+data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION+    { fniNextEntryOffset :: DWORD+    , fniAction :: DWORD+    , fniFileName :: String+    } deriving Show++type LPOVERLAPPED_COMPLETION_ROUTINE =+    FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())++-- | A handle for a watch.+getWatchHandle :: FilePath -> IO (HANDLE, FilePath)+getWatchHandle dir = do+    h <- createFile dir+        -- Access mode+        fILE_LIST_DIRECTORY+        -- Share mode+        (fILE_SHARE_READ .|. fILE_SHARE_WRITE)+        -- Security attributes+        Nothing+        -- Create mode, we want to look at an existing directory+        oPEN_EXISTING+        -- File attribute, NOT using OVERLAPPED since we work synchronously+        fILE_FLAG_BACKUP_SEMANTICS+        -- No template file+        Nothing+    return (h, dir)++-- For reference documentation see:+--+-- See https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw+-- Note that this API uses UTF-16 for file system paths:+-- 1. https://docs.microsoft.com/en-us/windows/win32/intl/unicode-in-the-windows-api+-- 2. https://docs.microsoft.com/en-us/windows/win32/intl/unicode+foreign import ccall safe+    "windows.h ReadDirectoryChangesW" c_ReadDirectoryChangesW ::+           HANDLE+        -> LPVOID+        -> DWORD+        -> BOOL+        -> DWORD+        -> LPDWORD+        -> LPOVERLAPPED+        -> LPOVERLAPPED_COMPLETION_ROUTINE+        -> IO BOOL++readDirectoryChangesW ::+       HANDLE+    -> Ptr FILE_NOTIFY_INFORMATION+    -> DWORD+    -> BOOL+    -> FileNotificationFlag+    -> LPDWORD+    -> IO ()+readDirectoryChangesW h buf bufSize wst f br =+    let res = c_ReadDirectoryChangesW+                    h (castPtr buf) bufSize wst f br nullPtr nullFunPtr+     in failIfFalse_ "ReadDirectoryChangesW" res++peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION+peekFNI buf = do+    neof <- peekByteOff buf 0+    acti <- peekByteOff buf 4+    fnle <- peekByteOff buf 8+    -- Note: The path is UTF-16 encoded C WChars, peekCWStringLen converts+    -- UTF-16 to UTF-32 Char String+    fnam <- peekCWStringLen+        -- start of array+        (buf `plusPtr` 12,+        -- fnle is the length in *bytes*, and a WCHAR is 2 bytes+        fromEnum (fnle :: DWORD) `div` 2)+    return $ FILE_NOTIFY_INFORMATION neof acti fnam++readChangeEvents ::+    Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]+readChangeEvents pfni root bytesRet = do+    fni <- peekFNI pfni+    let entry = Event+            { eventFlags = fniAction fni+            , eventRelPath = fniFileName fni+            , eventRootPath = root+            , totalBytes = bytesRet+            }+        nioff = fromEnum $ fniNextEntryOffset fni+    entries <-+        if nioff == 0+        then return []+        else readChangeEvents (pfni `plusPtr` nioff) root bytesRet+    return $ entry : entries++readDirectoryChanges ::+    String -> HANDLE -> Bool -> FileNotificationFlag -> IO [Event]+readDirectoryChanges root h wst mask = do+    let maxBuf = 63 * 1024+    allocaBytes maxBuf $ \buffer -> do+        alloca $ \bret -> do+            readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret+            bytesRet <- peekByteOff bret 0+            readChangeEvents buffer root bytesRet++-- XXX Try to get these from windows header files+type FileAction = DWORD++fILE_ACTION_ADDED             :: FileAction+fILE_ACTION_ADDED             =  1++fILE_ACTION_REMOVED           :: FileAction+fILE_ACTION_REMOVED           =  2++fILE_ACTION_MODIFIED          :: FileAction+fILE_ACTION_MODIFIED          =  3++fILE_ACTION_RENAMED_OLD_NAME  :: FileAction+fILE_ACTION_RENAMED_OLD_NAME  =  4++fILE_ACTION_RENAMED_NEW_NAME  :: FileAction+fILE_ACTION_RENAMED_NEW_NAME  =  5++eventStreamAggr :: (HANDLE, FilePath, Config) -> Stream IO Event+eventStreamAggr (handle, rootPath, cfg) =  do+    let recMode = getConfigRecMode cfg+        flagMasks = getConfigFlag cfg+        repeatM = S.sequence . S.repeat+    S.concatMap S.fromList $ repeatM+        $ readDirectoryChanges rootPath handle recMode flagMasks++pathsToHandles ::+    NonEmpty FilePath -> Config -> Stream IO (HANDLE, FilePath, Config)+pathsToHandles paths cfg = do+    let pathStream = S.fromList (NonEmpty.toList paths)+        st2 = S.mapM getWatchHandle pathStream+    fmap (\(h, f) -> (h, f, cfg)) st2++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++utf8ToString :: Array Word8 -> FilePath+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 :: 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.+-- Remove the utf-8 encoding requirement of paths? It can be encoding agnostic+-- "\" separated bytes, the application can decide what encoding to use.+-- Instead of always using widechar (-W) APIs can we call the underlying APIs+-- based on the configured code page?+-- https://docs.microsoft.com/en-us/windows/uwp/design/globalizing/use-utf8-code-page+--+-- | Start monitoring a list of directory paths for file system events with the+-- supplied configuration modifier operation over the' defaultConfig'. The+-- paths could be directories or symbolic links to directories.+--+-- When recursive mode is True, the whole directory tree under the path is+-- watched recursively.  When recursive mode is False, only the files and+-- directories directly under the watched directory are monitored, contents of+-- subdirectories are not monitored.  Monitoring starts from the current time+-- onwards. The paths are specified as UTF-8 encoded 'Array' of 'Word8'.+--+-- /Symbolic Links:/ If the pathname to be watched is a symbolic link then+-- watch the target of the symbolic link instead of the symbolic link itself.+-- Note that the path location in the events is through the original symbolic+-- link path rather than the resolved path.+--+-- @+-- watchWith+--  ('setAttrsModified' True . 'setLastWriteTimeModified' False)+--  [Array.fromList "dir"]+-- @+--+-- /Pre-release/+--+watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event+watchWith f paths =+    S.bracketIO before after (S.parConcatMap (eager True) eventStreamAggr)++    where++    before = return $ pathsToHandles (utf8ToStringList paths) $ f defaultConfig+    after = closePathHandleStream++-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.+--+-- >>> watchRecursive = watchWith (setRecursiveMode True)+--+-- /Pre-release/+--+watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event+watchRecursive = watchWith (setRecursiveMode True)++-- | Same as 'watchWith' using defaultConfig and non-recursive mode.+--+-- >>> watch = watchWith id+--+-- /Pre-release/+--+watch :: NonEmpty (Array Word8) -> Stream IO Event+watch = watchWith id++getFlag :: DWORD -> Event -> Bool+getFlag mask Event{..} = eventFlags == mask++-- XXX Change the type to Array Word8 to make it compatible with other APIs.+--+-- | Get the file system object path for which the event is generated, relative+-- to the watched root. The path is a UTF-8 encoded array of bytes.+--+-- /Pre-release/+--+getRelPath :: Event -> Array Word8+getRelPath Event{..} = (UTF8.toArray . UTF8.pack) eventRelPath++-- XXX Change the type to Array Word8 to make it compatible with other APIs.+--+-- | Get the watch root directory to which this event belongs.+--+-- /Pre-release/+--+getRoot :: Event -> Array Word8+getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath++-- | Get the absolute file system object path for which the event is generated.+--+-- When the watch root is a symlink, the absolute path returned is via the+-- original symlink and not through the resolved path.+--+-- /Pre-release/+--+getAbsPath :: Event -> Array Word8+getAbsPath ev = getRoot ev <> backSlash <> getRelPath ev+    where backSlash = A.fromList [ fromIntegral (ord '\\') ]++-- XXX need to document the exact semantics of these.+--+-- | This event is generated when a file or directory is created in a watched+-- directory or directory tree when in recursive watch mode.  Creating a hard+-- link also generates this event.+--+-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/+--+-- /Pre-release/+--+isCreated :: Event -> Bool+isCreated = getFlag fILE_ACTION_ADDED++-- | This event is generated when a file or directory is deleted from the+-- watched directory or directory tree when in recursive mode. This event is+-- generated even when a hard link is deleted.+--+-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/+--+-- /Pre-release/+--+isDeleted :: Event -> Bool+isDeleted = getFlag fILE_ACTION_REMOVED++-- | Generated for the original path when an object is moved from under a+-- monitored directory.+--+-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/+--+-- /Pre-release/+--+isMovedFrom :: Event -> Bool+isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME++-- | Generated for the new path when an object is moved under a monitored+-- directory.+--+-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/+--+-- /Pre-release/+--+isMovedTo :: Event -> Bool+isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME++-- | Generated for a path that is moved from or moved to the monitored+-- directory.+--+-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev+--+-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/+-- /Occurs only for an object inside the watched directory/+--+-- /Pre-release/+--+isMoved :: Event -> Bool+isMoved ev = isMovedFrom ev || isMovedTo ev++-- XXX This event is generated only for files and not directories?+--+-- | This event occurs when a file or directory contents, timestamps or+-- attributes are modified.  Since it can occur on multiple changes, you may+-- have to check the attributes to know what exactly changed when multiple type+-- of modified events are enabled.+--+-- In non-recursive mode this event does not occur for directories.  In+-- recursive mode this event occurs for the parent directory if a file or+-- directory inside it is created or renamed.+--+-- /Occurs when one of the @set*Modified@ events is enabled/+--+-- /Pre-release/+--+isModified :: Event -> Bool+isModified = getFlag fILE_ACTION_MODIFIED++-- | If the kernel event buffer overflows, entire contents of the buffer are+-- discarded, therefore, events are lost.  The user application must scan+-- everything under the watched paths to know the current state of the file+-- system tree.+--+-- /Pre-release/+--+isEventsLost :: Event -> Bool+isEventsLost Event{..} = totalBytes == 0++-------------------------------------------------------------------------------+-- Debugging+-------------------------------------------------------------------------------++-- | Convert an 'Event' record to a String representation.+showEvent :: Event -> String+showEvent ev@Event{..} =+        "--------------------------"+    ++ "\nRoot = " ++ utf8ToString (getRoot ev)+    ++ "\nPath = " ++ utf8ToString (getRelPath ev)+    ++ "\ngetAbsPath = " ++ utf8ToString (getAbsPath ev)+    ++ "\nFlags " ++ show eventFlags+    ++ showev isEventsLost "Overflow"+    ++ showev isCreated "Created"+    ++ showev isDeleted "Deleted"+    ++ showev isModified "Modified"+    ++ showev isMovedFrom "MovedFrom"+    ++ showev isMovedTo "MovedTo"+    ++ "\n"++    where showev f str = if f ev then "\n" ++ str else ""
+ src/Streamly/Internal/FileSystem/FD.hs view
@@ -0,0 +1,582 @@+#include "inline.hs"++-- |+-- Module      : Streamly.Internal.FileSystem.FD+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- This module is a an experimental replacement for+-- "Streamly.FileSystem.Handle". The former module provides IO facilities based+-- on the GHC Handle type. The APIs in this module avoid the GHC handle layer+-- and provide more explicit control over buffering.+--+-- Read and write data as streams and arrays to and from files.+--+-- This module provides read and write APIs based on handles. Before reading or+-- writing, a file must be opened first using 'openFile'. The 'Handle' returned+-- by 'openFile' is then used to access the file. A 'Handle' is backed by an+-- operating system file descriptor. When the 'Handle' is garbage collected the+-- underlying file descriptor is automatically closed. A handle can be+-- explicitly closed using 'closeFile'.+--+-- Reading and writing APIs are divided into two categories, sequential+-- streaming APIs and random or seekable access APIs.  File 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.+--+-- > import qualified Streamly.Internal.FileSystem.FD as FD+--++module Streamly.Internal.FileSystem.FD+    (+    -- * File Handles+      Handle+    , stdin+    , stdout+    , stderr+    , openFile++    -- TODO file path based APIs+    -- , readFile+    -- , writeFile++    -- * Streaming IO+    -- | Streaming APIs read or write data to or from a file or device+    -- sequentially, they never perform a seek to a random location.  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+    -- 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.++    -- ** Read File to Stream+    , read+    -- , readUtf8+    -- , readLines+    -- , readFrames+    , readInChunksOf++    -- -- * Array Read+    -- , readArrayUpto+    -- , readArrayOf++    , readArrays+    , readArraysOfUpto+    -- , readArraysOf++    -- ** Write File from Stream+    , write+    -- , writeUtf8+    -- , writeUtf8Lines+    -- , writeFrames+    , writeInChunksOf++    -- -- * Array Write+    -- , writeArray+    , writeArrays+    , writeArraysPackedUpto++    -- XXX these are incomplete+    -- , writev+    -- , writevArraysPackedUpto++    -- -- * 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.+    --+    -- , readIndex+    -- , readSlice+    -- , readSliceRev+    -- , readAt -- read from a given position to th end of file+    -- , readSliceArrayUpto+    -- , readSliceArrayOf++    -- , writeIndex+    -- , writeSlice+    -- , writeSliceRev+    -- , writeAt -- start writing at the given position+    -- , writeSliceArray+    )+where++import Control.Monad.IO.Class (MonadIO(..))+import Data.Word (Word8)+-- import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Foreign.Ptr (castPtr)+-- import System.IO (Handle, hGetBufSome, hPutBuf)+import System.IO (IOMode)+import Prelude hiding (read)++import qualified GHC.IO.FD as FD+import qualified GHC.IO.Device as RawIO++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)++#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 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+-------------------------------------------------------------------------------+--+-- 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.++-------------------------------------------------------------------------------+-- Handles+-------------------------------------------------------------------------------++-- XXX attach a finalizer+-- | A 'Handle' is returned by 'openFile' and is subsequently used to perform+-- read and write operations on a file.+--+newtype Handle = Handle FD.FD++-- | File handle for standard input+stdin :: Handle+stdin = Handle FD.stdin++-- | File handle for standard output+stdout :: Handle+stdout = Handle FD.stdout++-- | File handle for standard error+stderr :: Handle+stderr = Handle FD.stderr++-- XXX we can support all the flags that the "open" system call supports.+-- Instead of using RTS locking mechanism can we use system provided locking+-- instead?+--+-- | Open a file that is not a directory and return a file handle.+-- 'openFile' enforces a multiple-reader single-writer locking on files. That+-- is, there may either be many handles on the same file which manage input, or+-- just one handle on the file which manages output. If any open handle is+-- managing a file for output, no new handle can be allocated for that file. If+-- any open handle is managing a file for input, new handles can only be+-- allocated if they do not manage output. Whether two files are the same is+-- implementation-dependent, but they should normally be the same if they have+-- the same absolute path name and neither has been renamed, for example.+--+openFile :: FilePath -> IOMode -> IO Handle+openFile path mode = Handle . fst <$> FD.openFile path mode True++-------------------------------------------------------------------------------+-- Array IO (Input)+-------------------------------------------------------------------------------++-- | Read a 'ByteArray' from a file handle. 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. It reads a maximum+-- of up to the size requested.+{-# INLINABLE readArrayUpto #-}+readArrayUpto :: Int -> Handle -> IO (Array Word8)+readArrayUpto size (Handle fd) = do+    arr <-+        MArray.unsafeCreateWithPtr' size $ \p ->+             -- n <- hGetBufSome h p size+#if MIN_VERSION_base(4,15,0)+            RawIO.read fd p 0 size+#else+            RawIO.read fd p size+#endif+    -- XXX shrink only if the diff is significant+    -- Use unsafeFreezeWithShrink+    pure $ unsafeFreeze arr++-------------------------------------------------------------------------------+-- Array IO (output)+-------------------------------------------------------------------------------++-- | Write an 'Array' to a file handle.+--+-- @since 0.7.0+{-# INLINABLE writeArray #-}+writeArray :: Unbox a => Handle -> Array a -> IO ()+writeArray _ arr | A.length arr == 0 = return ()+writeArray (Handle fd) arr =+    unsafePinnedAsPtr arr $ \p ->+    -- RawIO.writeAll fd (castPtr p) aLen+#if MIN_VERSION_base(4,15,0)+    RawIO.write fd (castPtr p) 0 aLen+#else+    RawIO.write fd (castPtr p) aLen+#endif+    {-+    -- Experiment to compare "writev" based IO with "write" based IO.+    iov <- A.newArray 1+    let iov' = iov {arrEnd = arrBound iov}+    A.writeIndex iov' 0 (RawIO.IOVec (castPtr p) (fromIntegral aLen))+    RawIO.writevAll fd (unsafeForeignPtrToPtr (aStart iov')) 1+    -}+    where+    aLen = byteLength arr++#if !defined(mingw32_HOST_OS)+{-+-- | Write an array of 'IOVec' to a file handle.+--+-- @since 0.7.0+{-# INLINABLE writeIOVec #-}+writeIOVec :: Handle -> Array RawIO.IOVec -> IO ()+writeIOVec _ iov | A.length iov == 0 = return ()+writeIOVec (Handle fd) iov =+    unsafePinnedAsPtr iov $ \p ->+        RawIO.writevAll fd p (A.length iov)+-}+#endif++-------------------------------------------------------------------------------+-- Stream of Arrays IO+-------------------------------------------------------------------------------++-- | @readArraysOfUpto 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 _readArraysOfUpto #-}+_readArraysOfUpto :: (MonadIO m)+    => Int -> Handle -> Stream m (Array Word8)+_readArraysOfUpto size h = S.fromStreamK go+  where+    -- XXX use cons/nil instead+    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 :: (MonadIO m)+    => Int -> Handle -> Stream m (Array Word8)+readArraysOfUpto size h = 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 ()++-- XXX read 'Array a' instead of Word8+--+-- | @readArrays h@ reads a stream of arrays from file handle @h@.+-- The maximum size of a single array is limited to @defaultChunkSize@.+-- 'readArrays' ignores the prevailing 'TextEncoding' and 'NewlineMode'+-- on the 'Handle'.+--+-- > readArrays = readArraysOfUpto defaultChunkSize+--+-- @since 0.7.0+{-# INLINE readArrays #-}+readArrays :: (MonadIO m) => Handle -> Stream m (Array Word8)+readArrays = readArraysOfUpto 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.++-- | @readInChunksOf chunkSize handle@ reads a byte stream from a file handle,+-- reads are performed in chunks of up to @chunkSize@.  The stream ends as soon+-- as EOF is encountered.+--+{-# INLINE readInChunksOf #-}+readInChunksOf :: (MonadIO m) => Int -> Handle -> Stream m Word8+readInChunksOf chunkSize h = AS.concat $ readArraysOfUpto chunkSize h++-- TODO+-- 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+-- stream ends when EOF is encountered.+--+-- @since 0.7.0+{-# INLINE read #-}+read :: (MonadIO m) => Handle -> Stream m Word8+read = AS.concat . readArrays++-------------------------------------------------------------------------------+-- Writing+-------------------------------------------------------------------------------++-- | Write a stream of arrays to a handle.+--+-- @since 0.7.0+{-# INLINE writeArrays #-}+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+-- be smaller than that as we do not split the arrays to fit them to the+-- specified size.+--+-- @since 0.7.0+{-# INLINE writeArraysPackedUpto #-}+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 -> Stream m (Array RawIO.IOVec) -> m ()+writev h = S.mapM_ (liftIO . writeIOVec h)++-- XXX this is incomplete+-- | Write a stream of arrays to a handle after grouping them in 'IOVec' arrays+-- of up to a maximum total size. Writes are performed using gather IO via+-- @writev@ system call. The maximum number of entries in each 'IOVec' group+-- limited to 512.+--+-- @since 0.7.0+{-# INLINE _writevArraysPackedUpto #-}+_writevArraysPackedUpto :: MonadIO 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.+--+-- 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 writeInChunksOf #-}+writeInChunksOf :: MonadIO m => Int -> Handle -> Stream m Word8 -> m ()+writeInChunksOf n h m = writeArrays h $ AS.chunksOf n m++-- > write = 'writeInChunksOf' A.defaultChunkSize+--+-- | Write a byte stream to a file handle. Combines the bytes in chunks of size+-- up to 'A.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 write #-}+write :: MonadIO m => Handle -> Stream m Word8 -> m ()+write = writeInChunksOf defaultChunkSize++{-+{-# INLINE write #-}+write :: (MonadIO m, Unboxed a) => Handle -> Stream m a -> m ()+write = toHandleWith A.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 :: (MonadIO m) => Handle -> Stream m Char+readUtf8 = decodeUtf8 . read++-- |+-- > writeUtf8 h s = write h $ encodeUtf8 s+--+-- Encode a stream of unicode characters to UTF8 and write it to the given file+-- handle. Default block buffering applies to the writes.+--+-- @since 0.7.0+{-# INLINE writeUtf8 #-}+writeUtf8 :: MonadIO m => Handle -> Stream m Char -> m ()+writeUtf8 h s = write h $ encodeUtf8 s++-- | Write a stream of unicode characters after encoding to UTF-8 in chunks+-- separated by a linefeed character @'\n'@. If the size of the buffer exceeds+-- @defaultChunkSize@ and a linefeed is not yet found, the buffer is written+-- anyway.  This is similar to writing to a 'Handle' with the 'LineBuffering'+-- option.+--+-- @since 0.7.0+{-# INLINE writeUtf8ByLines #-}+writeUtf8ByLines :: (MonadIO m) => Handle -> Stream m Char -> m ()+writeUtf8ByLines = undefined++-- | Read UTF-8 lines from a file handle and apply the specified fold to each+-- line. This is similar to reading a 'Handle' with the 'LineBuffering' option.+--+-- @since 0.7.0+{-# INLINE readLines #-}+readLines :: (MonadIO m) => Handle -> Fold m Char b -> Stream m b+readLines h f = foldLines (readUtf8 h) f++-------------------------------------------------------------------------------+-- Framing on a sequence+-------------------------------------------------------------------------------++-- | Read a stream from a file handle and split it into frames delimited by+-- the specified sequence of elements. The supplied fold is applied on each+-- frame.+--+-- @since 0.7.0+{-# INLINE readFrames #-}+readFrames :: (MonadIO m, Unboxed a)+    => Array a -> Handle -> Fold m a b -> Stream m b+readFrames = undefined -- foldFrames . read++-- | Write a stream to the given file handle buffering up to frames separated+-- by the given sequence or up to a maximum of @defaultChunkSize@.+--+-- @since 0.7.0+{-# INLINE writeByFrames #-}+writeByFrames :: (MonadIO m, Unboxed a)+    => Array a -> Handle -> Stream m a -> m ()+writeByFrames = undefined++-------------------------------------------------------------------------------+-- Random Access IO (Seek)+-------------------------------------------------------------------------------++-- XXX handles could be shared, so we may not want to use the handle state at+-- all for these APIs. we can use pread and pwrite instead. On windows we will+-- need to use readFile/writeFile with an offset argument.++-------------------------------------------------------------------------------++-- | Read the element at the given index treating the file as an array.+--+-- @since 0.7.0+{-# INLINE readIndex #-}+readIndex :: Unboxed a => Handle -> Int -> Maybe a+readIndex arr i = undefined++-- NOTE: To represent a range to read we have chosen (start, size) instead of+-- (start, end). This helps in removing the ambiguity of whether "end" is+-- included in the range or not.+--+-- We could avoid specifying the range to be read and instead use "take size"+-- on the stream, but it may end up reading more and then consume it partially.++-- | @readSliceWith chunkSize handle pos len@ reads up to @len@ bytes+-- from @handle@ starting at the offset @pos@ from the beginning of the file.+--+-- Reads are performed in chunks of size @chunkSize@.  For block devices, to+-- avoid reading partial blocks @chunkSize@ must align with the block size of+-- the underlying device. If the underlying block size is unknown, it is a good+-- idea to keep it a multiple 4KiB. This API ensures that the start of each+-- chunk is aligned with @chunkSize@ from second chunk onwards.+--+{-# INLINE readSliceWith #-}+readSliceWith :: (MonadIO m, Unboxed a)+    => Int -> Handle -> Int -> Int -> Stream m a+readSliceWith chunkSize h pos len = undefined++-- | @readSlice h i count@ streams a slice from the file handle @h@ starting+-- at index @i@ and reading up to @count@ elements in the forward direction+-- ending at the index @i + count - 1@.+--+-- @since 0.7.0+{-# INLINE readSlice #-}+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+-- at index @i@ and reading up to @count@ elements in the reverse direction+-- ending at the index @i - count + 1@.+--+-- @since 0.7.0+{-# INLINE readSliceRev #-}+readSliceRev :: (MonadIO m, 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, Unboxed a) => Handle -> Int -> a -> m ()+writeIndex h i a = undefined++-- | @writeSlice h i count stream@ writes a stream to the file handle @h@+-- starting at index @i@ and writing up to @count@ elements in the forward+-- direction ending at the index @i + count - 1@.+--+-- @since 0.7.0+{-# INLINE writeSlice #-}+writeSlice :: (Monad m, Unboxed a)+    => Handle -> Int -> Int -> Stream m a -> m ()+writeSlice h i len s = undefined++-- | @writeSliceRev h i count stream@ writes a stream to the file handle @h@+-- starting at index @i@ and writing up to @count@ elements in the reverse+-- direction ending at the index @i - count + 1@.+--+-- @since 0.7.0+{-# INLINE writeSliceRev #-}+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
@@ -0,0 +1,216 @@+#include "inline.hs"++-- |+-- Module      : Streamly.Internal.FileSystem.FDIO+-- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 1994-2008 The University of Glasgow+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Low level IO routines interfacing the operating system.+--++module Streamly.Internal.FileSystem.FDIO+    ( write+    , writeAll+    , writev+    , writevAll+    )+where++import Control.Monad (when)+import Streamly.Internal.System.IOVec.Type (IOVec)+#if !defined(mingw32_HOST_OS)+import Control.Concurrent (threadWaitWrite)+import Data.Int (Int64)+import Foreign.C.Error (throwErrnoIfMinus1RetryMayBlock)+import Foreign.C.Types (CBool(..))+import System.Posix.Internals (c_write, c_safe_write)+import Streamly.Internal.System.IOVec.Type (c_writev, c_safe_writev)+#endif++import Foreign.C.Types (CSize(..), CInt(..))+import Data.Word (Word8)+import Foreign.Ptr (plusPtr, Ptr)++import GHC.IO.FD (FD(..))++-------------------------------------------------------------------------------+-- IO Routines+-------------------------------------------------------------------------------++-- See System.POSIX.Internals in GHC base package++-------------------------------------------------------------------------------+-- Write without blocking the underlying OS thread+-------------------------------------------------------------------------------++#if !defined(mingw32_HOST_OS)++foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool++isNonBlocking :: FD -> Bool+isNonBlocking fd = fdIsNonBlocking fd /= 0++-- "poll"s the fd for data to become available or timeout+-- See cbits/inputReady.c in base package+foreign import ccall unsafe "fdReady"+    unsafe_fdReady :: CInt -> CBool -> Int64 -> CBool -> IO CInt++writeNonBlocking :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+writeNonBlocking loc !fd !buf !off !len+    | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block+    | otherwise   = do+        let isWrite = 1+            isSocket = 0+            msecs = 0+        r <- unsafe_fdReady (fdFD fd) isWrite msecs isSocket+        when (r == 0) $ threadWaitWrite (fromIntegral (fdFD fd))+        if threaded then safe_write else unsafe_write++    where++    do_write call = fromIntegral `fmap`+                      throwErrnoIfMinus1RetryMayBlock loc call+                        (threadWaitWrite (fromIntegral (fdFD fd)))+    unsafe_write  = do_write (c_write (fdFD fd) (buf `plusPtr` off) len)+    safe_write    = do_write (c_safe_write (fdFD fd) (buf `plusPtr` off) len)++writevNonBlocking :: String -> FD -> Ptr IOVec -> Int -> IO CInt+writevNonBlocking loc !fd !iov !cnt+    | isNonBlocking fd = unsafe_write -- unsafe is ok, it can't block+    | otherwise   = do+        let isWrite = 1+            isSocket = 0+            msecs = 0+        r <- unsafe_fdReady (fdFD fd) isWrite msecs isSocket+        when (r == 0) $ threadWaitWrite (fromIntegral (fdFD fd))+        if threaded then safe_write else unsafe_write++    where++    do_write call = fromIntegral `fmap`+                      throwErrnoIfMinus1RetryMayBlock loc call+                        (threadWaitWrite (fromIntegral (fdFD fd)))+    unsafe_write  = do_write (c_writev (fdFD fd) iov (fromIntegral cnt))+    safe_write    = do_write (c_safe_writev (fdFD fd) iov (fromIntegral cnt))++#else+writeNonBlocking :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+writeNonBlocking = undefined++writevNonBlocking :: String -> FD -> Ptr IOVec -> Int -> IO CInt+writevNonBlocking = undefined+#endif++-- Windows code is disabled for now+#if 0++#if defined(mingw32_HOST_OS)+# if defined(i386_HOST_ARCH)+#  define WINDOWS_CCONV stdcall+# elif defined(x86_64_HOST_ARCH)+#  define WINDOWS_CCONV ccall+# else+#  error Unknown mingw32 arch+# endif+#endif++foreign import WINDOWS_CCONV safe "recv"+   c_safe_recv :: CInt -> Ptr Word8 -> CInt -> CInt{-flags-} -> IO CInt++foreign import WINDOWS_CCONV safe "send"+   c_safe_send :: CInt -> Ptr Word8 -> CInt -> CInt{-flags-} -> IO CInt++blockingWriteRawBufferPtr :: String -> FD -> Ptr Word8-> Int -> CSize -> IO CInt+blockingWriteRawBufferPtr loc !fd !buf !off !len+  = throwErrnoIfMinus1Retry loc $ do+        let start_ptr = buf `plusPtr` off+            send_ret = c_safe_send  (fdFD fd) start_ptr (fromIntegral len) 0+            write_ret = c_safe_write (fdFD fd) start_ptr (fromIntegral len)+        r <- bool write_ret send_ret (fdIsSocket fd)+        when (r == -1) c_maperrno+        return r+      -- We don't trust write() to give us the correct errno, and+      -- instead do the errno conversion from GetLastError()+      -- ourselves. The main reason is that we treat ERROR_NO_DATA+      -- (pipe is closing) as EPIPE, whereas write() returns EINVAL+      -- for this case. We need to detect EPIPE correctly, because it+      -- shouldn't be reported as an error when it happens on stdout.+      -- As for send()'s case, Winsock functions don't do errno+      -- conversion in any case so we have to do it ourselves.+      -- That means we're doing the errno conversion no matter if the+      -- fd is from a socket or not.++-- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.+-- These calls may block, but that's ok.++asyncWriteRawBufferPtr :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+asyncWriteRawBufferPtr loc !fd !buf !off !len = do+    (l, rc) <- asyncWrite (fromIntegral (fdFD fd)) (fdIsSocket_ fd)+                  (fromIntegral len) (buf `plusPtr` off)+    if l == (-1)+      then let sock_errno = c_maperrno_func (fromIntegral rc)+               non_sock_errno = Errno (fromIntegral rc)+               errno = bool non_sock_errno sock_errno (fdIsSocket fd)+           in  ioError (errnoToIOError loc errno Nothing Nothing)+      else return (fromIntegral l)++writeNonBlocking :: String -> FD -> Ptr Word8 -> Int -> CSize -> IO CInt+writeNonBlocking loc !fd !buf !off !len+    | threaded  = blockingWriteRawBufferPtr loc fd buf off len+    | otherwise = asyncWriteRawBufferPtr    loc fd buf off len++#endif++-- | @write FD buffer offset length@ tries to write data on the given+-- filesystem fd (cannot be a socket) up to sepcified length starting from the+-- given offset in the buffer. The write will not block the OS thread, it may+-- suspend the Haskell thread until write can proceed.  Returns the actual+-- amount of data written.+write :: FD -> Ptr Word8 -> Int -> CSize -> IO CInt+write = writeNonBlocking "Streamly.Internal.FileSystem.FDIO"++-- XXX sendAll for sockets has a similar code, we can deduplicate the two.+-- XXX we need to check the errno to determine if the loop should continue. For+-- example, write may return without writing all data if the process file-size+-- limit has reached, in that case keep writing in a loop is fruitless.+--+-- | Keep writing in a loop until all data in the buffer has been written.+writeAll :: FD -> Ptr Word8 -> Int -> IO ()+writeAll fd ptr bytes = do+    res <- write fd ptr 0 (fromIntegral bytes)+    let res' = fromIntegral res+    when (res' < bytes) $+      writeAll fd (ptr `plusPtr` res') (bytes - res')++-------------------------------------------------------------------------------+-- Vector IO+-------------------------------------------------------------------------------++-- | @write FD iovec count@ tries to write data on the given filesystem fd+-- (cannot be a socket) from an iovec with specified number of entries.  The+-- write will not block the OS thread, it may suspend the Haskell thread until+-- write can proceed.  Returns the actual amount of data written.+writev :: FD -> Ptr IOVec -> Int -> IO CInt+writev = writevNonBlocking "Streamly.Internal.FileSystem.FDIO"++-- XXX incomplete+-- | Keep writing an iovec in a loop until all the iovec entries are written.+writevAll :: FD -> Ptr IOVec -> Int -> IO ()+writevAll fd iovec count = do+    _res <- writev fd iovec count+    {-+    let res' = fromIntegral res+    totalBytes = countIOVecBytes+    if res' < totalBytes+     then do+        let iovec' = createModifiedIOVec+            count' = ...+        writeAll fd iovec' count'+     else return ()+    -}+    return ()
+ src/Streamly/Internal/Network/Inet/TCP.hs view
@@ -0,0 +1,509 @@+-- |+-- Module      : Streamly.Internal.Network.Inet.TCP+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Combinators to build Inet/TCP clients and servers.++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+    -- ** Streams+      accept+    , acceptLocal+    , acceptOnAddr+    , acceptOnAddrWith++    -- ** Unfolds+    , acceptor+    , acceptorLocal+    , acceptorWith+    , acceptorOnAddr+    , acceptorOnAddrWith++    -- * TCP clients+    -- | IP Address based operations.+    , connect+    , withConnectionM++    -- ** Unfolds+    , usingConnection+    , reader++    -- ** Streams+    , withConnection+    -- *** Source+    , read+    -- , readUtf8+    -- , readLines+    -- , readFrames+    -- , readByChunks++    -- -- * Array Read+    -- , readArrayUpto+    -- , readArrayOf++    -- , readChunksUpto+    -- , readChunksOf+    -- , readChunks++    -- *** Sink+    , write+    -- , writeUtf8+    -- , writeUtf8ByLines+    -- , writeByFrames+    , writeWithBufferOf+    , putBytes+    , putBytesWithBufferOf++    -- -- * Array Write+    -- , writeArray+    , writeChunks+    , putChunks++    -- ** Transformation+    , pipeBytes+    , pipeChunks+    {-+    -- ** Sink Servers++    -- These abstractions can be applied to any setting where we need to do a+    -- sink processing of multiple streams e.g. output from multiple processes+    -- or data coming from multiple files.++    -- handle connections concurrently using a specified fold+    -- , handleConnections++    -- handle frames concurrently using a specified fold+    , handleFrames++    -- merge frames from all connection into a single stream. Frames can be+    -- created by a specified fold.+    , mergeFrames++    -- * UDP Servers+    , 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(..))+import Data.Word (Word8)+import Network.Socket+       (Socket, PortNumber, SocketOption(..), Family(..), SockAddr(..),+        SocketType(..), defaultProtocol, maxListenQueue, tupleToHostAddress,+        socket)+import Prelude hiding (read)++import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Control.ForkLifted (fork)+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.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.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 acceptorOnAddrWith #-}+acceptorOnAddrWith+    :: MonadIO m+    => [(SocketOption, Int)]+    -> Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket+acceptorOnAddrWith opts = UF.lmap f ISK.acceptor+    where+    f (addr, port) =+        (maxListenQueue+        , SockSpec+            { sockFamily = AF_INET+            , sockType = Stream+            , sockProto = defaultProtocol -- TCP+            , sockOpts = opts+            }+        , SockAddrInet port (tupleToHostAddress addr)+        )++-- | Unfold a tuple @(ipAddr, port)@ into a stream of connected TCP sockets.+-- @ipAddr@ is the local IP address and @port@ is the local port on which+-- connections are accepted.+--+{-# INLINE acceptorOnAddr #-}+acceptorOnAddr+    :: MonadIO m+    => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket+acceptorOnAddr = acceptorOnAddrWith []++{-# INLINE acceptorWith #-}+acceptorWith :: MonadIO m+    => [(SocketOption, Int)]+    -> Unfold m PortNumber Socket+acceptorWith opts = UF.first (0,0,0,0) (acceptorOnAddrWith opts)++-- | 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.+--+-- >>> acceptor = Unfold.first (0,0,0,0) TCP.acceptorOnAddr+--+{-# INLINE acceptor #-}+acceptor :: MonadIO m => Unfold m PortNumber Socket+acceptor = UF.first (0,0,0,0) acceptorOnAddr++{-# 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.+--+-- >>> acceptorLocal = Unfold.first (127,0,0,1) TCP.acceptorOnAddr+--+{-# 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)+-------------------------------------------------------------------------------++-- | 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+    -> Stream m Socket+acceptOnAddrWith opts addr port =+    ISK.accept maxListenQueue SockSpec+        { sockFamily = AF_INET+        , sockType = Stream+        , sockProto = defaultProtocol+        , sockOpts = opts+        }+        (SockAddrInet port (tupleToHostAddress addr))++-- | Like 'accept' but binds on the specified IPv4 address.+--+-- >>> acceptOnAddr = TCP.acceptOnAddrWith []+--+-- /Pre-release/+{-# INLINE acceptOnAddr #-}+acceptOnAddr+    :: MonadIO m+    => (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> Stream m Socket+acceptOnAddr = acceptOnAddrWith []++-- | 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.+--+-- >>> accept = TCP.acceptOnAddr (0,0,0,0)+--+-- /Pre-release/+{-# INLINE accept #-}+accept :: MonadIO m => PortNumber -> Stream m Socket+accept = acceptOnAddr (0,0,0,0)++-- | 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.+--+-- >>> acceptLocal = TCP.acceptOnAddr (127,0,0,1)+--+-- /Pre-release/+{-# INLINE acceptLocal #-}+acceptLocal :: MonadIO m => PortNumber -> Stream m Socket+acceptLocal = acceptOnAddr (127,0,0,1)++-------------------------------------------------------------------------------+-- TCP Clients+-------------------------------------------------------------------------------++-- | Connect to the specified IP address and port number. Returns a connected+-- socket or throws an exception.+--+connect :: (Word8, Word8, Word8, Word8) -> PortNumber -> IO Socket+connect addr port = do+    sock <- socket AF_INET Stream defaultProtocol+    Net.connect sock (SockAddrInet port (Net.tupleToHostAddress addr))+        `onException` Net.close sock+    return sock++-- | Connect to a remote host using IP address and port and run the supplied+-- action on the resulting socket.  'withConnectionM' makes sure that the+-- socket is closed on normal termination or in case of an exception.  If+-- closing the socket raises an exception, then this exception will be raised+-- by 'withConnectionM'.+--+-- /Pre-release/+{-# INLINABLE withConnectionM #-}+withConnectionM :: (MonadMask m, MonadIO m)+    => (Word8, Word8, Word8, Word8) -> PortNumber -> (Socket -> m ()) -> m ()+withConnectionM addr port =+    bracket (liftIO $ connect addr port) (liftIO . Net.close)++-------------------------------------------------------------------------------+-- Connect (unfolds)+-------------------------------------------------------------------------------++-- | Transform an 'Unfold' from a 'Socket' to an unfold from a remote IP+-- address and port. The resulting unfold opens a socket, uses it using the+-- supplied unfold and then makes sure that the socket is closed on normal+-- termination or in case of an exception.  If closing the socket raises an+-- exception, then this exception will be raised by 'usingConnection'.+--+-- /Pre-release/+{-# INLINE usingConnection #-}+usingConnection :: (MonadCatch m, MonadAsync m)+    => Unfold m Socket a+    -> Unfold m ((Word8, Word8, Word8, Word8), PortNumber) a+usingConnection = UF.bracketIO (\(addr, port) -> connect addr port) Net.close++-------------------------------------------------------------------------------+-- Connect (streams)+-------------------------------------------------------------------------------++-- | @'withConnection' addr port act@ opens a connection to the specified IPv4+-- host address and port and passes the resulting socket handle to the+-- computation @act@.  The handle will be closed on exit from 'withConnection',+-- whether by normal termination or by raising an exception.  If closing the+-- handle raises an exception, then this exception will be raised by+-- 'withConnection' rather than any exception raised by 'act'.+--+-- /Pre-release/+{-# INLINE withConnection #-}+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+-------------------------------------------------------------------------------++-- | Read a stream from the supplied IPv4 host address and port number.+--+{-# INLINE reader #-}+reader :: (MonadCatch m, MonadAsync m)+    => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Word8+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.+--+-- /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+-------------------------------------------------------------------------------++-- | Write a stream of arrays to the supplied IPv4 host address and port+-- number.+--+-- /Pre-release/+{-# INLINE putChunks #-}+putChunks+    :: (MonadCatch m, MonadAsync m)+    => (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> Stream m (Array Word8)+    -> m ()+putChunks addr port 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.+--+{-# INLINE writeChunks #-}+writeChunks+    :: (MonadIO m, MonadCatch m)+    => (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> Fold m (Array Word8) ()+writeChunks addr port = Fold step initial extract final+    where+    initial = do+        skt <- liftIO (connect addr port)+        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.addOne x fld `MC.onException` liftIO (Net.close skt)+        return $ FL.Partial (Tuple' r skt)++    extract _ = return ()++    final (Tuple' (Fold _ initial1 _ final1) skt) = do+        liftIO $ Net.close skt+        res <- initial1+        case res of+            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.+--+-- /Pre-release/+{-# INLINE putBytesWithBufferOf #-}+putBytesWithBufferOf+    :: (MonadCatch m, MonadAsync m)+    => Int+    -> (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> Stream m Word8+    -> 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.+--+{-# INLINE writeWithBufferOf #-}+writeWithBufferOf+    :: (MonadIO m, MonadCatch m)+    => Int+    -> (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> Fold m Word8 ()+writeWithBufferOf n addr port =+    FL.groupsOf n (A.unsafeCreateOf' n) (writeChunks addr port)++-- | Write a stream to the supplied IPv4 host address and port number.+--+-- /Pre-release/+{-# INLINE putBytes #-}+putBytes :: (MonadCatch m, MonadAsync 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.+--+{-# INLINE write #-}+write :: (MonadIO m, MonadCatch m)+    => (Word8, Word8, Word8, Word8) -> PortNumber -> Fold m Word8 ()+write = writeWithBufferOf defaultChunkSize++-------------------------------------------------------------------------------+-- Transformations+-------------------------------------------------------------------------------++{-# INLINE withInputConnect #-}+withInputConnect+    :: (MonadCatch m, MonadAsync m)+    => (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> 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 (fwrite sk input)+        return (sk, tid)++    handler (sk, _) = fread sk++    -- XXX kill the thread immediately?+    post (sk, _) = liftIO $ Net.close sk++-- | Send an input stream to a remote host and produce the output stream from+-- the host. The server host just acts as a transformation function on the+-- input stream.  Both sending and receiving happen asynchronously.+--+-- /Pre-release/+--+{-# INLINE pipeBytes #-}+pipeBytes+    :: (MonadAsync m, MonadCatch m)+    => (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> 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
@@ -0,0 +1,539 @@+#include "inline.hs"++-- |+-- Module      : Streamly.Internal.Network.Socket+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Network.Socket+    (+      SockSpec (..)+    -- * Use a socket+    , forSocketM+    , withSocket++    -- * Accept connections+    , accept+    , acceptor++    -- * Connect+    , connect+    , connectFrom++    -- * Read from connection+    , getChunk++    -- ** Streams+    , read+    , readWith+    , readChunks+    , readChunksWith++    -- ** Unfolds+    , reader+    , readerWith+    , chunkReader+    , chunkReaderWith++    -- * Write to connection+    , putChunk++    -- ** Folds+    , write+    , writeWith+    , writeChunks+    , writeChunksWith+    , writeMaybesWith++    -- ** Stream writes+    , putChunks+    , putBytesWith+    , putBytes++    -- 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 Data.Maybe (isNothing, fromJust)+import Data.Word (Word8)+import Foreign.Ptr (plusPtr, Ptr, castPtr)+import Streamly.Data.MutByteArray (Unbox)+import Network.Socket+       (Socket, SocketOption(..), Family(..), SockAddr(..),+        ProtocolNumber, withSocketsDo, SocketType(..), socket, bind,+        setSocketOption, sendBuf, recvBuf)+#if MIN_VERSION_network(3,1,0)+import Network.Socket (withFdSocket)+#else+import Network.Socket (fdSocket)+#endif+import Prelude hiding (read)++import qualified Network.Socket as Net++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.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'.+--+{-# INLINE forSocketM #-}+forSocketM :: (MonadMask m, MonadIO m) => (Socket -> m ()) -> Socket -> m ()+forSocketM f sk = finally (f sk) (liftIO (Net.close sk))++-- | Like 'forSocketM' but runs a streaming computation instead of a monadic+-- computation.+--+-- /Inhibits stream fusion/+--+-- /Internal/+{-# INLINE withSocket #-}+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)+-------------------------------------------------------------------------------++-- 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+    {+      sockFamily :: !Family+    , sockType   :: !SocketType+    , sockProto  :: !ProtocolNumber+    , sockOpts   :: ![(SocketOption, Int)]+    }++initListener :: Int -> SockSpec -> SockAddr -> IO Socket+initListener listenQLen SockSpec{..} addr =+  withSocketsDo $ do+    sock <- socket sockFamily sockType sockProto+    use sock `onException` Net.close sock+    return sock++    where++    use sock = do+        mapM_ (\(opt, val) -> setSocketOption sock opt val) sockOpts+        bind sock addr+        Net.listen sock listenQLen++{-# INLINE listenTuples #-}+listenTuples :: MonadIO m+    => Unfold m (Int, SockSpec, SockAddr) (Socket, SockAddr)+listenTuples = Unfold step inject+    where+    inject (listenQLen, spec, addr) =+        liftIO $ initListener listenQLen spec addr++    step listener = do+        r <- liftIO (Net.accept listener `onException` Net.close 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+-- maximum number of pending connections in the backlog. @spec@ is the socket+-- protocol and options specification and @addr@ is the protocol address where+-- the server listens for incoming connections.+--+{-# INLINE acceptor #-}+acceptor :: MonadIO m => Unfold m (Int, SockSpec, SockAddr) Socket+acceptor = fmap fst listenTuples++{-# INLINE connectCommon #-}+connectCommon :: SockSpec -> Maybe SockAddr -> SockAddr -> IO Socket+connectCommon SockSpec{..} local remote = withSocketsDo $ do+    sock <- socket sockFamily sockType sockProto+    use sock `onException` Net.close sock+    return sock++    where++    use sock = do+        mapM_ (\(opt, val) -> setSocketOption sock opt val) sockOpts+        forM_ local (bind sock)+        Net.connect sock remote++-- | Connect to a remote host using the given socket specification and remote+-- address. Returns a connected socket or throws an exception.+--+-- /Pre-release/+--+{-# INLINE connect #-}+connect :: SockSpec -> SockAddr -> IO Socket+connect spec = connectCommon spec Nothing++-- | Connect to a remote host using the given socket specification, a local+-- address to bind to and a remote address to connect to. Returns a connected+-- socket or throws an exception.+--+-- /Pre-release/+--+{-# INLINE connectFrom #-}+connectFrom :: SockSpec -> SockAddr -> SockAddr -> IO Socket+connectFrom spec local = connectCommon spec (Just local)++-------------------------------------------------------------------------------+-- Listen (Streams)+-------------------------------------------------------------------------------++{-# INLINE recvConnectionTuplesWith #-}+recvConnectionTuplesWith :: MonadIO m+    => Int -> SockSpec -> SockAddr -> Stream m (Socket, SockAddr)+recvConnectionTuplesWith tcpListenQ spec addr = S.unfoldrM step Nothing+    where+    step Nothing = do+        listener <- liftIO $ initListener tcpListenQ spec addr+        r <- liftIO (Net.accept listener `onException` Net.close listener)+        return $ Just (r, Just listener)++    step (Just listener) = do+        r <- liftIO (Net.accept listener `onException` Net.close listener)+        return $ Just (r, Just listener)++-- | Start a TCP stream server that listens for connections on the supplied+-- server address specification (address family, local interface IP address and+-- port). The server generates a stream of connected sockets.  The first+-- argument is the maximum number of pending connections in the backlog.+--+-- /Pre-release/+{-# 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)+    -> Int+    -> h+    -> IO (Array Word8)+readArrayUptoWith f size h = do+    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.+--+{-# INLINABLE getChunk #-}+getChunk :: Int -> Socket -> IO (Array Word8)+getChunk = readArrayUptoWith recvBuf++-------------------------------------------------------------------------------+-- Array IO (output)+-------------------------------------------------------------------------------++waitWhen0 :: Int -> Socket -> IO ()+waitWhen0 0 s = when rtsSupportsBoundThreads $+#if MIN_VERSION_network(3,1,0)+    withFdSocket s $ \fd -> threadWaitWrite $ fromIntegral fd+#elif MIN_VERSION_network(3,0,0)+    fdSocket s >>= threadWaitWrite . fromIntegral+#else+    let fd = fdSocket s in threadWaitWrite $ fromIntegral fd+#endif+waitWhen0 _ _ = return ()++sendAll :: Socket -> Ptr Word8 -> Int -> IO ()+sendAll _ _ len | len <= 0 = return ()+sendAll s p len = do+    sent <- sendBuf s p len+    waitWhen0 sent s+    -- assert (sent <= len)+    when (sent >= 0) $ sendAll s (p `plusPtr` sent) (len - sent)++{-# INLINABLE writeArrayWith #-}+writeArrayWith :: Unbox a+    => (h -> Ptr Word8 -> Int -> IO ())+    -> h+    -> Array a+    -> IO ()+writeArrayWith _ _ arr | A.length arr == 0 = return ()+writeArrayWith f h arr =+    A.unsafePinnedAsPtr arr $ \ptr byteLen -> f h (castPtr ptr) byteLen++-- | Write an Array to a socket.+--+{-# INLINABLE putChunk #-}+putChunk :: Unbox a => Socket -> Array a -> IO ()+putChunk = writeArrayWith sendAll++-------------------------------------------------------------------------------+-- Stream of Arrays IO+-------------------------------------------------------------------------------++{-# INLINE _readChunksUptoWith #-}+_readChunksUptoWith :: (MonadIO m)+    => (Int -> h -> IO (Array Word8))+    -> Int -> h -> Stream m (Array Word8)+_readChunksUptoWith f size h = S.fromStreamK go+  where+    -- XXX use cons/nil instead+    go = K.mkStream $ \_ yld _ stp -> do+        arr <- liftIO $ f size h+        if A.length arr == 0+        then stp+        else yld arr go++-- | @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 $ getChunk size h+        return $+            case A.length arr of+                0 -> S.Stop+                _ -> S.Yield arr ()++-- | Read a stream of byte arrays from a socket. The maximum size of a single+-- array is limited to @defaultChunkSize@.+--+-- >>> readChunks = Socket.readChunksWith 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@.+--+{-# 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 $ getChunk size h+        return $+            case A.length arr of+                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.Type.defaultChunkSize'. The+-- size of arrays in the resulting stream are therefore less than or equal to+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'.+--+{-# INLINE chunkReader #-}+chunkReader :: MonadIO m => Unfold m Socket (Array Word8)+chunkReader = UF.first defaultChunkSize chunkReaderWith++-------------------------------------------------------------------------------+-- Read File to Stream+-------------------------------------------------------------------------------++{-# INLINE concatChunks #-}+concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+concatChunks = S.unfoldEach A.reader++-- | Generate a byte stream from a socket using a buffer of the given size.+--+-- /Pre-release/+{-# INLINE readWith #-}+readWith :: MonadIO m => Int -> Socket -> Stream m Word8+readWith size = concatChunks . readChunksWith size++-- | Generate a byte stream from a socket.+--+-- >>> read = Socket.readWith defaultChunkSize+--+-- /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@.+--+{-# 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 = readerWith++-- | Unfolds a 'Socket' into a byte stream.  IO requests to the socket are+-- performed in sizes of+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'.+--+{-# INLINE reader #-}+reader :: MonadIO m => Unfold m Socket Word8+reader = UF.first defaultChunkSize readerWith++-------------------------------------------------------------------------------+-- Writing+-------------------------------------------------------------------------------++-- | Write a stream of arrays to a handle.+--+{-# INLINE putChunks #-}+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.+--+{-# INLINE writeChunks #-}+writeChunks :: (MonadIO m, Unbox a) => Socket -> Fold m (Array a) ()+writeChunks h = FL.drainMapM (liftIO . putChunk h)++-- | @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.+--+{-# 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, Unbox a)+    => Int -> Socket -> Fold m (Array a) ()+writeChunksWithBufferOf = writeChunksWith++-- GHC buffer size dEFAULT_FD_BUFFER_SIZE=8192 bytes.+--+-- XXX test this+-- Note that if you use a chunk size less than 8K (GHC's default buffer+-- size) then you are advised to use 'NOBuffering' mode on the 'Handle' in case you+-- do not want buffering to occur at GHC level as well. Same thing applies to+-- writes as well.++-- | 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.+--+{-# 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.+--+{-# 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 = 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 writeMaybesWith #-}+writeMaybesWith :: (MonadIO m )+    => Int -> Socket -> Fold m (Maybe Word8) ()+writeMaybesWith n h =+    let writeNJusts = FL.lmap fromJust $ A.createOf' n+        writeOnNothing = FL.takeEndBy_ isNothing writeNJusts+    in FL.many writeOnNothing (writeChunks h)++-- | 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.+--+{-# INLINE putBytes #-}+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 = Socket.writeWith defaultChunkSize+--+{-# INLINE write #-}+write :: MonadIO m => Socket -> Fold m Word8 ()+write = writeWith defaultChunkSize
+ src/Streamly/Internal/System/IOVec.hs view
@@ -0,0 +1,132 @@+-- |+-- Module      : Streamly.Internal.System.IOVec+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Low level IO routines interfacing the operating system.+--++module Streamly.Internal.System.IOVec+    ( IOVec(..)+    , c_writev+    , c_safe_writev+#if !defined(mingw32_HOST_OS)+{-+    , groupIOVecsOf+    , groupIOVecsOfMut+-}+#endif+    )+where++#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.MutArray (length)+import Streamly.Internal.Data.SVar.Type (adaptState)+import Streamly.Internal.Data.MutArray (Array(..))++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++import Prelude hiding (length)++#if !defined(mingw32_HOST_OS)+{-+data GatherState s arr+    = GatherInitial s+    | GatherBuffering s arr Int+    | GatherYielding arr (GatherState s arr)+    | GatherFinish++-- | @groupIOVecsOf maxBytes maxEntries@ groups arrays in the incoming stream+-- to create a stream of 'IOVec' arrays with a maximum of @maxBytes@ bytes in+-- each array and a maximum of @maxEntries@ entries in each array.+--+-- @since 0.7.0+{-# INLINE_NORMAL groupIOVecsOfMut #-}+groupIOVecsOfMut :: MonadIO m+    => Int -> Int -> D.Stream m (Array a) -> D.Stream m (Array IOVec)+groupIOVecsOfMut n maxIOVLen (D.Stream step state) =+    D.Stream step' (GatherInitial state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (GatherInitial st) = do+        when (n <= 0) $+            -- XXX we can pass the module string from the higher level API+            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.MutArray.Type.groupIOVecsOf: the number of "+                 ++ "IOVec entries [" ++ show n ++ "] must be a natural number"+        r <- step (adaptState gst) st+        case r of+            D.Yield arr s -> do+                let p = arrStart arr+                    len = MArray.byteLength arr+                iov <- liftIO $ MArray.newArray maxIOVLen+                iov' <- liftIO $ MArray.snocUnsafe iov (IOVec (castPtr p)+                                                (fromIntegral len))+                if len >= n+                then return $ D.Skip (GatherYielding iov' (GatherInitial s))+                else return $ D.Skip (GatherBuffering s iov' len)+            D.Skip s -> return $ D.Skip (GatherInitial s)+            D.Stop -> return D.Stop++    step' gst (GatherBuffering st iov len) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield arr s -> do+                let p = arrStart arr+                    alen = MArray.byteLength arr+                    len' = len + alen+                if len' > n || length iov >= maxIOVLen+                then do+                    iov' <- liftIO $ MArray.newArray maxIOVLen+                    iov'' <- liftIO $ MArray.snocUnsafe iov' (IOVec (castPtr p)+                                                      (fromIntegral alen))+                    return $ D.Skip (GatherYielding iov+                                        (GatherBuffering s iov'' alen))+                else do+                    iov' <- liftIO $ MArray.snocUnsafe iov (IOVec (castPtr p)+                                                    (fromIntegral alen))+                    return $ D.Skip (GatherBuffering s iov' len')+            D.Skip s -> return $ D.Skip (GatherBuffering s iov len)+            D.Stop -> return $ D.Skip (GatherYielding iov GatherFinish)++    step' _ GatherFinish = return D.Stop++    step' _ (GatherYielding iov next) = return $ D.Yield iov next++-- | @groupIOVecsOf maxBytes maxEntries@ groups arrays in the incoming stream+-- to create a stream of 'IOVec' arrays with a maximum of @maxBytes@ bytes in+-- each array and a maximum of @maxEntries@ entries in each array.+--+-- @since 0.7.0+{-# INLINE_NORMAL groupIOVecsOf #-}+groupIOVecsOf :: MonadIO m+    => Int+    -> Int+    -> D.Stream m (Array.Array a) -> D.Stream m (Array.Array IOVec)+groupIOVecsOf n maxIOVLen str =+    D.map Array.unsafeFreeze+        $ groupIOVecsOfMut n maxIOVLen+        $ D.map Array.unsafeThaw str+-}+#endif
+ src/Streamly/Internal/System/IOVec/Type.hsc view
@@ -0,0 +1,83 @@+#include "MachDeps.h"++-- |+-- Module      : Streamly.Internal.System.IOVec.Type+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Low level IO routines interfacing the operating system.+--++module Streamly.Internal.System.IOVec.Type+    ( IOVec(..)+    , c_writev+    , c_safe_writev+    )+where+++import Data.Word (Word8)+#if (WORD_SIZE_IN_BITS == 32)+import Data.Word (Word32)+#else+import Data.Word (Word64)+#endif+import Foreign.C.Types (CInt(..))+import Foreign.Ptr (Ptr)+import System.Posix.Types (CSsize(..))+#if !defined(mingw32_HOST_OS)+import Foreign.Storable (Storable(..))+#endif++-------------------------------------------------------------------------------+-- IOVec+-------------------------------------------------------------------------------++data IOVec = IOVec+  { iovBase :: {-# UNPACK #-} !(Ptr Word8)+#if (WORD_SIZE_IN_BITS == 32)+  , iovLen  :: {-# UNPACK #-} !Word32+#else+  , iovLen  :: {-# UNPACK #-} !Word64+#endif+  } deriving (Eq, Show)++#if !defined(mingw32_HOST_OS)++#include <sys/uio.h>++instance Storable IOVec where+  sizeOf _ = #{size struct iovec}+  alignment _ = #{alignment struct iovec}+  peek ptr = do+      base <- #{peek struct iovec, iov_base} ptr+      len  :: #{type size_t} <- #{peek struct iovec, iov_len}  ptr+      return $ IOVec base len+  poke ptr vec = do+      let base = iovBase vec+          len  :: #{type size_t} = iovLen vec+      #{poke struct iovec, iov_base} ptr base+      #{poke struct iovec, iov_len}  ptr len+#endif++-- capi calling convention does not work without -fobject-code option with GHCi+-- so using this in DEVBUILD only for now.+--+#if !defined(mingw32_HOST_OS) && defined DEVBUILD+foreign import capi unsafe "sys/uio.h writev"+   c_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize++foreign import capi safe "sys/uio.h writev"+   c_safe_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize++#else+c_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize+c_writev = error "writev not implemented"++c_safe_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize+c_safe_writev = error "writev not implemented"+#endif
+ src/Streamly/Internal/Unicode/Char.hs view
@@ -0,0 +1,328 @@+-- |+-- Module      : Streamly.Internal.Unicode.Char+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD-3-Clause+-- 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 -- XXX Remove or move to unicode-data++    -- XXX move to Unicode.Char.Case?+    -- * Unicode aware operations+    {-+      toCaseFold+    , toLower+    , toUpper+    , toTitle+    -}++    -- XXX Move to Unicode.Stream.Normalize or Unicode.Normalize?+    -- * Unicode normalization+    , NormalizationMode(..)+    , normalize+    )+where++#include "inline.hs"++import Data.Char (isAsciiUpper, isAsciiLower, chr, ord)+import Unicode.Char (DecomposeMode(..))+import Streamly.Internal.Data.Stream (Stream(..), Step (..))++import qualified Unicode.Char as Char++-------------------------------------------------------------------------------+-- Unicode aware operations on strings+-------------------------------------------------------------------------------++-- | Select alphabetic characters in the ascii character set.+--+-- /Pre-release/+--+{-# INLINE isAsciiAlpha #-}+isAsciiAlpha :: Char -> Bool+isAsciiAlpha c = isAsciiUpper c || isAsciiLower c++-------------------------------------------------------------------------------+-- Unicode aware operations on strings+-------------------------------------------------------------------------------++{-+-- |+-- /undefined/+toCaseFold :: IsStream t => Char -> t m Char+toCaseFold = undefined++-- |+-- /undefined/+toLower :: IsStream t => Char -> t m Char+toLower = undefined++-- |+-- /undefined/+toUpper :: IsStream t => Char -> t m Char+toUpper = undefined++-- |+-- /undefined/+toTitle :: IsStream t => Char -> t m Char+toTitle = undefined+-}++-------------------------------------------------------------------------------+-- Unicode normalization+-------------------------------------------------------------------------------++data NormalizationMode+    = NFD    -- ^ Canonical decomposition.+    | NFKD   -- ^ Compatibility decomposition.+    | NFC    -- ^ Canonical decomposition followed by canonical composition.+    | NFKC   -- ^ Compatibility decomposition followed by canonical composition.+      deriving (Eq, Show, Enum)++-------------------------------------------------------------------------------+-- Normalization combinators+-------------------------------------------------------------------------------++type ReBuf = [Char]++{-# INLINE insertIntoReBuf #-}+insertIntoReBuf :: Char -> ReBuf -> ReBuf+insertIntoReBuf c [] = [c]+insertIntoReBuf c xxs@(x:xs)+    | Char.combiningClass c < Char.combiningClass x = c : xxs+    | otherwise = x : insertIntoReBuf c xs++-- {-# ANN type DecomposeState Fuse #-}+data DecomposeState st+    = YieldCharList [Char] (DecomposeState st)+    | ReadInputChar ReBuf st+    | IsHangul Char st+    | IsDecomposable [Char] ReBuf st+    | DecomposeStop++{-# INLINE_NORMAL decomposeD #-}+decomposeD ::+       Monad m => Bool -> DecomposeMode -> Stream m Char -> Stream m Char+decomposeD decomposeHangul mode (Stream step state) =+    Stream sstep (ReadInputChar [] state)++    where++    {-# INLINE_LATE sstep #-}+    -- XXX Does this cause any problem?+    sstep _ (YieldCharList [] ns) = return $ Skip ns+    sstep _ (YieldCharList (ch:chs) ns) =+        return $ Yield ch (YieldCharList chs ns)+    sstep gst (ReadInputChar rebuf st) = do+        res <- step gst st+        return+          $ Skip+          $ case res of+                Yield ch st1+                    | Char.isHangul ch ->+                        if decomposeHangul+                        then YieldCharList rebuf (IsHangul ch st1)+                        else YieldCharList+                                 (rebuf ++ [ch])+                                 (ReadInputChar [] st1)+                    | Char.isDecomposable mode ch ->+                        IsDecomposable (Char.decompose mode ch) rebuf st1+                    | otherwise ->+                        if Char.isCombining ch+                        then ReadInputChar (insertIntoReBuf ch rebuf) st1+                        else YieldCharList+                                 (rebuf ++ [ch])+                                 (ReadInputChar [] st1)+                Skip st1 -> ReadInputChar rebuf st1+                Stop -> YieldCharList rebuf DecomposeStop+    sstep _ (IsHangul ch st) =+        return+          $ Skip+          $ let (l, v, t) = Char.decomposeHangul ch+             in if t == chr Char.jamoTFirst+                then YieldCharList [l, v] (ReadInputChar [] st)+                else YieldCharList [l, v, t] (ReadInputChar [] st)+    sstep _ (IsDecomposable [] rebuf st) =+        return $ Skip $ ReadInputChar rebuf st+    sstep _ (IsDecomposable (ch:chs) rebuf st)+        | Char.isDecomposable mode ch =+            return+              $ Skip $ IsDecomposable (Char.decompose mode ch ++ chs) rebuf st+        | otherwise =+            return+              $ Skip+              $ if Char.isCombining ch+                then IsDecomposable chs (insertIntoReBuf ch rebuf) st+                else YieldCharList (rebuf ++ [ch]) (IsDecomposable chs [] st)+    sstep _ DecomposeStop = return Stop++-- Hold an L to wait for V, hold an LV to wait for T.+data JamoBuf+    = Jamo !Char -- Jamo L, V or T+    | Hangul !Char -- Hangul Syllable LV or LVT+    | HangulLV !Char++{-# INLINE fromJamoBuf #-}+fromJamoBuf :: JamoBuf -> Char+fromJamoBuf (Jamo ch) = ch+fromJamoBuf (Hangul ch) = ch+fromJamoBuf (HangulLV ch) = ch++-- {-# ANN type ComposeState Fuse #-}+data ComposeState st+    = YieldChar Char (ComposeState st)+    | YieldList [Char] (ComposeState st)+    | ComposeNone st+    | ComposeReg Int [Char] st+    | ComposeJamo JamoBuf st+    | ComposeStop++-- Assumes every character except hangul characters are fully decomposed and the+-- combining characters are reordered. Hangul characters may or may not be+-- decomposed.+{-# INLINE_EARLY partialComposeD #-}+partialComposeD :: Monad m => Stream m Char -> Stream m Char+partialComposeD (Stream step state) = Stream step' (ComposeNone state)++    where++    {-# INLINE_NORMAL step' #-}+    step' _ ComposeStop = return Stop+    step' _ (YieldChar ch ns) = return $ Yield ch ns+    step' _ (YieldList [] ns) = return $ Skip ns+    step' _ (YieldList (x:xs) ns) = return $ Yield x $ YieldList xs ns+    step' gst (ComposeNone st) = do+        r <- step gst st+        return+          $ case r of+                Yield x st1 -> Skip $ composeNone x st1+                Skip st1 -> Skip $ ComposeNone st1+                Stop -> Stop+    step' gst (ComposeJamo jbuf st) = do+        r <- step gst st+        return+          $ case r of+                Yield x st1 -> Skip $ composeJamo jbuf x st1+                Skip st1 -> Skip $ ComposeJamo jbuf st1+                Stop -> Skip $ YieldChar (fromJamoBuf jbuf) ComposeStop+    step' gst (ComposeReg i rbuf st) = do+        r <- step gst st+        return+          $ case r of+                Yield x st1 -> Skip $ composeReg i rbuf x st1+                Skip st1 -> Skip $ ComposeReg i rbuf st1+                Stop -> Skip $ YieldList rbuf ComposeStop++    {-# INLINE initHangul #-}+    initHangul c = ComposeJamo (Hangul c)++    {-# INLINE initJamo #-}+    initJamo c = ComposeJamo (Jamo c)++    {-# INLINE initReg #-}+    initReg !c = ComposeReg 0 [c]++    {-# INLINE composeNone #-}+    composeNone ch st+        | Char.isHangul ch = initHangul ch st+        | Char.isJamo ch = initJamo ch st+        | otherwise = initReg ch st++    {-# INLINE composeCharHangul #-}+    composeCharHangul jbuf ch st =+        YieldChar (fromJamoBuf jbuf) $ ComposeJamo (Hangul ch) st++    {-# INLINE composeCharJamo #-}+    composeCharJamo jbuf ch st+        | ich <= Char.jamoLLast =+            YieldChar (fromJamoBuf jbuf) $ ComposeJamo (Jamo ch) st+        | ich < Char.jamoVFirst = flushAndWrite jbuf ch st+        | ich <= Char.jamoVLast =+            case jbuf of+                Jamo c ->+                    case Char.jamoLIndex c of+                        Just li ->+                            let vi = ich - Char.jamoVFirst+                                lvi = li * Char.jamoNCount + vi * Char.jamoTCount+                                lv = chr (Char.hangulFirst + lvi)+                             in ComposeJamo (HangulLV lv) st+                        Nothing -> writeTwo c ch st+                Hangul c -> writeTwo c ch st+                HangulLV c -> writeTwo c ch st+        | ich <= Char.jamoTFirst = flushAndWrite jbuf ch st+        | otherwise = do+            let ti = ich - Char.jamoTFirst+            case jbuf of+                Jamo c -> writeTwo c ch st+                Hangul c+                    | Char.isHangulLV c -> writeLVT c ti st+                    | otherwise -> writeTwo c ch st+                HangulLV c -> writeLVT c ti st++        where++        flushAndWrite jb c s = YieldList [fromJamoBuf jb, c] $ ComposeNone s++        writeLVT lv ti s =+            let lvt = chr $ ord lv + ti+             in YieldChar lvt $ ComposeNone s++        writeTwo c1 c2 s = YieldList [c1, c2] $ ComposeNone s++        ich = ord ch++    {-# INLINE composeJamo #-}+    composeJamo jbuf ch st+        | Char.isJamo ch = composeCharJamo jbuf ch st+        | Char.isHangul ch = composeCharHangul jbuf ch st+        | otherwise = YieldChar (fromJamoBuf jbuf) (ComposeReg 0 [ch] st)++    -- i ~ Char.combiningClass (last rbuf)+    {-# INLINE composeCharCombining #-}+    composeCharCombining i rbuf ch st =+        if cch > i+        then case Char.compose str ch of+                 Nothing -> ComposeReg cch (rbuf ++ [ch]) st+                 Just x -> ComposeReg i (x : tail rbuf) st+        else ComposeReg i (rbuf ++ [ch]) st++        where++        str = head rbuf+        cch = Char.combiningClass ch++    {-# INLINE composeReg #-}+    composeReg i rbuf !ch !st+        | Char.isHangul ch = YieldList rbuf $ initHangul ch st+        | Char.isJamo ch = YieldList rbuf $ initJamo ch st+        | Char.isCombining ch = composeCharCombining i rbuf ch st+        | [s] <- rbuf+        , Char.isCombiningStarter ch+        , Just x <- Char.composeStarters s ch = ComposeReg 0 [x] st+        | otherwise = YieldList rbuf $ ComposeReg 0 [ch] st++normalizeD :: Monad m => NormalizationMode -> Stream m Char -> Stream m Char+normalizeD NFD = decomposeD True Canonical+normalizeD NFKD = decomposeD True Kompat+normalizeD NFC = partialComposeD . decomposeD False Canonical+normalizeD NFKC = partialComposeD . decomposeD False Kompat++normalize ::+       Monad m+    => NormalizationMode+    -> Stream m Char+    -> Stream m Char+normalize = normalizeD
+ src/Streamly/Internal/Unicode/Utf8.hs view
@@ -0,0 +1,73 @@+-- |+-- Module      : Streamly.Internal.Unicode.Utf8+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- 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+      Utf8++    -- * Creation and elimination+    , pack+    , unpack+    , toArray+    )+where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Word (Word8)+import Streamly.Data.Array (Array)+import System.IO.Unsafe (unsafePerformIO)++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++--------------------------------------------------------------------------------+-- Type+--------------------------------------------------------------------------------++-- | A space efficient, packed, unboxed Unicode container.+newtype Utf8 = Utf8 (Array Word8)++--------------------------------------------------------------------------------+-- Functions+--------------------------------------------------------------------------------++{-# INLINE toArray #-}+toArray :: Utf8 -> Array Word8+toArray (Utf8 arr) = arr+++{-# INLINEABLE pack #-}+pack :: String -> Utf8+pack s =+    Utf8+        $ unsafePerformIO+        $ Array.fromStreamN len $ Unicode.encodeUtf8' $ Stream.fromList s++    where++    len = length s++{-# INLINEABLE unpack #-}+unpack :: Utf8 -> String+unpack u =+    unsafePerformIO+        $ Stream.fold Fold.toList $ Unicode.decodeUtf8' $ Array.read $ toArray u
+ src/Streamly/Network/Inet/TCP.hs view
@@ -0,0 +1,92 @@+-- |+-- Module      : Streamly.Network.Server+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- Combinators to build Inet\/IPv4/TCP clients and servers.+--+-- >>> 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+    -- ** Streams+      accept+    , acceptLocal+    , acceptOnAddr+    , acceptOnAddrWith++    -- ** Unfolds+    , acceptor+    , acceptorLocal+    , acceptorOnAddr++    -- * Connect to Servers+    , connect++    {-+    -- XXX Expose this as a pipe when we have pipes.+    -- * Transformation+    -- , pipeBytes++    -- ** Sink Servers++    -- These abstractions can be applied to any setting where we need to do a+    -- sink processing of multiple streams e.g. output from multiple processes+    -- or data coming from multiple files.++    -- handle connections concurrently using a specified fold+    -- , handleConnections++    -- handle frames concurrently using a specified fold+    , handleFrames++    -- merge frames from all connection into a single stream. Frames can be+    -- created by a specified fold.+    , mergeFrames++    -- * UDP Servers+    , datagrams+    , datagramsOn+    -}++    -- * Deprecated+    , acceptorOnPort+    , acceptorOnPortLocal+    )+where++import Streamly.Internal.Network.Inet.TCP
+ src/Streamly/Network/Socket.hs view
@@ -0,0 +1,155 @@+-- |+-- Module      : Streamly.Network.Socket+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- 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 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' 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').+--+-- Following is a short example of a concurrent echo server.  Please note that+-- this example can be written even more succinctly by using higher level+-- operations from "Streamly.Network.Inet.TCP" module.+--+-- >>> :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.Type.defaultChunkSize'.  Unless+-- specified otherwise in the API, writes are collected into chunks of+-- 'Streamly.Internal.System.IO.defaultChunkSize' before they are written to+-- the socket.+--+-- >>> import qualified Streamly.Network.Socket as Socket+--+-- = See Also+--+-- * "Streamly.Internal.Network.Socket"+-- * <http://hackage.haskell.org/package/network network>++-------------------------------------------------------------------------------+-- Internal Notes+-------------------------------------------------------------------------------+--+-- A socket is a handle to a protocol endpoint.+--+-- This module provides APIs to read and write streams and arrays from and to+-- network sockets. Sockets may be connected or unconnected. Connected sockets+-- can only send or recv data to/from the connected endpoint, therefore, APIs+-- for connected sockets do not need to explicitly specify the remote endpoint.+-- APIs for unconnected sockets need to explicitly specify the remote endpoint.+--+-- By design, connected socket IO APIs are similar to+-- "Streamly.Data.Array.Foreign" read write APIs. They are almost identical to the+-- sequential streaming APIs in "Streamly.Internal.FileSystem.File".+--+module Streamly.Network.Socket+    (+    -- * Socket Specification+      SockSpec(..)++    -- * Accept Connections+    , accept+    , acceptor++    -- * Reads+    -- ** Singleton+    , getChunk++    -- ** Streams+    , read+    , readWith+    , readChunks+    , readChunksWith++    -- ** Unfolds+    , reader+    , readerWith+    , chunkReader+    , chunkReaderWith++    -- * Writes+    -- ** Singleton+    , putChunk++    -- ** Folds+    , write+    , writeWith+    , writeChunks+    , 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,1039 +1,1247 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE RankNTypes                #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX--#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -Wno-orphans #-}-#endif--#include "Streams/inline.h"---- |--- Module      : Streamly.Prelude--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC------ This module is designed to be imported qualified:------ @--- import qualified Streamly.Prelude as S--- @------ Functions with the suffix @M@ are general functions that work on monadic--- arguments. The corresponding functions without the suffix @M@ work on pure--- arguments and can in general be derived from their monadic versions but are--- provided for convenience and for consistency with other pure APIs in the--- @base@ package.------ Functions having a 'MonadAsync' constraint work concurrently when used with--- appropriate stream type combinator. Please be careful to not use 'parallely'--- with infinite streams.------ Deconstruction and folds accept a 'SerialT' type instead of a polymorphic--- type to ensure that streams always have a concrete monomorphic type by--- default, reducing type errors. In case you want to use any other type of--- stream you can use one of the type combinators provided in the "Streamly"--- module to convert the stream type.--module Streamly.Prelude-    (-    -- * Construction-    -- | All other stream construction and generation combinators described-    -- later, and even more custom combinators can be expressed in terms of-    -- these primitives. However, the special versions provided in this module-    -- can be more efficient in some situations.--    -- ** From Elements-    -- | Primitives to construct a stream from pure values or monadic actions.-      K.nil-    , K.cons-    , (K..:)-    , consM-    , (|:)-    , yield-    , yieldM--    -- ** From Streams-    -- | You can construct streams by appending or merging existing streams.-    -- When constructing streams from streams, '<>' and 'mempty' are the-    -- intuitive equivalents of 'K.cons' and 'K.nil', respectively. These-    -- primitives can be very useful when constructing your own custom stream-    -- combinators. Also see the variants of '<>' defined in the "Streamly"-    -- module. Note that appending streams is inexpensive, it is much more-    -- efficient than appending lists.--    -- * Generation-    -- ** Unfold and Iterate-    -- | Note that the generative steps of unfold and iterate are inherently-    -- serial as the next step depends on the result of the previous step.-    -- However, consumption of the result from the previous step can happen in-    -- parallel with the generation by the next step.-    , unfoldr-    , unfoldrM-    , iterate-    , iterateM--    -- ** Replicate and Repeat-    -- | Generate a monadic stream from a seed value or function. Note that-    -- these functions can generate a stream fully concurrently as, unlike-    -- unfolds, there is no dependency between steps, therefore, an unbounded-    -- number of steps can run concurrently. All of these can be expressed in-    -- terms of 'K.cons' and 'K.nil' primitives.-    , replicateM-    , K.repeat-    , repeatM--    -- ** Generate From-    -- | Convert an input structure, container or source into a stream. All of-    -- these can be expressed in terms of primitives.-    , fromList-    , fromListM-    , K.fromFoldable-    , fromFoldableM-    , fromHandle--    -- * Deconstruction-    , uncons--    -- * Elimination--    -- ** General Folds-    -- | All the folds can be implemented in terms of 'uncons', however the-    -- specific implementations provided here are generally more efficient.-    -- Folds are inherently serial as each step needs to use the result of-    -- the previous step.-    , foldr-    , foldr1-    , foldrM-    , foldl'-    , foldl1'-    , foldlM'-    , foldx-    , foldxM--    -- ** Specialized Folds-    -- | These folds can be expressed in terms of the general fold routines but-    -- the special versions here can be more efficient in many cases.--    -- Filtering folds: extract parts of the stream-    , head-    , tail-    , last-    , init--    -- Conditional folds: may terminate early based on a condition-    , null-    , elem-    , elemIndex-    , notElem-    , lookup-    , find-    , findIndex-    , all-    , any-    , and-    , or--    -- Full folds - need to go through all elements-    , length-    , maximum-    , minimum-    , sum-    , product--    -- ** Fold To-    -- | Convert or divert a stream into an output structure, container or-    -- sink.-    , toList-    , toHandle--    -- * Transformation-    -- | One to one transformations, each element in the input stream is-    -- transformed into a corresponding element in the output stream.-    -- Therefore, the length of the stream and the ordering of elements in the-    -- stream remains unchanged after the transformation.--    -- ** Scanning-    -- | Scan is a transformation by continuously folding the result with the-    -- next element of the stream. This is the generalized way to transform a-    -- stream carrying state from previous transformation steps, other forms of-    -- transformation like map can be expressed in terms of this.-    , scanl'-    , scanlM'-    , scanx--    -- ** Mapping-    -- | Map is a special form of scan where no state is carried from one step-    -- to the next.-    , Serial.map-    , mapM--    -- ** Flattening-    , sequence--    -- * Filtering and Insertion-    -- | Adding or removing elements from the stream thus changing the length-    -- of the stream.--    -- ** Filtering-    , filter-    , filterM-    , take-    , takeWhile-    , takeWhileM-    , drop-    , dropWhile-    , dropWhileM--    -- ** Inserting-    , intersperseM--    -- * Reordering-    , reverse--    -- * Hybrid Operations-    -- ** Map and Fold-    , mapM_--    -- ** Map and Filter-    , mapMaybe-    , mapMaybeM--    -- ** Scan and filter-    , findIndices-    , elemIndices--    -- * Zipping-    , zipWith-    , zipWithM-    , Z.zipAsyncWith-    , Z.zipAsyncWithM--    -- * Deprecated-    , K.once-    , each-    , scan-    , foldl-    , foldlM-    )-where--import Control.Monad.IO.Class (MonadIO(..))-import Data.Maybe (isJust, fromJust)-import Prelude-       hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,-               foldl, mapM, mapM_, sequence, all, any, sum, product, elem,-               notElem, maximum, minimum, head, last, tail, length, null,-               reverse, iterate, init, and, or, lookup, foldr1)-import qualified Prelude-import qualified System.IO as IO--import Streamly.SVar (MonadAsync, defState, rstState)-import Streamly.Streams.SVar (maxYields)-import Streamly.Streams.StreamK (IsStream(..))-import Streamly.Streams.Serial (SerialT)--import qualified Streamly.Streams.StreamK as K-import qualified Streamly.Streams.StreamD as D-import qualified Streamly.Streams.Zip as Z--#ifdef USE_STREAMK_ONLY-import qualified Streamly.Streams.StreamK as S-import qualified Streamly.Streams.Zip as S-#else-import qualified Streamly.Streams.StreamD as S-#endif--import qualified Streamly.Streams.Serial as Serial----------------------------------------------------------------------------------- Conversion to and from direct style stream----------------------------------------------------------------------------------- These definitions are dependent on what is imported as S-{-# INLINE fromStreamS #-}-fromStreamS :: (IsStream t, Monad m) => S.Stream m a -> t m a-fromStreamS = fromStream . S.toStreamK--{-# INLINE toStreamS #-}-toStreamS :: (IsStream t, Monad m) => t m a -> S.Stream m a-toStreamS = S.fromStreamK . toStream--{-# INLINE fromStreamD #-}-fromStreamD :: (IsStream t, Monad m) => D.Stream m a -> t m a-fromStreamD = fromStream . D.toStreamK--{-# INLINE toStreamD #-}-toStreamD :: (IsStream t, Monad m) => t m a -> D.Stream m a-toStreamD = D.fromStreamK . toStream----------------------------------------------------------------------------------- Deconstruction----------------------------------------------------------------------------------- | Decompose a stream into its head and tail. If the stream is empty, returns--- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is--- the head of the stream and @ma@ its tail.------ @since 0.1.0-uncons :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (a, t m a))-uncons m = K.uncons (K.adapt m)----------------------------------------------------------------------------------- Generation by Unfolding----------------------------------------------------------------------------------- | Build a stream by unfolding a /pure/ step function starting from a seed.--- The step function returns the next element in the stream and the next seed--- value. When it is done it returns 'Nothing' and the stream ends. For--- example,------ @--- let f b =---         if b > 3---         then Nothing---         else Just (b, b + 1)--- in toList $ unfoldr f 0--- @--- @--- [0,1,2,3]--- @------ unfoldr can be expressed in terms of 'yield' and '<>' as follows:------ @--- unfoldr step s =---     case step s of---         Nothing -> mempty---         Just (a, b) -> 'yield' a '<>' (unfoldr step b)--- @------ @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)-{-# RULES "unfoldr fallback to StreamK" [1]-    forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}---- | Build a stream by unfolding a /monadic/ step function starting from a--- seed.  The step function returns the next element in the stream and the next--- seed value. When it is done it returns 'Nothing' and the stream ends. For--- example,------ @--- let f b =---         if b > 3---         then return Nothing---         else print b >> return (Just (b, b + 1))--- in runStream $ unfoldrM f 0--- @--- @---  0---  1---  2---  3--- @--- When run concurrently, the next unfold step can run concurrently with the--- processing of the output of the previous step.  Note that more than one step--- cannot run concurrently as the next step depends on the output of the--- previous step.------ @--- (asyncly $ S.unfoldrM (\\n -> liftIO (threadDelay 1000000) >> return (Just (n, n + 1))) 0)---     & S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()--- @------ /Concurrent/------ /Since: 0.1.0/-{-# INLINE_EARLY unfoldrM #-}-unfoldrM :: (IsStream t, MonadAsync m) => (b -> m (Maybe (a, b))) -> b -> t m a-unfoldrM = K.unfoldrM--{-# RULES "unfoldrM serial" unfoldrM = unfoldrMSerial #-}-{-# INLINE_EARLY unfoldrMSerial #-}-unfoldrMSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> SerialT m a-unfoldrMSerial step seed = fromStreamS (S.unfoldrM step seed)----------------------------------------------------------------------------------- Specialized Generation----------------------------------------------------------------------------------- Faster than yieldM because there is no bind.------ | Create a singleton stream from a pure value. Same as @a `cons` nil@ but--- slighly more efficient.  Note that in monadic streams, 'yield' is the same--- as 'pure' or 'return', however, in Zip applicative streams it is not the--- same as 'pure' because in that case 'pure' is equivalent to 'repeat'--- instead.  In all other stream types, 'yield' is the same as @yieldM . pure@--- but more efficient.------ @since 0.4.0-{-# INLINE yield #-}-yield :: IsStream t => a -> t m a-yield = K.yield---- | Create a singleton stream from a monadic action. Same as @m \`consM` nil@--- but more efficient.------ @--- > toList $ yieldM getLine--- hello--- ["hello"]--- @------ @since 0.4.0-{-# INLINE yieldM #-}-yieldM :: (Monad m, IsStream t) => m a -> t m a-yieldM = K.yieldM---- | Generate a stream by performing a monadic action @n@ times. Can be--- expressed as @stimes n (yieldM m)@.--------- @--- runStream $ serially $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)--- runStream $ asyncly  $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)--- @------ /Concurrent/------ @since 0.1.1-replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a-replicateM n m = go n-    where-    go cnt = if cnt <= 0 then K.nil else m |: go (cnt - 1)---- | Generate a stream by repeatedly executing a monadic action forever. Can be--- expressed as @cycle1 . yieldM@.------ @--- runStream $ serially $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)--- runStream $ asyncly  $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)--- @------ /Concurrent, infinite (do not use with 'parallely')/------ @since 0.2.0-repeatM :: (IsStream t, MonadAsync m) => m a -> t m a-repeatM = go-    where go m = m |: go m---- | Iterate a pure function from a seed value, streaming the results forever.------ @since 0.1.2-iterate :: IsStream t => (a -> a) -> a -> t m a-iterate step = fromStream . go-    where-    go s = K.cons s (go (step s))---- | Iterate a monadic function from a seed value, streaming the results--- forever.------ When run concurrently, the next iteration can run concurrently with the--- processing of the previous iteration. Note that more than one iteration--- cannot run concurrently as the next iteration depends on the output of the--- previous iteration.------ @--- runStream $ serially $ S.take 10 $ S.iterateM---      (\\x -> threadDelay 1000000 >> print x >> return (x + 1)) 0------ runStream $ asyncly  $ S.take 10 $ S.iterateM---      (\\x -> threadDelay 1000000 >> print x >> return (x + 1)) 0--- @------ /Concurrent/------ @since 0.1.2-iterateM :: (IsStream t, MonadAsync m) => (a -> m a) -> a -> t m a-iterateM step = go-    where-    go s = fromStream $ K.Stream $ \svr stp sng yld -> do-       next <- step s-       K.unStream (toStream (return s |: go next)) svr stp sng yld----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- | Construct a stream from a list containing pure values. More efficient list--- specific implementation of 'K.fromFoldable' as it works well with fusion--- optimization.------ @since 0.4.0-{-# INLINE_EARLY fromList #-}-fromList :: (Monad m, IsStream t) => [a] -> t m a-fromList = fromStreamS . S.fromList-{-# RULES "fromList fallback to StreamK" [1]-    forall a. S.toStreamK (S.fromList a) = K.fromFoldable a #-}---- | Construct a stream from a list containing monadic actions. More efficient--- list specific implementation of 'fromFoldableM' especially for serial--- streams as it works well with fusion optimization.------ @since 0.4.0-{-# INLINE_EARLY fromListM #-}-fromListM :: (MonadAsync m, IsStream t) => [m a] -> t m a-fromListM = fromStreamD . D.fromListM-{-# RULES "fromListM fallback to StreamK" [1]-    forall a. D.toStreamK (D.fromListM a) = fromFoldableM a #-}---- | Construct a stream from a 'Foldable' containing monadic actions. Same as--- @'Prelude.foldr' 'consM' 'K.nil'@.------ @--- runStream $ serially $ S.fromFoldableM $ replicate 10 (threadDelay 1000000 >> print 1)--- runStream $ asyncly  $ S.fromFoldableM $ replicate 10 (threadDelay 1000000 >> print 1)--- @------ /Concurrent (do not use with 'parallely' on infinite containers)/------ @since 0.3.0-{-# INLINE fromFoldableM #-}-fromFoldableM :: (IsStream t, MonadAsync m, Foldable f) => f (m a) -> t m a-fromFoldableM = Prelude.foldr consM K.nil---- | 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 = K.fromFoldable---- | Read lines from an IO Handle into a stream of Strings.------ @since 0.1.0-fromHandle :: (IsStream t, MonadIO m) => IO.Handle -> t m String-fromHandle h = fromStream go-  where-  go = K.Stream $ \_ stp _ yld -> do-        eof <- liftIO $ IO.hIsEOF h-        if eof-        then stp-        else do-            str <- liftIO $ IO.hGetLine h-            yld str go----------------------------------------------------------------------------------- Elimination by Folding----------------------------------------------------------------------------------- | Lazy right fold with a monadic step function. For example, to fold a--- stream into a list:------ @--- >> runIdentity $ foldrM (\\x xs -> return (x : xs)) [] (serially $ fromFoldable [1,2,3])--- [1,2,3]--- @------ @since 0.2.0-{-# INLINE foldrM #-}-foldrM :: Monad m => (a -> b -> m b) -> b -> SerialT m a -> m b-foldrM step acc m = S.foldrM step acc $ toStreamS m---- | Lazy right associative fold. For example, to fold a stream into a list:------ @--- >> runIdentity $ foldr (:) [] (serially $ fromFoldable [1,2,3])--- [1,2,3]--- @------ @since 0.1.0-{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> SerialT m a -> m b--- XXX somehow this definition does not perform well, need to investigate--- foldr step acc m = S.foldr step acc $ S.fromStreamK (toStream m)-foldr f = foldrM (\a b -> return (f a b))---- | Right fold, for non-empty streams, using first element as the starting--- value. Returns 'Nothing' if the stream is empty.------ @since 0.5.0-{-# INLINE foldr1 #-}-foldr1 :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)-foldr1 = K.foldr1---- | 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.2.0-{-# INLINE foldx #-}-foldx :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b-foldx = K.foldx---- |--- @since 0.1.0-{-# DEPRECATED foldl "Please use foldx instead." #-}-foldl :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b-foldl = foldx---- | Strict left associative fold.------ @since 0.2.0-{-# INLINE foldl' #-}-foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b-foldl' step begin m = S.foldl' step begin $ toStreamS m---- | Strict left fold, for non-empty streams, using first element as the--- starting value. Returns 'Nothing' if the stream is empty.------ @since 0.5.0-foldl1' :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)-foldl1' step m = do-    r <- uncons m-    case r of-        Nothing -> return Nothing-        Just (h, t) -> do-            res <- foldl' step h t-            return $ Just res---- XXX replace the recursive "go" with explicit continuations.--- | Like 'foldx', but with a monadic step function.------ @since 0.2.0-foldxM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b-foldxM = K.foldxM---- |--- @since 0.1.0-{-# DEPRECATED foldlM "Please use foldxM instead." #-}-foldlM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b-foldlM = foldxM---- | Like 'foldl'' but with a monadic step function.------ @since 0.2.0-foldlM' :: Monad m => (b -> a -> m b) -> b -> SerialT m a -> m b-foldlM' step begin m = S.foldlM' step begin $ toStreamS m----------------------------------------------------------------------------------- Specialized folds----------------------------------------------------------------------------------- | Determine whether the stream is empty.------ @since 0.1.1-{-# INLINE null #-}-null :: Monad m => SerialT m a -> m Bool-null = K.null---- | Extract the first element of the stream, if any.------ @since 0.1.0-{-# INLINE head #-}-head :: Monad m => SerialT m a -> m (Maybe a)-head = K.head---- | Extract all but the first element of the stream, if any.------ @since 0.1.1-{-# INLINE tail #-}-tail :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))-tail m = K.tail (K.adapt 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 m = K.init (K.adapt m)---- | Extract the last element of the stream, if any.------ @since 0.1.1-{-# INLINE last #-}-last :: Monad m => SerialT m a -> m (Maybe a)-last m = S.last $ toStreamS m---- | Determine whether an element is present in the stream.------ @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)---- | Determine whether an element is not present in the stream.------ @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)---- | Determine the length of the stream.------ @since 0.1.0-{-# INLINE length #-}-length :: Monad m => SerialT m a -> m Int-length = foldl' (\n _ -> n + 1) 0---- | Determine whether all elements of a stream satisfy a predicate.------ @since 0.1.0-{-# INLINE all #-}-all :: Monad m => (a -> Bool) -> SerialT m a -> m Bool-all p m = S.all p (toStreamS m)---- | Determine whether any of the elements of a stream satisfy a predicate.------ @since 0.1.0-{-# INLINE any #-}-any :: Monad m => (a -> Bool) -> SerialT m a -> m Bool-any p m = S.any p (toStreamS m)---- | Determines if all elements of a boolean stream are True.------ @since 0.5.0-{-# INLINE and #-}-and :: Monad m => SerialT m Bool -> m Bool-and = all (==True)---- | Determines wheter at least one element of a boolean stream is True.------ @since 0.5.0-{-# INLINE or #-}-or :: Monad m => SerialT m Bool -> m Bool-or = any (==True)---- | Determine the sum of all elements of a stream of numbers------ @since 0.1.0-{-# INLINE sum #-}-sum :: (Monad m, Num a) => SerialT m a -> m a-sum = foldl' (+) 0---- | Determine the product of all elements of a stream of numbers------ @since 0.1.1-{-# INLINE product #-}-product :: (Monad m, Num a) => SerialT m a -> m a-product = foldl' (*) 1---- | Determine the minimum element in a stream.------ @since 0.1.0-{-# INLINE minimum #-}-minimum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)-minimum m = S.minimum (toStreamS m)---- | Determine the maximum element in a stream.------ @since 0.1.0-{-# INLINE maximum #-}-maximum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)-maximum m = S.maximum (toStreamS m)---- | Looks the given key up, treating the given stream as an association list.------ @since 0.5.0-{-# INLINE lookup #-}-lookup :: (Monad m, Eq a) => a -> SerialT m (a, b) -> m (Maybe b)-lookup = K.lookup---- | Returns the first element of the stream satisfying the given predicate,--- if any.------ @since 0.5.0-{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe a)-find = K.find---- | Find all the indices where the element in the stream satisfies the given--- predicate.------ @since 0.5.0-{-# INLINE findIndices #-}-findIndices :: IsStream t => (a -> Bool) -> t m a -> t m Int-findIndices = K.findIndices---- | Gives the index of the first stream element satisfying the given--- preficate.------ @since 0.5.0-{-# INLINE findIndex #-}-findIndex :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe Int)-findIndex p = head . findIndices p---- | Find all the indices where the value of the element in the stream is equal--- to the given value.------ @since 0.5.0-{-# INLINE elemIndices #-}-elemIndices :: (IsStream t, Eq a) => a -> t m a -> t m Int-elemIndices a = findIndices (==a)---- | Gives the first index of an element in the stream, which equals the given.------ @since 0.5.0-{-# INLINE elemIndex #-}-elemIndex :: (Monad m, Eq a) => a -> SerialT m a -> m (Maybe Int)-elemIndex a = findIndex (==a)----------------------------------------------------------------------------------- Map and Fold----------------------------------------------------------------------------------- XXX this can utilize parallel mapping if we implement it as runStream . mapM--- | Apply a monadic action to each element of the stream and discard the--- output of the action.------ @since 0.1.0-{-# INLINE mapM_ #-}-mapM_ :: Monad m => (a -> m b) -> SerialT m a -> m ()-mapM_ f m = S.mapM_ f $ toStreamS m----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- | Convert a stream into a list in the underlying monad.------ @since 0.1.0-{-# INLINE toList #-}-toList :: Monad m => SerialT m a -> m [a]-toList m = S.toList $ toStreamS m---- | Write a stream of Strings to an IO Handle.------ @since 0.1.0-toHandle :: MonadIO m => IO.Handle -> SerialT m String -> m ()-toHandle h m = go (toStream m)-    where-    go m1 =-        let stop = return ()-            single a = liftIO (IO.hPutStrLn h a)-            yieldk a r = liftIO (IO.hPutStrLn h a) >> go r-        in K.unStream m1 defState stop single yieldk----------------------------------------------------------------------------------- Transformation by Folding (Scans)----------------------------------------------------------------------------------- | Strict left scan with an extraction function. Like 'scanl'', but applies a--- user supplied extraction function (the third argument) at each step. This is--- designed to work with the @foldl@ library. The suffix @x@ is a mnemonic for--- extraction.------ @since 0.2.0-{-# INLINE scanx #-}-scanx :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b-scanx = K.scanx---- |--- @since 0.1.1-{-# DEPRECATED scan "Please use scanx instead." #-}-scan :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b-scan = scanx---- | Like 'scanl'' but with a monadic step function.------ @since 0.4.0-{-# INLINE scanlM' #-}-scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b-scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m---- | Strict left scan. Like 'foldl'', but returns the folded value at each--- step, generating a stream of all intermediate fold results. The first--- element of the stream is the user supplied initial value, and the last--- element of the stream is the same as the result of 'foldl''.------ @since 0.2.0-{-# INLINE scanl' #-}-scanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b-scanl' step = scanlM' (\a b -> return (step a b))----------------------------------------------------------------------------------- Transformation by Filtering----------------------------------------------------------------------------------- | Include only those elements that pass a predicate.------ @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 = K.filter-#endif---- | Same as 'filter' but with a monadic predicate.------ @since 0.4.0-{-# INLINE filterM #-}-filterM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a-filterM p m = fromStreamD $ D.filterM p $ toStreamD m---- | Take first 'n' elements from the stream and discard the rest.------ @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-    (maxYields (Just (fromIntegral n)) m)---- | End the stream as soon as the predicate fails on an element.------ @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---- | Same as 'takeWhile' but with a monadic predicate.------ @since 0.4.0-{-# INLINE takeWhileM #-}-takeWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a-takeWhileM p m = fromStreamD $ D.takeWhileM p $ toStreamD m---- | Discard first 'n' elements from the stream and take the rest.------ @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 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---- | Same as 'dropWhile' but with a monadic predicate.------ @since 0.4.0-{-# INLINE dropWhileM #-}-dropWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a-dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m----------------------------------------------------------------------------------- Transformation by Mapping----------------------------------------------------------------------------------- | Replace each element of the stream with the result of a monadic action--- applied on the element.------ @--- runStream $ S.replicateM 10 (return 1)---           & (serially . S.mapM (\\x -> threadDelay 1000000 >> print x))------ runStream $ S.replicateM 10 (return 1)---           & (asyncly . S.mapM (\\x -> threadDelay 1000000 >> print x))--- @------ /Concurrent (do not use with 'parallely' on infinite streams)/------ @since 0.1.0-{-# INLINE_EARLY mapM #-}-mapM :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m b-mapM = K.mapM--{-# RULES "mapM serial" mapM = mapMSerial #-}-{-# INLINE mapMSerial #-}-mapMSerial :: Monad m => (a -> m b) -> SerialT m a -> SerialT m b-mapMSerial = Serial.mapM---- | Reduce a stream of monadic actions to a stream of the output of those--- actions.------ @--- runStream $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)---           & (serially . S.sequence)------ runStream $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)---           & (asyncly . S.sequence)--- @------ /Concurrent (do not use with 'parallely' on infinite streams)/------ @since 0.1.0-{-# INLINE sequence #-}-sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a-sequence = K.sequence----------------------------------------------------------------------------------- Transformation by Map and Filter----------------------------------------------------------------------------------- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'--- elements, and return a stream of values extracted from 'Just'.------ @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---- | Like 'mapMaybe' but maps a monadic function.------ /Concurrent (do not use with 'parallely' on infinite streams)/------ @since 0.3.0-{-# INLINE mapMaybeM #-}-mapMaybeM :: (IsStream t, MonadAsync m, Functor (t m))-          => (a -> m (Maybe b)) -> t m a -> t m b-mapMaybeM f = fmap fromJust . filter isJust . mapM f----------------------------------------------------------------------------------- Transformation by Reordering----------------------------------------------------------------------------------- XXX to scale this we need to use a slab allocated array backed--- representation for temporary storage.------ | Returns the elements of the stream in reverse order.--- The stream must be finite.------ @since 0.1.1-reverse :: (IsStream t) => t m a -> t m a-reverse m = fromStream $ go K.nil (toStream m)-    where-    go rev rest = K.Stream $ \st stp sng yld ->-        let runIt x = K.unStream x (rstState st) stp sng yld-            stop = runIt rev-            single a = runIt $ a `K.cons` rev-            yieldk a r = runIt $ go (a `K.cons` rev) r-         in K.unStream rest (rstState st) stop single yieldk----------------------------------------------------------------------------------- Transformation by Inserting----------------------------------------------------------------------------------- | Generate a stream by performing the monadic action inbetween all elements--- of the given stream.------ @since 0.5.0-{-# INLINE intersperseM #-}-intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a-intersperseM = K.intersperseM----------------------------------------------------------------------------------- Zipping----------------------------------------------------------------------------------- | Zip two streams serially using a monadic zipping function.------ @since 0.4.0-{-# INLINABLE zipWithM #-}-zipWithM :: (IsStream t, Monad m) => (a -> b -> m c) -> t m a -> t m b -> t m c-zipWithM f m1 m2 = fromStreamS $ S.zipWithM f (toStreamS m1) (toStreamS m2)---- | Zip two streams serially using a pure zipping function.------ @since 0.1.0-{-# INLINABLE zipWith #-}-zipWith :: (IsStream t, Monad m) => (a -> b -> c) -> t m a -> t m b -> t m c-zipWith f m1 m2 = fromStreamS $ S.zipWith f (toStreamS m1) (toStreamS m2)+{-# OPTIONS_GHC -Wno-deprecations #-}++#include "inline.hs"++-- |+-- Module      : Streamly.Prelude+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- To run examples in this module:+--+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Prelude as Stream+--+-- We will add some more imports in the examples as needed.+--+-- For effectful streams we will use the following IO action that blocks for+-- @n@ seconds:+--+-- >>> import Control.Concurrent (threadDelay)+-- >>> :{+--  delay n = do+--      threadDelay (n * 1000000)   -- sleep for n seconds+--      putStrLn (show n ++ " sec") -- print "n sec"+--      return n                    -- IO Int+-- :}+--+-- >>> delay 1+-- 1 sec+-- 1+--+-- = Overview+--+-- Streamly is a framework for modular data flow based programming and+-- declarative concurrency.  Powerful stream fusion framework in streamly+-- allows high performance combinatorial programming even when using byte level+-- streams.  Streamly API is similar to Haskell lists.+--+-- The basic stream type is 'SerialT'. The type @SerialT IO a@ is an effectful+-- equivalent of a list @[a]@ using the IO monad.  Streams can be constructed+-- like lists, except that they use 'nil' instead of '[]' and 'cons' instead of+-- ':'.+--+-- `cons` constructs a pure stream which is more or less the same as a list:+--+-- >>> import Streamly.Prelude (SerialT, cons, consM, nil)+-- >>> stream = 1 `cons` 2 `cons` nil :: SerialT IO Int+-- >>> Stream.toList stream -- IO [Int]+-- [1,2]+--+-- 'consM' constructs a stream from effectful actions:+--+-- >>> stream = delay 1 `consM` delay 2 `consM` nil+-- >>> Stream.toList stream+-- 1 sec+-- 2 sec+-- [1,2]+--+-- == Console Echo Program+--+-- In the following example, 'repeatM' generates an infinite stream of 'String'+-- by repeatedly performing the 'getLine' IO action. 'mapM' then applies+-- 'putStrLn' on each element in the stream converting it to stream of '()'.+-- Finally, 'drain' folds the stream to IO discarding the () values, thus+-- producing only effects.+--+-- >>> import Data.Function ((&))+--+-- @+-- > :{+--  Stream.repeatM getLine      -- SerialT IO String+--      & Stream.mapM putStrLn  -- SerialT IO ()+--      & Stream.drain          -- IO ()+-- :}+-- @+--+-- This is a console echo program. It is an example of a declarative loop+-- written using streaming combinators.  Compare it with an imperative @while@+-- loop.+--+-- Hopefully, this gives you an idea how we can program declaratively by+-- representing loops using streams. In this module, you can find all+-- "Data.List" like functions and many more powerful combinators to perform+-- common programming tasks. Also see "Streamly.Internal.Data.Stream.IsStream"+-- module for many more @Pre-release@ combinators. See the+-- <https://github.com/composewell/streamly-examples> repository for many more+-- real world examples of stream programming.+--+-- == Polymorphic Combinators+--+-- Streamly has several stream types, 'SerialT' is one type of stream with+-- serial execution of actions, 'AsyncT' is another with concurrent execution.+-- The combinators in this module are polymorphic in stream type. For example,+--+-- @+-- repeatM :: (IsStream t, MonadAsync m) => m a -> t m a+-- @+--+-- @t@ is the stream type, @m@ is the underlying 'Monad' of the stream (e.g.+-- IO) and @a@ is the type of elements in the stream (e.g. Int).+--+-- Stream elimination combinators accept a 'SerialT' type instead of a+-- polymorphic type to force a concrete monomorphic type by default, reducing+-- type errors. That's why in the console echo example above the stream type is+-- 'SerialT'.+--+-- @+-- drain :: Monad m => SerialT m a -> m ()+-- @+--+-- We can force a certain stream type in polymorphic code by using "Stream Type+-- Adaptors". For example, to force 'AsyncT':+--+-- >>> Stream.drain $ Stream.fromAsync $ Stream.replicateM 10 $ delay 1+-- ...+--+-- == Combining two streams+--+-- Two streams can be combined to form a single stream in various interesting+-- ways. 'serial' (append), 'wSerial' (interleave), 'ahead' (concurrent,+-- ordered append), 'async' (lazy concurrent, unordered append) , 'wAsync'+-- (lazy concurrent, unordered interleave), 'parallel' (strict concurrent+-- merge), 'zipWith', 'zipAsyncWith' (concurrent zip), 'mergeBy',+-- 'mergeAsyncBy' (concurrent merge) are some ways of combining two streams.+--+-- For example, the `parallel` combinator schedules both the streams+-- concurrently.+--+-- >>> stream1 = Stream.fromListM [delay 3, delay 4]+-- >>> stream2 = Stream.fromListM [delay 1, delay 2]+-- >>> Stream.toList $ stream1 `parallel` stream2+-- ...+--+-- We can chain the operations to combine more than two streams:+--+-- >>> stream3 = Stream.fromListM [delay 1, delay 2]+-- >>> Stream.toList $ stream1 `parallel` stream2 `parallel` stream3+-- ...+--+-- Concurrent generation ('consM') and concurrent merging of streams is the+-- fundamental basis of all concurrency in streamly.+--+-- == Combining many streams+--+-- The 'concatMapWith' combinator can be used to generalize the two stream+-- combining combinators to @n@ streams.  For example, we can use+-- @concatMapWith parallel@ to read concurrently from all incoming network+-- connections and combine the input streams into a single output stream:+--+-- @+-- import qualified Streamly.Network.Inet.TCP as TCP+-- import qualified Streamly.Network.Socket as Socket+--+-- Stream.unfold TCP.acceptOnPort 8090+--  & Stream.concatMapWith Stream.parallel (Stream.unfold Socket.read)+-- @+--+-- See the @streamly-examples@ repository for a full working example.+--+-- == Concurrent Nested Loops+--+-- The Monad instance of 'SerialT' is an example of nested looping. It is in+-- fact a list transformer. Different stream types provide different variants+-- of nested looping.  For example, the 'Monad' instance of 'ParallelT' uses+-- @concatMapWith parallel@ as its bind operation. Therefore, each iteration of+-- the loop for 'ParallelT' stream can run concurrently.  See the documentation+-- for individual stream types for the specific execution behavior of the+-- stream as well as the behavior of 'Semigroup' and 'Monad' instances.+--+-- == Stream Types+--+-- Streamly has several stream types. These types differ in three fundamental+-- operations, 'consM' ('IsStream' instance), '<>' ('Semigroup' instance) and+-- '>>=' ('Monad' instance).  Below we will see how 'consM' behaves for+-- 'SerialT', 'AsyncT' and 'AheadT' stream types.+--+-- 'SerialT' executes actions serially, so the total delay in the following+-- example is @2 + 1 = 3@ seconds:+--+-- >>> stream = delay 2 `consM` delay 1 `consM` nil+-- >>> Stream.toList stream -- IO [Int]+-- 2 sec+-- 1 sec+-- [2,1]+--+-- 'AsyncT' executes the actions concurrently, so the total delay is @max 2 1 =+-- 2@ seconds:+--+-- >>> Stream.toList $ Stream.fromAsync stream -- IO [Int]+-- 1 sec+-- 2 sec+-- [1,2]+--+-- 'AsyncT' produces the results in the order in which execution finishes.+-- Notice the order of elements in the list above, it is not the same as the+-- order of actions in the stream.+--+-- 'AheadT' is similar to 'AsyncT' but the order of results is the same as the+-- order of actions, even though they execute concurrently:+--+-- >>> Stream.toList $ Stream.fromAhead stream -- IO [Int]+-- 1 sec+-- 2 sec+-- [2,1]+--+-- == Semigroup Instance+--+-- Earlier we distinguished stream types based on the execution behavior of+-- actions within a stream. Stream types are also distinguished based on how+-- actions from different streams are scheduled for execution when two streams+-- are combined together.+--+-- For example, both 'SerialT' and 'WSerialT' execute actions within the stream+-- serially, however, they differ in how actions from individual streams are+-- executed when two streams are combined with '<>' (the 'Semigroup' instance).+--+-- For 'SerialT', '<>' has an appending behavior i.e. it executes the actions+-- from the second stream after executing actions from the first stream:+--+-- >>> stream1 = Stream.fromListM [delay 1, delay 2]+-- >>> stream2 = Stream.fromListM [delay 3, delay 4]+-- >>> Stream.toList $ stream1 <> stream2+-- 1 sec+-- 2 sec+-- 3 sec+-- 4 sec+-- [1,2,3,4]+--+-- For 'WSerialT', '<>' has an interleaving behavior i.e. it executes one+-- action from the first stream and then one action from the second stream and+-- so on:+--+-- >>> Stream.toList $ Stream.fromWSerial $ stream1 <> stream2+-- 1 sec+-- 3 sec+-- 2 sec+-- 4 sec+-- [1,3,2,4]+--+-- The '<>' operation of 'SerialT' and 'WSerialT' is the same as 'serial' and+-- 'wSerial' respectively. The 'serial' combinator combines two streams of any+-- type in the same way as a serial stream combines.+--+-- == Concurrent Combinators+--+-- Like 'consM', there are several other stream generation operations whose+-- execution behavior depends on the stream type, they all follow behavior+-- similar to 'consM'.+--+-- By default, folds like 'drain' force the stream type to be 'SerialT', so+-- 'replicateM' in the following code runs serially, and takes 10 seconds:+--+-- >>> Stream.drain $ Stream.replicateM 10 $ delay 1+-- ...+--+-- We can use the 'fromAsync' combinator to force the argument stream to be of+-- 'AsyncT' type, 'replicateM' in the following example executes the replicated+-- actions concurrently, thus taking only 1 second:+--+-- >>> Stream.drain $ Stream.fromAsync $ Stream.replicateM 10 $ delay 1+-- ...+--+-- We can use 'mapM' to map an action concurrently:+--+-- >>> f x = delay 1 >> return (x + 1)+-- >>> Stream.toList $ Stream.fromAhead $ Stream.mapM f $ Stream.fromList [1..3]+-- ...+-- [2,3,4]+--+-- 'fromAhead' forces mapM to happen in 'AheadT' style, thus all three actions+-- take only one second even though each individual action blocks for a second.+--+-- See the documentation of individual combinators to check if it is concurrent+-- or not. The concurrent combinators necessarily have a @MonadAsync m@+-- constraint. However, a @MonadAsync m@ constraint does not necessarily mean+-- that the combinator is concurrent.+--+-- == Automatic Concurrency Control+--+-- 'SerialT' (and 'WSerialT') runs all tasks serially whereas 'ParallelT' runs+-- all tasks concurrently i.e. one thread per task. The stream types 'AsyncT',+-- 'WAsyncT', and 'AheadT' provide demand driven concurrency. It means that+-- based on the rate at which the consumer is consuming the stream, it+-- maintains the optimal number of threads to increase or decrease parallelism.+--+-- However, the programmer can control the maximum number of threads using+-- 'maxThreads'. It provides an upper bound on the concurrent IO requests or+-- CPU cores that can be used. 'maxBuffer' limits the number of evaluated+-- stream elements that we can buffer.  See the "Concurrency Control" section+-- for details.+--+-- == Caveats+--+-- When we use combinators like 'fromAsync' on a piece of code, all combinators+-- inside the argument of fromAsync become concurrent which is often counter+-- productive.  Therefore, we recommend that in a pipeline, you identify the+-- combinators that you really want to be concurrent and add a 'fromSerial' after+-- those combinators so that the code following the combinator remains serial:+--+-- @+-- Stream.fromAsync $ ... concurrent combinator here ... $ Stream.fromSerial $ ...+-- @+--+-- == Conventions+--+-- Functions with the suffix @M@ are general functions that work on monadic+-- arguments. The corresponding functions without the suffix @M@ work on pure+-- arguments and can in general be derived from their monadic versions but are+-- provided for convenience and for consistency with other pure APIs in the+-- @base@ package.+--+-- In many cases, short definitions of the combinators are provided in the+-- documentation for illustration. The actual implementation may differ for+-- 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@.+    --+    -- See also: "Streamly.Internal.Data.Stream.IsStream.Generate" for+    -- @Pre-release@ functions.++    -- ** Primitives+    -- | Primitives to construct a stream from pure values or monadic actions.+    -- All other stream construction and generation combinators described later+    -- can be expressed in terms of these primitives. However, the special+    -- versions provided in this module can be much more efficient in most+    -- cases. Users can create custom combinators using these primitives.++      nil+    , cons+    , (.:)++    , consM+    , (|:)++    -- ** Unfolding+    -- | Generalized way of generating a stream efficiently.+    , unfold+    , unfoldr+    , unfoldrM++    -- ** From Values+    -- | Generate a monadic stream from a seed value or values.+    , fromPure+    , fromEffect+    , repeat+    , repeatM+    , replicate+    , replicateM++    -- Note: Using enumeration functions e.g. 'Prelude.enumFromThen' turns out+    -- to be slightly faster than the idioms like @[from, then..]@.+    --+    -- ** Enumeration+    -- | We can use the 'Enum' type class to enumerate a type producing a list+    -- and then convert it to a stream:+    --+    -- @+    -- 'fromList' $ 'Prelude.enumFromThen' from then+    -- @+    --+    -- However, this is not particularly efficient.+    -- The 'Enumerable' type class provides corresponding functions that+    -- generate a stream instead of a list, efficiently.++    , Enumerable (..)+    , enumerate+    , enumerateTo++    -- ** Iteration+    , iterate+    , iterateM++    -- ** From Generators+    -- | Generate a monadic stream from a seed value and a generator function.+    , fromIndices+    , fromIndicesM++    -- ** From Containers+    -- | Convert an input structure, container or source into a stream. All of+    -- these can be expressed in terms of primitives.+    , fromList+    , fromListM+    , fromFoldable+    , fromFoldableM++    -- * Elimination+    -- | Functions ending in the general shape @t m a -> m b@+    --+    -- See also: "Streamly.Internal.Data.Stream.IsStream.Eliminate" for+    -- @Pre-release@ functions.++    -- ** Running a 'Fold'+    -- $runningfolds++    , fold++    -- ** Deconstruction+    -- | Functions ending in the general shape @t m a -> m (b, t m a)@++    , uncons+    , tail+    , init++    -- ** General Folds+-- | In imperative terms a fold can be considered as a loop over the stream+-- that reduces the stream to a single value.+-- Left and right folds both use a fold function @f@ and an identity element+-- @z@ (@zero@) to deconstruct a recursive data structure and reconstruct a+-- new data structure. The new structure may be a recursive construction (a+-- container) or a non-recursive single value reduction of the original+-- structure.+--+-- Both right and left folds are mathematical duals of each other, they are+-- functionally equivalent.  Operationally, a left fold on a left associated+-- structure behaves exactly in the same way as a right fold on a right+-- associated structure. Similarly, a left fold on a right associated structure+-- behaves in the same way as a right fold on a left associated structure.+-- However, the behavior of a right fold on a right associated structure is+-- operationally different (even though functionally equivalent) than a left+-- fold on the same structure.+--+-- On right associated structures like Haskell @cons@ lists or Streamly+-- streams, a lazy right fold is naturally suitable for lazy recursive+-- reconstruction of a new structure, while a strict left fold is naturally+-- suitable for efficient reduction. In right folds control is in the hand of+-- the @puller@ whereas in left folds the control is in the hand of the+-- @pusher@.+--+-- The behavior of right and left folds are described in detail in the+-- individual fold's documentation.  To illustrate the two folds for right+-- associated @cons@ lists:+--+-- > foldr :: (a -> b -> b) -> b -> [a] -> b+-- > foldr f z [] = z+-- > foldr f z (x:xs) = x `f` foldr f z xs+-- >+-- > foldl :: (b -> a -> b) -> b -> [a] -> b+-- > foldl f z [] = z+-- > foldl f z (x:xs) = foldl f (z `f` x) xs+--+-- @foldr@ is conceptually equivalent to:+--+-- > foldr f z [] = z+-- > foldr f z [x] = f x z+-- > foldr f z xs = foldr f (foldr f z (tail xs)) [head xs]+--+-- @foldl@ is conceptually equivalent to:+--+-- > foldl f z [] = z+-- > foldl f z [x] = f z x+-- > foldl f z xs = foldl f (foldl f z (init xs)) [last xs]+--+-- Left and right folds are duals of each other.+--+-- @+-- foldr f z xs = foldl (flip f) z (reverse xs)+-- foldl f z xs = foldr (flip f) z (reverse xs)+-- @+--+-- More generally:+--+-- @+-- foldr f z xs = foldl g id xs z where g k x = k . f x+-- foldl f z xs = foldr g id xs z where g x k = k . flip f x+-- @+--++-- As a general rule, foldr cannot have state and foldl cannot have control.++-- NOTE: Folds are inherently serial as each step needs to use the result of+-- the previous step. However, it is possible to fold parts of the stream in+-- parallel and then combine the results using a monoid.++    -- *** Right Folds+    -- $rightfolds+    , foldrM+    , foldr++    -- *** Left Folds+    -- $leftfolds+    , foldl'+    , foldl1'+    , foldlM'++    -- ** Specific Folds+    -- *** Full Folds+    -- | Folds that are guaranteed to evaluate the whole stream.++    -- -- ** To Summary (Full Folds)+    -- -- | Folds that summarize the stream to a single value.+    , drain+    , last+    , length+    , sum+    , product++    -- -- ** To Summary (Maybe) (Full Folds)+    -- -- | Folds that summarize a non-empty stream to a 'Just' value and return+    -- 'Nothing' for an empty stream.+    , maximumBy+    , maximum+    , minimumBy+    , minimum+    , the++    -- *** Partial Folds+    -- | Folds that may terminate before evaluating the whole stream. These+    -- folds strictly evaluate the stream until the result is determined.++    -- -- ** To Elements (Partial Folds)+    , drainN+    , drainWhile++    -- -- | Folds that extract selected elements of a stream or their properties.+    , (!!)+    , head+    , findM+    , find+    , lookup+    , findIndex+    , elemIndex++    -- -- ** To Boolean (Partial Folds)+    -- -- | Folds that summarize the stream to a boolean value.+    , null+    , elem+    , notElem+    , all+    , any+    , and+    , or++    -- *** To Containers+    -- | Convert a stream into a container holding all the values.+    , toList++    -- ** Folding Concurrently+    , (|$.)+    , (|&.)++    -- ** Multi-Stream folds+    , eqBy+    , cmpBy+    , isPrefixOf+    , isSubsequenceOf++    -- trimming sequences+    , stripPrefix++    -- * Transformation+    -- | See also: "Streamly.Internal.Data.Stream.IsStream.Transform" for+    -- @Pre-release@ functions.++    -- ** Mapping+    -- | In imperative terms a map operation can be considered as a loop over+    -- the stream that transforms the stream into another stream by performing+    -- an operation on each element of the stream.+    --+    -- 'map' is the least powerful transformation operation with strictest+    -- guarantees.  A map, (1) is a stateless loop which means that no state is+    -- allowed to be carried from one iteration to another, therefore,+    -- operations on different elements are guaranteed to not affect each+    -- other, (2) is a strictly one-to-one transformation of stream elements+    -- which means it guarantees that no elements can be added or removed from+    -- the stream, it can merely transform them.+    , map+    , sequence+    , mapM++    -- ** Mapping Side Effects+    , mapM_+    , trace+    , tap+    , delay++    -- ** Scanning+    --+    -- | A scan is more powerful than map. While a 'map' is a stateless loop, a+    -- @scan@ is a stateful loop which means that a state can be shared across+    -- all the loop iterations, therefore, future iterations can be impacted by+    -- the state changes made by the past iterations. A scan yields the state+    -- of the loop after each iteration. Like a map, a @postscan@ or @prescan@+    -- does not add or remove elements in the stream, it just transforms them.+    -- However, a @scan@ adds one extra element to the stream.+    --+    -- A left associative scan, also known as a prefix sum, can be thought of+    -- as a stream transformation consisting of left folds of all prefixes of a+    -- stream.  Another way of thinking about it is that it streams all the+    -- intermediate values of the accumulator while applying a left fold on the+    -- input stream.  A right associative scan, on the other hand, can be+    -- thought of as a stream consisting of right folds of all the suffixes of+    -- a stream.+    --+    -- The following equations hold for lists:+    --+    -- > scanl f z xs == map (foldl f z) $ inits xs+    -- > scanr f z xs == map (foldr f z) $ tails xs+    --+    -- @+    -- > scanl (+) 0 [1,2,3,4]+    -- 0                 = 0+    -- 0 + 1             = 1+    -- 0 + 1 + 2         = 3+    -- 0 + 1 + 2 + 3     = 6+    -- 0 + 1 + 2 + 3 + 4 = 10+    --+    -- > scanr (+) 0 [1,2,3,4]+    -- 1 + 2 + 3 + 4 + 0 = 10+    --     2 + 3 + 4 + 0 = 9+    --         3 + 4 + 0 = 7+    --             4 + 0 = 4+    --                 0 = 0+    -- @+    --+    -- Left and right scans are duals:+    --+    -- > scanr f z xs ==  reverse $ scanl (flip f) z (reverse xs)+    -- > scanl f z xs ==  reverse $ scanr (flip f) z (reverse xs)+    --+    -- A scan is a stateful map i.e. a combination of map and fold:+    --+    -- > map f xs =           tail $ scanl (\_ x -> f x) z xs+    -- > map f xs = reverse $ head $ scanr (\_ x -> f x) z xs+    --+    -- > foldl f z xs = last $ scanl f z xs+    -- > foldr f z xs = head $ scanr f z xs++    -- ** Left scans+    , scanl'+    , scanlM'+    , postscanl'+    , postscanlM'+    , scanl1'+    , scanl1M'++    -- ** Scanning By 'Fold'+    , scan+    , postscan++    -- ** Filtering+    -- | Remove some elements from the stream based on a predicate. In+    -- imperative terms a filter over a stream corresponds to a loop with a+    -- @continue@ clause for the cases when the predicate fails.++    , deleteBy+    , filter+    , filterM+    , uniq++    -- ** Trimming+    -- | Take or remove elements from one or both ends of a stream.+    , take+    , takeWhile+    , takeWhileM+    , drop+    , dropWhile+    , dropWhileM++    -- ** Inserting Elements+    -- | Inserting elements is a special case of interleaving/merging streams.++    , insertBy+    , intersperseM+    , intersperse++    -- ** Reordering Elements+    , reverse++    -- ** Indexing+    -- | Indexing can be considered as a special type of zipping where we zip a+    -- stream with an index stream.+    , indexed+    , indexedR++    -- ** Searching+    -- | Finding the presence or location of an element, a sequence of elements+    -- or another stream within a stream.++    -- -- ** Searching Elements+    , findIndices+    , elemIndices++    -- ** Maybe Streams+    , mapMaybe+    , mapMaybeM++    -- * Concurrent Transformation+    -- ** Concurrent Pipelines+    -- $application+    , (|$)+    , (|&)+    , mkAsync++    -- ** Concurrency Control+    -- $concurrency+    , maxThreads+    , maxBuffer++    -- ** Rate Limiting+    , Rate (..)+    , rate+    , avgRate+    , minRate+    , maxRate+    , constRate++    -- * Combining Streams+    -- | New streams can be constructed by appending, merging or zipping+    -- existing streams.+    --+    -- Any exceptions generated by concurrent evaluation are propagated to+    -- the consumer of the stream as soon as they occur.  Exceptions from a+    -- particular stream are guaranteed to arrive in the same order in the+    -- output stream as they were generated in the input stream.+    --+    -- See 'maxThreads' and 'maxBuffer' to control the concurrency of the+    -- concurrent combinators.+    --+    -- See also: "Streamly.Internal.Data.Stream.IsStream.Expand" for+    -- @Pre-release@ functions.++    -- ** Linear combinators+    -- | These functions have O(n) append performance.  They can be used+    -- efficiently with 'concatMapWith' et. al.++    , serial+    , wSerial+    , ahead+    , async+    , wAsync+    , parallel++    -- ** PairWise combinators+    -- | These functions have O(n^2) append performance when used linearly e.g.+    -- using 'concatMapWith'. However, they can be combined pair wise using+    -- 'Streamly.Internal.Data.Stream.IsStream.Expand.concatPairsWith' to give+    -- O(n * log n) complexity.++    -- , merge+    , mergeBy+    , mergeByM+    , mergeAsyncBy+    , mergeAsyncByM++    , zipWith+    , zipWithM+    , zipAsyncWith+    , zipAsyncWithM++    -- ** Nested Unfolds+    , unfoldMany+    , intercalate+    , intercalateSuffix++    -- ** Nested Streams+    -- | Stream operations like map and filter represent loop processing in+    -- imperative programming terms. Similarly, the imperative concept of+    -- nested loops are represented by streams of streams. The 'concatMap'+    -- operation represents nested looping.+    -- A 'concatMap' operation loops over the input stream and then for each+    -- element of the input stream generates another stream and then loops over+    -- that inner stream as well producing effects and generating a single+    -- output stream.+    -- The 'Monad' instances of different stream types provide a more+    -- convenient way of writing nested loops. Note that the monad bind+    -- operation is just @flip concatMap@.+    --+    -- One dimension loops are just a special case of nested loops.  For+    -- example, 'concatMap' can degenerate to a simple map operation:+    --+    -- > map f m = S.concatMap (\x -> S.fromPure (f x)) m+    --+    -- Similarly, 'concatMap' can perform filtering by mapping an element to a+    -- 'nil' stream:+    --+    -- > filter p m = S.concatMap (\x -> if p x then S.fromPure x else S.nil) m+    --++    , concatMapWith+    , concatMap+    , concatMapM++    -- ** 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.+    --+    , concatFoldableWith+    , concatMapFoldableWith+    , concatForFoldableWith++    -- * Reducing+    -- |+    -- See also: "Streamly.Internal.Data.Stream.IsStream.Reduce" for+    -- @Pre-release@ functions.++    -- ** Nested Folds+    , foldMany+    , chunksOf+    , intervalsOf++    -- ** Splitting+    -- | In general we can express splitting in terms of parser combinators.+    -- These are some common use functions for convenience and efficiency.+    -- While parsers can fail these functions are designed to transform a+    -- stream without failure with a predefined behavior for all cases.+    --+    -- In general, there are three possible ways of combining stream segments+    -- with a separator. The separator could be prefixed to each segment,+    -- suffixed to each segment, or it could be infixed between segments.+    -- 'intersperse' and 'intercalate' operations are examples of infixed+    -- combining whereas 'unlines' is an example of suffixed combining. When we+    -- split a stream with separators we can split in three different ways,+    -- each being an opposite of the three ways of combining.+    --+    -- Splitting may keep the separator or drop it. Depending on how we split,+    -- the separator may be kept attached to the stream segments in prefix or+    -- suffix position or as a separate element in infix position. Combinators+    -- like 'splitOn' that use @On@ in their names drop the separator and+    -- combinators that use 'With' in their names keep the separator. When a+    -- segment is missing it is considered as empty, therefore, we never+    -- encounter an error in parsing.++    -- -- ** Splitting By Elements+    , splitOn+    , splitOnSuffix++    , splitWithSuffix+    , wordsBy -- strip, compact and split++    -- ** Grouping+    -- | Splitting a stream by combining multiple contiguous elements into+    -- groups using some criterion.+    , groups+    , groupsBy+    , groupsByRolling++    -- * Exceptions+    -- | Most of these combinators inhibit stream fusion, therefore, when+    -- possible, they should be called in an outer loop to mitigate the cost.+    -- For example, instead of calling them on a stream of chars call them on a+    -- stream of arrays before flattening it to a stream of chars.+    --+    -- See also: "Streamly.Internal.Data.Stream.IsStream.Exception" for+    -- @Pre-release@ functions.++    , before+    , after+    , bracket+    , onException+    , finally+    , handle++    -- * Lifting Inner Monad+    -- | See also: "Streamly.Internal.Data.Stream.IsStream.Lift" for+    -- @Pre-release@ functions.++    , liftInner+    , runReaderT+    , runStateT++    -- * Stream Types+    -- | Stream types that end with a @T@ (e.g. 'SerialT') are monad+    -- transformers.++    -- ** Serial Streams+    -- $serial+    , SerialT+    , WSerialT++    -- ** Speculative Streams+    -- $ahead+    , AheadT++    -- ** Asynchronous Streams+    -- $async+    , AsyncT+    , WAsyncT+    , ParallelT++    -- ** Zipping Streams+    -- $zipping+    , ZipSerialM+    , ZipAsyncM++    -- * IO Streams+    , Serial+    , WSerial+    , Ahead+    , Async+    , WAsync+    , Parallel+    , ZipSerial+    , ZipAsync++    -- * Type Synonyms+    , MonadAsync++    -- * Converting from/to Stream/StreamK types+    , fromStream+    , toStream+    , fromStreamK+    , toStreamK++    -- * Stream Type Adapters+    -- $adapters+    , IsStream ()++    , fromSerial+    , fromWSerial+    , fromAsync+    , fromAhead+    , fromWAsync+    , fromParallel+    , fromZipSerial+    , fromZipAsync+    , adapt++    -- * Deprecated+    , yield+    , yieldM+    , scanx+    , foldx+    , foldxM+    , foldr1+    , runStream+    , runN+    , runWhile+    , fromHandle+    , toHandle+    , concatUnfold+    )+where++import Streamly.Internal.Control.Concurrent (MonadAsync)+import Prelude+       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++-- $serial+--+-- Serial streams are /spatially ordered/, they execute the actions in the+-- stream strictly one after the other.+--+-- There are two serial stream types 'SerialT' and 'WSerialT'.  They differ+-- only in the 'Semigroup' and 'Monad' instance behavior.++-- $ahead+--+-- Speculative streams evaluate some future actions speculatively and+-- concurrently, and keep the results ready for consumption. As in serial+-- streams, results are consumed in the same order as the actions in the+-- stream.+--+-- Even though the results of actions are ordered, the side effects are only+-- partially ordered.  Therefore, the semigroup operation is not commutative+-- from the pure outputs perspective but commutative from side effects+-- perspective.++-- $async+--+-- Asynchronous streams evaluate some future actions concurrently, the results+-- are given to the consumer as soon as they become available, they may not be+-- in the same order as the actions in the stream.+--+-- The results of the actions as well as their side effects are partially+-- ordered. Since the order of elements does not matter the 'Semigroup'+-- operation is effectively commutative.+--+-- There are two asynchronous stream types 'AsyncT' and 'WAsyncT'.  They differ+-- only in the 'Semigroup' and 'Monad' instance behavior.++-- $zipping+--+-- 'ZipSerialM' and 'ZipAsyncM', provide 'Applicative' instances for zipping the+-- corresponding elements of two streams together. Note that these types are+-- not monads.++-- $rightfolds+--+-- Let's take a closer look at the @foldr@ definition for lists, as given+-- earlier:+--+-- @+-- foldr f z (x:xs) = x \`f` foldr f z xs+-- @+--+-- @foldr@ invokes the fold step function @f@ as @f x (foldr f z xs)@. At each+-- invocation of @f@, @foldr@ gives us the next element in the input container+-- @x@ and a recursive expression @foldr f z xs@ representing the yet unbuilt+-- (lazy thunk) part of the output.+--+-- When @f x xs@ is lazy in @xs@ it can consume the input one element at a time+-- in FIFO order to build a lazy output expression. For example,+--+-- > f x remaining = show x : remaining+--+-- @take 2 $ foldr f [] (1:2:undefined)@ would consume the input lazily on+-- demand, consuming only first two elements and resulting in ["1", "2"]. @f@+-- can terminate recursion by not evaluating the @remaining@ part:+--+-- > f 2 remaining = show 2 : []+-- > f x remaining = show x : remaining+--+-- @f@ would terminate recursion whenever it sees element @2@ in the input.+-- Therefore, @take 2 $ foldr f [] (1:2:undefined)@ would work without any+-- problem.+--+-- On the other hand, if @f a b@ is strict in @b@ it would end up consuming the+-- whole input right away and expanding the recursive expression @b@ (i.e.+-- @foldr f z xs@) fully before it yields an output expression, resulting in+-- the following /right associated expression/:+--+-- @+-- foldr f z xs == x1 \`f` (x2 \`f` ...(xn \`f` z))+-- @+--+-- For example,+--+-- > f x remaining = x + remaining+--+-- With this definition, @foldr f 0 [1..1000]@, would recurse completely until+-- it reaches the terminating case @... `f` (1000 `f` 0)@, and then+-- start reducing the whole expression from right to left, therefore, consuming+-- the input elements in LIFO order. Thus, such an evaluation would require+-- memory proportional to the size of input. Try out @foldr (+) 0 (map (\\x ->+-- trace (show x) x) [1..10])@.+--+-- Notice the order of the arguments to the step function @f a b@. It follows+-- the order of @a@ and @b@ in the right associative recursive expression+-- generated by expanding @a \`f` b@.+--+-- A right fold is a pull fold, the step function is the puller, it can pull+-- more data from the input container by using its second argument in the+-- output expression or terminate pulling by not using it. As a corollary:+--+-- 1. a step function which is lazy in its second argument (usually functions+-- or constructors that build a lazy structure e.g. @(:)@) can pull lazily on+-- demand.+-- 2. a step function strict in its second argument (usually reducers e.g.+-- (+)) would end up pulling all of its input and buffer it in memory before+-- potentially reducing it.+--+-- A right fold is suitable for lazy reconstructions e.g.  transformation,+-- mapping, filtering of /right associated input structures/ (e.g. cons lists).+-- Whereas a left fold is suitable for reductions (e.g. summing a stream of+-- numbers) of right associated structures. Note that these roles will reverse+-- for left associated structures (e.g. snoc lists). Most of our observations+-- here assume right associated structures, lists being the canonical example.+--+-- 1. A lazy FIFO style pull using a right fold allows pulling a potentially+-- /infinite/ input stream lazily, perform transformations on it, and+-- reconstruct a new structure without having to buffer the whole structure. In+-- contrast, a left fold would buffer the entire structure before the+-- reconstructed structure can be consumed.+-- 2. Even if buffering the entire input structure is ok, we need to keep in+-- mind that a right fold reconstructs structures in a FIFO style, whereas a+-- left fold reconstructs in a LIFO style, thereby reversing the order of+-- elements..+-- 3. A right fold has termination control and therefore can terminate early+-- without going through the entire input, a left fold cannot terminate+-- without consuming all of its input.  For example, a right fold+-- implementation of 'or' can terminate as soon as it finds the first 'True'+-- element, whereas a left fold would necessarily go through the entire input+-- irrespective of that.+-- 4. Reduction (e.g. using (+) on a stream of numbers) using a right fold+-- occurs in a LIFO style, which means that the entire input gets buffered+-- before reduction starts. Whereas with a strict left fold reductions occur+-- incrementally in FIFO style. Therefore, a strict left fold is more suitable+-- for reductions.+--++-- $leftfolds+--+-- Note that the observations below about the behavior of a left fold assume+-- that we are working on a right associated structure like cons lists and+-- streamly streams. If we are working on a left associated structure (e.g.+-- snoc lists) the roles of right and left folds would reverse.+--+-- Let's take a closer look at the @foldl@ definition for lists given above:+--+-- @+-- foldl f z (x:xs) = foldl f (z \`f` x) xs+-- @+--+-- @foldl@ calls itself recursively, in each call it invokes @f@ as @f z x@+-- providing it with the result accumulated till now @z@ (the state) and the+-- next element from the input container. First call to @f@ is supplied with+-- the initial value of the accumulator @z@ and each subsequent call uses the+-- output of the previous call to @f z x@.+--+-- >> foldl' (+) 0 [1,2,3]+-- > 6+--+-- The recursive call at the head of the output expression is bound to be+-- evaluated until recursion terminates, therefore, a left fold always+-- /consumes the whole input container/. The following would result in an+-- error, even though the fold is not using the values at all:+--+-- >> foldl' (\_ _ -> 0) 0 (1:undefined)+-- > *** Exception: Prelude.undefined+--+-- As @foldl@ recurses, it builds the left associated expression shown below.+-- Notice, the order of the arguments to the step function @f b a@. It follows+-- the left associative recursive expression generated by expanding @b \`f` a@.+--+-- @+-- foldl f z xs == (((z \`f` x1) \`f` x2) ...) \`f` xn+-- @+--+--+-- The strict left fold @foldl'@ forces the reduction of its argument @z \`f`+-- x@ before using it, therefore it never builds the whole expression in+-- memory.  Thus, @z \`f` x1@ would get reduced to @z1@ and then @z1 \`f` x2@+-- would get reduced to @z2@ and so on, incrementally reducing the expression+-- from left to right as it recurses, consuming the input in FIFO order.  Try+-- out @foldl' (+) 0 (map (\\x -> trace (show x) x) [1..10])@ to see how it+-- works. For example:+--+-- @+-- >>> Stream.foldl' (+) 0 $ Stream.fromList [1,2,3,4]+-- 10+--+-- @+--+-- @+-- 0 + 1 = 1+-- 1 + 2 = 3+-- 3 + 3 = 6+-- 6 + 4 = 10+-- @+--+-- However, @foldl'@ evaluates the accumulator only to WHNF. It may further+-- help if the step function uses a strict data structure as accumulator to+-- improve performance and to keep the expression fully reduced at all times+-- during the fold.+--+-- A left fold can also build a new structure instead of reducing one if a+-- constructor is used as a fold step. However, it may not be very useful+-- because it will consume the whole input and construct the new structure in+-- memory before we can consume it. Thus the whole structure gets buffered in+-- memory. When the list constructor is used it would build a new list in+-- reverse (LIFO) order:+--+-- @+-- >>> Stream.foldl' (flip (:)) [] $ Stream.fromList [1,2,3,4]+-- [4,3,2,1]+--+-- @+--+-- A left fold is a push fold. The producer pushes its contents to the step+-- function of the fold. The step function therefore has no control to stop the+-- input, it can only discard it if it does not need it. We can also consider a+-- left fold as a state machine where the state is store in the accumulator,+-- the state can be modified based on new inputs that are pushed to the fold.+--+-- In general, a strict left fold is a reducing fold, whereas a right fold is a+-- constructing fold. A strict left fold reduces in a FIFO order whereas it+-- constructs in a LIFO order, and vice-versa for the right fold. See the+-- documentation of 'foldrM' for a discussion on where a left or right fold is+-- suitable.+--+-- To perform a left fold lazily without having to consume all the input one+-- can use @scanl@ to stream the intermediate results of the fold and consume+-- the resulting stream lazily.+--++-- $runningfolds+--+-- See "Streamly.Data.Fold" for an overview of composable folds. All folds in+-- this module can be expressed in terms of composable folds using 'fold'.+--+-- $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 '$'.++-- $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:+--+-- @+--  ...+--  $ Stream.maxBuffer 10+--  $ Stream.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':+--+-- @+--  ...+--  & Stream.maxBuffer 10+--  & Stream.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.
− src/Streamly/SVar.hs 
@@ -1,2211 +0,0 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE KindSignatures             #-}-{-# LANGUAGE ConstraintKinds            #-}-{-# LANGUAGE ExistentialQuantification  #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE MagicHash                  #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE RankNTypes                 #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE UnboxedTuples              #-}---- |--- Module      : Streamly.SVar--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC--module Streamly.SVar-    (-      MonadAsync-    , SVarStyle (..)-    , SVar (..)--    -- State threaded around the stream-    , Limit (..)-    , State (streamVar)-    , defState-    , rstState-    , getMaxThreads-    , setMaxThreads-    , getMaxBuffer-    , setMaxBuffer-    , getStreamRate-    , setStreamRate-    , setStreamLatency-    , getYieldLimit-    , setYieldLimit-    , getInspectMode-    , setInspectMode--    , cleanupSVar-    , cleanupSVarFromWorker--    -- SVar related-    , newAheadVar-    , newParallelVar-    , captureMonadState-    , RunInIO (..)--    , atomicModifyIORefCAS-    , WorkerInfo (..)-    , YieldRateInfo (..)-    , ThreadAbort (..)-    , ChildEvent (..)-    , AheadHeapEntry (..)-    , send-    , sendYield-    , sendStop-    , enqueueLIFO-    , enqueueFIFO-    , enqueueAhead-    , reEnqueueAhead-    , pushWorkerPar--    , queueEmptyAhead-    , dequeueAhead--    , HeapDequeueResult(..)-    , dequeueFromHeap-    , dequeueFromHeapSeq-    , requeueOnHeapTop-    , updateHeapSeq-    , withIORef-    , heapIsSane--    , Rate (..)-    , getYieldRateInfo-    , newSVarStats-    , collectLatency-    , workerUpdateLatency-    , isBeyondMaxRate-    , workerRateControl-    , updateYieldCount-    , decrementYieldLimit-    , decrementYieldLimitPost-    , incrementYieldLimit-    , postProcessBounded-    , postProcessPaced-    , readOutputQBounded-    , readOutputQPaced-    , dispatchWorkerPaced-    , sendFirstWorker-    , delThread--    , toStreamVar-    , SVarStats (..)-    , NanoSecs (..)-    , dumpSVar-    )-where--import Control.Concurrent-       (ThreadId, myThreadId, threadDelay, throwTo)-import Control.Concurrent.MVar-       (MVar, newEmptyMVar, tryPutMVar, takeMVar, newMVar, tryReadMVar)-import Control.Exception-       (SomeException(..), catch, mask, assert, Exception, catches,-        throwIO, Handler(..), BlockedIndefinitelyOnMVar(..),-        BlockedIndefinitelyOnSTM(..))-import Control.Monad (when)-import Control.Monad.Catch (MonadThrow)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Trans.Control (MonadBaseControl, control, StM)-import Data.Atomics-       (casIORef, readForCAS, peekTicket, atomicModifyIORefCAS_,-        writeBarrier, storeLoadBarrier)-import Data.Concurrent.Queue.MichaelScott (LinkedQueue, pushL)-import Data.Functor (void)-import Data.Heap (Heap, Entry(..))-import Data.Int (Int64)-import Data.IORef-       (IORef, modifyIORef, newIORef, readIORef, writeIORef, atomicModifyIORef)-import Data.List ((\\))-import Data.Maybe (fromJust)-import Data.Semigroup ((<>))-import Data.Set (Set)-import GHC.Conc (ThreadId(..))-import GHC.Exts-import GHC.IO (IO(..))-import System.Clock (TimeSpec, Clock(Monotonic), getTime, toNanoSecs)-import System.IO (hPutStrLn, stderr)-import Text.Printf (printf)--import qualified Data.Heap as H-import qualified Data.Set                    as S---- Always use signed arithmetic to avoid inadvertant overflows of signed values--- on conversion when comparing unsigned quantities with signed.-newtype NanoSecs = NanoSecs Int64-    deriving ( Eq-             , Read-             , Show-             , Enum-             , Bounded-             , Num-             , Real-             , Integral-             , Ord-             )--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 :: (* -> *) -> * -> *) m a =-      AheadEntryNull-    | AheadEntryPure a-    | AheadEntryStream (t m a)----------------------------------------------------------------------------------- State threaded around the monad 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, TimeSpec)-    }----- | 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-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-    }--data LatencyRange = LatencyRange-    { minLatency :: NanoSecs-    , maxLatency :: NanoSecs-    } deriving Show---- Rate control.-data YieldRateInfo = YieldRateInfo-    { svarLatencyTarget    :: NanoSecs-    , svarLatencyRange     :: LatencyRange-    , svarRateBuffer       :: Int-    , 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-    , svarAllTimeLatency :: IORef (Count, TimeSpec)--    -- XXX Worker latency specified by the user to be used before the first-    -- actual measurement arrives. Not yet implemented-    , workerBootstrapLatency :: Maybe NanoSecs--    -- 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.-    , 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.-    -- (yieldCount, timeTaken)-    , workerPendingLatency   :: IORef (Count, NanoSecs)--    -- 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.-    -- (yieldCount, timeTaken)-    , workerCollectedLatency :: IORef (Count, NanoSecs)--    -- Latency as measured by workers, aggregated for the last period.-    , workerMeasuredLatency :: IORef NanoSecs-    }--data SVarStats = SVarStats {-      totalDispatches  :: IORef Int-    , maxWorkers       :: IORef Int-    , maxOutQSize      :: IORef Int-    , maxHeapSize      :: IORef Int-    , maxWorkQSize     :: IORef Int-    , avgWorkerLatency :: IORef (Count, NanoSecs)-    , minWorkerLatency :: IORef NanoSecs-    , maxWorkerLatency :: IORef NanoSecs-    , svarStopTime     :: IORef (Maybe TimeSpec)-}--data Limit = Unlimited | Limited Word deriving Show--data SVar t m a = SVar-    {-    -- Read only state-      svarStyle       :: SVarStyle-    , svarMrun        :: RunInIO m--    -- 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.-    , outputQueue    :: IORef ([ChildEvent a], Int)-    , outputDoorBell :: MVar ()  -- signal the consumer about output-    , readOutputQ    :: m [ChildEvent a]-    , postProcess    :: m Bool--    -- Combined/aggregate parameters-    , maxWorkerLimit :: Limit-    , maxBufferLimit :: Limit-    , remainingWork  :: Maybe (IORef Count)-    , yieldRateInfo  :: Maybe YieldRateInfo--    -- Used only by bounded SVar types-    , enqueue        :: t m a -> IO ()-    , isWorkDone     :: IO Bool-    , isQueueDone    :: IO Bool-    , needDoorBell   :: IORef Bool-    , workLoop       :: Maybe WorkerInfo -> m ()--    -- Shared, thread tracking-    , workerThreads  :: IORef (Set ThreadId)-    , 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)-    }------------------------------------------------------------------------------------ State for concurrency control------------------------------------------------------------------------------------ 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 NanoSecs -- 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.-rstState :: State t m a -> State t m b-rstState 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 NanoSecs-getStreamLatency = _streamLatency--setInspectMode :: State t m a -> State t m a-setInspectMode st = st { _inspectMode = True }--getInspectMode :: State t m a -> Bool-getInspectMode = _inspectMode------------------------------------------------------------------------------------ Cleanup----------------------------------------------------------------------------------cleanupSVar :: SVar t m a -> IO ()-cleanupSVar sv = do-    workers <- readIORef (workerThreads sv)-    Prelude.mapM_ (`throwTo` ThreadAbort)-          (S.toList workers)--cleanupSVarFromWorker :: SVar t m a -> IO ()-cleanupSVarFromWorker sv = do-    workers <- readIORef (workerThreads sv)-    self <- myThreadId-    mapM_ (`throwTo` ThreadAbort)-          (S.toList workers \\ [self])------------------------------------------------------------------------------------ Dumping the SVar for debug/diag------------------------------------------------------------------------------------ | Convert a number of seconds to a string.  The string will consist--- of four decimal places, followed by a short description of the time--- units.-secs :: Double -> String-secs k-    | k < 0      = '-' : secs (-k)-    | k >= 1     = k        `with` "s"-    | k >= 1e-3  = (k*1e3)  `with` "ms"-#ifdef mingw32_HOST_OS-    | k >= 1e-6  = (k*1e6)  `with` "us"-#else-    | k >= 1e-6  = (k*1e6)  `with` "μs"-#endif-    | k >= 1e-9  = (k*1e9)  `with` "ns"-    | k >= 1e-12 = (k*1e12) `with` "ps"-    | k >= 1e-15 = (k*1e15) `with` "fs"-    | k >= 1e-18 = (k*1e18) `with` "as"-    | otherwise  = printf "%g s" k-     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---- XXX Code duplicated from collectLatency-drainLatency :: SVar t m a -> YieldRateInfo -> IO (Count, TimeSpec, NanoSecs)-drainLatency sv yinfo = do-    let cur      = workerPendingLatency yinfo-        col      = workerCollectedLatency yinfo-        longTerm = svarAllTimeLatency yinfo-        measured = workerMeasuredLatency yinfo--    (count, time)       <- atomicModifyIORefCAS cur $ \v -> ((0,0), v)-    (colCount, colTime) <- readIORef col-    (lcount, ltime)     <- readIORef longTerm-    prev                <- readIORef measured--    let pendingCount = colCount + count-        pendingTime  = colTime + time--        lcount' = lcount + pendingCount-        notUpdated = (lcount', ltime, prev)--    if (pendingCount > 0)-    then do-        let new = pendingTime `div` (fromIntegral pendingCount)-        when (svarInspectMode sv) $ do-            let ss = svarStats sv-            minLat <- readIORef (minWorkerLatency ss)-            when (new < minLat || minLat == 0) $-                writeIORef (minWorkerLatency ss) new--            maxLat <- readIORef (maxWorkerLatency ss)-            when (new > maxLat) $ writeIORef (maxWorkerLatency ss) new-            modifyIORef (avgWorkerLatency ss) $-                \(cnt, t) -> (cnt + pendingCount, t + pendingTime)-        -- To avoid minor fluctuations update in batches-        writeIORef col (0, 0)-        writeIORef measured new-        modifyIORef longTerm $ \(_, t) -> (lcount', t)-        return (lcount', ltime, new)-    else return notUpdated--dumpSVarStats :: SVar t m a -> SVarStats -> SVarStyle -> IO String-dumpSVarStats sv ss style = do-    case yieldRateInfo sv of-        Nothing -> return ()-        Just yinfo -> do-            _ <- liftIO $ drainLatency sv yinfo-            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-    (svarCnt, svarGainLossCnt, svarLat) <- case yieldRateInfo sv of-        Nothing -> return (0, 0, 0)-        Just yinfo -> do-            (cnt, startTime) <- readIORef $ svarAllTimeLatency yinfo-            if cnt > 0-            then do-                t <- readIORef (svarStopTime ss)-                gl <- readIORef (svarGainedLostYields yinfo)-                case t of-                    Nothing -> do-                        now <- getTime Monotonic-                        let interval = toNanoSecs (now - startTime)-                        return (cnt, gl, interval `div` fromIntegral cnt)-                    Just stopTime -> do-                        let interval = toNanoSecs (stopTime - startTime)-                        return (cnt, gl, interval `div` fromIntegral cnt)-            else return (0, 0, 0)--    return $ unlines-        [ "total dispatches = " <> show dispatches-        , "max workers = " <> show maxWrk-        , "max outQSize = " <> show maxOq-            <> (if style == AheadVar-               then "\nheap max size = " <> show maxHp-               else "")-            <> (if minLat > 0-               then "\nmin worker latency = "-                    <> secs (fromIntegral minLat * 1e-9)-               else "")-            <> (if maxLat > 0-               then "\nmax worker latency = "-                    <> secs (fromIntegral maxLat * 1e-9)-               else "")-            <> (if avgCnt > 0-                then let lat = avgTime `div` fromIntegral avgCnt-                     in "\navg worker latency = "-                        <> secs (fromIntegral lat * 1e-9)-                else "")-            <> (if svarLat > 0-               then "\nSVar latency = "-                        <> secs (fromIntegral svarLat * 1e-9)-               else "")-            <> (if svarCnt > 0-               then "\nSVar yield count = " <> show svarCnt-               else "")-            <> (if svarGainLossCnt > 0-               then "\nSVar gain/loss yield count = " <> show svarGainLossCnt-               else "")-        ]--{-# NOINLINE dumpSVar #-}-dumpSVar :: SVar t m a -> IO String-dumpSVar sv = do-    (oqList, oqLen) <- readIORef $ outputQueue sv-    db <- tryReadMVar $ outputDoorBell sv-    aheadDump <--        if svarStyle sv == AheadVar-        then do-            (oheap, oheapSeq) <- readIORef $ outputHeap sv-            (wq, wqSeq) <- readIORef $ aheadWorkQueue sv-            return $ unlines-                [ "heap length = " <> show (H.size oheap)-                , "heap seqeunce = " <> show oheapSeq-                , "work queue length = " <> show (length wq)-                , "work queue sequence = " <> show wqSeq-                ]-        else return []--    let style = svarStyle sv-    waiting <--        if style /= ParallelVar-        then readIORef $ needDoorBell sv-        else return False-    rthread <- readIORef $ workerThreads sv-    workers <- readIORef $ workerCount sv-    stats <- dumpSVarStats sv (svarStats sv) (svarStyle sv)--    return $ unlines-        [-          "Creator tid = " <> show (svarCreator sv),-          "style = " <> show (svarStyle sv)-        , "---------CURRENT STATE-----------"-        , "outputQueue length computed  = " <> show (length oqList)-        , "outputQueue length maintained = " <> show oqLen-        -- XXX print the types of events in the outputQueue, first 5-        , "outputDoorBell = " <> show db-        ]-        <> aheadDump-        <> unlines-        [ "needDoorBell = " <> show waiting-        , "running threads = " <> show rthread-        -- XXX print the status of first 5 threads-        , "running thread count = " <> show workers-        ]-        <> "---------STATS-----------\n"-        <> stats---- MVar diagnostics has some overhead - around 5% on asyncly 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.--{-# NOINLINE mvarExcHandler #-}-mvarExcHandler :: SVar t m a -> String -> BlockedIndefinitelyOnMVar -> IO ()-mvarExcHandler sv label e@BlockedIndefinitelyOnMVar = do-    svInfo <- dumpSVar sv-    hPutStrLn stderr $ label <> " " <> "BlockedIndefinitelyOnMVar\n" <> svInfo-    throwIO e--{-# NOINLINE stmExcHandler #-}-stmExcHandler :: SVar t m a -> String -> BlockedIndefinitelyOnSTM -> IO ()-stmExcHandler sv label e@BlockedIndefinitelyOnSTM = do-    svInfo <- dumpSVar sv-    hPutStrLn stderr $ label <> " " <> "BlockedIndefinitelyOnSTM\n" <> svInfo-    throwIO e--withDiagMVar :: SVar t m a -> String -> IO () -> IO ()-withDiagMVar sv label action =-    if svarInspectMode sv-    then-        action `catches` [ Handler (mvarExcHandler sv label)-                         , Handler (stmExcHandler sv label)-                         ]-    else action------------------------------------------------------------------------------------ CAS------------------------------------------------------------------------------------ Slightly faster version of CAS. Gained some improvement by avoiding the use--- of "evaluate" because we know we do not have exceptions in fn.-{-# INLINE atomicModifyIORefCAS #-}-atomicModifyIORefCAS :: IORef a -> (a -> (a,b)) -> IO b-atomicModifyIORefCAS ref fn = do-    tkt <- readForCAS ref-    loop tkt retries--    where--    retries = 25 :: Int-    loop _   0     = atomicModifyIORef ref fn-    loop old tries = do-        let (new, result) = fn $ peekTicket old-        (success, tkt) <- casIORef ref old new-        if success-        then return result-        else loop tkt (tries - 1)--{-# INLINE ringDoorBell #-}-ringDoorBell :: SVar t m a -> IO ()-ringDoorBell sv = do-    storeLoadBarrier-    w <- readIORef $ needDoorBell sv-    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_ (needDoorBell sv) (const False)-        void $ tryPutMVar (outputDoorBell sv) ()------------------------------------------------------------------------------------ Spawning threads and collecting result in streamed fashion----------------------------------------------------------------------------------- | 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-type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)---- When we run computations concurrently, we completely isolate the state of--- the concurrent computations from the parent computation.  The invariant is--- that we should never be running two concurrent computations in the same--- thread without using the runInIO function.  Also, we should never be running--- a concurrent computation in the parent thread, otherwise it may affect the--- state of the parent which is against the defined semantics of concurrent--- execution.-newtype RunInIO m = RunInIO { runInIO :: forall b. m b -> IO (StM m b) }--captureMonadState :: MonadBaseControl IO m => m (RunInIO m)-captureMonadState = control $ \run -> run (return $ RunInIO run)---- 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 action = IO $ \ s ->-   case fork# action s of (# s1, tid #) -> (# s1, ThreadId tid #)--{-# INLINE doFork #-}-doFork :: MonadBaseControl IO m-    => m ()-    -> RunInIO m-    -> (SomeException -> IO ())-    -> m ThreadId-doFork action (RunInIO mrun) exHandler =-    control $ \run ->-        mask $ \restore -> do-                tid <- rawForkIO $ catch (restore $ void $ mrun action)-                                         exHandler-                run (return tid)---- 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.------ Note that we need it to be an Int type so that we have the ability to undo a--- decrement that takes below zero.-{-# INLINE decrementYieldLimit #-}-decrementYieldLimit :: SVar t m a -> IO Bool-decrementYieldLimit sv =-    case remainingWork sv of-        Nothing -> return True-        Just ref -> do-            r <- atomicModifyIORefCAS ref $ \x -> (x - 1, x)-            return $ r >= 1---- decrementYieldLimit returns False when the old limit is 0. This one returns--- False when the old limit is 1.-{-# INLINE decrementYieldLimitPost #-}-decrementYieldLimitPost :: SVar t m a -> IO Bool-decrementYieldLimitPost sv =-    case remainingWork sv of-        Nothing -> return True-        Just ref -> do-            r <- atomicModifyIORefCAS ref $ \x -> (x - 1, x)-            return $ r > 1--{-# INLINE incrementYieldLimit #-}-incrementYieldLimit :: SVar t m a -> IO ()-incrementYieldLimit sv =-    case remainingWork sv of-        Nothing -> return ()-        Just ref -> atomicModifyIORefCAS_ ref (+ 1)---- XXX exception safety of all atomic/MVar operations---- TBD Each worker can have their own queue and the consumer can empty one--- queue at a time, that way contention can be reduced.---- XXX Only yields should be counted in the buffer limit and not the Stop--- events.---- | This function is used by the producer threads to queue output for the--- consumer thread to consume. Returns whether the queue has more space.-send :: SVar t m a -> ChildEvent a -> IO Bool-send sv msg = do-    -- XXX can the access to outputQueue and maxBufferLimit be made faster-    -- somehow?-    len <- atomicModifyIORefCAS (outputQueue sv) $ \(es, n) ->-        ((msg : es, n + 1), n)-    when (len <= 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 (outputDoorBell sv) ()--    -- XXX we should reserve the buffer when we pick up the work from the-    -- queue, instead of checking it here when it is too late.-    let limit = maxBufferLimit sv-    case limit of-        Unlimited -> return True-        Limited lim -> do-            active <- readIORef (workerCount sv)-            return $ len < (fromIntegral lim - active)--workerCollectLatency :: WorkerInfo -> IO (Maybe (Count, NanoSecs))-workerCollectLatency winfo = do-    (cnt0, t0) <- readIORef (workerLatencyStart winfo)-    cnt1 <- readIORef (workerYieldCount winfo)-    let cnt = cnt1 - cnt0--    if cnt > 0-    then do-        t1 <- getTime Monotonic-        let period = fromInteger $ toNanoSecs (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.------ 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-            let ref = workerPendingLatency yinfo-            atomicModifyIORefCAS_ ref $ \(n, t) -> (n + cnt, t + period)-        Nothing -> return ()--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---- 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.-{-# NOINLINE checkRatePeriodic #-}-checkRatePeriodic :: SVar t m a-                  -> YieldRateInfo-                  -> WorkerInfo-                  -> Count-                  -> IO Bool-checkRatePeriodic sv yinfo winfo ycnt = do-    i <- readIORef (workerPollingInterval yinfo)-    -- XXX use generation count to check if the interval has been updated-    if i /= 0 && (ycnt `mod` i) == 0-    then do-        workerUpdateLatency yinfo winfo-        -- XXX not required for parallel streams-        isBeyondMaxRate sv yinfo-    else return False---- CAUTION! this also updates the yield count and therefore should be called--- only when we are actually yielding an element.-{-# NOINLINE workerRateControl #-}-workerRateControl :: SVar t m a -> YieldRateInfo -> WorkerInfo -> IO Bool-workerRateControl sv yinfo winfo = do-    cnt <- updateYieldCount winfo-    beyondMaxRate <- checkRatePeriodic sv yinfo winfo cnt-    return $ not (isBeyondMaxYield cnt winfo || beyondMaxRate)---- 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.-{-# INLINE sendYield #-}-sendYield :: SVar t m a -> Maybe WorkerInfo -> ChildEvent a -> IO Bool-sendYield sv mwinfo msg = do-    r <- send sv msg-    rateLimitOk <--        case mwinfo of-            Just winfo ->-                case yieldRateInfo sv of-                    Nothing -> return True-                    Just yinfo -> workerRateControl sv yinfo winfo-            Nothing -> return True-    return $ r && rateLimitOk--{-# INLINE workerStopUpdate #-}-workerStopUpdate :: WorkerInfo -> YieldRateInfo -> IO ()-workerStopUpdate winfo info = do-    i <- readIORef (workerPollingInterval info)-    when (i /= 0) $ workerUpdateLatency info winfo--{-# INLINABLE sendStop #-}-sendStop :: SVar t m a -> Maybe WorkerInfo -> IO ()-sendStop sv mwinfo = do-    atomicModifyIORefCAS_ (workerCount sv) $ \n -> n - 1-    case (mwinfo, yieldRateInfo sv) of-      (Just winfo, Just info) ->-          workerStopUpdate winfo info-      _ ->-          return ()-    myThreadId >>= \tid -> void $ send sv (ChildStop tid Nothing)------------------------------------------------------------------------------------ Async------------------------------------------------------------------------------------ Note: For purely right associated expressions this queue should have at most--- one element. It grows to more than one when we have left associcated--- expressions. Large left associated compositions can grow this to a--- large size-{-# INLINE enqueueLIFO #-}-enqueueLIFO :: SVar t m a -> IORef [t m a] -> t m a -> IO ()-enqueueLIFO sv q m = do-    atomicModifyIORefCAS_ q $ \ms -> m : ms-    ringDoorBell sv------------------------------------------------------------------------------------ WAsync------------------------------------------------------------------------------------ XXX we can use the Ahead style sequence/heap mechanism to make the best--- effort to always try to finish the streams on the left side of an expression--- first as long as possible.--{-# INLINE enqueueFIFO #-}-enqueueFIFO :: SVar t m a -> LinkedQueue (t m a) -> t m a -> IO ()-enqueueFIFO sv q m = do-    pushL q m-    ringDoorBell sv------------------------------------------------------------------------------------ Ahead------------------------------------------------------------------------------------ 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.---- 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.--- Thererefore the queue never has more than one item in it.------ 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.-{-# INLINE enqueueAhead #-}-enqueueAhead :: SVar t m a -> IORef ([t m a], Int) -> t m a -> IO ()-enqueueAhead sv q m = do-    atomicModifyIORefCAS_ q $ \ case-        ([], n) -> ([m], n + 1)  -- increment sequence-        _ -> error "not empty"-    ringDoorBell sv---- enqueue without incrementing the sequence number-{-# INLINE reEnqueueAhead #-}-reEnqueueAhead :: SVar t m a -> IORef ([t m a], Int) -> t m a -> IO ()-reEnqueueAhead sv q m = do-    atomicModifyIORefCAS_ q $ \ case-        ([], n) -> ([m], n)  -- DO NOT increment sequence-        _ -> error "not empty"-    ringDoorBell 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 queueEmptyAhead #-}-queueEmptyAhead :: MonadIO m => IORef ([t m a], Int) -> m Bool-queueEmptyAhead q = liftIO $ do-    (xs, _) <- readIORef q-    return $ null xs--{-# INLINE dequeueAhead #-}-dequeueAhead :: MonadIO m-    => IORef ([t m a], Int) -> m (Maybe (t m a, Int))-dequeueAhead q = liftIO $-    atomicModifyIORefCAS q $ \case-            ([], n) -> (([], n), Nothing)-            (x : [], n) -> (([], n), Just (x, n))-            _ -> error "more than one item on queue"------------------------------------------------------------------------------------ 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 HeapDequeueResult t m a =-      Clearing-    | Waiting Int-    | Ready (Entry Int (AheadHeapEntry t m a))--{-# INLINE dequeueFromHeap #-}-dequeueFromHeap-    :: IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)-    -> IO (HeapDequeueResult t 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)--{-# INLINE dequeueFromHeapSeq #-}-dequeueFromHeapSeq-    :: IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)-    -> Int-    -> IO (HeapDequeueResult t 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 t m a)), Maybe Int)-    -> Entry Int (AheadHeapEntry t 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 t m a)), Maybe Int)-    -> Int-    -> IO ()-updateHeapSeq hpVar seqNo =-    atomicModifyIORef_ hpVar $ \(hp, snum) ->-        assert (heapIsSane snum seqNo) (hp, Just seqNo)------------------------------------------------------------------------------------ WAhead------------------------------------------------------------------------------------ XXX To be implemented. Use a linked queue like WAsync and put back the--- remaining computation at the back of the queue instead of the heap, and--- increment the sequence number.---- 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 => SVar t m a -> ThreadId -> m ()-addThread sv tid =-    liftIO $ modifyIORef (workerThreads sv) (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 => SVar t m a -> ThreadId -> m ()-delThread sv tid =-    liftIO $ modifyIORef (workerThreads sv) (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 => SVar t m a -> ThreadId -> m ()-modifyThread sv tid = do-    changed <- liftIO $ atomicModifyIORefCAS (workerThreads sv) $ \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 (outputDoorBell sv) ()---- | 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 => SVar t m a -> m Bool-allThreadsDone sv = liftIO $ S.null <$> readIORef (workerThreads sv)--{-# NOINLINE handleChildException #-}-handleChildException :: SVar t m a -> SomeException -> IO ()-handleChildException sv e = do-    tid <- myThreadId-    void $ send sv (ChildStop tid (Just e))--{-# NOINLINE recordMaxWorkers #-}-recordMaxWorkers :: MonadIO m => SVar t m a -> m ()-recordMaxWorkers sv = liftIO $ do-    active <- readIORef (workerCount sv)-    maxWrk <- readIORef (maxWorkers $ svarStats sv)-    when (active > maxWrk) $ writeIORef (maxWorkers $ svarStats sv) active-    modifyIORef (totalDispatches $ svarStats sv) (+1)--{-# NOINLINE pushWorker #-}-pushWorker :: MonadAsync m => Count -> SVar t m a -> m ()-pushWorker yieldMax sv = do-    liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1-    when (svarInspectMode sv) $ recordMaxWorkers sv-    -- This allocation matters when significant number of workers are being-    -- sent. We allocate it only when needed.-    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-                    }-    doFork (workLoop sv winfo) (svarMrun sv) (handleChildException sv)-        >>= addThread sv---- XXX we can push the workerCount modification in accountThread and use the--- same pushWorker for Parallel case as well.------ | In contrast to pushWorker which always happens only from the consumer--- thread, a pushWorkerPar can happen concurrently from multiple threads on the--- producer side. So we need to use a thread safe modification of--- workerThreads. Alternatively, we can use a CreateThread event to avoid--- using a CAS based modification.-{-# INLINE pushWorkerPar #-}-pushWorkerPar-    :: MonadAsync m-    => SVar t m a -> (Maybe WorkerInfo -> m ()) -> m ()-pushWorkerPar sv wloop =-    if svarInspectMode sv-    then forkWithDiag-    else doFork (wloop Nothing) (svarMrun sv) (handleChildException sv)-            >>= modifyThread sv--    where--    {-# NOINLINE forkWithDiag #-}-    forkWithDiag = do-        -- We do not use workerCount in case of ParallelVar but still there is-        -- no harm in maintaining it correctly.-        liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1-        recordMaxWorkers sv-        -- This allocation matters when significant number of workers are being-        -- sent. We allocate it only when needed. The overhead increases by 4x.-        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 = 0-                        , workerYieldCount = cntRef-                        , workerLatencyStart = lat-                        }--        doFork (wloop winfo) (svarMrun sv) (handleChildException sv)-            >>= modifyThread sv---- Returns:--- True: can dispatch more--- False: cannot dispatch any more-dispatchWorker :: MonadAsync m => Count -> SVar t m a -> m Bool-dispatchWorker yieldCount sv = do-    let workerLimit = maxWorkerLimit sv-    -- 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.-    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-        -- Note that the worker count is only decremented during event-        -- processing in fromStreamVar and therefore it is safe to read and-        -- use it without a lock.-        active <- liftIO $ readIORef $ workerCount sv-        if not qDone-        then 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 <- case remainingWork sv of-                Nothing -> return workerLimit-                Just ref -> do-                    n <- liftIO $ readIORef ref-                    return $-                        case workerLimit of-                            Unlimited -> Limited (fromIntegral n)-                            Limited lim -> Limited $ min lim (fromIntegral n)--            -- 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.-            let dispatch = pushWorker yieldCount sv >> return True-             in case limit of-                Unlimited -> dispatch-                -- 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 | lim > 0 -> dispatch-                _ -> return False-        else do-            when (active <= 0) $ pushWorker 0 sv-            return False-    else return False---- | 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 :: NanoSecs-minThreadDelay = 10^(6 :: Int)---- | 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 :: NanoSecs-rateRecoveryTime = 1000000--nanoToMicroSecs :: NanoSecs -> Int-nanoToMicroSecs s = fromIntegral s `div` 1000---- We either block, or send one worker with limited yield count or one or more--- workers with unlimited yield count.-data Work-    = BlockWait NanoSecs-    | PartialWorker Count-    | ManyWorkers Int Count-    deriving Show---- XXX we can use phantom types to distinguish the duration/latency/expectedLat-estimateWorkers-    :: Limit-    -> Count-    -> Count-    -> NanoSecs-    -> NanoSecs-    -> NanoSecs-    -> LatencyRange-    -> 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 acheive 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 acheive. 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 = NanoSecs $ 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)---- | Get the worker latency without resetting workerPendingLatency--- Returns (total yield count, base time, measured latency)--- CAUTION! keep it in sync with collectLatency-getWorkerLatency :: YieldRateInfo -> IO (Count, TimeSpec, NanoSecs)-getWorkerLatency yinfo  = do-    let cur      = workerPendingLatency yinfo-        col      = workerCollectedLatency yinfo-        longTerm = svarAllTimeLatency yinfo-        measured = workerMeasuredLatency yinfo--    (count, time)       <- readIORef cur-    (colCount, colTime) <- readIORef col-    (lcount, ltime)     <- readIORef longTerm-    prev                <- readIORef measured--    let pendingCount = colCount + count-        pendingTime  = colTime + time-        new =-            if pendingCount > 0-            then let lat = pendingTime `div` fromIntegral pendingCount-                 -- XXX Give more weight to new?-                 in (lat + prev) `div` 2-            else prev-    return (lcount + pendingCount, ltime, new)--isBeyondMaxRate :: SVar t m a -> YieldRateInfo -> IO Bool-isBeyondMaxRate sv yinfo = do-    (count, tstamp, wLatency) <- getWorkerLatency yinfo-    now <- getTime Monotonic-    let duration = fromInteger $ toNanoSecs $ now - tstamp-    let targetLat = svarLatencyTarget yinfo-    gainLoss <- readIORef (svarGainedLostYields yinfo)-    let work = estimateWorkers (maxWorkerLimit sv) count gainLoss duration-                               wLatency targetLat (svarLatencyRange yinfo)-    cnt <- readIORef $ workerCount sv-    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---- 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 -> NanoSecs -> IO ()-updateWorkerPollingInterval yinfo latency = do-    let periodRef = workerPollingInterval yinfo-        cnt = max 1 $ minThreadDelay `div` latency-        period = min cnt (fromIntegral magicMaxBuffer)--    writeIORef periodRef (fromIntegral period)---- Returns a triple, (1) yield count since last collection, (2) the base time--- when we started counting, (3) average latency in the last measurement--- period. The former two are used for accurate measurement of the going rate--- whereas the average is used for future estimates e.g. how many workers--- should be maintained to maintain the rate.--- CAUTION! keep it in sync with getWorkerLatency-collectLatency :: SVar t m a -> YieldRateInfo -> IO (Count, TimeSpec, NanoSecs)-collectLatency sv yinfo = do-    let cur      = workerPendingLatency yinfo-        col      = workerCollectedLatency yinfo-        longTerm = svarAllTimeLatency yinfo-        measured = workerMeasuredLatency yinfo--    (count, time)       <- atomicModifyIORefCAS cur $ \v -> ((0,0), v)-    (colCount, colTime) <- readIORef col-    (lcount, ltime)     <- readIORef longTerm-    prev                <- readIORef measured--    let pendingCount = colCount + count-        pendingTime  = colTime + time--        lcount' = lcount + pendingCount-        tripleWith lat = (lcount', ltime, lat)--    if pendingCount > 0-    then do-        let new = pendingTime `div` (fromIntegral pendingCount)-        when (svarInspectMode sv) $ do-            let ss = svarStats sv-            minLat <- readIORef (minWorkerLatency ss)-            when (new < minLat || minLat == 0) $-                writeIORef (minWorkerLatency ss) new--            maxLat <- readIORef (maxWorkerLatency ss)-            when (new > maxLat) $ writeIORef (maxWorkerLatency ss) new-        -- 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     (pendingCount > fromIntegral magicMaxBuffer)-            || (pendingTime > minThreadDelay)-            || (let r = fromIntegral new / fromIntegral prev :: Double-                 in prev > 0 && (r > 2 || r < 0.5))-            || (prev == 0)-        then do-            when (svarInspectMode sv) $ do-                let ss = svarStats sv-                modifyIORef (avgWorkerLatency ss) $-                    \(cnt, t) -> (cnt + pendingCount, t + pendingTime)-            updateWorkerPollingInterval yinfo (max new prev)-            writeIORef col (0, 0)-            writeIORef measured ((prev + new) `div` 2)-            modifyIORef longTerm $ \(_, t) -> (lcount', t)-            return $ tripleWith new-        else do-            writeIORef col (pendingCount, pendingTime)-            return $ tripleWith prev-    else return $ tripleWith prev---- 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.------ Returns:--- True: can dispatch more--- False: full, no more dispatches-dispatchWorkerPaced :: MonadAsync m => SVar t m a -> m Bool-dispatchWorkerPaced sv = do-    let yinfo = fromJust $ yieldRateInfo sv-    (svarYields, svarElapsed, wLatency) <- do-        now <- liftIO $ getTime Monotonic-        (yieldCount, baseTime, lat) <--            liftIO $ collectLatency sv yinfo-        let elapsed = fromInteger $ toNanoSecs $ now - baseTime-        let latency =-                if lat == 0-                then-                    case workerBootstrapLatency yinfo of-                        Nothing -> lat-                        Just t -> t-                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, otherwise we will-                -- defer the output of those. Note we cannot use workerCount-                -- here as it is not a reliable way to ensure there are-                -- definitely no active workers. When workerCount is 0 we may-                -- still have a Stop event waiting in the outputQueue.-                done <- allThreadsDone sv-                when done $ void $ do-                    liftIO $ threadDelay $ nanoToMicroSecs s-                    dispatchWorker 1 sv-                return False-            PartialWorker yields -> do-                assert (yields > 0) (return ())-                updateGainedLostYields yinfo yields--                done <- allThreadsDone sv-                when done $ void $ dispatchWorker yields sv-                return False-            ManyWorkers netWorkers yields -> do-                assert (netWorkers >= 1) (return ())-                assert (yields >= 0) (return ())-                updateGainedLostYields yinfo yields--                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--    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--sendWorkerDelayPaced :: SVar t m a -> IO ()-sendWorkerDelayPaced _ = return ()--sendWorkerDelay :: SVar t 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 ()--{-# NOINLINE sendWorkerWait #-}-sendWorkerWait-    :: MonadAsync m-    => (SVar t m a -> IO ())-    -> (SVar t m a -> m Bool)-    -> SVar t m a-    -> m ()-sendWorkerWait delay dispatch sv = 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) $ 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_ (needDoorBell 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 sendWorkerWait delay dispatch sv-        else do-            liftIO $ withDiagMVar sv "sendWorkerWait: nothing to do"-                             $ takeMVar (outputDoorBell sv)-            (_, len) <- liftIO $ readIORef (outputQueue sv)-            when (len <= 0) $ sendWorkerWait delay dispatch sv--{-# INLINE readOutputQRaw #-}-readOutputQRaw :: SVar t m a -> IO ([ChildEvent a], Int)-readOutputQRaw sv = do-    (list, len) <- atomicModifyIORefCAS (outputQueue sv) $ \x -> (([],0), x)-    when (svarInspectMode sv) $ do-        let ref = maxOutQSize $ svarStats sv-        oqLen <- readIORef ref-        when (len > oqLen) $ writeIORef ref len-    return (list, len)--readOutputQBounded :: MonadAsync m => SVar t m a -> m [ChildEvent a]-readOutputQBounded sv = do-    (list, len) <- liftIO $ readOutputQRaw 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) (pushWorker 0 sv)--    {-# INLINE blockingRead #-}-    blockingRead = do-        sendWorkerWait sendWorkerDelay (dispatchWorker 0) sv-        liftIO (fst `fmap` readOutputQRaw sv)--readOutputQPaced :: MonadAsync m => SVar t m a -> m [ChildEvent a]-readOutputQPaced sv = do-    (list, len) <- liftIO $ readOutputQRaw 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-        sendWorkerWait sendWorkerDelayPaced dispatchWorkerPaced sv-        liftIO (fst `fmap` readOutputQRaw sv)--postProcessBounded :: MonadAsync m => SVar t m a -> m Bool-postProcessBounded sv = do-    workersDone <- allThreadsDone 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) (pushWorker 0 sv)-        -- XXX do we need to dispatch many here?-        -- void $ dispatchWorker sv-        return r-    else return False--postProcessPaced :: MonadAsync m => SVar t m a -> m Bool-postProcessPaced sv = do-    workersDone <- allThreadsDone 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 sv-            when noWorker $ pushWorker 0 sv-        return r-    else return False--getYieldRateInfo :: State t m a -> IO (Maybe YieldRateInfo)-getYieldRateInfo 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)-        wcol     <- newIORef (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-            }--newSVarStats :: IO SVarStats-newSVarStats = do-    disp   <- newIORef 0-    maxWrk <- newIORef 0-    maxOq  <- newIORef 0-    maxHs  <- newIORef 0-    maxWq  <- newIORef 0-    avgLat <- newIORef (0, NanoSecs 0)-    maxLat <- newIORef (NanoSecs 0)-    minLat <- newIORef (NanoSecs 0)-    stpTime <- newIORef Nothing--    return SVarStats-        { totalDispatches  = disp-        , maxWorkers       = maxWrk-        , maxOutQSize      = maxOq-        , maxHeapSize      = maxHs-        , maxWorkQSize     = maxWq-        , avgWorkerLatency = avgLat-        , minWorkerLatency = minLat-        , maxWorkerLatency = maxLat-        , svarStopTime     = stpTime-        }--getAheadSVar :: MonadAsync m-    => State t m a-    -> (   IORef ([t m a], Int)-        -> IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)-        -> State t m a-        -> SVar t m a-        -> Maybe WorkerInfo-        -> m ())-    -> RunInIO m-    -> IO (SVar t m a)-getAheadSVar st f mrun = do-    outQ    <- newIORef ([], 0)-    -- the second component of the tuple is "Nothing" when heap is being-    -- cleared, "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 S.empty-    -- Sequence number is incremented whenever something is queued, therefore,-    -- first sequence number would be 0-    q <- newIORef ([], -1)-    stopMVar <- newMVar ()-    yl <- case getYieldLimit st of-            Nothing -> return Nothing-            Just x -> Just <$> newIORef x-    rateInfo <- getYieldRateInfo st--    stats <- newSVarStats-    tid <- myThreadId--    let getSVar sv readOutput postProc = SVar-            { outputQueue      = outQ-            , remainingWork  = yl-            , maxBufferLimit   = getMaxBuffer st-            , maxWorkerLimit   = getMaxThreads st-            , yieldRateInfo    = rateInfo-            , outputDoorBell   = outQMv-            , readOutputQ      = readOutput sv-            , postProcess      = postProc sv-            , workerThreads    = running-            , workLoop         = f q outH st{streamVar = Just sv} sv-            , enqueue          = enqueueAhead sv q-            , isWorkDone       = isWorkDoneAhead sv q outH-            , isQueueDone      = isQueueDoneAhead sv q-            , needDoorBell     = wfw-            , svarStyle        = AheadVar-            , svarMrun         = mrun-            , workerCount      = active-            , accountThread    = delThread sv-            , workerStopMVar   = stopMVar-            , svarRef          = Nothing-            , svarInspectMode  = getInspectMode st-            , svarCreator      = tid-            , aheadWorkQueue   = q-            , outputHeap       = outH-            , svarStats        = stats-            }--    let sv =-            case getStreamRate st of-                Nothing -> getSVar sv readOutputQBounded postProcessBounded-                Just _  -> getSVar sv readOutputQPaced postProcessPaced-     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--getParallelSVar :: MonadIO m => State t m a -> RunInIO m -> IO (SVar t m a)-getParallelSVar st mrun = do-    outQ    <- newIORef ([], 0)-    outQMv  <- newEmptyMVar-    active  <- newIORef 0-    running <- newIORef S.empty-    yl <- case getYieldLimit st of-            Nothing -> return Nothing-            Just x -> Just <$> newIORef x-    rateInfo <- getYieldRateInfo st--    stats <- newSVarStats-    tid <- myThreadId--    let sv =-            SVar { outputQueue      = outQ-                 , remainingWork  = yl-                 , maxBufferLimit   = Unlimited-                 , maxWorkerLimit   = Unlimited-                 -- Used only for diagnostics-                 , yieldRateInfo    = rateInfo-                 , outputDoorBell   = outQMv-                 , readOutputQ      = readOutputQPar sv-                 , postProcess      = allThreadsDone sv-                 , workerThreads    = running-                 , workLoop         = undefined-                 , enqueue          = undefined-                 , isWorkDone       = undefined-                 , isQueueDone      = undefined-                 , needDoorBell     = undefined-                 , svarStyle        = ParallelVar-                 , svarMrun         = mrun-                 , workerCount      = active-                 , accountThread    = modifyThread sv-                 , workerStopMVar   = undefined-                 , svarRef          = Nothing-                 , svarInspectMode  = getInspectMode st-                 , svarCreator      = tid-                 , aheadWorkQueue   = undefined-                 , outputHeap       = undefined-                 , svarStats        = stats-                 }-     in return sv--    where--    readOutputQPar sv = liftIO $ do-        withDiagMVar sv "readOutputQPar: doorbell"-            $ takeMVar (outputDoorBell sv)-        case yieldRateInfo sv of-            Nothing -> return ()-            Just yinfo -> void $ collectLatency sv yinfo-        fst `fmap` readOutputQRaw sv--sendFirstWorker :: MonadAsync m => SVar t m a -> t m a -> m (SVar t m a)-sendFirstWorker sv m = do-    -- Note: We must have all the work on the queue before sending the-    -- pushworker, otherwise the pushworker may exit before we even get a-    -- chance to push.-    liftIO $ enqueue sv m-    case yieldRateInfo sv of-        Nothing -> pushWorker 0 sv-        Just yinfo  ->-            if svarLatencyTarget yinfo == maxBound-            then liftIO $ threadDelay maxBound-            else pushWorker 1 sv-    return sv--{-# INLINABLE newAheadVar #-}-newAheadVar :: MonadAsync m-    => State t m a-    -> t m a-    -> (   IORef ([t m a], Int)-        -> IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)-        -> State t m a-        -> SVar t m a-        -> Maybe WorkerInfo-        -> m ())-    -> m (SVar t m a)-newAheadVar st m wloop = do-    mrun <- captureMonadState-    sv <- liftIO $ getAheadSVar st wloop mrun-    sendFirstWorker sv m--{-# INLINABLE newParallelVar #-}-newParallelVar :: MonadAsync m => State t m a -> m (SVar t m a)-newParallelVar st = do-    mrun <- captureMonadState-    liftIO $ getParallelSVar st mrun---- XXX this errors out for Parallel/Ahead SVars--- | Write a stream to an 'SVar' in a non-blocking manner. The stream can then--- be read back from the SVar using 'fromSVar'.-toStreamVar :: MonadAsync m => SVar t m a -> t m a -> m ()-toStreamVar sv m = do-    liftIO $ enqueue sv m-    done <- allThreadsDone sv-    -- XXX This is safe only when called from the consumer thread or when no-    -- consumer is present.  There may be a race if we are not running in the-    -- consumer thread.-    -- XXX do this only if the work queue is not empty. The work may have been-    -- carried out by existing workers.-    when done $-        case yieldRateInfo sv of-            Nothing -> pushWorker 0 sv-            Just _  -> pushWorker 1 sv
− src/Streamly/Streams/Ahead.hs 
@@ -1,703 +0,0 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving#-}-{-# LANGUAGE InstanceSigs              #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX---- |--- Module      : Streamly.Streams.Ahead--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC-------module Streamly.Streams.Ahead-    (-      AheadT-    , Ahead-    , aheadly-    , ahead-    )-where--import Control.Concurrent.MVar (putMVar, takeMVar)-import Control.Exception (assert)-import Control.Monad (ap, void, when)-import Control.Monad.Base (MonadBase(..), liftBaseDefault)-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(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Heap (Heap, Entry(..))-import Data.IORef (IORef, readIORef, atomicModifyIORef, writeIORef)-import Data.Maybe (fromJust)-import Data.Semigroup (Semigroup(..))-import GHC.Exts (inline)--import qualified Data.Heap as H--import Streamly.Streams.SVar (fromSVar)-import Streamly.Streams.Serial (map)-import Streamly.SVar-import Streamly.Streams.StreamK-       (IsStream(..), Stream(..), unstreamShared, unStreamIsolated,-        runStreamSVar)-import qualified Streamly.Streams.StreamK as K--import Prelude hiding (map)--#include "Instances.hs"------------------------------------------------------------------------------------ Ahead------------------------------------------------------------------------------------ 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 ::-       SVar Stream m a-    -> Heap (Entry Int (AheadHeapEntry Stream 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 ::-       SVar Stream m a-    -> IORef (Heap (Entry Int (AheadHeapEntry Stream 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 stop = 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-                    rateOk <- isBeyondMaxRate sv yinfo-                    if rateOk then continue else stop-        else stop--abortExecution ::-       IORef ([Stream m a], Int)-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> Stream m a-    -> IO ()-abortExecution q sv winfo m = do-    reEnqueueAhead sv q m-    incrementYieldLimit sv-    sendStop sv winfo---- 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.----processHeap :: MonadIO m-    => IORef ([Stream m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> AheadHeapEntry Stream m a-    -> Int-    -> Bool -- we are draining the heap before we stop-    -> m ()-processHeap q heap st sv winfo entry sno stopping = loopHeap sno entry--    where--    stopIfNeeded ent seqNo r = 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-            sendStop sv winfo-        else runStreamWithYieldLimit True seqNo r--    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 $ send sv (ChildYield a)-                nextHeap seqNo-            AheadEntryStream r ->-                if stopping-                then stopIfNeeded ent seqNo r-                else runStreamWithYieldLimit True seqNo r--    nextHeap prevSeqNo = do-        res <- liftIO $ dequeueFromHeapSeq heap (prevSeqNo + 1)-        case res of-            Ready (Entry seqNo hent) -> loopHeap seqNo hent-            Clearing -> liftIO $ sendStop sv winfo-            Waiting _ ->-                if stopping-                then do-                    r <- liftIO $ preStopCheck sv heap-                    if r-                    then liftIO $ sendStop sv winfo-                    else processWorkQueue prevSeqNo-                else inline processWorkQueue prevSeqNo--    processWorkQueue prevSeqNo = do-        work <- dequeueAhead q-        case work of-            Nothing -> liftIO $ sendStop sv winfo-            Just (m, seqNo) -> do-                yieldLimitOk <- liftIO $ decrementYieldLimit sv-                if yieldLimitOk-                then-                    if seqNo == prevSeqNo + 1-                    then processWithToken q heap st sv winfo m seqNo-                    else processWithoutToken q heap st sv winfo m seqNo-                else liftIO $ abortExecution q sv winfo m--    -- 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 $ sendYield sv winfo (ChildYield a)-        nextHeap seqNo--    -- 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 sv-        if continue -- see comment above -- && yieldLimitOk-        then do-            let stop = do-                  liftIO (incrementYieldLimit sv)-                  nextHeap seqNo-            runStreamSVar sv r st stop-                          (singleStreamFromHeap seqNo)-                          (yieldStreamFromHeap seqNo)-        else liftIO $ do-            let ent = Entry seqNo (AheadEntryStream r)-            liftIO $ requeueOnHeapTop heap ent seqNo-            incrementYieldLimit sv-            sendStop sv winfo--    yieldStreamFromHeap seqNo a r = do-        continue <- liftIO $ sendYield sv winfo (ChildYield a)-        runStreamWithYieldLimit continue seqNo r--{-# NOINLINE drainHeap #-}-drainHeap :: MonadIO m-    => IORef ([Stream m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> m ()-drainHeap q heap st sv winfo = do-    r <- liftIO $ dequeueFromHeap heap-    case r of-        Ready (Entry seqNo hent) ->-            processHeap q heap st sv winfo hent seqNo True-        _ -> liftIO $ sendStop sv winfo--data HeapStatus = HContinue | HStop--processWithoutToken :: MonadIO m-    => IORef ([Stream m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> Stream m a-    -> Int-    -> m ()-processWithoutToken q heap st sv winfo m seqNo = do-    -- we have already decremented the yield limit for m-    let stop = do-            liftIO (incrementYieldLimit 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--    runStreamSVar sv m st stop-        (toHeap . AheadEntryPure)-        (\a r -> toHeap $ AheadEntryStream $ K.cons a r)--    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-        let drainAndStop = drainHeap q heap st sv winfo-            mainLoop = workLoopAhead q heap st sv winfo-        status <--            case yieldRateInfo sv of-                Nothing -> return HContinue-                Just yinfo ->-                    case winfo of-                        Just info -> do-                            rateOk <- liftIO $ workerRateControl sv yinfo info-                            if rateOk-                            then return HContinue-                            else return HStop-                        Nothing -> return HContinue--        if heapOk-        then-            case status of-                HContinue -> mainLoop-                HStop -> drainAndStop-        else drainAndStop--processWithToken :: MonadIO m-    => IORef ([Stream m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> Stream m a-    -> Int-    -> m ()-processWithToken q heap st sv winfo action sno = do-    -- Note, we enter this function with yield limit already decremented-    -- XXX deduplicate stop in all invocations-    let stop = do-            liftIO (incrementYieldLimit sv)-            loopWithToken (sno + 1)--    runStreamSVar sv action st stop (singleOutput sno) (yieldOutput sno)--    where--    singleOutput seqNo a = do-        continue <- liftIO $ sendYield sv winfo (ChildYield a)-        if continue-        then loopWithToken (seqNo + 1)-        else do-            liftIO $ updateHeapSeq heap (seqNo + 1)-            drainHeap q heap st sv winfo--    -- 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 $ sendYield sv winfo (ChildYield a)-        yieldLimitOk <- liftIO $ decrementYieldLimit sv-        if continue && yieldLimitOk-        then do-            let stop = do-                    liftIO (incrementYieldLimit sv)-                    loopWithToken (seqNo + 1)-            runStreamSVar sv r st stop-                          (singleOutput seqNo)-                          (yieldOutput seqNo)-        else do-            let ent = Entry seqNo (AheadEntryStream r)-            liftIO $ requeueOnHeapTop heap ent seqNo-            liftIO $ incrementYieldLimit sv-            drainHeap q heap st sv winfo--    loopWithToken nextSeqNo = do-        work <- dequeueAhead q-        case work of-            Nothing -> do-                liftIO $ updateHeapSeq heap nextSeqNo-                workLoopAhead q heap st sv winfo--            Just (m, seqNo) -> do-                yieldLimitOk <- liftIO $ decrementYieldLimit sv-                let undo = liftIO $ do-                        updateHeapSeq heap nextSeqNo-                        reEnqueueAhead sv q m-                        incrementYieldLimit sv-                if yieldLimitOk-                then-                    if seqNo == nextSeqNo-                    then do-                        let stop = do-                                liftIO (incrementYieldLimit sv)-                                loopWithToken (seqNo + 1)-                        runStreamSVar sv m st stop-                                      (singleOutput seqNo)-                                      (yieldOutput seqNo)-                    else-                        -- 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.-                        undo >> workLoopAhead q heap st sv winfo-                else undo >> drainHeap q heap st 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.---- XXX we can remove the sv parameter as it can be derived from st--workLoopAhead :: MonadIO m-    => IORef ([Stream m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry Stream m a)), Maybe Int)-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> m ()-workLoopAhead q heap st sv winfo = do-        r <- liftIO $ dequeueFromHeap heap-        case r of-            Ready (Entry seqNo hent) ->-                processHeap q heap st sv winfo hent seqNo False-            Clearing -> liftIO $ sendStop sv winfo-            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.-                ---                work <- dequeueAhead q-                case work of-                    Nothing -> liftIO $ sendStop sv winfo-                    Just (m, seqNo) -> do-                        yieldLimitOk <- liftIO $ decrementYieldLimit sv-                        if yieldLimitOk-                        then-                            if seqNo == 0-                            then processWithToken q heap st sv winfo m seqNo-                            else processWithoutToken q heap st sv winfo m seqNo-                        -- If some worker decremented the yield limit but then-                        -- did not yield anything and therefore incremented it-                        -- later, then if we did not requeue m here we may find-                        -- the work queue empty and therefore miss executing-                        -- the remaining action.-                        else liftIO $ abortExecution q sv winfo m------------------------------------------------------------------------------------ WAhead------------------------------------------------------------------------------------ XXX To be implemented. Use a linked queue like WAsync and put back the--- remaining computation at the back of the queue instead of the heap, and--- increment the sequence number.---- The only difference between forkSVarAsync and this is that we run the left--- computation without a shared SVar.-forkSVarAhead :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-forkSVarAhead m1 m2 = Stream $ \st stp sng yld -> do-        sv <- newAheadVar st (concurrently m1 m2) workLoopAhead-        unStream (fromSVar sv) (rstState st) stp sng yld-    where-    concurrently ma mb = Stream $ \st stp sng yld -> do-        liftIO $ enqueue (fromJust $ streamVar st) mb-        unStream ma (rstState st) stp sng yld--{-# INLINE aheadS #-}-aheadS :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-aheadS m1 m2 = Stream $ \st stp sng yld ->-    case streamVar st of-        Just sv | svarStyle sv == AheadVar -> do-            liftIO $ enqueue sv m2-            -- Always run the left side on a new SVar to avoid complexity in-            -- sequencing results. This means the left side cannot further-            -- split into more ahead computations on the same SVar.-            unStream m1 (rstState st) stp sng yld-        _ -> unStream (forkSVarAhead m1 m2) st stp sng yld---- | XXX we can implement it more efficienty by directly implementing instead--- of combining streams using ahead.-{-# INLINE consMAhead #-}-consMAhead :: MonadAsync m => m a -> Stream m a -> Stream m a-consMAhead m r = K.yieldM m `aheadS` r----------------------------------------------------------------------------------- AheadT----------------------------------------------------------------------------------- | Deep ahead composition or ahead composition with depth first traversal.--- The semigroup composition of 'AheadT' appends streams in a depth first--- manner just like 'SerialT' except that it can produce elements concurrently--- ahead of time. It is like 'AsyncT' except that 'AsyncT' produces the output--- as it arrives whereas 'AheadT' orders the output in the traversal order.------ @--- main = ('toList' . 'aheadly' $ (fromFoldable [1,2]) \<> (fromFoldable [3,4])) >>= print--- @--- @--- [1,2,3,4]--- @------ Any exceptions generated by a constituent stream are propagated to the--- output stream.------ Similarly, the monad instance of 'AheadT' may run each iteration--- concurrently ahead of time but presents the results in the same order as--- 'SerialT'.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Control.Concurrent------ main = 'runStream' . 'aheadly' $ do---     n <- return 3 \<\> return 2 \<\> return 1---     S.yieldM $ do---          threadDelay (n * 1000000)---          myThreadId >>= \\tid -> putStrLn (show tid ++ ": Delay " ++ show n)--- @--- @--- ThreadId 40: Delay 1--- ThreadId 39: Delay 2--- ThreadId 38: Delay 3--- @------ All iterations may run in the same thread if they do not block.------ Note that ahead composition with depth first traversal can be used to--- combine infinite number of streams as it explores only a bounded number of--- streams at a time.------ @since 0.3.0-newtype AheadT m a = AheadT {getAheadT :: Stream m a}-    deriving (MonadTrans)---- | A serial IO stream of elements of type @a@ with concurrent lookahead.  See--- 'AheadT' documentation for more details.------ @since 0.3.0-type Ahead = AheadT IO---- | Fix the type of a polymorphic stream as 'AheadT'.------ @since 0.3.0-aheadly :: IsStream t => AheadT m a -> t m a-aheadly = K.adapt--instance IsStream AheadT where-    toStream = getAheadT-    fromStream = AheadT--    {-# INLINE consM #-}-    {-# SPECIALIZE consM :: IO a -> AheadT IO a -> AheadT IO a #-}-    consM m r = fromStream $ consMAhead m (toStream r)--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> AheadT IO a -> AheadT IO a #-}-    (|:) = consM----------------------------------------------------------------------------------- Semigroup----------------------------------------------------------------------------------- | Polymorphic version of the 'Semigroup' operation '<>' of 'AheadT'.--- Merges two streams sequentially but with concurrent lookahead.------ @since 0.3.0-{-# INLINE ahead #-}-ahead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-ahead m1 m2 = fromStream $ Stream $ \st stp sng yld ->-    unStream (aheadS (toStream m1) (toStream m2)) st stp sng yld--instance MonadAsync m => Semigroup (AheadT m a) where-    (<>) = ahead----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance MonadAsync m => Monoid (AheadT m a) where-    mempty = K.nil-    mappend = (<>)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------{-# INLINE aheadbind #-}-aheadbind-    :: MonadAsync m-    => Stream m a-    -> (a -> Stream m b)-    -> Stream m b-aheadbind m f = go m-    where-        go (Stream g) =-            Stream $ \st stp sng yld ->-                let runShared x   = unstreamShared x st stp sng yld-                    runIsolated x = unStreamIsolated x st stp sng yld--                    single a   = runIsolated $ f a-                    yieldk a r = runShared $-                        K.isolateStream (f a) `aheadS` go r-                in g (rstState st) stp single yieldk--instance MonadAsync m => Monad (AheadT m) where-    return = pure-    (AheadT m) >>= f = AheadT $ aheadbind m (getAheadT . f)----------------------------------------------------------------------------------- Other instances---------------------------------------------------------------------------------MONAD_APPLICATIVE_INSTANCE(AheadT,MONADPARALLEL)-MONAD_COMMON_INSTANCES(AheadT, MONADPARALLEL)
− src/Streamly/Streams/Async.hs 
@@ -1,820 +0,0 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving#-}-{-# LANGUAGE InstanceSigs              #-}-{-# LANGUAGE LambdaCase                #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE ScopedTypeVariables       #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX---- |--- Module      : Streamly.Streams.Async--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC-------module Streamly.Streams.Async-    (-      AsyncT-    , Async-    , asyncly-    , async-    , (<|)             --deprecated-    , mkAsync-    , mkAsync'--    , WAsyncT-    , WAsync-    , wAsyncly-    , wAsync-    )-where--import Control.Concurrent (myThreadId)-import Control.Monad (ap)-import Control.Monad.Base (MonadBase(..), liftBaseDefault)-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(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Concurrent.Queue.MichaelScott (LinkedQueue, newQ, nullQ, tryPopR)-import Data.IORef (IORef, newIORef, readIORef)-import Data.Maybe (fromJust)-import Data.Semigroup (Semigroup(..))--import Prelude hiding (map)-import qualified Data.Set as S--import Streamly.Streams.SVar (fromSVar)-import Streamly.Streams.Serial (map)-import Streamly.SVar-import Streamly.Streams.StreamK (IsStream(..), Stream(..), adapt, runStreamSVar)-import qualified Streamly.Streams.StreamK as K--#include "Instances.hs"------------------------------------------------------------------------------------ Async----------------------------------------------------------------------------------{-# INLINE workLoopLIFO #-}-workLoopLIFO-    :: MonadIO m-    => IORef [Stream m a]-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> m ()-workLoopLIFO q st sv winfo = run--    where--    run = do-        work <- dequeue-        case work of-            Nothing -> liftIO $ sendStop sv winfo-            Just m -> runStreamSVar sv m st run single yieldk--    single a = do-        res <- liftIO $ sendYield sv winfo (ChildYield a)-        if res then run else liftIO $ sendStop sv winfo--    yieldk a r = do-        res <- liftIO $ sendYield sv winfo (ChildYield a)-        if res-        then runStreamSVar sv r st run single yieldk-        else liftIO $ do-            enqueueLIFO sv q r-            sendStop sv winfo--    dequeue = liftIO $ atomicModifyIORefCAS q $ \case-                [] -> ([], Nothing)-                x : xs -> (xs, Just x)---- 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-    :: MonadIO m-    => IORef [Stream m a]-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> m ()-workLoopLIFOLimited q st sv winfo = run--    where--    run = do-        work <- dequeue-        case work of-            Nothing -> liftIO $ sendStop sv winfo-            Just 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 sv-                if yieldLimitOk-                then do-                    let stop = liftIO (incrementYieldLimit sv) >> run-                    runStreamSVar sv m st stop single yieldk-                -- Avoid any side effects, undo the yield limit decrement if we-                -- never yielded anything.-                else liftIO $ do-                    enqueueLIFO sv q m-                    incrementYieldLimit sv-                    sendStop sv winfo--    single a = do-        res <- liftIO $ sendYield sv winfo (ChildYield a)-        if res then run else liftIO $ sendStop sv winfo--    -- XXX can we pass on the yield limit downstream to limit the concurrency-    -- of constituent streams.-    yieldk a r = do-        res <- liftIO $ sendYield sv winfo (ChildYield a)-        yieldLimitOk <- liftIO $ decrementYieldLimit sv-        let stop = liftIO (incrementYieldLimit sv) >> run-        if res && yieldLimitOk-        then runStreamSVar sv r st stop single yieldk-        else liftIO $ do-            incrementYieldLimit sv-            enqueueLIFO sv q r-            sendStop sv winfo--    dequeue = liftIO $ atomicModifyIORefCAS q $ \case-                [] -> ([], Nothing)-                x : xs -> (xs, Just x)------------------------------------------------------------------------------------ WAsync------------------------------------------------------------------------------------ XXX we can remove sv as it is derivable from st--{-# INLINE workLoopFIFO #-}-workLoopFIFO-    :: MonadIO m-    => LinkedQueue (Stream m a)-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> m ()-workLoopFIFO q st sv winfo = run--    where--    run = do-        work <- liftIO $ tryPopR q-        case work of-            Nothing -> liftIO $ sendStop sv winfo-            Just m -> runStreamSVar sv m st run single yieldk--    single a = do-        res <- liftIO $ sendYield sv winfo (ChildYield a)-        if res then run else liftIO $ sendStop sv winfo--    yieldk a r = do-        res <- liftIO $ sendYield sv winfo (ChildYield a)-        if res-        then runStreamSVar sv r st run single yieldk-        else liftIO $ do-            enqueueFIFO sv q r-            sendStop sv winfo--{-# INLINE workLoopFIFOLimited #-}-workLoopFIFOLimited-    :: MonadIO m-    => LinkedQueue (Stream m a)-    -> State Stream m a-    -> SVar Stream m a-    -> Maybe WorkerInfo-    -> m ()-workLoopFIFOLimited q st sv winfo = run--    where--    run = do-        work <- liftIO $ tryPopR q-        case work of-            Nothing -> liftIO $ sendStop sv winfo-            Just m -> do-                yieldLimitOk <- liftIO $ decrementYieldLimit sv-                if yieldLimitOk-                then do-                    let stop = liftIO (incrementYieldLimit sv) >> run-                    runStreamSVar sv m st stop single yieldk-                else liftIO $ do-                    enqueueFIFO sv q m-                    incrementYieldLimit sv-                    sendStop sv winfo--    single a = do-        res <- liftIO $ sendYield sv winfo (ChildYield a)-        if res then run else liftIO $ sendStop sv winfo--    yieldk a r = do-        res <- liftIO $ sendYield sv winfo (ChildYield a)-        yieldLimitOk <- liftIO $ decrementYieldLimit sv-        let stop = liftIO (incrementYieldLimit sv) >> run-        if res && yieldLimitOk-        then runStreamSVar sv r st stop single yieldk-        else liftIO $ do-            incrementYieldLimit sv-            enqueueFIFO sv q r-            sendStop sv winfo------------------------------------------------------------------------------------ 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.-getLifoSVar :: forall m a. MonadAsync m-    => State Stream m a -> RunInIO m -> IO (SVar Stream m a)-getLifoSVar st mrun = do-    outQ    <- newIORef ([], 0)-    outQMv  <- newEmptyMVar-    active  <- newIORef 0-    wfw     <- newIORef False-    running <- newIORef S.empty-    q       <- newIORef []-    yl      <- case getYieldLimit st of-                Nothing -> return Nothing-                Just x -> Just <$> newIORef x-    rateInfo <- getYieldRateInfo st--    stats <- newSVarStats-    tid <- myThreadId--    let isWorkFinished _ = null <$> readIORef q--    let isWorkFinishedLimited sv = do-            yieldsDone <--                    case remainingWork sv of-                        Just ref -> do-                            n <- readIORef ref-                            return (n <= 0)-                        Nothing -> return False-            qEmpty <- null <$> readIORef q-            return $ qEmpty || yieldsDone--    let getSVar :: SVar Stream m a-            -> (SVar Stream m a -> m [ChildEvent a])-            -> (SVar Stream m a -> m Bool)-            -> (SVar Stream m a -> IO Bool)-            -> (IORef [Stream m a]-                -> State Stream m a-                -> SVar Stream m a-                -> Maybe WorkerInfo-                -> m())-            -> SVar Stream m a-        getSVar sv readOutput postProc workDone wloop = SVar-            { outputQueue      = outQ-            , remainingWork    = yl-            , maxBufferLimit   = getMaxBuffer st-            , maxWorkerLimit   = getMaxThreads st-            , yieldRateInfo    = rateInfo-            , outputDoorBell   = outQMv-            , readOutputQ      = readOutput sv-            , postProcess      = postProc sv-            , workerThreads    = running-            , workLoop         = wloop q st{streamVar = Just sv} sv-            , enqueue          = enqueueLIFO sv q-            , isWorkDone       = workDone sv-            , isQueueDone      = workDone sv-            , needDoorBell     = wfw-            , svarStyle        = AsyncVar-            , svarMrun         = mrun-            , workerCount      = active-            , accountThread    = delThread sv-            , workerStopMVar   = undefined-            , svarRef          = Nothing-            , svarInspectMode  = getInspectMode st-            , svarCreator      = tid-            , aheadWorkQueue   = undefined-            , outputHeap       = undefined-            , svarStats        = stats-            }--    let sv =-            case getStreamRate st of-                Nothing ->-                    case getYieldLimit st of-                        Nothing -> getSVar sv readOutputQBounded-                                              postProcessBounded-                                              isWorkFinished-                                              workLoopLIFO-                        Just _  -> getSVar sv readOutputQBounded-                                              postProcessBounded-                                              isWorkFinishedLimited-                                              workLoopLIFOLimited-                Just _  ->-                    case getYieldLimit st of-                        Nothing -> getSVar sv readOutputQPaced-                                              postProcessPaced-                                              isWorkFinished-                                              workLoopLIFO-                        Just _  -> getSVar sv readOutputQPaced-                                              postProcessPaced-                                              isWorkFinishedLimited-                                              workLoopLIFOLimited-     in return sv--getFifoSVar :: forall m a. MonadAsync m-    => State Stream m a -> RunInIO m -> IO (SVar Stream m a)-getFifoSVar st mrun = do-    outQ    <- newIORef ([], 0)-    outQMv  <- newEmptyMVar-    active  <- newIORef 0-    wfw     <- newIORef False-    running <- newIORef S.empty-    q       <- newQ-    yl      <- case getYieldLimit st of-                Nothing -> return Nothing-                Just x -> Just <$> newIORef x-    rateInfo <- getYieldRateInfo st--    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 :: SVar Stream m a-            -> (SVar Stream m a -> m [ChildEvent a])-            -> (SVar Stream m a -> m Bool)-            -> (SVar Stream m a -> IO Bool)-            -> (LinkedQueue (Stream m a)-                -> State Stream m a-                -> SVar Stream m a-                -> Maybe WorkerInfo-                -> m())-            -> SVar Stream m a-        getSVar sv readOutput postProc workDone wloop = SVar-            { outputQueue      = outQ-            , remainingWork  = yl-            , maxBufferLimit   = getMaxBuffer st-            , maxWorkerLimit   = getMaxThreads st-            , yieldRateInfo    = rateInfo-            , outputDoorBell   = outQMv-            , readOutputQ      = readOutput sv-            , postProcess      = postProc sv-            , workerThreads    = running-            , workLoop         = wloop q st{streamVar = Just sv} sv-            , enqueue          = enqueueFIFO sv q-            , isWorkDone       = workDone sv-            , isQueueDone      = workDone sv-            , needDoorBell     = wfw-            , svarStyle        = WAsyncVar-            , svarMrun         = mrun-            , workerCount      = active-            , accountThread    = delThread sv-            , workerStopMVar   = undefined-            , svarRef          = Nothing-            , svarInspectMode  = getInspectMode st-            , svarCreator      = tid-            , aheadWorkQueue   = undefined-            , outputHeap       = undefined-            , svarStats        = stats-            }--    let sv =-            case getStreamRate st of-                Nothing ->-                    case getYieldLimit st of-                        Nothing -> getSVar sv readOutputQBounded-                                              postProcessBounded-                                              isWorkFinished-                                              workLoopFIFO-                        Just _  -> getSVar sv readOutputQBounded-                                              postProcessBounded-                                              isWorkFinishedLimited-                                              workLoopFIFOLimited-                Just _  ->-                    case getYieldLimit st of-                        Nothing -> getSVar sv readOutputQPaced-                                              postProcessPaced-                                              isWorkFinished-                                              workLoopFIFO-                        Just _  -> getSVar sv readOutputQPaced-                                              postProcessPaced-                                              isWorkFinishedLimited-                                              workLoopFIFOLimited-     in return sv--{-# INLINABLE newAsyncVar #-}-newAsyncVar :: MonadAsync m-    => State Stream m a -> Stream m a -> m (SVar Stream m a)-newAsyncVar st m = do-    mrun <- captureMonadState-    sv <- liftIO $ getLifoSVar st mrun-    sendFirstWorker sv m---- XXX Get rid of this?--- | 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 m = fmap fromSVar (newAsyncVar defState (toStream m))--{-# INLINABLE mkAsync' #-}-mkAsync' :: (IsStream t, MonadAsync m) => State Stream m a -> t m a -> m (t m a)-mkAsync' st m = fmap fromSVar (newAsyncVar st (toStream m))---- | Create a new SVar and enqueue one stream computation on it.-{-# INLINABLE newWAsyncVar #-}-newWAsyncVar :: MonadAsync m-    => State Stream m a -> Stream m a -> m (SVar Stream m a)-newWAsyncVar st m = do-    mrun <- captureMonadState-    sv <- liftIO $ getFifoSVar st mrun-    sendFirstWorker sv m----------------------------------------------------------------------------------- Running streams concurrently----------------------------------------------------------------------------------- Concurrency rate control.------ Our objective is to create more threads on demand if the consumer is running--- faster than us. As soon as we encounter a concurrent composition we create a--- push pull pair of threads. We use an SVar for communication between the--- consumer, pulling from the SVar and the producer who is pushing to the SVar.--- The producer creates more threads if the SVar drains and becomes empty, that--- is the consumer is running faster.------ XXX Note 1: This mechanism can be problematic if the initial production--- latency is high, we may end up creating too many threads. So we need some--- way to monitor and use the latency as well. Having a limit on the dispatches--- (programmer controlled) may also help.------ TBD Note 2: We may want to run computations at the lower level of the--- composition tree serially even when they are composed using a parallel--- combinator. We can use 'serial' in place of 'async' and 'wSerial' in--- place of 'wAsync'. If we find that an SVar immediately above a computation--- gets drained empty we can switch to parallelizing the computation.  For that--- we can use a state flag to fork the rest of the computation at any point of--- time inside the Monad bind operation if the consumer is running at a faster--- speed.------ TBD Note 3: the binary operation ('parallel') composition allows us to--- dispatch a chunkSize of only 1.  If we have to dispatch in arbitrary--- chunksizes we will need to compose the parallel actions using a data--- constructor (A Free container) instead so that we can divide it in chunks of--- arbitrary size before dispatching. If the stream is composed of--- hierarchically composed grains of different sizes then we can always switch--- to a desired granularity depending on the consumer speed.------ TBD Note 4: for pure work (when we are not in the IO monad) we can divide it--- into just the number of CPUs.---- | Join two computations on the currently running 'SVar' queue for concurrent--- execution.  When we are using parallel composition, an SVar is passed around--- as a state variable. We try to schedule a new parallel computation on the--- SVar passed to us. The first time, when no SVar exists, a new SVar is--- created.  Subsequently, 'joinStreamVarAsync' may get called when a computation--- already scheduled on the SVar is further evaluated. For example, when (a--- `parallel` b) is evaluated it calls a 'joinStreamVarAsync' to put 'a' and 'b' on--- the current scheduler queue.------ The 'SVarStyle' required by the current composition context is passed as one--- of the parameters.  If the scheduling and composition style of the new--- computation being scheduled is different than the style of the current SVar,--- then we create a new SVar and schedule it on that.  The newly created SVar--- joins as one of the computations on the current SVar queue.------ Cases when we need to switch to a new SVar:------ * (x `parallel` y) `parallel` (t `parallel` u) -- all of them get scheduled on the same SVar--- * (x `parallel` y) `parallel` (t `async` u) -- @t@ and @u@ get scheduled on a new child SVar---   because of the scheduling policy change.--- * if we 'adapt' a stream of type 'async' to a stream of type---   'Parallel', we create a new SVar at the transitioning bind.--- * When the stream is switching from disjunctive composition to conjunctive---   composition and vice-versa we create a new SVar to isolate the scheduling---   of the two.--forkSVarAsync :: MonadAsync m-    => SVarStyle -> Stream m a -> Stream m a -> Stream m a-forkSVarAsync style m1 m2 = Stream $ \st stp sng yld -> do-    sv <- case style of-        AsyncVar -> newAsyncVar st (concurrently m1 m2)-        WAsyncVar -> newWAsyncVar st (concurrently m1 m2)-        _ -> error "illegal svar type"-    unStream (fromSVar sv) (rstState st) stp sng yld-    where-    concurrently ma mb = Stream $ \st stp sng yld -> do-        liftIO $ enqueue (fromJust $ streamVar st) mb-        unStream ma st stp sng yld--{-# INLINE joinStreamVarAsync #-}-joinStreamVarAsync :: MonadAsync m-    => SVarStyle -> Stream m a -> Stream m a -> Stream m a-joinStreamVarAsync style m1 m2 = Stream $ \st stp sng yld ->-    case streamVar st of-        Just sv | svarStyle sv == style ->-            liftIO (enqueue sv m2) >> unStream m1 st stp sng yld-        _ -> unStream (forkSVarAsync style m1 m2) st stp sng yld----------------------------------------------------------------------------------- Semigroup and Monoid style compositions for parallel actions---------------------------------------------------------------------------------{-# INLINE asyncS #-}-asyncS :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-asyncS = joinStreamVarAsync AsyncVar---- | Polymorphic version of the 'Semigroup' operation '<>' of 'AsyncT'.--- Merges two streams possibly concurrently, preferring the--- elements from the left one when available.------ @since 0.2.0-{-# INLINE async #-}-async :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-async m1 m2 = fromStream $ Stream $ \st stp sng yld ->-    unStream (joinStreamVarAsync AsyncVar (toStream m1) (toStream m2))-             st stp sng yld---- | 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---- | XXX we can implement it more efficienty by directly implementing instead--- of combining streams using async.-{-# INLINE consMAsync #-}-consMAsync :: MonadAsync m => m a -> Stream m a -> Stream m a-consMAsync m r = K.yieldM m `asyncS` r----------------------------------------------------------------------------------- AsyncT----------------------------------------------------------------------------------- | Deep async composition or async composition with depth first traversal. In--- a left to right 'Semigroup' composition it tries to yield elements from the--- left stream as long as it can, but it can run the right stream in parallel--- if it needs to, based on demand. The right stream can be run if the left--- stream blocks on IO or cannot produce elements fast enough for the consumer.------ @--- main = ('toList' . 'asyncly' $ (fromFoldable [1,2]) \<> (fromFoldable [3,4])) >>= print--- @--- @--- [1,2,3,4]--- @------ Any exceptions generated by a constituent stream are propagated to the--- output stream. The output and exceptions from a single stream are guaranteed--- to arrive in the same order in the resulting stream as they were generated--- in the input stream. However, the relative ordering of elements from--- different streams in the resulting stream can vary depending on scheduling--- and generation delays.------ Similarly, the monad instance of 'AsyncT' /may/ run each iteration--- concurrently based on demand.  More concurrent iterations are started only--- if the previous iterations are not able to produce enough output for the--- consumer.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Control.Concurrent------ main = 'runStream' . 'asyncly' $ do---     n <- return 3 \<\> return 2 \<\> return 1---     S.yieldM $ do---          threadDelay (n * 1000000)---          myThreadId >>= \\tid -> putStrLn (show tid ++ ": Delay " ++ show n)--- @--- @--- ThreadId 40: Delay 1--- ThreadId 39: Delay 2--- ThreadId 38: Delay 3--- @------ All iterations may run in the same thread if they do not block.------ Note that async composition with depth first traversal can be used to--- combine infinite number of streams as it explores only a bounded number of--- streams at a time.------ @since 0.1.0-newtype AsyncT m a = AsyncT {getAsyncT :: Stream m a}-    deriving (MonadTrans)---- | A demand driven left biased parallely composing IO stream of elements of--- type @a@.  See 'AsyncT' documentation for more details.------ @since 0.2.0-type Async = AsyncT IO---- | Fix the type of a polymorphic stream as 'AsyncT'.------ @since 0.1.0-asyncly :: IsStream t => AsyncT m a -> t m a-asyncly = adapt--instance IsStream AsyncT where-    toStream = getAsyncT-    fromStream = AsyncT--    {-# INLINE consM #-}-    {-# SPECIALIZE consM :: IO a -> AsyncT IO a -> AsyncT IO a #-}-    consM m r = fromStream $ consMAsync m (toStream r)--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> AsyncT IO a -> AsyncT IO a #-}-    (|:) = consM----------------------------------------------------------------------------------- Semigroup---------------------------------------------------------------------------------instance MonadAsync m => Semigroup (AsyncT m a) where-    (<>) = async----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance MonadAsync m => Monoid (AsyncT m a) where-    mempty = K.nil-    mappend = (<>)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance MonadAsync m => Monad (AsyncT m) where-    return = pure-    (AsyncT m) >>= f = AsyncT $ K.bindWith asyncS m (getAsyncT . f)----------------------------------------------------------------------------------- Other instances---------------------------------------------------------------------------------MONAD_APPLICATIVE_INSTANCE(AsyncT,MONADPARALLEL)-MONAD_COMMON_INSTANCES(AsyncT, MONADPARALLEL)----------------------------------------------------------------------------------- WAsyncT---------------------------------------------------------------------------------{-# INLINE wAsyncS #-}-wAsyncS :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-wAsyncS = joinStreamVarAsync WAsyncVar---- | XXX we can implement it more efficienty by directly implementing instead--- of combining streams using wAsync.-{-# INLINE consMWAsync #-}-consMWAsync :: MonadAsync m => m a -> Stream m a -> Stream m a-consMWAsync m r = K.yieldM m `wAsyncS` r---- | Polymorphic version of the 'Semigroup' operation '<>' of 'WAsyncT'.--- Merges two streams concurrently choosing elements from both fairly.------ @since 0.2.0-{-# INLINE wAsync #-}-wAsync :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-wAsync m1 m2 = fromStream $ Stream $ \st stp sng yld ->-    unStream (wAsyncS (toStream m1) (toStream m2)) st stp sng yld---- | Wide async composition or async composition with breadth first traversal.--- The Semigroup instance of 'WAsyncT' concurrently /traverses/ the composed--- streams using a depth first travesal or in a round robin fashion, yielding--- elements from both streams alternately.------ @--- main = ('toList' . 'wAsyncly' $ (fromFoldable [1,2]) \<> (fromFoldable [3,4])) >>= print--- @--- @--- [1,3,2,4]--- @------ Any exceptions generated by a constituent stream are propagated to the--- output stream. The output and exceptions from a single stream are guaranteed--- to arrive in the same order in the resulting stream as they were generated--- in the input stream. However, the relative ordering of elements from--- different streams in the resulting stream can vary depending on scheduling--- and generation delays.------ Similarly, the 'Monad' instance of 'WAsyncT' runs /all/ iterations fairly--- concurrently using a round robin scheduling.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Control.Concurrent------ main = 'runStream' . 'wAsyncly' $ do---     n <- return 3 \<\> return 2 \<\> return 1---     S.yieldM $ do---          threadDelay (n * 1000000)---          myThreadId >>= \\tid -> putStrLn (show tid ++ ": Delay " ++ show n)--- @--- @--- ThreadId 40: Delay 1--- ThreadId 39: Delay 2--- ThreadId 38: Delay 3--- @------ Unlike 'AsyncT' all iterations are guaranteed to run fairly--- concurrently, unconditionally.------ Note that async composition with breadth first traversal can only combine a--- finite number of streams as it needs to retain state for each unfinished--- stream.------ @since 0.2.0-newtype WAsyncT m a = WAsyncT {getWAsyncT :: Stream m a}-    deriving (MonadTrans)---- | A round robin parallely composing IO stream of elements of type @a@.--- See 'WAsyncT' documentation for more details.------ @since 0.2.0-type WAsync = WAsyncT IO---- | Fix the type of a polymorphic stream as 'WAsyncT'.------ @since 0.2.0-wAsyncly :: IsStream t => WAsyncT m a -> t m a-wAsyncly = adapt--instance IsStream WAsyncT where-    toStream = getWAsyncT-    fromStream = WAsyncT--    {-# INLINE consM #-}-    {-# SPECIALIZE consM :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}-    consM m r = fromStream $ consMWAsync m (toStream r)--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}-    (|:) = consM----------------------------------------------------------------------------------- Semigroup---------------------------------------------------------------------------------instance MonadAsync m => Semigroup (WAsyncT m a) where-    (<>) = wAsync----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance MonadAsync m => Monoid (WAsyncT m a) where-    mempty = K.nil-    mappend = (<>)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance MonadAsync m => Monad (WAsyncT m) where-    return = pure-    (WAsyncT m) >>= f =-        WAsyncT $ K.bindWith wAsyncS m (getWAsyncT . f)----------------------------------------------------------------------------------- Other instances---------------------------------------------------------------------------------MONAD_APPLICATIVE_INSTANCE(WAsyncT,MONADPARALLEL)-MONAD_COMMON_INSTANCES(WAsyncT, MONADPARALLEL)
− src/Streamly/Streams/Instances.hs 
@@ -1,43 +0,0 @@---------------------------------------------------------------------------------- CPP macros for common instances----------------------------------------------------------------------------------- XXX use template haskell instead and include Monoid and IsStream instances--- as well.--#define MONADPARALLEL , MonadAsync m--#define MONAD_APPLICATIVE_INSTANCE(STREAM,CONSTRAINT)         \-instance (Monad m CONSTRAINT) => Applicative (STREAM m) where { \-    pure = STREAM . K.yield;                     \-    (<*>) = ap }--#define MONAD_COMMON_INSTANCES(STREAM,CONSTRAINT)                            \-instance Monad m => Functor (STREAM m) where { \-    fmap = map };                                                             \-                                                                              \-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 };                                                 \-                                                                              \-instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where {           \-    throwM = lift . throwM };                                                 \-                                                                              \-{- \-instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where {       \-    throwError = lift . throwError;                                           \-    catchError m h =                                                          \-        fromStream $ withCatchError (toStream m) (\e -> toStream $ h e) };  \--} \-                                                                              \-instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where {     \-    ask = lift ask;                                                           \-    local f m = fromStream $ K.withLocal f (toStream m) };                    \-                                                                              \-instance (MonadState s m CONSTRAINT) => MonadState s (STREAM m) where {       \-    get     = lift get;                                                       \-    put x   = lift (put x);                                                   \-    state k = lift (state k) }-
− src/Streamly/Streams/Parallel.hs 
@@ -1,383 +0,0 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving#-}-{-# LANGUAGE InstanceSigs              #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX---- |--- Module      : Streamly.Streams.Parallel--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC-------module Streamly.Streams.Parallel-    (-      ParallelT-    , Parallel-    , parallely-    , parallel--    -- * Function application-    , mkParallel-    , (|$)-    , (|&)-    , (|$.)-    , (|&.)-    )-where--import Control.Monad (ap)-import Control.Monad.Base (MonadBase(..), liftBaseDefault)-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(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Functor (void)-import Data.Maybe (fromJust)-import Data.Semigroup (Semigroup(..))-import Prelude hiding (map)--import Streamly.Streams.SVar (fromSVar)-import Streamly.Streams.Serial (map)-import Streamly.SVar-import Streamly.Streams.StreamK (IsStream(..), Stream(..), adapt)-import qualified Streamly.Streams.StreamK as K--#include "Instances.hs"------------------------------------------------------------------------------------ Parallel----------------------------------------------------------------------------------{-# NOINLINE runOne #-}-runOne-    :: MonadIO m-    => State Stream m a -> Stream m a -> Maybe WorkerInfo -> m ()-runOne st m winfo = unStream m st stop single yieldk--    where--    sv = fromJust $ streamVar st-    mrun = runInIO $ svarMrun sv--    withLimitCheck action = do-        yieldLimitOk <- liftIO $ decrementYieldLimitPost sv-        if yieldLimitOk-        then action-        else liftIO $ cleanupSVarFromWorker sv--    stop = liftIO $ sendStop sv winfo-    sendit a = liftIO $ sendYield sv winfo (ChildYield a)-    single a = sendit a >> withLimitCheck stop--    -- XXX there is no flow control in parallel case. We should perhaps use a-    -- queue and queue it back on that and exit the thread when the outputQueue-    -- overflows. Parallel is dangerous because it can accumulate unbounded-    -- output in the buffer.-    yieldk a r = void (sendit a)-        >> withLimitCheck (void $ liftIO $ mrun $ runOne st r winfo)--{-# NOINLINE forkSVarPar #-}-forkSVarPar :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-forkSVarPar m r = Stream $ \st stp sng yld -> do-    sv <- newParallelVar st-    pushWorkerPar sv (runOne st{streamVar = Just sv} m)-    pushWorkerPar sv (runOne st{streamVar = Just sv} r)-    unStream (fromSVar sv) (rstState st) stp sng yld--{-# INLINE joinStreamVarPar #-}-joinStreamVarPar :: MonadAsync m-    => SVarStyle -> Stream m a -> Stream m a -> Stream m a-joinStreamVarPar style m1 m2 = Stream $ \st stp sng yld ->-    case streamVar st of-        Just sv | svarStyle sv == style -> do-            pushWorkerPar sv (runOne st m1)-            unStream m2 st stp sng yld-        _ -> unStream (forkSVarPar m1 m2) st stp sng yld--{-# INLINE parallelStream #-}-parallelStream :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-parallelStream = joinStreamVarPar ParallelVar---- | XXX we can implement it more efficienty by directly implementing instead--- of combining streams using parallel.-{-# INLINE consMParallel #-}-consMParallel :: MonadAsync m => m a -> Stream m a -> Stream m a-consMParallel m r = K.yieldM m `parallelStream` r---- | Polymorphic version of the 'Semigroup' operation '<>' of 'ParallelT'--- Merges two streams concurrently.------ @since 0.2.0-{-# INLINE parallel #-}-parallel :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-parallel m1 m2 = fromStream $ Stream $ \st stp sng yld ->-    unStream (parallelStream (toStream m1) (toStream m2))-             st stp sng yld----------------------------------------------------------------------------------- Convert a stream to parallel---------------------------------------------------------------------------------mkParallel :: (IsStream t, MonadAsync m) => t m a -> m (t m a)-mkParallel m = do-    sv <- newParallelVar defState-    pushWorkerPar sv (runOne defState{streamVar = Just sv} $ toStream m)-    return $ fromSVar sv----------------------------------------------------------------------------------- Stream to stream concurrent function application---------------------------------------------------------------------------------{-# INLINE applyWith #-}-applyWith :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> t m a -> t m b-applyWith f m = fromStream $ Stream $ \st stp sng yld -> do-    sv <- newParallelVar (rstState st)-    pushWorkerPar sv (runOne st{streamVar = Just sv} (toStream m))-    unStream (toStream $ f $ fromSVar sv) (rstState st) stp sng yld----------------------------------------------------------------------------------- Stream runner concurrent function application---------------------------------------------------------------------------------{-# INLINE runWith #-}-runWith :: (IsStream t, MonadAsync m) => (t m a -> m b) -> t m a -> m b-runWith f m = do-    sv <- newParallelVar defState-    pushWorkerPar sv (runOne defState{streamVar = Just sv} $ toStream m)-    f $ fromSVar sv----------------------------------------------------------------------------------- Concurrent Application---------------------------------------------------------------------------------infixr 0 |$-infixr 0 |$.--infixl 1 |&-infixl 1 |&.---- | Parallel function application operator for streams; just like the regular--- function application operator '$' except that it is concurrent. The--- following code prints a value every second even though each stage adds a 1--- second delay.--------- @--- runStream $---    S.mapM (\\x -> threadDelay 1000000 >> print x)---      |$ S.repeatM (threadDelay 1000000 >> return 1)--- @------ /Concurrent/------ @since 0.3.0-{-# INLINE (|$) #-}-(|$) :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> t m a -> t m b-f |$ x = applyWith f x---- | Parallel reverse function application operator for streams; just like the--- regular reverse function application operator '&' except that it is--- concurrent.------ @--- runStream $---       S.repeatM (threadDelay 1000000 >> return 1)---    |& S.mapM (\\x -> threadDelay 1000000 >> print x)--- @------ /Concurrent/------ @since 0.3.0-{-# INLINE (|&) #-}-(|&) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> t m b) -> t m b-x |& f = f |$ x---- | Parallel function application operator; applies a @run@ or @fold@ function--- to a stream such that the fold consumer and the stream producer run in--- parallel. A @run@ or @fold@ function reduces the stream to a value in the--- underlying monad. The @.@ at the end of the operator is a mnemonic for--- termination of the stream.------ @---    S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()---       |$. S.repeatM (threadDelay 1000000 >> return 1)--- @------ /Concurrent/------ @since 0.3.0-{-# INLINE (|$.) #-}-(|$.) :: (IsStream t, MonadAsync m) => (t m a -> m b) -> t m a -> m b-f |$. x = runWith f x---- | Parallel reverse function application operator for applying a run or fold--- functions to a stream. Just like '|$.' except that the operands are reversed.------ @---        S.repeatM (threadDelay 1000000 >> return 1)---    |&. S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()--- @------ /Concurrent/------ @since 0.3.0-{-# INLINE (|&.) #-}-(|&.) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> m b) -> m b-x |&. f = f |$. x----------------------------------------------------------------------------------- ParallelT----------------------------------------------------------------------------------- | Async composition with simultaneous traversal of all streams.------ The Semigroup instance of 'ParallelT' concurrently /merges/ two streams,--- running both strictly concurrently and yielding elements from both streams--- as they arrive. When multiple streams are combined using 'ParallelT' each--- one is evaluated in its own thread and the results produced are presented in--- the combined stream on a first come first serve basis.------ 'AsyncT' and 'WAsyncT' are /concurrent lookahead streams/ each with a--- specific type of consumption pattern (depth first or breadth first). Since--- they are lookahead, they may introduce certain default latency in starting--- more concurrent tasks for efficiency reasons or may put a default limitation--- on the resource consumption (e.g. number of concurrent threads for--- lookahead).  If we look at the implementation detail, they both can share a--- pool of worker threads to evaluate the streams in the desired pattern and at--- the desired rate. However, 'ParallelT' uses a separate runtime thread to--- evaluate each stream.------ 'WAsyncT' is similar to 'ParallelT', as both of them evaluate the--- constituent streams fairly in a round robin fashion.--- However, the key difference is that 'WAsyncT' is lazy or pull driven--- whereas 'ParallelT' is strict or push driven.  'ParallelT' immediately--- starts concurrent evaluation of both the streams (in separate threads) and--- later picks the results whereas 'WAsyncT' may wait for a certain latency--- threshold before initiating concurrent evaluation of the next stream. The--- concurrent scheduling of the next stream or the degree of concurrency is--- driven by the feedback from the consumer. In case of 'ParallelT' each stream--- is evaluated in a separate thread and results are /pushed/ to a shared--- output buffer, the evaluation rate is controlled by blocking when the buffer--- is full.------ Concurrent lookahead streams are generally more efficient than--- 'ParallelT' and can work pretty efficiently even for smaller tasks because--- they do not necessarily use a separate thread for each task. So they should--- be preferred over 'ParallelT' especially when efficiency is a concern and--- simultaneous strict evaluation is not a requirement.  'ParallelT' is useful--- for cases when the streams are required to be evaluated simultaneously--- irrespective of how the consumer consumes them e.g.  when we want to race--- two tasks and want to start both strictly at the same time or if we have--- timers in the parallel tasks and our results depend on the timers being--- started at the same time.  We can say that 'ParallelT' is almost the same--- (modulo some implementation differences) as 'WAsyncT' when the latter is--- used with unlimited lookahead and zero latency in initiating lookahead.------ @--- main = ('toList' . 'parallely' $ (fromFoldable [1,2]) \<> (fromFoldable [3,4])) >>= print--- @--- @--- [1,3,2,4]--- @------ When streams with more than one element are merged, it yields whichever--- stream yields first without any bias, unlike the 'Async' style streams.------ Any exceptions generated by a constituent stream are propagated to the--- output stream. The output and exceptions from a single stream are guaranteed--- to arrive in the same order in the resulting stream as they were generated--- in the input stream. However, the relative ordering of elements from--- different streams in the resulting stream can vary depending on scheduling--- and generation delays.------ Similarly, the 'Monad' instance of 'ParallelT' runs /all/ iterations--- of the loop concurrently.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Control.Concurrent------ main = 'runStream' . 'parallely' $ do---     n <- return 3 \<\> return 2 \<\> return 1---     S.yieldM $ do---          threadDelay (n * 1000000)---          myThreadId >>= \\tid -> putStrLn (show tid ++ ": Delay " ++ show n)--- @--- @--- ThreadId 40: Delay 1--- ThreadId 39: Delay 2--- ThreadId 38: Delay 3--- @------ Note that parallel composition can only combine a finite number of--- streams as it needs to retain state for each unfinished stream.------ @since 0.1.0-newtype ParallelT m a = ParallelT {getParallelT :: Stream m a}-    deriving (MonadTrans)---- | A parallely composing IO stream of elements of type @a@.--- See 'ParallelT' documentation for more details.------ @since 0.2.0-type Parallel = ParallelT IO---- | Fix the type of a polymorphic stream as 'ParallelT'.------ @since 0.1.0-parallely :: IsStream t => ParallelT m a -> t m a-parallely = adapt--instance IsStream ParallelT where-    toStream = getParallelT-    fromStream = ParallelT--    {-# INLINE consM #-}-    {-# SPECIALIZE consM :: IO a -> ParallelT IO a -> ParallelT IO a #-}-    consM m r = fromStream $ consMParallel m (toStream r)--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> ParallelT IO a -> ParallelT IO a #-}-    (|:) = consM----------------------------------------------------------------------------------- Semigroup---------------------------------------------------------------------------------instance MonadAsync m => Semigroup (ParallelT m a) where-    (<>) = parallel----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance MonadAsync m => Monoid (ParallelT m a) where-    mempty = K.nil-    mappend = (<>)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance MonadAsync m => Monad (ParallelT m) where-    return = pure-    (ParallelT m) >>= f-        = ParallelT $ K.bindWith parallelStream m (getParallelT . f)----------------------------------------------------------------------------------- Other instances---------------------------------------------------------------------------------MONAD_APPLICATIVE_INSTANCE(ParallelT,MONADPARALLEL)-MONAD_COMMON_INSTANCES(ParallelT, MONADPARALLEL)
− src/Streamly/Streams/Prelude.hs 
@@ -1,66 +0,0 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE InstanceSigs              #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE RankNTypes                #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX---- |--- Module      : Streamly.Streams.Prelude--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC-------module Streamly.Streams.Prelude-    (-    -- * Fold Utilities-      foldWith-    , foldMapWith-    , forEachWith-    )-where--import Streamly.Streams.StreamK (IsStream(..))-import qualified Streamly.Streams.StreamK as K----------------------------------------------------------------------------------- Fold Utilities----------------------------------------------------------------------------------- | A variant of 'Data.Foldable.fold' that allows you to fold a 'Foldable'--- container of streams using the specified stream sum operation.------ @foldWith 'async' $ map return [1..3]@------ @since 0.1.0-{-# INLINABLE foldWith #-}-foldWith :: (IsStream t, Foldable f)-    => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-foldWith f = foldr f K.nil---- | A variant of 'foldMap' that allows you to map a monadic streaming action--- on a 'Foldable' container and then fold it using the specified stream sum--- operation.------ @foldMapWith 'async' return [1..3]@------ @since 0.1.0-{-# 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 f g = foldr (f . g) K.nil---- | Like 'foldMapWith' but with the last two arguments reversed i.e. the--- monadic streaming function is the last argument.------ @since 0.1.0-{-# 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 f xs g = foldr (f . g) K.nil xs
− src/Streamly/Streams/SVar.hs 
@@ -1,306 +0,0 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE RankNTypes                #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX--#include "inline.h"---- |--- Module      : Streamly.Streams.SVar--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC-------module Streamly.Streams.SVar-    (-      fromSVar-    , toSVar-    , maxThreads-    , maxBuffer-    , maxYields-    , rate-    , avgRate-    , minRate-    , maxRate-    , constRate-    , inspectMode-    , printState-    )-where--import Control.Exception (fromException)-import Control.Monad (when)-import Control.Monad.Catch (throwM)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Data.Int (Int64)-import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef)-import Data.Maybe (isNothing)-import Data.Semigroup ((<>))-import System.IO (hPutStrLn, stderr)-import System.Clock (Clock(Monotonic), getTime)-import System.Mem (performMajorGC)--import Streamly.SVar-import Streamly.Streams.StreamK-import Streamly.Streams.Serial (SerialT)--printSVar :: SVar t m a -> String -> IO ()-printSVar sv how = do-    svInfo <- dumpSVar sv-    hPutStrLn stderr $ "\n" <> how <> "\n" <> svInfo--printState :: MonadIO m => State Stream m a -> m ()-printState st = liftIO $ do-    let msv = streamVar st-    case msv of-        Just sv -> dumpSVar sv >>= putStrLn-        Nothing -> putStrLn "No SVar"---- | Pull a stream from an SVar.-{-# NOINLINE fromStreamVar #-}-fromStreamVar :: MonadAsync m => SVar Stream m a -> Stream m a-fromStreamVar sv = Stream $ \st stp sng yld -> 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.-    unStream (processEvents $ reverse list) (rstState st) stp sng yld--    where--    allDone stp = do-        when (svarInspectMode sv) $ do-            t <- liftIO $ getTime Monotonic-            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)-            liftIO $ printSVar sv "SVar Done"-        stp--    {-# INLINE processEvents #-}-    processEvents [] = Stream $ \st stp sng yld -> do-        done <- postProcess sv-        if done-        then allDone stp-        else unStream (fromStreamVar sv) (rstState st) stp sng yld--    processEvents (ev : es) = Stream $ \st stp sng yld -> do-        let rest = processEvents es-        case ev of-            ChildYield a -> yld a rest-            ChildStop tid e -> do-                accountThread sv tid-                case e of-                    Nothing -> unStream rest (rstState st) stp sng yld-                    Just ex ->-                        case fromException ex of-                            Just ThreadAbort ->-                                unStream rest (rstState st) stp sng yld-                            Nothing -> liftIO (cleanupSVar sv) >> throwM ex--{-# INLINE fromSVar #-}-fromSVar :: (MonadAsync m, IsStream t) => SVar Stream m a -> t m a-fromSVar sv =-    fromStream $ Stream $ \st stp sng yld -> do-        ref <- liftIO $ newIORef ()-        _ <- liftIO $ mkWeakIORef ref hook-        -- We pass a copy of sv to fromStreamVar, 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.-        unStream (fromStreamVar sv{svarRef = Just ref}) st stp sng yld-    where--    hook = do-        when (svarInspectMode sv) $ do-            r <- liftIO $ readIORef (svarStopTime (svarStats sv))-            when (isNothing r) $-                printSVar sv "SVar Garbage Collected"-        cleanupSVar sv-        -- If there are any SVars referenced by this SVar a GC will prompt-        -- them to be cleaned up quickly.-        when (svarInspectMode sv) performMajorGC---- | Write a stream to an 'SVar' in a non-blocking manner. The stream can then--- be read back from the SVar using 'fromSVar'.-toSVar :: (IsStream t, MonadAsync m) => SVar Stream m a -> t m a -> m ()-toSVar sv m = toStreamVar sv (toStream m)------------------------------------------------------------------------------------ Concurrency control-------------------------------------------------------------------------------------- XXX need to write these in direct style otherwise they will break fusion.------ | Specify the maximum number of threads that can be spawned concurrently for--- any concurrent combinator in a stream.--- 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.------ @since 0.4.0-{-# INLINE_NORMAL maxThreads #-}-maxThreads :: IsStream t => Int -> t m a -> t m a-maxThreads n m = fromStream $ Stream $ \st stp sng yld ->-    unStream (toStream m) (setMaxThreads n st) stp sng yld--{--{-# RULES "maxThreadsSerial serial" maxThreads = maxThreadsSerial #-}-maxThreadsSerial :: Int -> SerialT m a -> SerialT m a-maxThreadsSerial _ = id--}---- | 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.------ @since 0.4.0-{-# INLINE_NORMAL maxBuffer #-}-maxBuffer :: IsStream t => Int -> t m a -> t m a-maxBuffer n m = fromStream $ Stream $ \st stp sng yld ->-    unStream (toStream m) (setMaxBuffer n st) stp sng yld--{--{-# RULES "maxBuffer serial" maxBuffer = maxBufferSerial #-}-maxBufferSerial :: Int -> SerialT m a -> SerialT m a-maxBufferSerial _ = id--}---- | Specify the pull rate of a stream.--- A 'Nothing' value resets the rate to default which is unlimited.  When the--- rate is specified, concurrent production may be ramped up or down--- automatically to achieve the specified yield rate. The specific behavior for--- different styles of 'Rate' specifications is documented under 'Rate'.  The--- effective maximum production rate achieved by a stream 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------ @since 0.5.0-{-# INLINE_NORMAL rate #-}-rate :: IsStream t => Maybe Rate -> t m a -> t m a-rate r m = fromStream $ Stream $ \st stp sng yld ->-    case r of-        Just (Rate low goal _ _) | goal < low ->-            error "rate: Target rate cannot be lower than minimum rate."-        Just (Rate _ goal high _) | goal > high ->-            error "rate: Target rate cannot be greater than maximum rate."-        Just (Rate low _ high _) | low > high ->-            error "rate: Minimum rate cannot be greater than maximum rate."-        _ -> unStream (toStream m) (setStreamRate r st) stp sng yld---- XXX implement for serial streams as well, as a simple delay--{--{-# RULES "rate serial" rate = yieldRateSerial #-}-yieldRateSerial :: Double -> SerialT m a -> SerialT m a-yieldRateSerial _ = id--}---- | 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.------ @since 0.5.0-avgRate :: IsStream t => Double -> t m a -> t m a-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.------ @since 0.5.0-minRate :: IsStream t => Double -> t m a -> t m a-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.------ @since 0.5.0-maxRate :: IsStream t => Double -> t m a -> t m a-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.------ @since 0.5.0-constRate :: IsStream t => Double -> t m a -> t m a-constRate r = rate (Just $ Rate r r r 0)---- | Specify the average latency, in nanoseconds, of a single threaded action--- in a concurrent composition. Streamly can measure the latencies, but that is--- possible only after at least one task has completed. This combinator can be--- used to provide a latency hint so that rate control using 'rate' can take--- that into account right from the beginning. When not specified then a--- default behavior is chosen which could be too slow or too fast, and would be--- restricted by any other control parameters configured.--- A value of 0 indicates default behavior, a negative value means there is no--- limit i.e. zero latency.--- This would normally be useful only in high latency and high throughput--- cases.----{-# INLINE_NORMAL _serialLatency #-}-_serialLatency :: IsStream t => Int -> t m a -> t m a-_serialLatency n m = fromStream $ Stream $ \st stp sng yld ->-    unStream (toStream m) (setStreamLatency n st) stp sng yld--{--{-# RULES "serialLatency serial" _serialLatency = serialLatencySerial #-}-serialLatencySerial :: Int -> SerialT m a -> SerialT m a-serialLatencySerial _ = id--}---- Stop concurrent dispatches after this limit. This is useful in API's like--- "take" where we want to dispatch only upto the number of elements "take"--- needs.  This value applies only to the immediate next level and is not--- inherited by everything in enclosed scope.-{-# INLINE_NORMAL maxYields #-}-maxYields :: IsStream t => Maybe Int64 -> t m a -> t m a-maxYields n m = fromStream $ Stream $ \st stp sng yld ->-    unStream (toStream m) (setYieldLimit n st) stp sng yld--{-# RULES "maxYields serial" maxYields = maxYieldsSerial #-}-maxYieldsSerial :: Maybe Int64 -> SerialT m a -> SerialT m a-maxYieldsSerial _ = id---- | Print debug information about an SVar when the stream ends-inspectMode :: IsStream t => t m a -> t m a-inspectMode m = fromStream $ Stream $ \st stp sng yld ->-     unStream (toStream m) (setInspectMode st) stp sng yld
− src/Streamly/Streams/Serial.hs 
@@ -1,344 +0,0 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving#-}-{-# LANGUAGE InstanceSigs              #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX---- |--- Module      : Streamly.Streams.Serial--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC-------module Streamly.Streams.Serial-    (-    -- * Serial appending stream-      SerialT-    , StreamT           -- deprecated-    , Serial-    , serial-    , serially--    -- * Serial interleaving stream-    , WSerialT-    , InterleavedT      -- deprecated-    , WSerial-    , wSerial-    , (<=>)            -- deprecated-    , wSerially-    , interleaving     -- deprecated--    -- * Transformation-    , map-    , mapM-    )-where--import Control.Monad (ap)-import Control.Monad.Base (MonadBase(..), liftBaseDefault)-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(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Semigroup (Semigroup(..))-import Prelude hiding (map, mapM)--import Streamly.SVar (rstState)-import Streamly.Streams.StreamK (IsStream(..), adapt, Stream(..))-import qualified Streamly.Streams.StreamK as K-import qualified Streamly.Streams.StreamD as D--#include "Instances.hs"-#include "inline.h"----------------------------------------------------------------------------------- SerialT----------------------------------------------------------------------------------- | Deep serial composition or serial composition with depth first traversal.--- The 'Semigroup' instance of 'SerialT' appends two streams serially in a--- depth first manner, yielding all elements from the first stream, and then--- all elements from the second stream.------ @--- import Streamly--- import qualified "Streamly.Prelude" as S------ main = ('toList' . 'serially' $ (fromFoldable [1,2]) \<\> (fromFoldable [3,4])) >>= print--- @--- @--- [1,2,3,4]--- @------ The 'Monad' instance runs the /monadic continuation/ for each--- element of the stream, serially.------ @--- main = 'runStream' . 'serially' $ do---     x <- return 1 \<\> return 2---     S.yieldM $ print x--- @--- @--- 1--- 2--- @------ 'SerialT' nests streams serially in a depth first manner.------ @--- main = 'runStream' . 'serially' $ do---     x <- return 1 \<\> return 2---     y <- return 3 \<\> return 4---     S.yieldM $ print (x, y)--- @--- @--- (1,3)--- (1,4)--- (2,3)--- (2,4)--- @------ This behavior of 'SerialT' is exactly like a list transformer. We call the--- monadic code being run for each element of the stream a monadic--- continuation. In imperative paradigm we can think of this composition as--- nested @for@ loops and the monadic continuation is the body of the loop. The--- loop iterates for all elements of the stream.------ The 'serially' combinator can be omitted as the default stream type is--- 'SerialT'.--- Note that serial composition with depth first traversal can be used to--- combine an infinite number of streams as it explores only one stream at a--- time.------ @since 0.2.0-newtype SerialT m a = SerialT {getSerialT :: Stream m a}-    deriving (Semigroup, Monoid, MonadTrans)---- | A serial IO stream of elements of type @a@. See 'SerialT' documentation--- for more details.------ @since 0.2.0-type Serial = SerialT IO---- |--- @since 0.1.0-{-# DEPRECATED StreamT "Please use 'SerialT' instead." #-}-type StreamT = SerialT---- | Fix the type of a polymorphic stream as 'SerialT'.------ @since 0.1.0-serially :: IsStream t => SerialT m a -> t m a-serially = adapt--instance IsStream SerialT where-    toStream = getSerialT-    fromStream = SerialT--    {-# INLINE consM #-}-    {-# SPECIALIZE consM :: IO a -> SerialT IO a -> SerialT IO a #-}-    consM :: Monad m => m a -> SerialT m a -> SerialT m a-    consM m r = fromStream $ K.consMSerial m (toStream r)--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> SerialT IO a -> SerialT IO a #-}-    (|:) :: Monad m => m a -> SerialT m a -> SerialT m a-    m |: r = fromStream $ K.consMSerial m (toStream r)----------------------------------------------------------------------------------- Semigroup----------------------------------------------------------------------------------- | Polymorphic version of the 'Semigroup' operation '<>' of 'SerialT'.--- Appends two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.------ @since 0.2.0-{-# INLINE serial #-}-serial :: IsStream t => t m a -> t m a -> t m a-serial m1 m2 = fromStream $ Stream $ \st stp sng yld ->-    unStream (K.serial (toStream m1) (toStream m2))-             (rstState st) stp sng yld----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance Monad m => Monad (SerialT m) where-    return = pure-    (SerialT (Stream m)) >>= f = SerialT $ Stream $ \st stp sng yld ->-        let run x = unStream x (rstState st) stp sng yld-            single a   = run $ toStream (f a)-            yieldk a r = run $ toStream $ f a <> (fromStream r >>= f)-        in m (rstState st) stp single yieldk----------------------------------------------------------------------------------- Other instances---------------------------------------------------------------------------------{-# INLINE_EARLY mapM #-}-mapM :: (IsStream t, Monad m) => (a -> m b) -> t m a -> t m b-mapM f m = fromStream $ D.toStreamK $ D.mapM f $ D.fromStreamK (toStream m)---- | Same as 'fmap'.------ @since 0.4.0-{-# INLINE map #-}-map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b-map f = mapM (return . f)--MONAD_APPLICATIVE_INSTANCE(SerialT,)-MONAD_COMMON_INSTANCES(SerialT,)----------------------------------------------------------------------------------- WSerialT----------------------------------------------------------------------------------- | Wide serial composition or serial composition with a breadth first--- traversal. The 'Semigroup' instance of 'WSerialT' traverses--- the two streams in a breadth first manner. In other words, it interleaves--- two streams, yielding one element from each stream alternately.------ @--- import Streamly--- import qualified "Streamly.Prelude" as S------ main = ('toList' . 'wSerially' $ (fromFoldable [1,2]) \<\> (fromFoldable [3,4])) >>= print--- @--- @--- [1,3,2,4]--- @------ Similarly, the 'Monad' instance interleaves the iterations of the--- inner and the outer loop, nesting loops in a breadth first manner.--------- @--- main = 'runStream' . 'wSerially' $ do---     x <- return 1 \<\> return 2---     y <- return 3 \<\> return 4---     S.yieldM $ print (x, y)--- @--- @--- (1,3)--- (2,3)--- (1,4)--- (2,4)--- @------ Note that a serial composition with breadth first traversal can only combine--- a finite number of streams as it needs to retain state for each unfinished--- stream.------ @since 0.2.0-newtype WSerialT m a = WSerialT {getWSerialT :: Stream m a}-    deriving (MonadTrans)---- | An interleaving serial IO stream of elements of type @a@. See 'WSerialT'--- documentation for more details.------ @since 0.2.0-type WSerial = WSerialT IO---- |--- @since 0.1.0-{-# DEPRECATED InterleavedT "Please use 'WSerialT' instead." #-}-type InterleavedT = WSerialT---- | Fix the type of a polymorphic stream as 'WSerialT'.------ @since 0.2.0-wSerially :: IsStream t => WSerialT m a -> t m a-wSerially = adapt---- | Same as 'wSerially'.------ @since 0.1.0-{-# DEPRECATED interleaving "Please use wSerially instead." #-}-interleaving :: IsStream t => WSerialT m a -> t m a-interleaving = wSerially--instance IsStream WSerialT where-    toStream = getWSerialT-    fromStream = WSerialT--    {-# INLINE consM #-}-    {-# SPECIALIZE consM :: IO a -> WSerialT IO a -> WSerialT IO a #-}-    consM :: Monad m => m a -> WSerialT m a -> WSerialT m a-    consM m r = fromStream $ K.consMSerial m (toStream r)--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> WSerialT IO a -> WSerialT IO a #-}-    (|:) :: Monad m => m a -> WSerialT m a -> WSerialT m a-    m |: r = fromStream $ K.consMSerial m (toStream r)----------------------------------------------------------------------------------- Semigroup---------------------------------------------------------------------------------{-# INLINE interleave #-}-interleave :: Stream m a -> Stream m a -> Stream m a-interleave m1 m2 = Stream $ \st stp sng yld -> do-    let stop       = unStream m2 (rstState st) stp sng yld-        single a   = yld a m2-        yieldk a r = yld a (interleave m2 r)-    unStream m1 (rstState st) stop single yieldk---- | Polymorphic version of the 'Semigroup' operation '<>' of 'WSerialT'.--- Interleaves two streams, yielding one element from each stream alternately.------ @since 0.2.0-{-# INLINE wSerial #-}-wSerial :: IsStream t => t m a -> t m a -> t m a-wSerial m1 m2 = fromStream $ Stream $ \st stp sng yld ->-    unStream (interleave (toStream m1) (toStream m2))-             (rstState st) stp sng yld--instance Semigroup (WSerialT m a) where-    (<>) = wSerial--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----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance Monoid (WSerialT m a) where-    mempty = K.nil-    mappend = (<>)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance Monad m => Monad (WSerialT m) where-    return = pure-    (WSerialT (Stream m)) >>= f = WSerialT $ Stream $ \st stp sng yld ->-        let run x = unStream x (rstState st) stp sng yld-            single a   = run $ toStream (f a)-            yieldk a r = run $ toStream $ f a <> (fromStream r >>= f)-        in m (rstState st) stp single yieldk----------------------------------------------------------------------------------- Other instances---------------------------------------------------------------------------------MONAD_APPLICATIVE_INSTANCE(WSerialT,)-MONAD_COMMON_INSTANCES(WSerialT,)
− src/Streamly/Streams/StreamD.hs 
@@ -1,669 +0,0 @@-{-# LANGUAGE BangPatterns              #-}-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE RankNTypes                #-}--#include "inline.h"---- |--- Module      : Streamly.Streams.StreamD--- Copyright   : (c) 2018 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC------ Direct style re-implementation of CPS style stream in StreamK module.  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.Streams.StreamD as D--- @---- Some of functions in this file have been adapted from the vector--- library,  https://hackage.haskell.org/package/vector.--module Streamly.Streams.StreamD-    (-    -- * The stream type-      Step (..)-    , Stream (..)--    -- * Construction-    , nil-    , cons--    -- * Deconstruction-    , uncons--    -- * Generation-    -- ** Unfolds-    , unfoldr-    , unfoldrM--    -- ** Specialized Generation-    -- | Generate a monadic stream from a seed.-    , repeat-    , enumFromStepN--    -- ** Conversions-    -- | Transform an input structure into a stream.-    -- | Direct style stream does not support @fromFoldable@.-    , yield-    , yieldM-    , fromList-    , fromListM-    , fromStreamK--    -- * Elimination-    -- ** General Folds-    , foldr-    , foldrM-    , foldl'-    , foldlM'--    -- ** Specialized Folds-    , runStream-    , null-    , head-    , tail-    , last-    , elem-    , notElem-    , all-    , any-    , maximum-    , minimum--    -- ** Map and Fold-    , mapM_--    -- ** Conversions-    -- | Transform a stream into another type.-    , toList-    , toStreamK--    -- * Transformation-    -- ** By folding (scans)-    , scanlM'--    -- * Filtering-    , filter-    , filterM-    , take-    , takeWhile-    , takeWhileM-    , drop-    , dropWhile-    , dropWhileM--    -- * Mapping-    , map-    , mapM--    -- ** Map and Filter-    , mapMaybe-    , mapMaybeM--    -- * Zipping-    , zipWith-    , zipWithM-    )-where--import Data.Maybe (fromJust, isJust)-import GHC.Types ( SPEC(..) )-import Prelude-       hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,-               takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,-               notElem, null, head, tail, zipWith)--import Streamly.SVar (MonadAsync, State(..), defState, rstState)-import qualified Streamly.Streams.StreamK as K----------------------------------------------------------------------------------- The direct style stream type----------------------------------------------------------------------------------- | 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.-data Step s a = Yield a s | Stop--instance Functor (Step s) where-    {-# INLINE fmap #-}-    fmap f (Yield x s) = Yield (f x) s-    fmap _ Stop = Stop---- 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. Stream (State K.Stream m a -> s -> m (Step s a)) s----------------------------------------------------------------------------------- Construction----------------------------------------------------------------------------------- | An empty 'Stream'.-{-# INLINE_NORMAL nil #-}-nil :: Monad m => Stream m a-nil = Stream (\_ _ -> return Stop) ()---- | Can fuse but has O(n^2) complexity.-cons :: Monad m => a -> Stream m a -> Stream m a-cons x (Stream step state) = Stream step1 Nothing-    where-    step1 _ Nothing   = return $ Yield x (Just state)-    step1 gst (Just st) = do-        r <- step (rstState gst) st-        case r of-            Yield a s -> return $ Yield a (Just s)-            Stop -> return Stop------------------------------------------------------------------------------------ Deconstruction------------------------------------------------------------------------------------ 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 (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        return $ case r of-            Yield x s -> Just (x, Stream step s)-            Stop      -> Nothing----------------------------------------------------------------------------------- Generation by unfold---------------------------------------------------------------------------------{-# INLINE_NORMAL unfoldrM #-}-unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-unfoldrM next state = Stream step state-  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)----------------------------------------------------------------------------------- Specialized Generation---------------------------------------------------------------------------------repeat :: Monad m => a -> Stream m a-repeat x = Stream (\_ _ -> return $ Yield x ()) ()--{-# INLINE_NORMAL enumFromStepN #-}-enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a-enumFromStepN from stride n =-    from `seq` stride `seq` n `seq` Stream step (from, n)-    where-        {-# INLINE_LATE step #-}-        step _ (x, i) | i > 0     = return $ Yield x (x + stride, i - 1)-                      | otherwise = return Stop------------------------------------------------------------------------------------ Generation by Conversion------------------------------------------------------------------------------------ | Create a singleton 'Stream' from a pure value.-{-# INLINE_NORMAL yield #-}-yield :: Monad m => a -> Stream m a-yield x = Stream (\_ s -> return $ 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 yieldM #-}-yieldM :: Monad m => m a -> Stream m a-yieldM m = Stream step True-  where-    {-# INLINE_LATE step #-}-    step _ True  = m >>= \x -> return $ Yield x False-    step _ False = return Stop---- 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---- | Convert a list of pure values to a 'Stream'-{-# INLINE_LATE fromList #-}-fromList :: Monad m => [a] -> Stream m a-fromList = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ (x:xs) = return $ Yield x xs-    step _ []     = return Stop---- XXX pass the state to streamD-{-# INLINE_LATE fromStreamK #-}-fromStreamK :: Monad m => K.Stream m a -> Stream m a-fromStreamK = Stream step-    where-    step gst m1 =-        let stop       = return Stop-            single a   = return $ Yield a K.nil-            yieldk a r = return $ Yield a r-         in K.unStream m1 gst stop single yieldk----------------------------------------------------------------------------------- Elimination by Folds---------------------------------------------------------------------------------{-# INLINE_NORMAL foldrM #-}-foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b-foldrM f z (Stream step state) = go SPEC state-  where-    go !_ st = do-          r <- step defState st-          case r of-            Yield x s -> go SPEC s >>= f x-            Stop      -> return z--{-# INLINE_NORMAL foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b-foldr f = foldrM (\a b -> return (f a b))--{-# INLINE_NORMAL foldlM' #-}-foldlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b-foldlM' fstep begin (Stream step state) = go SPEC begin state-  where-    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-            Stop -> return acc--{-# INLINE foldl' #-}-foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b-foldl' fstep = foldlM' (\b a -> return (fstep b a))----------------------------------------------------------------------------------- Specialized Folds----------------------------------------------------------------------------------- | Run a streaming composition, discard the results.-{-# INLINE_LATE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield _ s -> go SPEC s-            Stop      -> return ()--{-# INLINE_NORMAL null #-}-null :: Monad m => Stream m a -> m Bool-null (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield _ _ -> return False-            Stop -> return True---- XXX SPEC?-{-# INLINE_NORMAL head #-}-head :: Monad m => Stream m a -> m (Maybe a)-head (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x _ -> return (Just x)-            Stop -> return Nothing---- 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 (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield _ s -> return (Just $ Stream step 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 (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s ->-                if x == e-                then return True-                else go s-            Stop -> return False--{-# INLINE_NORMAL notElem #-}-notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-notElem e (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s ->-                if x == e-                then return False-                else go s-            Stop -> return True--{-# INLINE_NORMAL all #-}-all :: Monad m => (a -> Bool) -> Stream m a -> m Bool-all p (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s ->-                if p x-                then go s-                else return False-            Stop -> return True--{-# INLINE_NORMAL any #-}-any :: Monad m => (a -> Bool) -> Stream m a -> m Bool-any p (Stream step state) = go state-  where-    go st = do-        r <- step defState st-        case r of-            Yield x s ->-                if p x-                then return True-                else 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-            Stop -> return Nothing-    go (Just acc) st = do-        r <- step defState st-        case r of-            Yield x s ->-                if acc <= x-                then go (Just x) s-                else 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-            Stop -> return Nothing-    go (Just acc) st = do-        r <- step defState st-        case r of-            Yield x s ->-                if acc <= x-                then go (Just acc) s-                else go (Just x) s-            Stop -> return (Just acc)----------------------------------------------------------------------------------- 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 = runStream . mapM m----------------------------------------------------------------------------------- Converting folds---------------------------------------------------------------------------------{-# INLINE toList #-}-toList :: Monad m => Stream m a -> m [a]-toList = foldr (:) []---- Convert a direct stream to and from CPS encoded stream-{-# INLINE_LATE toStreamK #-}-toStreamK :: Monad m => Stream m a -> K.Stream m a-toStreamK (Stream step state) = go state-    where-    go st = K.Stream $ \gst stp _ yld -> do-        r <- step gst st-        case r of-            Yield x s -> yld x (go s)-            Stop      -> stp--#ifndef DISABLE_FUSION-{-# RULES "fromStreamK/toStreamK fusion"-    forall s. toStreamK (fromStreamK s) = s #-}-{-# RULES "toStreamK/fromStreamK fusion"-    forall s. fromStreamK (toStreamK s) = s #-}-#endif----------------------------------------------------------------------------------- Transformation by Folding (Scans)---------------------------------------------------------------------------------{-# INLINE_NORMAL postscanlM' #-}-postscanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b-postscanlM' fstep begin (Stream step state) =-    begin `seq` Stream step' (state, begin)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, acc) = acc `seq` do-        r <- step (rstState gst) st-        case r of-            Yield x s -> do-                y <- fstep acc x-                y `seq` return (Yield y (s, y))-            Stop -> return Stop--{-# INLINE scanlM' #-}-scanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b-scanlM' fstep begin s = begin `seq` (begin `cons` postscanlM' fstep begin s)------------------------------------------------------------------------------------ Filtering----------------------------------------------------------------------------------{-# INLINE_NORMAL take #-}-take :: Monad 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-        r <- step (rstState gst) st-        return $ case r of-            Yield x s -> Yield x (s, i + 1)-            Stop      -> Stop-    step' _ (_, _) = return Stop--{-# 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 (rstState gst) st-        case r of-            Yield x s -> do-                b <- f x-                return $ if b then Yield x s else Stop-            Stop -> return Stop--{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-takeWhile f = takeWhileM (return . f)--{-# INLINE_NORMAL drop #-}-drop :: Monad m => Int -> Stream m a -> Stream m a-drop n (Stream step state) = Stream step' (state, n)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, i) = do-        r <- step (rstState gst) st-        case r of-            Yield _ s | i > 0 -> step' gst (s, i - 1)-            Yield x s -> return $ Yield x (s, 0)-            Stop      -> return Stop--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 (rstState gst) st-        case r of-            Yield x s -> do-                b <- f x-                if b-                then step' gst (DropWhileDrop s)-                else step' gst (DropWhileYield x s)-            Stop -> return Stop--    step' gst (DropWhileNext st) =  do-        r <- step (rstState gst) st-        case r of-            Yield x s -> step' gst (DropWhileYield x 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)--{-# 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 (rstState gst) st-        case r of-            Yield x s -> do-                b <- f x-                if b-                then return $ Yield x s-                else step' gst s-            Stop -> return Stop--{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-filter f = filterM (return . f)----------------------------------------------------------------------------------- Transformation by Mapping----------------------------------------------------------------------------------- | 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 (rstState gst) st-        case r of-            Yield x s -> f x >>= \a -> return $ Yield a s-            Stop      -> return Stop--{-# INLINE map #-}-map :: Monad m => (a -> b) -> Stream m a -> Stream m b-map f = mapM (return . f)----------------------------------------------------------------------------------- Transformation by Map and Filter----------------------------------------------------------------------------------- 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----------------------------------------------------------------------------------- Instances---------------------------------------------------------------------------------{-# 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 (rstState gst) sa-        case r of-            Yield x sa' -> step gst (sa', sb, Just x)-            Stop        -> return Stop--    step gst (sa, sb, Just x) = do-        r <- stepb (rstState gst) sb-        case r of-            Yield y sb' -> do-                z <- f x y-                return $ Yield z (sa, sb', Nothing)-            Stop -> return Stop--{-# RULES "zipWithM xs xs"-    forall f xs. zipWithM f xs xs = mapM (\x -> f x x) xs #-}--{-# 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))----------------------------------------------------------------------------------- Instances---------------------------------------------------------------------------------instance Monad m => Functor (Stream m) where-    {-# INLINE fmap #-}-    fmap = map
− src/Streamly/Streams/StreamK.hs 
@@ -1,1071 +0,0 @@-{-# LANGUAGE BangPatterns              #-}-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE InstanceSigs              #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE RankNTypes                #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX---- |--- Module      : Streamly.Streams.StreamK--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.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.Streams.StreamK as K--- @----module Streamly.Streams.StreamK-    (-    -- * A class for streams-      IsStream (..)-    , adapt--    -- * The stream type-    , Stream (..)-    , unStreamIsolated-    , isolateStream-    , unstreamShared-    , runStreamSVar--    -- * Construction-    , mkStream-    , nil-    , cons-    , (.:)--    -- * Asynchronous construction-    , nilK-    , yieldK-    , consK--    -- * Deconstruction-    , uncons--    -- * Generation-    -- ** Unfolds-    , unfoldr-    , unfoldrM--    -- ** Specialized Generation-    , repeat--    -- ** Conversions-    , yield-    , yieldM-    , fromFoldable-    , fromList-    , fromStreamK--    -- * Elimination-    -- ** General Folds-    , foldStream-    , foldr-    , foldrM-    , foldr1-    , foldl'-    , foldlM'-    , foldx-    , foldxM--    -- ** Specialized Folds-    , runStream-    , null-    , head-    , tail-    , init-    , elem-    , notElem-    , all-    , any-    , last-    , minimum-    , maximum-    , findIndices-    , lookup-    , find--    -- ** Map and Fold-    , mapM_--    -- ** Conversions-    , toList-    , toStreamK--    -- * Transformation-    -- ** By folding (scans)-    , scanl'-    , scanx--    -- ** Filtering-    , filter-    , take-    , takeWhile-    , drop-    , dropWhile--    -- ** Mapping-    , map-    , mapM-    , sequence--    -- ** Inserting-    , intersperseM--    -- ** Map and Filter-    , mapMaybe--    -- ** Zipping-    , zipWith-    , zipWithM--    -- * Semigroup Style Composition-    , serial--    -- * Utilities-    , consMSerial-    , bindWith-    , withLocal--    -- * Deprecated-    , Streaming -- deprecated-    , once      -- deprecated-    )-where--import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.Reader.Class  (MonadReader(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Semigroup (Semigroup(..))-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)-import qualified Prelude--import Streamly.SVar----------------------------------------------------------------------------------- The 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.----newtype Stream m a =-    Stream {-        unStream :: forall r.-               State Stream m a          -- state-            -> m r                       -- stop-            -> (a -> m r)                -- singleton-            -> (a -> Stream m a -> m r)  -- yield-            -> m r-    }---- XXX make this the default "unStream"--- | unwraps the Stream type producing the stream function that can be run with--- continuations.-{-# INLINE unStreamIsolated #-}-unStreamIsolated ::-       Stream m a-    -> State Stream m a          -- state-    -> m r                       -- stop-    -> (a -> m r)                -- singleton-    -> (a -> Stream m a -> m r)  -- yield-    -> m r-unStreamIsolated x st = unStream x (rstState st)--{-# INLINE isolateStream #-}-isolateStream :: Stream m a -> Stream m a-isolateStream x = Stream $ \st stp sng yld ->-    unStreamIsolated x st stp sng yld---- | Like unstream, but passes a shared SVar across continuations.-{-# INLINE unstreamShared #-}-unstreamShared ::-       Stream m a-    -> State Stream m a          -- state-    -> m r                       -- stop-    -> (a -> m r)                -- singleton-    -> (a -> Stream m a -> m r)  -- yield-    -> m r-unstreamShared = unStream---- Run the stream using a run function associated with the SVar that runs the--- streams with a captured snapshot of the monadic state.-{-# INLINE runStreamSVar #-}-runStreamSVar-    :: MonadIO m-    => SVar Stream m a-    -> Stream m a-    -> State Stream m a          -- state-    -> m r                       -- stop-    -> (a -> m r)                -- singleton-    -> (a -> Stream m a -> m r)  -- yield-    -> m ()-runStreamSVar sv m st stp sng yld =-    let mrun = runInIO $ svarMrun sv-    in void $ liftIO $ mrun $ unStream m st stp sng yld----------------------------------------------------------------------------------- Types that can behave as a Stream---------------------------------------------------------------------------------infixr 5 `consM`-infixr 5 |:---- | Class of types that can represent a stream of elements of some type 'a' in--- some monad 'm'.------ @since 0.2.0-class IsStream t where-    toStream :: t m a -> Stream m a-    fromStream :: Stream m a -> t m a-    -- | Constructs a stream by adding a monadic action at the head of an-    -- existing stream. For example:-    ---    -- @-    -- > toList $ getLine \`consM` getLine \`consM` nil-    -- hello-    -- world-    -- ["hello","world"]-    -- @-    ---    -- /Concurrent (do not use 'parallely' to construct infinite streams)/-    ---    -- @since 0.2.0-    consM :: MonadAsync m => m a -> t m a -> t m a-    -- | Operator equivalent of 'consM'. We can read it as "@parallel colon@"-    -- to remember that @|@ comes before ':'.-    ---    -- @-    -- > toList $ getLine |: getLine |: nil-    -- hello-    -- world-    -- ["hello","world"]-    -- @-    ---    -- @-    -- let delay = threadDelay 1000000 >> print 1-    -- runStream $ serially  $ delay |: delay |: delay |: nil-    -- runStream $ parallely $ delay |: delay |: delay |: nil-    -- @-    ---    -- /Concurrent (do not use 'parallely' to construct infinite streams)/-    ---    -- @since 0.2.0-    (|:) :: MonadAsync m => m a -> t m a -> t m a-    -- 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------------------------------------------------------------------------------------ | Adapt any specific stream type to any other specific stream type.------ @since 0.1.0-adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a-adapt = fromStream . toStream----------------------------------------------------------------------------------- Building a stream----------------------------------------------------------------------------------- | Build a stream from an 'SVar', a stop continuation, a singleton stream--- continuation and a yield continuation.-mkStream:: IsStream t-    => (forall r. State Stream m a-        -> m r-        -> (a -> m r)-        -> (a -> t m a -> m r)-        -> m r)-    -> t m a-mkStream k = fromStream $ Stream $ \st stp sng yld ->-    let yieldk a r = yld a (toStream r)-     in k (rstState st) stp sng yieldk----------------------------------------------------------------------------------- Construction----------------------------------------------------------------------------------- | An empty stream.------ @--- > toList nil--- []--- @------ @since 0.1.0-nil :: IsStream t => t m a-nil = fromStream $ Stream $ \_ stp _ _ -> stp--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-cons :: IsStream t => a -> t m a -> t m a-cons a r = fromStream $ Stream $ \_ _ _ yld -> yld a (toStream r)--infixr 5 .:---- | Operator equivalent of 'cons'.------ @--- > toList $ 1 .: 2 .: 3 .: nil--- [1,2,3]--- @------ @since 0.1.1-(.:) :: IsStream t => a -> t m a -> t m a-(.:) = cons--{-# INLINE consMSerial #-}-consMSerial :: (Monad m) => m a -> Stream m a -> Stream m a-consMSerial m r = Stream $ \_ _ _ yld -> m >>= \a -> yld a r----------------------------------------------------------------------------------- Asynchronous construction----------------------------------------------------------------------------------- | Make an empty stream from a callback function.-nilK :: IsStream t => (forall r. m r -> m r) -> t m a-nilK k = fromStream $ Stream $ \_ stp _ _ -> k stp---- | Make a singleton stream from a one shot callback function.-yieldK :: IsStream t => (forall r. (a -> m r) -> m r) -> t m a-yieldK k = fromStream $ Stream $ \_ _ sng _ -> k sng---- | Construct a stream from a callback function.-consK :: IsStream t => (forall r. (a -> m r) -> m r) -> t m a -> t m a-consK k r = fromStream $ Stream $ \_ _ _ yld -> k (\x -> yld x (toStream r))---- XXX consK with concurrent callbacks--- XXX Build a stream from a repeating callback function.------------------------------------------------------------------------------------ IsStream Stream----------------------------------------------------------------------------------instance IsStream Stream where-    toStream = id-    fromStream = id--    {-# INLINE consM #-}-    {-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}-    consM :: Monad m => m a -> Stream m a -> Stream m a-    consM = consMSerial--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> Stream IO a -> Stream IO a #-}-    (|:) :: Monad m => m a -> Stream m a -> Stream m a-    (|:) = consMSerial------------------------------------------------------------------------------------ Deconstruction----------------------------------------------------------------------------------{-# INLINE uncons #-}-uncons :: (IsStream t, Monad m) => t m a -> m (Maybe (a, t m a))-uncons m =-    let stop = return Nothing-        single a = return (Just (a, nil))-        yieldk a r = return (Just (a, fromStream r))-    in unStream (toStream m) defState stop single yieldk------------------------------------------------------------------------------------ Generation----------------------------------------------------------------------------------{-# INLINE unfoldr #-}-unfoldr :: IsStream t => (b -> Maybe (a, b)) -> b -> t m a-unfoldr step = fromStream . go-    where-    go s = Stream $ \_ stp _ yld ->-        case step s of-            Nothing -> stp-            Just (a, b) -> yld a (go b)--{-# INLINE unfoldrM #-}-unfoldrM :: (IsStream t, MonadAsync m) => (b -> m (Maybe (a, b))) -> b -> t m a-unfoldrM step = go-    where-    go s = fromStream $ Stream $ \svr stp sng yld -> do-        mayb <- step s-        case mayb of-            Nothing -> stp-            Just (a, b) ->-                unStream (toStream (return a |: go b)) svr stp sng yld------------------------------------------------------------------------------------ Special generation----------------------------------------------------------------------------------yield :: IsStream t => a -> t m a-yield a = fromStream $ Stream $ \_ _ single _ -> single a--{-# INLINE yieldM #-}-yieldM :: (Monad m, IsStream t) => m a -> t m a-yieldM m = fromStream $ Stream $ \_ _ single _ -> m >>= single---- | Same as yieldM------ @since 0.2.0-{-# DEPRECATED once "Please use yieldM instead." #-}-{-# INLINE once #-}-once :: (Monad m, IsStream t) => m a -> t m a-once = yieldM---- | Generate an infinite stream by repeating a pure value.--- Can be expressed as @cycle1 . yield@.------ @since 0.4.0-repeat :: IsStream t => a -> t m a-repeat a = let x = cons a x in x------------------------------------------------------------------------------------ Conversions------------------------------------------------------------------------------------ | Construct a stream from a 'Foldable' containing pure values. Same as--- @'Prelude.foldr' 'cons' 'nil'@.------ @since 0.2.0-{-# INLINE fromFoldable #-}-fromFoldable :: (IsStream t, Foldable f) => f a -> t m a-fromFoldable = Prelude.foldr cons nil--{-# INLINE fromList #-}-fromList :: IsStream t => [a] -> t m a-fromList = fromFoldable--{-# INLINE fromStreamK #-}-fromStreamK :: Stream m a -> Stream m a-fromStreamK = id------------------------------------------------------------------------------------ Elimination by Folding------------------------------------------------------------------------------------ | Fold a stream by providing an SVar, a stop continuation, a singleton--- continuation and a yield continuation.-foldStream-    :: IsStream t-    => State Stream m a-    -> m r-    -> (a -> m r)-    -> (a -> t m a -> m r)-    -> t m a-    -> m r-foldStream st blank single step m =-    let yieldk a x = step a (fromStream x)-     in unStream (toStream m) st blank single yieldk---- | Lazy right associative fold.-foldr :: (IsStream t, Monad m) => (a -> b -> b) -> b -> t m a -> m b-foldr step acc m = go (toStream m)-    where-    go m1 =-        let stop = return acc-            single a = return (step a acc)-            yieldk a r = go r >>= \b -> return (step a b)-        in unStream m1 defState stop single yieldk---- | Lazy right fold with a monadic step function.-{-# INLINE foldrM #-}-foldrM :: (IsStream t, Monad m) => (a -> b -> m b) -> b -> t m a -> m b-foldrM step acc m = go (toStream m)-    where-    go m1 =-        let stop = return acc-            single a = step a acc-            yieldk a r = go r >>= step a-        in unStream m1 defState stop single yieldk--{-# INLINE foldr1 #-}-foldr1 :: (IsStream t, Monad m) => (a -> a -> a) -> t 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 (toStream 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 unStream m1 defState stp single yieldk---- | 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.-{-# INLINE foldx #-}-foldx :: (IsStream t, Monad m)-    => (x -> a -> x) -> x -> (x -> b) -> t m a -> m b-foldx step begin done m = get $ go (toStream m) begin-    where-    {-# NOINLINE get #-}-    get m1 =-        let single = return . done-         in unStream m1 undefined undefined single undefined--    -- 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 m1 !acc = Stream $ \_ _ sng yld ->-        let stop = sng acc-            single a = sng $ step acc a-            yieldk a r =-                let stream = go r (step acc a)-                in unStream stream defState undefined sng yld-        in unStream m1 defState stop single yieldk---- | Strict left associative fold.-{-# INLINE foldl' #-}-foldl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> m b-foldl' step begin = foldx step begin id---- XXX replace the recursive "go" with explicit continuations.--- | Like 'foldx', but with a monadic step function.-foldxM :: (IsStream t, Monad m)-    => (x -> a -> m x) -> m x -> (x -> m b) -> t m a -> m b-foldxM step begin done m = go begin (toStream m)-    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 unStream m1 defState stop single yieldk---- | Like 'foldl'' but with a monadic step function.-foldlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> m b-foldlM' step begin = foldxM step (return begin) return----------------------------------------------------------------------------------- Specialized folds---------------------------------------------------------------------------------{-# INLINE runStream #-}-runStream :: (Monad m, IsStream t) => t m a -> m ()-runStream m = go (toStream m)-    where-    go m1 =-        let stop = return ()-            single _ = return ()-            yieldk _ r = go (toStream r)-         in unStream m1 defState stop single yieldk--{-# INLINE null #-}-null :: (IsStream t, Monad m) => t m a -> m Bool-null m =-    let stop      = return True-        single _  = return False-        yieldk _ _ = return False-    in unStream (toStream m) defState stop single yieldk--{-# INLINE head #-}-head :: (IsStream t, Monad m) => t m a -> m (Maybe a)-head m =-    let stop      = return Nothing-        single a  = return (Just a)-        yieldk a _ = return (Just a)-    in unStream (toStream m) defState stop single yieldk--{-# INLINE tail #-}-tail :: (IsStream t, Monad m) => t m a -> m (Maybe (t m a))-tail m =-    let stop      = return Nothing-        single _  = return $ Just nil-        yieldk _ r = return $ Just $ fromStream r-    in unStream (toStream m) defState stop single yieldk--{-# INLINE init #-}-init :: (IsStream t, Monad m) => t m a -> m (Maybe (t m a))-init m = go1 (toStream m)-    where-    go1 m1 = do-        r <- uncons m1-        case r of-            Nothing -> return Nothing-            Just (h, t) -> return . Just . fromStream $ go h t-    go p m1 = Stream $ \_ stp sng yld ->-        let single _ = sng p-            yieldk a x = yld p $ go a x-         in unStream m1 defState stp single yieldk--{-# INLINE elem #-}-elem :: (IsStream t, Monad m, Eq a) => a -> t m a -> m Bool-elem e m = go (toStream m)-    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 unStream m1 defState stop single yieldk--{-# INLINE notElem #-}-notElem :: (IsStream t, Monad m, Eq a) => a -> t m a -> m Bool-notElem e m = go (toStream m)-    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 unStream m1 defState stop single yieldk--all :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m Bool-all p m = go (toStream m)-    where-    go m1 =-        let single a   | p a       = return True-                       | otherwise = return False-            yieldk a r | p a       = go r-                       | otherwise = return False-         in unStream m1 defState (return True) single yieldk--any :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m Bool-any p m = go (toStream m)-    where-    go m1 =-        let single a   | p a       = return True-                       | otherwise = return False-            yieldk a r | p a       = return True-                       | otherwise = go r-         in unStream m1 defState (return False) single yieldk---- | Extract the last element of the stream, if any.-{-# INLINE last #-}-last :: (IsStream t, Monad m) => t m a -> m (Maybe a)-last = foldx (\_ y -> Just y) Nothing id--{-# INLINE minimum #-}-minimum :: (IsStream t, Monad m, Ord a) => t m a -> m (Maybe a)-minimum m = go Nothing (toStream m)-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in unStream m1 defState stop single yieldk--    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 unStream m1 defState stop single yieldk--{-# INLINE maximum #-}-maximum :: (IsStream t, Monad m, Ord a) => t m a -> m (Maybe a)-maximum m = go Nothing (toStream m)-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in unStream m1 defState stop single yieldk--    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 unStream m1 defState stop single yieldk--{-# INLINE lookup #-}-lookup :: (IsStream t, Monad m, Eq a) => a -> t m (a, b) -> m (Maybe b)-lookup e m = go (toStream m)-    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 unStream m1 defState (return Nothing) single yieldk--{-# INLINE find #-}-find :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m (Maybe a)-find p m = go (toStream m)-    where-    go m1 =-        let single a | p a = return $ Just a-                     | otherwise = return Nothing-            yieldk a x | p a = return $ Just a-                       | otherwise = go x-        in unStream m1 defState (return Nothing) single yieldk--{-# INLINE findIndices #-}-findIndices :: IsStream t => (a -> Bool) -> t m a -> t m Int-findIndices p = fromStream . go 0 . toStream-    where-    go offset m1 = Stream $ \st stp sng yld ->-        let single a | p a = sng offset-                     | otherwise = stp-            yieldk a x | p a = yld offset $ go (offset + 1) x-                       | otherwise = unStream (go (offset + 1) x) st stp sng yld-        in unStream m1 (rstState st) stp single yieldk----------------------------------------------------------------------------------- Map and Fold----------------------------------------------------------------------------------- | Apply a monadic action to each element of the stream and discard the--- output of the action.-mapM_ :: (IsStream t, Monad m) => (a -> m b) -> t m a -> m ()-mapM_ f m = go (toStream m)-    where-    go m1 =-        let stop = return ()-            single a = void (f a)-            yieldk a r = f a >> go r-         in unStream m1 defState stop single yieldk----------------------------------------------------------------------------------- Converting folds---------------------------------------------------------------------------------{-# INLINABLE toList #-}-toList :: (IsStream t, Monad m) => t m a -> m [a]-toList = foldr (:) []--{-# INLINE toStreamK #-}-toStreamK :: Stream m a -> Stream m a-toStreamK = id------------------------------------------------------------------------------------ Transformation by folding (Scans)----------------------------------------------------------------------------------{-# INLINE scanx #-}-scanx :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b-scanx step begin done m =-    cons (done begin) $ fromStream $ go (toStream m) begin-    where-    go m1 !acc = Stream $ \st stp sng yld ->-        let single a = sng (done $ step acc a)-            yieldk a r =-                let s = step acc a-                in yld (done s) (go r s)-        in unStream m1 (rstState st) stp single yieldk--{-# INLINE scanl' #-}-scanl' :: IsStream t => (b -> a -> b) -> b -> t m a -> t m b-scanl' step begin = scanx step begin id------------------------------------------------------------------------------------ Filtering----------------------------------------------------------------------------------{-# INLINE filter #-}-filter :: IsStream t => (a -> Bool) -> t m a -> t m a-filter p m = fromStream $ go (toStream m)-    where-    go m1 = Stream $ \st stp sng yld ->-        let single a   | p a       = sng a-                       | otherwise = stp-            yieldk a r | p a       = yld a (go r)-                       | otherwise = unStream r (rstState st) stp single yieldk-         in unStream m1 (rstState st) stp single yieldk--{-# INLINE take #-}-take :: IsStream t => Int -> t m a -> t m a-take n m = fromStream $ go n (toStream m)-    where-    go n1 m1 = Stream $ \st stp sng yld ->-        let yieldk a r = yld a (go (n1 - 1) r)-        in if n1 <= 0-           then stp-           else unStream m1 (rstState st) stp sng yieldk--{-# INLINE takeWhile #-}-takeWhile :: IsStream t => (a -> Bool) -> t m a -> t m a-takeWhile p m = fromStream $ go (toStream m)-    where-    go m1 = Stream $ \st stp sng yld ->-        let single a   | p a       = sng a-                       | otherwise = stp-            yieldk a r | p a       = yld a (go r)-                       | otherwise = stp-         in unStream m1 (rstState st) stp single yieldk--drop :: IsStream t => Int -> t m a -> t m a-drop n m = fromStream $ Stream $ \st stp sng yld ->-    unStream (go n (toStream m)) (rstState st) stp sng yld-    where-    go n1 m1 = Stream $ \st stp sng yld ->-        let single _ = stp-            yieldk _ r = (unStream $ go (n1 - 1) r) st stp sng yld-        -- Somehow "<=" check performs better than a ">"-        in if n1 <= 0-           then unStream m1 st stp sng yld-           else unStream m1 st stp single yieldk--{-# INLINE dropWhile #-}-dropWhile :: IsStream t => (a -> Bool) -> t m a -> t m a-dropWhile p m = fromStream $ go (toStream m)-    where-    go m1 = Stream $ \st stp sng yld ->-        let single a   | p a       = stp-                       | otherwise = sng a-            yieldk a r | p a = unStream r (rstState st) stp single yieldk-                       | otherwise = yld a r-         in unStream m1 (rstState st) stp single yieldk------------------------------------------------------------------------------------ Mapping----------------------------------------------------------------------------------{-# INLINE map #-}-map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b-map f m = fromStream $ Stream $ \st stp sng yld ->-    let single     = sng . f-        yieldk a r = yld (f a) (fmap f r)-    in unStream (toStream m) (rstState st) stp single yieldk---- Be careful when modifying this, this uses a consM (|:) deliberately to allow--- other stream types to overload it.-{-# INLINE mapM #-}-mapM :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m b-mapM f m = go (toStream m)-    where-    go m1 = fromStream $ Stream $ \st stp sng yld ->-        let single a  = f a >>= sng-            yieldk a r = unStream (toStream (f a |: go r)) st stp sng yld-         in unStream m1 (rstState st) stp single yieldk---- Be careful when modifying this, this uses a consM (|:) deliberately to allow--- other stream types to overload it.-{-# INLINE sequence #-}-sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a-sequence m = go (toStream m)-    where-    go m1 = fromStream $ Stream $ \st stp sng yld ->-        let single ma = ma >>= sng-            yieldk ma r = unStream (toStream $ ma |: go r) st stp sng yld-         in unStream m1 (rstState st) stp single yieldk------------------------------------------------------------------------------------ Inserting----------------------------------------------------------------------------------{-# INLINE intersperseM #-}-intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a-intersperseM a m = fromStream $ prependingStart (toStream m)-    where-    prependingStart m1 = Stream $ \st stp sng yld ->-        let yieldk i x = unStream (return i |: go x) st stp sng yld-         in unStream m1 (rstState st) stp sng yieldk-    go m2 = fromStream $ Stream $ \st stp sng yld ->-        let single i = unStream (a |: yield i) st stp sng yld-            yieldk i x = unStream (a |: return i |: go x) st stp sng yld-         in unStream m2 (rstState st) stp single yieldk------------------------------------------------------------------------------------ Map and Filter----------------------------------------------------------------------------------{-# INLINE mapMaybe #-}-mapMaybe :: IsStream t => (a -> Maybe b) -> t m a -> t m b-mapMaybe f m = go (toStream m)-  where-    go m1 = fromStream $ Stream $ \st stp sng yld ->-        let single a = case f a of-                Just b  -> sng b-                Nothing -> stp-            yieldk a r = case f a of-                Just b  -> yld b (toStream $ go r)-                Nothing -> unStream r (rstState st) stp single yieldk-        in unStream m1 (rstState st) stp single yieldk----------------------------------------------------------------------------------- Serial Zipping---------------------------------------------------------------------------------{-# INLINE zipWithS #-}-zipWithS :: (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-zipWithS f = go-    where-    go mx my = Stream $ \st stp sng yld -> do-        let merge a ra =-                let single2 b = sng (f a b)-                    yield2 b rb = yld (f a b) (go ra rb)-                 in unStream my (rstState st) stp single2 yield2-        let single1 a = merge a nil-            yield1 = merge-        unStream mx (rstState st) stp single1 yield1---- | Zip two streams serially using a pure zipping function.------ @since 0.1.0-{-# INLINABLE zipWith #-}-zipWith :: IsStream t => (a -> b -> c) -> t m a -> t m b -> t m c-zipWith f m1 m2 = fromStream $ zipWithS f (toStream m1) (toStream m2)---- | Zip two streams serially using a monadic zipping function.------ @since 0.1.0-zipWithM :: (IsStream t, Monad m) => (a -> b -> m c) -> t m a -> t m b -> t m c-zipWithM f m1 m2 = fromStream $ go (toStream m1) (toStream m2)-    where-    go mx my = Stream $ \st stp sng yld -> do-        let merge a ra =-                let runIt x = unStream x (rstState st) stp sng yld-                    single2 b   = f a b >>= sng-                    yield2 b rb = f a b >>= \x -> runIt (x `cons` go ra rb)-                 in unStream my (rstState st) stp single2 yield2-        let single1 a = merge a nil-            yield1 = merge-        unStream mx (rstState st) stp single1 yield1----------------------------------------------------------------------------------- Semigroup----------------------------------------------------------------------------------- | Concatenates two streams sequentially i.e. the first stream is--- exhausted completely before yielding any element from the second stream.-{-# INLINE serial #-}-serial :: Stream m a -> Stream m a -> Stream m a-serial m1 m2 = go m1-    where-    go (Stream m) = Stream $ \st stp sng yld ->-            let stop       = unStream m2 (rstState st) stp sng yld-                single a   = yld a m2-                yieldk a r = yld a (go r)-            in m (rstState st) stop single yieldk--instance Semigroup (Stream m a) where-    (<>) = serial----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance Monoid (Stream m a) where-    mempty = nil-    mappend = (<>)------------------------------------------------------------------------------------ Functor----------------------------------------------------------------------------------instance Monad m => Functor (Stream m) where-    fmap = map------------------------------------------------------------------------------------ Bind utility----------------------------------------------------------------------------------{-# INLINE bindWith #-}-bindWith-    :: (forall c. Stream m c -> Stream m c -> Stream m c)-    -> Stream m a-    -> (a -> Stream m b)-    -> Stream m b-bindWith par m f = go m-    where-        go (Stream g) =-            Stream $ \st stp sng yld ->-                let runShared x = unstreamShared x st stp sng yld-                    runIsolated x = unStreamIsolated x st stp sng yld--                    single a   = runIsolated $ f a-                    yieldk a r = runShared $ isolateStream (f a) `par` go r-                in g (rstState st) stp single yieldk----------------------------------------------------------------------------------- Alternative & MonadPlus---------------------------------------------------------------------------------_alt :: Stream m a -> Stream m a -> Stream m a-_alt m1 m2 = Stream $ \st stp sng yld ->-    let stop  = unStream m2 (rstState st) stp sng yld-    in unStream m1 (rstState st) stop sng yld----------------------------------------------------------------------------------- MonadReader---------------------------------------------------------------------------------withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a-withLocal f m =-    Stream $ \st stp sng yld ->-        let single = local f . sng-            yieldk a r = local f $ yld a (withLocal f r)-        in unStream m (rstState st) (local f stp) single yieldk----------------------------------------------------------------------------------- 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 =-    Stream $ \_ 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--}------------------------------------------------------------------------------------ Transformers----------------------------------------------------------------------------------instance MonadTrans Stream where-    lift = yieldM
− src/Streamly/Streams/Zip.hs 
@@ -1,207 +0,0 @@-{-# LANGUAGE CPP                       #-}-{-# LANGUAGE ConstraintKinds           #-}-{-# LANGUAGE FlexibleContexts          #-}-{-# LANGUAGE FlexibleInstances         #-}-{-# LANGUAGE GeneralizedNewtypeDeriving#-}-{-# LANGUAGE InstanceSigs              #-}-{-# LANGUAGE MultiParamTypeClasses     #-}-{-# LANGUAGE UndecidableInstances      #-} -- XXX---- |--- Module      : Streamly.Streams.Zip--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC-------module Streamly.Streams.Zip-    (-      K.zipWith-    , K.zipWithM-    , zipAsyncWith-    , zipAsyncWithM--    , ZipSerialM-    , ZipSerial-    , ZipStream         -- deprecated-    , zipSerially-    , zipping          -- deprecated--    , ZipAsyncM-    , ZipAsync-    , zipAsyncly-    , zippingAsync     -- deprecated-    )-where--import Data.Semigroup (Semigroup(..))-import Prelude hiding (map, repeat, zipWith)--import Streamly.Streams.StreamK (IsStream(..), Stream(..))-import Streamly.Streams.Async (mkAsync')-import Streamly.Streams.Serial (map)-import Streamly.SVar (MonadAsync, rstState)--import qualified Streamly.Streams.StreamK as K--#include "Instances.hs"----------------------------------------------------------------------------------- Serially Zipping Streams----------------------------------------------------------------------------------- | The applicative instance of 'ZipSerialM' zips a number of streams serially--- i.e. it produces one element from each stream serially and then zips all--- those elements.------ @--- main = (toList . 'zipSerially' $ (,,) \<$\> s1 \<*\> s2 \<*\> s3) >>= print---     where s1 = fromFoldable [1, 2]---           s2 = fromFoldable [3, 4]---           s3 = fromFoldable [5, 6]--- @--- @--- [(1,3,5),(2,4,6)]--- @------ The 'Semigroup' instance of this type works the same way as that of--- 'SerialT'.------ @since 0.2.0-newtype ZipSerialM m a = ZipSerialM {getZipSerialM :: Stream m a}-        deriving (Semigroup, Monoid)---- |--- @since 0.1.0-{-# DEPRECATED ZipStream "Please use 'ZipSerialM' instead." #-}-type ZipStream = ZipSerialM---- | An IO stream whose applicative instance zips streams serially.------ @since 0.2.0-type ZipSerial = ZipSerialM IO---- | Fix the type of a polymorphic stream as 'ZipSerialM'.------ @since 0.2.0-zipSerially :: IsStream t => ZipSerialM m a -> t m a-zipSerially = K.adapt---- | Same as 'zipSerially'.------ @since 0.1.0-{-# DEPRECATED zipping "Please use zipSerially instead." #-}-zipping :: IsStream t => ZipSerialM m a -> t m a-zipping = zipSerially--instance IsStream ZipSerialM where-    toStream = getZipSerialM-    fromStream = 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 m r = fromStream $ K.consMSerial m (toStream r)--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}-    (|:) :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a-    m |: r = fromStream $ K.consMSerial m (toStream r)--instance Monad m => Functor (ZipSerialM m) where-    fmap = map--instance Monad m => Applicative (ZipSerialM m) where-    pure = ZipSerialM . K.repeat-    m1 <*> m2 = fromStream $ K.zipWith id (toStream m1) (toStream m2)----------------------------------------------------------------------------------- Parallel Zipping----------------------------------------------------------------------------------- | Zip two streams concurrently (i.e. both the elements being zipped are--- generated concurrently) using a pure zipping function.------ @since 0.1.0-zipAsyncWith :: (IsStream t, MonadAsync m)-    => (a -> b -> c) -> t m a -> t m b -> t m c-zipAsyncWith f m1 m2 = fromStream $ Stream $ \st stp sng yld -> do-    ma <- mkAsync' (rstState st) m1-    mb <- mkAsync' (rstState st) m2-    unStream (toStream (K.zipWith f ma mb)) (rstState st) stp sng yld---- | Zip two streams asyncly (i.e. both the elements being zipped are generated--- concurrently) using a monadic zipping function.------ @since 0.4.0-zipAsyncWithM :: (IsStream t, MonadAsync m)-    => (a -> b -> m c) -> t m a -> t m b -> t m c-zipAsyncWithM f m1 m2 = fromStream $ Stream $ \st stp sng yld -> do-    ma <- mkAsync' (rstState st) m1-    mb <- mkAsync' (rstState st) m2-    unStream (toStream (K.zipWithM f ma mb)) (rstState st) stp sng yld----------------------------------------------------------------------------------- Parallely Zipping Streams------------------------------------------------------------------------------------- | Like 'ZipSerialM' but zips in parallel, it generates all the elements to--- be zipped concurrently.------ @--- main = (toList . 'zipAsyncly' $ (,,) \<$\> s1 \<*\> s2 \<*\> s3) >>= print---     where s1 = fromFoldable [1, 2]---           s2 = fromFoldable [3, 4]---           s3 = fromFoldable [5, 6]--- @--- @--- [(1,3,5),(2,4,6)]--- @------ The 'Semigroup' instance of this type works the same way as that of--- 'SerialT'.------ @since 0.2.0-newtype ZipAsyncM m a = ZipAsyncM {getZipAsyncM :: Stream m a}-        deriving (Semigroup, Monoid)---- | An IO stream whose applicative instance zips streams wAsyncly.------ @since 0.2.0-type ZipAsync = ZipAsyncM IO---- | Fix the type of a polymorphic stream as 'ZipAsyncM'.------ @since 0.2.0-zipAsyncly :: IsStream t => ZipAsyncM m a -> t m a-zipAsyncly = K.adapt---- | Same as 'zipAsyncly'.------ @since 0.1.0-{-# DEPRECATED zippingAsync "Please use zipAsyncly instead." #-}-zippingAsync :: IsStream t => ZipAsyncM m a -> t m a-zippingAsync = zipAsyncly-instance IsStream ZipAsyncM where-    toStream = getZipAsyncM-    fromStream = ZipAsyncM--    {-# INLINE consM #-}-    {-# SPECIALIZE consM :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-}-    consM :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a-    consM m r = fromStream $ K.consMSerial m (toStream r)--    {-# INLINE (|:) #-}-    {-# SPECIALIZE (|:) :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-}-    (|:) :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a-    m |: r = fromStream $ K.consMSerial m (toStream r)--instance Monad m => Functor (ZipAsyncM m) where-    fmap = map--instance MonadAsync m => Applicative (ZipAsyncM m) where-    pure = ZipAsyncM . K.repeat-    m1 <*> m2 = zipAsyncWith id m1 m2
− src/Streamly/Streams/inline.h 
@@ -1,3 +0,0 @@-#define INLINE_EARLY  INLINE [2]-#define INLINE_NORMAL INLINE [1]-#define INLINE_LATE   INLINE [0]
− src/Streamly/Time.hs 
@@ -1,74 +0,0 @@--- |--- Module      : Streamly.Time--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com--- Stability   : experimental--- Portability : GHC------ Time utilities for reactive programming.--module Streamly.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/Tutorial.hs 
@@ -1,1704 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- |--- Module      : Streamly.Tutorial--- Copyright   : (c) 2017 Harendra Kumar------ License     : BSD3--- Maintainer  : harendra.kumar@gmail.com------ Streamly is a general computing framework based on streaming IO. The IO--- monad and pure lists are a special case of streamly. On one hand, streamly--- extends the lists of pure values to lists of monadic actions, on the other--- hand it extends the IO monad with concurrrent non-determinism. In simple--- imperative terms we can say that streamly extends the IO monad with @for@--- loops and nested @for@ loops with concurrency support. You can understand--- this analogy better once you can go through this tutorial.------ 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 the 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 the examples directory 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.------ In this tutorial we will go over the basic concepts and how to--- use the library. See the last section for further reading resources.--module Streamly.Tutorial-    (-    -- * Streams-    -- $streams--    -- * Concurrent Streams-    -- $concurrentStreams--    -- * Combining Streams-    -- $flavors--    -- * Imports and Supporting Code-    -- $imports--    -- * Generating Streams-    -- $generating--    -- * Generating Streams Concurrently-    -- $generatingConcurrently--    -- * Eliminating Streams-    -- $eliminating--    -- * Concurrent Pipeline Stages-    -- $concurrentApplication--    -- * Transforming Streams-    -- $transformation--    -- * Mapping Concurrently-    -- $concurrentTransformation--    -- * Merging Streams--    -- ** Semigroup Style-    -- $semigroup--    -- *** Deep Serial Composition ('Serial')-    -- $serial--    -- *** Wide Serial Composition ('WSerial')-    -- $interleaved--    -- *** Deep Ahead Composition ('Ahead')-    -- $ahead--    -- *** Deep Asynchronous Composition ('Async')-    -- $async--    -- *** Wide Asynchronous Composition ('WAsync')-    -- $wasync--    -- *** Parallel Asynchronous Composition ('Parallel')-    -- $parallel--    -- *** Custom composition-    -- $custom--    -- ** Monoid Style-    -- $monoid--    -- * Nesting Streams-    -- $nesting--    -- ** Monad-    -- $monad--    -- *** Deep Serial Nesting ('Serial')-    -- $regularSerial--    -- *** Wide Serial Nesting ('WSerial')-    -- $interleavedNesting--    -- *** Deep Ahead Nesting ('Ahead')-    -- $aheadNesting--    -- *** Deep Asynchronous Nesting ('Async')-    -- $concurrentNesting--    -- *** Wide Asynchronous Nesting ('WAsync')-    -- $wasyncNesting--    -- *** Parallel Asynchronous Nesting ('Parallel')-    -- $parallelNesting--    -- *** Exercise-    -- $monadExercise--    -- ** Applicative-    -- $applicative--    -- ** Functor-    -- $functor--    -- * Zipping Streams-    -- $zipping--    -- ** Serial Zipping-    -- $serialzip--    -- ** Parallel Zipping-    -- $parallelzip--    -- * Monad transformers-    -- $monadtransformers--    -- * Concurrent Programming-    -- $concurrent--    -- * Reactive Programming-    -- $reactive--    -- * Writing Concurrent Programs-    -- $programs--    -- * Performance-    -- $performance--    -- * Interoperation with Streaming Libraries-    -- $interop--    -- * Comparison with Existing Packages-    -- $comparison--    -- * Where to go next?-    -- $furtherReading-    )-where--import Streamly-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))---- $streams------ The way a list represents a sequence of pure values, a stream represents a--- sequence of monadic actions. 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. In contrast to the "Prelude" lists, merging or--- appending streams of arbitrary length is scalable and inexpensive.------ The basic stream type is 'Serial', it represents a sequence of IO actions,--- and is a 'Monad'.  The 'Serial' monad is almost a drop in replacement for--- the 'IO' monad, IO monad is a special case of the 'Serial' monad; IO monad--- represents a single IO action whereas the 'Serial' monad represents a series--- of IO actions.  The only change you need to make to go from 'IO' to 'Serial'--- is to use 'runStream' to run the monad and to prefix the IO actions with--- either 'yieldM' or 'liftIO'.  If you use liftIO you can switch from 'Serial'--- to IO monad by simply removing the 'runStream' function; no other changes--- are needed unless you have used some stream specific composition or--- combinators.------ Similarly, 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".---- $concurrentStreams------ Streams can be generated concurrently, even infnite streams can be generated--- concurrently using controlled concurrency, streams can be merged--- concurrently, multiple stages in a streaming pipeline can run concurrently,--- streams can be mapped concurrently, they can be zipped concurrently, and in--- a 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 acheive the desired--- composition style.  To force a particular type of composition we coerce the--- stream type using the corresponding type adapting combinator from--- 'serially', 'aheadly', 'asyncly', or 'parallely'.  The default stream type--- is inferred as 'Serial' unless you change it by using one of the combinators--- or using a type annotation.---- $flavors------ Streams can be combined using semigroup or monoid composition to form a--- composite stream. Traversal of a composition of streams could be @deep@ or--- @wide@.  Deep goes depth first i.e.  each stream is traversed fully before--- we traverse the next stream. Wide goes breadth first i.e. 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 'parallely' 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 'serially'--- combinator to suppress any unnecessary concurrency under the scope of that--- combinator.---- $monadtransformers------ To represent streams in an arbitrary monad use the more general monad--- transformer types for example the monad transformer type corresponding to--- the 'Serial' type is 'SerialT'.  @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.  In fact, the type 'Serial' is a synonym for--- @SerialT IO@.------ 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'.------ @--- > 'runStream' $ liftIO $ putStrLn "Hello world!"--- Hello world!--- > 'runStream' $ lift $ putStrLn "Hello world!"--- Hello world!--- @------- $generating------ We will assume the following imports in this tutorial. Go ahead, fire up a--- GHCi session and import these lines to start playing.------ @--- > import "Streamly"--- > import "Streamly.Prelude" ((|:))--- > import qualified "Streamly.Prelude" as S--- @------ 'nil' represents an empty stream and 'consM' or its operator form '|:' adds--- a monadic action at the head of the stream.------ @--- > S.'toList' S.'nil'--- []--- > S.'toList' $ 'getLine' |: 'getLine' |: S.'nil'--- hello--- world--- ["hello","world"]--- @------ To create a singleton stream from a pure value use 'yield' or 'pure' and to--- create a singleton stream from a monadic action use 'yieldM'. Note that in--- case of Zip applicative streams "pure" repeats the value to generate an--- infinite stream.------ @--- > S.'toList' $ 'pure' 1--- [1]--- > S.'toList' $ 'yield' 1--- [1]--- > S.'toList' $ S.'yieldM' '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':------ @--- > S.'toList' $ S.'fromFoldable' [1..3]--- [1,2,3]--- > S.'toList' $ 'Prelude.foldr' S.'cons' S.'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':------ @--- > 'runStream' $ 'Prelude.foldr' ('|:') S.'nil' ['putStr' "Hello ", 'putStrLn' "world!"]--- Hello world!--- @------ For more ways to construct a stream see the module "Streamly.Prelude".---- $generatingConcurrently------ Monadic construction and generation functions e.g. 'consM', 'unfoldrM',--- 'replicateM', 'repeatM', 'iterateM' and 'fromFoldableM' etc 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--- > S.'toList' $ 'parallely' $ p 3 |: p 2 |: p 1 |: S.'nil'--- [1,2,3]--- > S.'toList' $ 'aheadly' $ p 3 |: p 2 |: p 1 |: S.'nil'--- [3,2,1]--- @--- The following finishes in 10 seconds (100 seconds when serial):------ @--- > 'runStream' $ 'asyncly' $ S.'replicateM' 10 $ p 10--- @------- $eliminating------ We have already seen 'runStream' and 'toList' to eliminate a stream in the--- examples above.  'runStream' 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:------ @--- > 'runStream' $ S.'repeatM' getLine & S.'mapM' putStrLn--- @------ 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 "Streamly"--- import qualified "Streamly.Prelude" as S--- import Data.Char (toUpper)--- import Data.Function ((&))------ main = 'runStream' $---        S.'repeatM' getLine---      & S.'filter' (not . null)---      & S.'drop' 1---      & S.'take' 2---      & fmap (map toUpper)---      & S.'zipWith' (\\n s -> show n ++ " " ++ s) (S.'fromFoldable' [1..])---      & S.'mapM' putStrLn--- @---- $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--- > runStream $ aheadly $ S.'mapM' (\\x -> p 1 >> print x) (serially $ repeatM (p 1))--- @------- $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--- > runStream $ S.'repeatM' (p 1) '|&' S.'mapM' (\\x -> p 1 >> print x)--- @---- $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.---- $imports------ In most of example snippets we do not repeat the imports. Where imports are--- not explicitly specified use the imports shown below.------ @--- import "Streamly"--- import "Streamly.Prelude" ((|:), nil)--- import qualified "Streamly.Prelude" as S------ import Control.Concurrent--- import Control.Monad (forever)--- @------ 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.------ @--- delay n = S.'yieldM' $ do---  threadDelay (n * 1000000)---  tid \<- myThreadId---  putStrLn (show tid ++ ": Delay " ++ show n)--- @---- $serial------ The 'Semigroup' operation '<>' of the 'Serial' type combines the two streams--- in a /serial depth first/ manner. We use the 'serially' type combinator to--- effect 'Serial' style of composition. We can also use an explicit 'Serial'--- type annotation for the stream to acheive 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:------ @--- main = 'runStream' $ (print 1 |: print 2 |: nil) <> (print 3 |: print 4 |: nil)--- @--- @--- 1--- 2--- 3--- 4--- @------ All actions in both the streams are performed serially in the same thread.--- In the following example we can see that all actions are performed in the--- same thread and take a combined total of @3 + 2 + 1 = 6@ seconds:------ @--- main = 'runStream' $ delay 3 <> delay 2 <> delay 1--- @--- @--- ThreadId 36: Delay 3--- ThreadId 36: Delay 2--- ThreadId 36: Delay 1--- @------ 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:------ @--- main = 'runStream' $ (print 1 |: print 2 |: nil) \`serial` (print 3 |: print 4 |: nil)--- @---- $interleaved------ The 'Semigroup' operation '<>' of the 'WSerial' type combines the two--- streams in a /serial breadth first/ manner. We use the 'wSerially' type--- combinator to effect 'WSerial' style of composition. We can also use the--- 'WSerial' type annotation for the stream to acheive 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 peformed 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------ @--- main = 'runStream' . 'wSerially' $ (print 1 |: print 2 |: nil) <> (print 3 |: print 4 |: nil)--- @--- @--- 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. In--- the following example we can see that all actions are performed in the same--- thread and take a combined total of @3 + 2 + 1 = 6@ seconds:------ @--- main = 'runStream' . 'wSerially' $ delay 3 <> delay 2 <> delay 1--- @--- @--- ThreadId 36: Delay 3--- ThreadId 36: Delay 2--- ThreadId 36: Delay 1--- @------ 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 'wSerially'--- combinator in the following example:------ @--- main = 'runStream' $ (print 1 |: print 2 |: nil) \`wSerial` (print 3 |: print 4 |: nil)--- @--- @--- 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.---- $ahead------ The 'Semigroup' operation '<>' of the 'Ahead' type combines two streams in a--- /serial depth first/ manner with concurrent lookahead. We use the 'aheadly'--- type combinator to effect 'Ahead' style of composition. We can also use an--- explicit 'Ahead' type annotation for the stream to acheive 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:------ @--- main = do---  xs \<- 'toList' . 'aheadly' $ (p 1 |: p 2 |: nil) <> (p 3 |: p 4 |: nil)---  print xs---  where p n = threadDelay 1000000 >> return n--- @--- @--- [1,2,3,4]--- @------ Each stream is constructed 'aheadly' and then both the streams are merged--- 'aheadly', 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--- 'asyncly' type combinator to effect 'Async' style of composition. We--- can also use the 'Async' type annotation for the stream type to acheive--- 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:------ @--- main = do---   xs \<- 'runStream' . 'asyncly' $ (p 1 |: p 2 |: nil) <> (p 3 |: p 4 |: nil)---   print xs---   where p n = threadDelay 1000000 >> return n--- @--- @--- [4,2,1,3]--- @------ 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:------ @--- main = do---   xs \<- 'runStream' . 'asyncly' $ (serially $ p 1 |: p 2 |: nil) <> (serially $ p 3 |: p 4 |: nil)---   print xs---   where p n = threadDelay 1000000 >> return n--- @--- @--- [3,1,2,4]--- @------ 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:------ @--- main = 'runStream' . 'asyncly' $ delay 3 '<>' delay 2 '<>' delay 1--- @--- @--- ThreadId 42: Delay 1--- ThreadId 41: Delay 2--- ThreadId 40: 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.------ @--- main = 'runStream' . 'asyncly' $ (delay 1 <> delay 2) <> (delay 3 <> delay 4)--- @--- @--- 1--- 2--- 3--- 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:------ @--- main = 'runStream' . 'asyncly' $ traced (sqrt 9) '<>' traced (sqrt 16) '<>' traced (sqrt 25)---  where traced m = S.'yieldM' (myThreadId >>= print) >> return m--- @--- @--- ThreadId 40--- ThreadId 40--- ThreadId 40--- @------ 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 'asyncly' combinator in the following example:------ @--- main = 'runStream' $ delay 3 \`async` delay 2 \`async` delay 1--- @--- @--- ThreadId 42: Delay 1--- ThreadId 41: Delay 2--- ThreadId 40: 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 should be preferred over 'Parallel' or 'WAsync' unless you--- really need those. It utilizes the resources optimally. It 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 this 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 'wAsyncly'--- 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.------ @--- main = 'runStream' . 'wAsyncly' $ (serially $ print 1 |: print 2 |: nil) <> (serially $ print 3 |: print 4 |: nil)--- @--- @--- 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 'wAsyncly' combinator in the following example:------ @--- main = 'runStream' $ delay 3 \`wAsync` delay 2 \`wAsync` delay 1--- @--- @--- ThreadId 42: Delay 1--- ThreadId 41: Delay 2--- ThreadId 40: 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 'parallely' type combinator to effect 'Parallel' style of composition.--- We can also use the 'Parallel' type annotation for the stream type to--- acheive 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 following example sends a query to all the three search engines in--- parallel and prints the name of the search engines in the order in which the--- responses arrive:------ @--- import "Streamly"--- import qualified Streamly.Prelude as S--- import Network.HTTP.Simple------ main = 'runStream' . 'parallely' $ google \<> bing \<> duckduckgo---     where---         google     = get "https://www.google.com/search?q=haskell"---         bing       = get "https://www.bing.com/search?q=haskell"---         duckduckgo = get "https://www.duckduckgo.com/?q=haskell"---         get s = S.'yieldM' (httpNoBody (parseRequest_ s) >> putStrLn (show s))--- @------ 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--- 'parallely' combinator in the following example:------ @--- main = 'runStream' $ delay 3 \`parallel` delay 2 \`wAsync` delay 1--- @--- @--- ThreadId 42: Delay 1--- ThreadId 41: Delay 2--- ThreadId 40: 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.------- $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 the examples directory.---- $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:------ * 'foldWith' is like 'fold', it folds a 'Foldable' container of streams--- using the given composition operator.--- * 'foldMapWith' is like 'foldMap', it folds like @foldWith@ but also maps a--- function before folding.--- * 'forEachWith' is like @foldMapwith@ but the container argument comes before--- the function argument.------ 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:------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Control.Concurrent------ main = do---  'runStream' $ 'asyncly' $ foldMap delay [1..10]---  'runStream' $ 'foldWith'    'async' (map delay [1..10])---  'runStream' $ 'foldMapWith' 'async' delay [1..10]---  'runStream' $ 'forEachWith' 'async' [1..10] delay---  where delay n = S.'yieldM' $ threadDelay (n * 1000000) >> print n--- @---- $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 'serially' 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.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ main = 'runStream' $ do---     x <- S.'fromFoldable' [3,2,1]---     delay x--- @--- @--- ThreadId 30: Delay 3--- ThreadId 30: Delay 2--- ThreadId 30: Delay 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.------ A console echo loop copying standard input to standard output can simply be--- written like this:------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ main = 'runStream' $ forever $ S.yieldM getLine >>= S.yieldM . putStrLn--- @------ When multiple streams are composed using this style they nest in a DFS--- manner i.e. nested iterations of a loop are executed before we proceed to--- the next iteration of the parent loop. This behaves just like nested @for@--- loops in imperative programming.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ main = 'runStream' $ do---     x <- S.'fromFoldable' [1,2]---     y <- S.'fromFoldable' [3,4]---     S.'yieldM' $ putStrLn $ show (x, y)--- @--- @--- (1,3)--- (1,4)--- (2,3)--- (2,4)--- @------ Notice that this is analogous to merging streams of type 'Serial' or merging--- streams using 'serial'.---- $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.------ The 'aheadly' 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'.------ @--- import "Streamly"--- import "Streamly.Prelude" as S------ comp = 'toList' . 'aheadly' $ do---     x <- S.'fromFoldable' [3,2,1]---     delay x >> return x------ main = comp >> print--- @--- @--- ThreadId 40: Delay 1--- ThreadId 39: Delay 2--- ThreadId 38: 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.------- $concurrentNesting------ The 'Monad' composition of 'Async' type can perform the iterations of a--- loop concurrently.  Concurrency is demand driven i.e. more concurrent--- iterations are started only if the previous iterations are not able to--- produce enough output for the consumer of the output stream.  This works--- exactly the same way as the merging of two streams 'asyncly' works.--- This is the concurrent analogue of 'Serial' style monadic composition.------ The 'asyncly' 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'.------ @--- import "Streamly"--- import "Streamly.Prelude"------ main = 'runStream' . 'asyncly' $ do---     x <- S.'fromFoldable' [3,2,1]---     delay x--- @--- @--- ThreadId 40: Delay 1--- ThreadId 39: Delay 2--- ThreadId 38: 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 just as in the case of 'async' merging.--- When multiple streams are composed using this style, the iterations are--- triggered in a depth first manner just like 'Serial' i.e. nested iterations are--- executed before we proceed to the next iteration at higher level. However,--- unlike 'Serial' more than one iterations may be started concurrently based--- on the demand from the consumer of the stream.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ main = 'runStream' . 'asyncly' $ do---     x <- S.'fromFoldable' [1,2]---     y <- S.'fromFoldable' [3,4]---     S.'yieldM' $ putStrLn $ show (x, y)--- @--- @--- (1,3)--- (1,4)--- (2,3)--- (2,4)--- @---- $interleavedNesting------ The 'Monad' composition of 'WSerial' type interleaves the iterations of--- outer and inner loops in a nested loop composition. This works exactly the--- same way as the merging of two streams in 'wSerially' fashion works.  The--- 'wSerially' 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'.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ main = 'runStream' . 'wSerially' $ do---     x <- S.'fromFoldable' [1,2]---     y <- S.'fromFoldable' [3,4]---     S.yieldM $ putStrLn $ show (x, y)--- @--- @--- (1,3)--- (2,3)--- (1,4)--- (2,4)--- @------- $wasyncNesting------ Just like 'Async' the 'Monad' composition of 'WAsync' runs the iterations of--- a loop concurrently. The difference is in the nested loop behavior. The--- nested loops in this type are traversed and executed in a breadth first--- manner rather than the depth first manner of 'Async' style.--- The loop nesting works exactly the same way as the merging of streams--- 'wAsyncly' works.  The 'wAsyncly' 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'.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ main = 'runStream' . 'wAsyncly' $ do---     x <- S.'fromFoldable' [1,2]---     y <- S.'fromFoldable' [3,4]---     S.'yieldM' $ putStrLn $ show (x, y)--- @--- @--- (1,3)--- (2,3)--- (1,4)--- (2,4)--- @---- $parallelNesting------ Just like 'Async' or 'WAsync' the 'Monad' composition of 'Parallel' runs the--- iterations of a loop concurrently. The difference is in the nested loop--- behavior. The streams at each nest level is run fully concurrently--- irrespective of the demand.  The loop nesting works exactly the same way as--- the merging of streams 'parallely' works.  The 'parallely' 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'.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ main = 'runStream' . 'parallely' $ do---     x <- S.'fromFoldable' [3,2,1]---     delay x--- @--- @--- ThreadId 40: Delay 1--- ThreadId 39: Delay 2--- ThreadId 38: Delay 3--- @---- $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.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ composed :: (IsStream t, Monad (t IO)) => t IO ()--- composed = do---     sz <- sizes---     cl <- colors---     sh <- shapes---     S.'yieldM' $ putStrLn $ show (sz, cl, sh)------     where------     sizes  = S.'fromFoldable' [1, 2, 3]---     colors = S.'fromFoldable' ["red", "green", "blue"]---     shapes = S.'fromFoldable' ["triangle", "square", "circle"]--- @------ Now we can interpret this in whatever way we want:------ @--- main = 'runStream' . 'serially'  $ composed--- main = 'runStream' . 'wSerially' $ composed--- main = 'runStream' . 'asyncly'   $ composed--- main = 'runStream' . 'wAsyncly'  $ composed--- main = 'runStream' . 'parallely' $ 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.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S------ main = (S.'toList' $ fmap show $ S.'fromFoldable' [1..10]) >>= print--- @------ Also see the 'mapM' and 'sequence' functions for mapping actions, in the--- "Streamly.Prelude" module.---- $applicative------ Applicative is precisely the same as the 'ap' operation of 'Monad'. For--- zipping applicatives separate types 'ZipSerial' and 'ZipAsync' are--- provided.------ The following example uses the 'Serial' applicative, it runs all iterations--- serially and takes a total 17 seconds (1 + 3 + 4 + 2 + 3 + 4):------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Control.Concurrent------ s1 = d 1 <> d 2--- s2 = d 3 <> d 4--- d n = delay n >> return n------ main = (S.'toList' . 'serially' $ (,) \<$> s1 \<*> s2) >>= print--- @--- @--- ThreadId 36: Delay 1--- ThreadId 36: Delay 3--- ThreadId 36: Delay 4--- ThreadId 36: Delay 2--- ThreadId 36: Delay 3--- ThreadId 36: Delay 4--- [(1,3),(1,4),(2,3),(2,4)]--- @------ Similalrly 'WSerial' applicative runs the iterations in an interleaved--- order but since it is serial it takes a total of 17 seconds:------ @--- main = (S.'toList' . 'wSerially' $ (,) \<$> s1 \<*> s2) >>= print--- @--- @--- ThreadId 36: Delay 1--- ThreadId 36: Delay 3--- ThreadId 36: Delay 2--- ThreadId 36: Delay 3--- ThreadId 36: Delay 4--- ThreadId 36: Delay 4--- [(1,3),(2,3),(1,4),(2,4)]--- @------ 'Async' can run the iterations concurrently and therefore takes a total--- of 10 seconds (1 + 2 + 3 + 4):------ @--- main = (S.'toList' . 'asyncly' $ (,) \<$> 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)]--- @------ Similalrly 'WAsync' as well can run the iterations concurrently and--- therefore takes a total of 10 seconds (1 + 2 + 3 + 4):------ @--- main = (S.'toList' . 'wAsyncly' $ (,) \<$> 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)]--- @---- $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.--- 'zipSerially' type combinator can be used to switch to serial applicative--- zip composition:------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Control.Concurrent------ d n = delay n >> return n--- s1 = 'serially' $ d 1 <> d 2--- s2 = 'serially' $ d 3 <> d 4------ main = (S.'toList' . 'zipSerially' $ (,) \<$> s1 \<*> s2) >>= print--- @------ This takes total 10 seconds to zip, which is (1 + 2 + 3 + 4) since--- everything runs serially:------ @--- ThreadId 29: Delay 1--- ThreadId 29: Delay 3--- ThreadId 29: Delay 2--- ThreadId 29: Delay 4--- [(1,3),(2,4)]--- @---- $parallelzip------ The applicative instance of 'ZipAsync' type zips streams concurrently.--- 'zipAsyncly' type combinator can be used to switch to parallel applicative--- zip composition:--------- @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Control.Concurrent--- import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))------ d n = delay n >> return n--- s1 = 'serially' $ d 1 <> d 2--- s2 = 'serially' $ d 3 <> d 4------ main = do---     hSetBuffering stdout LineBuffering---     (S.'toList' . 'zipAsyncly' $ (,) \<$> s1 \<*> s2) >>= print--- @------ This takes 7 seconds to zip, which is max (1,3) + max (2,4) because 1 and 3--- are produced concurrently, and 2 and 4 are produced concurrently:------ @--- ThreadId 32: Delay 1--- ThreadId 32: Delay 2--- ThreadId 33: Delay 3--- ThreadId 33: Delay 4--- [(1,3),(2,4)]--- @---- $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 'streamly' combinator. We can--- choose different combinators for the monadic processing and the stream--- generation, to control the concurrency.  We can also use the 'asyncly'--- combinator instead of explicitly folding with 'async'.------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import Data.List (sum)------ main = do---     z \<-   S.'toList'---          $ 'serially'     -- Serial monadic processing (sqrt below)---          $ do---              x2 \<- 'forEachWith' 'async' [1..100] $ -- Concurrent @"for"@ loop---                          \\x -> return $ x * x  -- body of the loop---              y2 \<- 'forEachWith' '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,--- "ListDir.hs", "MergeSort.hs" and "SearchQuery.hs" in the examples directory.---- $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"--- import Streamly.Prelude as S--- import Control.Monad (when)--- import Control.Monad.IO.Class (MonadIO(..))--- import Control.Monad.State (MonadState, get, modify, runStateT)------ data Event = Harm Int | Heal Int | Quit deriving (Show)------ userAction :: MonadAsync m => 'SerialT' m Event--- userAction = S.repeatM $ liftIO askUser---     where---     askUser = do---         command <- getLine---         case command of---             "potion" -> return (Heal 10)---             "quit"   -> return  Quit---             _        -> putStrLn "What?" >> askUser------ acidRain :: MonadAsync m => SerialT m Event--- acidRain = asyncly $ constRate 1 $ S.repeatM $ liftIO $ return $ Harm 1------ game :: ('MonadAsync' m, MonadState Int m) => 'SerialT' m ()--- game = do---     event \<- userAction \`parallel` acidRain---     case event of---         Harm n -> modify $ \\h -> h - n---         Heal n -> modify $ \\h -> h + n---         Quit   -> fail "quit"------     h <- get---     when (h <= 0) $ fail "You die!"---     liftIO $ putStrLn $ "Health = " ++ show h------ main = do---     putStrLn "Your health is deteriorating due to acid rain,\\---              \\ type \\"potion\\" or \\"quit\\""---     _ <- runStateT ('runStream' game) 60---     return ()--- @------ You can also find the source of this example in the examples directory as--- "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 "Streamly.Examples.CirclingSquare".---- $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.---- $interop------ We can use @unfoldr@ and @uncons@ to convert one streaming type to another.------  Interop with @vector@:------ @--- import Streamly--- import qualified Streamly.Prelude as S--- import qualified Data.Vector.Fusion.Stream.Monadic as V------ -- | vector to streamly--- fromVector :: (IsStream t, Monad m) => V.Stream m a -> t m a--- fromVector = S.unfoldrM unconsV---     where---     unconsV v = do---         r <- V.null v---         if r---         then return Nothing---         else do---             h <- V.head v---             return $ Just (h, V.tail v)------ -- | streamly to vector--- toVector :: Monad m => SerialT m a -> V.Stream m a--- toVector = V.unfoldrM (S.uncons . adapt)------ main = do---     S.toList (fromVector (V.fromList [1..3]))   >>= print---     V.toList (toVector (S.fromFoldable [1..3])) >>= print--- @------  Interop with @pipes@:------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import qualified Pipes as P--- import qualified Pipes.Prelude as P------ -- | pipes to streamly--- fromPipes :: (IsStream t, Monad m) => P.Producer a m r -> t m a--- fromPipes = S.'unfoldrM' unconsP---     where---     -- Adapt P.next to return a Maybe instead of Either---     unconsP p = P.next p >>= either (\\_ -> return Nothing) (return . Just)------ -- | streamly to pipes--- toPipes :: Monad m => SerialT m a -> P.Producer a m ()--- toPipes = P.unfoldr unconsS---     where---     -- Adapt S.uncons to return an Either instead of Maybe---     unconsS s = S.'uncons' s >>= maybe (return $ Left ()) (return . Right)------ main = do---     S.'toList' (fromPipes (P.each [1..3])) >>= print---     P.toListM (toPipes (S.'fromFoldable' [1..3])) >>= print--- @------ Interop with @streaming@:------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import qualified Streaming as SG--- import qualified Streaming.Prelude as SG------ -- | streaming to streamly--- fromStreaming :: (IsStream t, Monad m) => SG.Stream (SG.Of a) m r -> t m a--- fromStreaming = S.unfoldrM SG.uncons------ -- | streamly to streaming--- toStreaming :: Monad m => SerialT m a -> SG.Stream (SG.Of a) m ()--- toStreaming = SG.unfoldr unconsS---     where---     -- Adapt S.uncons to return an Either instead of Maybe---     unconsS s = S.'uncons' s >>= maybe (return $ Left ()) (return . Right)------ main = do---     S.toList (fromStreaming (SG.each [1..3])) >>= print---     SG.toList (toStreaming (S.fromFoldable [1..3])) >>= print--- @------ Interop with @conduit@:------ @--- import "Streamly"--- import qualified "Streamly.Prelude" as S--- import qualified Data.Conduit as C--- import qualified Data.Conduit.List as C--- import qualified Data.Conduit.Combinators as C------ -- It seems there is no way out of a conduit as it does not provide an--- -- uncons or a tail function. We can convert streamly to conduit though.------ -- | streamly to conduit--- toConduit :: Monad m => SerialT m a -> C.ConduitT i a m ()--- toConduit s = C.unfoldM S.'uncons' s------ main = do---  C.runConduit (toConduit (S.'fromFoldable' [1..3]) C..| C.sinkList) >>= print--- @---- $comparison------ List transformers and logic programming monads also provide a product style--- composition similar to streamly, however streamly generalizes it with the--- time dimension; allowing streams to be composed in an asynchronous and--- concurrent fashion in many different ways.  It also provides multiple--- alternative ways of composing streams e.g.  serial, interleaved or--- concurrent.------ This seemingly simple addition of asynchronicity and concurrency to product--- style streaming composition unifies a number of 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. In other words, you can do everything with this one--- abstraction that you could do with the popular libraries listed under these--- categories in the list below.------ @--- +-----------------+----------------+--- | Non-determinism | <https://hackage.haskell.org/package/pipes pipes>          |--- |                 +----------------+--- |                 | <https://hackage.haskell.org/package/list-t list-t>         |--- |                 +----------------+--- |                 | <https://hackage.haskell.org/package/logict logict>         |--- +-----------------+----------------+--- | Streaming       | <https://hackage.haskell.org/package/vector vector>         |--- |                 +----------------+--- |                 | <https://hackage.haskell.org/package/streaming streaming>      |--- |                 +----------------+--- |                 | <https://hackage.haskell.org/package/pipes pipes>          |--- |                 +----------------+--- |                 | <https://hackage.haskell.org/package/conduit conduit>        |--- +-----------------+----------------+--- | Concurrency     | <https://hackage.haskell.org/package/async async>          |--- |                 +----------------+--- |                 | <https://hackage.haskell.org/package/transient transient>      |--- +-----------------+----------------+--- | FRP             | <https://hackage.haskell.org/package/Yampa Yampa>          |--- |                 +----------------+--- |                 | <https://hackage.haskell.org/package/dunai dunai>          |--- |                 +----------------+--- |                 | <https://hackage.haskell.org/package/reflex reflex>         |--- +-----------------+----------------+--- @------ Streamly is a list-transformer. It provides all the functionality provided--- by any of the list transformer and logic programming packages listed above.--- In addition, Streamly naturally integrates the concurrency dimension to the--- basic list transformer functionality.------ When it comes to streaming, in terms of the streaming API streamly is almost--- identical to the vector package. Streamly, vector and streaming packages all--- represent a stream as data and are therefore similar in the fundamental--- approach to streaming. The fundamental difference is that streamly adds--- concurrency support and the monad instance provides concurrent looping.--- Other streaming libraries like pipes, conduit and machines represent and--- compose stream processors rather than the stream data and therefore fall in--- another class of streaming libraries and have comparatively more complicated--- types.------ When it comes to concurrency, streamly can do everything that the @async@--- package can do and more. async provides applicative concurrency whereas--- streamly provides both applicative and monadic concurrency. The--- 'ZipAsync' type behaves like the applicative instance of async.  In--- comparison to transient streamly has a first class streaming interface and--- is a monad transformer that can be used universally in any Haskell monad--- transformer stack.  Streamly was in fact originally inspired by the--- concurrency implementation in @transient@ though it has no resemblence with--- that and takes a lazy pull approach versus transient's strict push approach.------ The non-determinism, concurrency and streaming combination make streamly a--- strong FRP capable library as well. FRP is fundamentally stream of events--- that can be processed concurrently. The example in this tutorial as well as--- the "Streamly.Examples.CirclingSquare" example from Yampa demonstrate the--- basic FRP 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--- similarity at the core.---- $furtherReading------ * Read the documentation of "Streamly" module--- * Read the documentation of "Streamly.Prelude" module--- * See the examples in the "examples" directory of the package--- * See the tests in the "test" directory of the package
+ src/assert.hs view
@@ -0,0 +1,6 @@+-- A convenient macro to assert in a do block. We cannot define this as a+-- Haskell function because then the compiler reports the assert location+-- inside the wrapper function rather than the original location.++import Control.Exception (assert)+#define assertM(p) assert (p) (return ())
+ src/config.h.in view
@@ -0,0 +1,43 @@+/* src/config.h.in.  Generated from configure.ac by autoheader.  */++/* 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+   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. */+#undef HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS++/* Define to 1 if you have the declaration of+   '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. */+#undef HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMCLONED++/* Define to 1 if you have the declaration of+   'kFSEventStreamEventFlagItemIsHardlink', and to 0 if you don't. */+#undef HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK++/* Define to the address where bug reports for this package should be sent. */+#undef PACKAGE_BUGREPORT++/* Define to the full name of this package. */+#undef PACKAGE_NAME++/* Define to the full name and version of this package. */+#undef PACKAGE_STRING++/* Define to the one symbol short name of this package. */+#undef PACKAGE_TARNAME++/* Define to the home page for this package. */+#undef PACKAGE_URL++/* Define to the version of this package. */+#undef PACKAGE_VERSION
+ 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
@@ -0,0 +1,27 @@+-- We use fromStreamK/toStreamK to convert the direct style stream to CPS+-- style. In the first phase we try fusing the fromStreamK/toStreamK using:+--+-- {-# RULES "fromStreamK/toStreamK fusion"+--     forall s. toStreamK (fromStreamK s) = s #-}+--+-- If for some reason some of the operations could not be fused then we have+-- fallback rules in the second phase. For example:+--+-- {-# INLINE_EARLY unfoldr #-}+-- unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a+-- unfoldr step seed = fromStreamD (S.unfoldr step seed)+-- {-# RULES "unfoldr fallback to StreamK" [1]+--     forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}```+--+-- Then, fromStreamK/toStreamK are inlined in the last phase:+--+-- {-# INLINE_LATE toStreamK #-}+-- toStreamK :: Monad m => Stream m a -> K.StreamK m a```+--+-- The fallback rules make sure that if we could not fuse the direct style+-- operations then better use the CPS style operation, because unfused direct+-- style would have worse performance than the CPS style ops.++#define INLINE_EARLY  INLINE [2]+#define INLINE_NORMAL INLINE [1]+#define INLINE_LATE   INLINE [0]
− stack-7.10.yaml 
@@ -1,19 +0,0 @@-resolver: lts-6.35-packages:-- '.'-extra-deps:-    - QuickCheck-2.10-    - lockfree-queue-0.2.3.1-    - simple-conduit-0.4.0-    - transient-0.5.9.2-    - http-conduit-2.2.2-    - http-client-0.5.0-    - http-client-tls-0.3.0-    - SDL-0.6.5.1-    - gauge-0.2.4-    - basement-0.0.7-flags: {}-extra-package-dbs: []-# For mac ports installed SDL library on Mac OS X-extra-include-dirs:-- /opt/local/include
− stack-8.0.yaml 
@@ -1,16 +0,0 @@-resolver: lts-9.20-packages:-- '.'-extra-deps:-    - QuickCheck-2.10-    - lockfree-queue-0.2.3.1-    - simple-conduit-0.6.0-    - SDL-0.6.5.1-    - gauge-0.2.4-    - basement-0.0.4-flags: {}-extra-package-dbs: []-rebuild-ghc-options: true-# For mac ports installed SDL library on Mac OS X-#extra-include-dirs:-#- /opt/local/include
− stack.yaml 
@@ -1,18 +0,0 @@-resolver: lts-12.11-packages:-- '.'-allow-newer: true-extra-deps:-    - SDL-0.6.6.0-    - gauge-0.2.4-    - Chart-1.9-    - Chart-diagrams-1.9-    - SVGFonts-1.6.0.3-    - bench-show-0.2.1--flags: {}-extra-package-dbs: []-rebuild-ghc-options: true-# For mac ports installed SDL library on Mac OS X-extra-include-dirs:-- /opt/local/include
streamly.cabal view
@@ -1,579 +1,594 @@-name:               streamly-version:            0.5.2-synopsis:           Beautiful Streaming, Concurrent and Reactive Composition-description:-  Streamly, short for streaming concurrently, provides monadic streams, with a-  simple API, almost identical to standard lists, and an 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.  The programmer does not have to-  be aware of threads, locking or synchronization to write scalable concurrent-  programs.-  .-  The basic streaming functionality of streamly is equivalent to that provided by-  streaming libraries like-  <https://hackage.haskell.org/package/vector vector>,-  <https://hackage.haskell.org/package/streaming streaming>,-  <https://hackage.haskell.org/package/pipes pipes>, and-  <https://hackage.haskell.org/package/conduit conduit>.-  In addition to providing streaming functionality, streamly subsumes the-  functionality of list transformer libraries like @pipes@ or-  <https://hackage.haskell.org/package/list-t list-t> and also the logic-  programming library <https://hackage.haskell.org/package/logict logict>. On-  the concurrency side, it subsumes the functionality of the-  <https://hackage.haskell.org/package/async async> package. Because it-  supports streaming with concurrency we can write FRP applications similar in-  concept to <https://hackage.haskell.org/package/Yampa Yampa> or-  <https://hackage.haskell.org/package/reflex reflex>.-  .-  For file IO, currently the library provides only one API to stream the lines-  in the file as Strings.  Future versions will provide better streaming file-  IO options.  Streamly interworks with the popular streaming libraries, see-  the interworking section in "Streamly.Tutorial".-  .-  Why use streamly?-  .-  * /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 primary design goal.-  * /Concurrency/: Simple, powerful, and scalable concurrency.  Concurrency is-    built-in, and not intrusive, concurrent programs are written exactly the-    same way 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 best possible performance.-    Serial peformance is equivalent to the venerable `vector` library in most-    cases and even better in some cases. Concurrent performance is unbeatable.-    See-    <https://github.com/composewell/streaming-benchmarks streaming-benchmarks>-    for a comparison of popular streaming libraries on micro-benchmarks.-  .-  Where to find more information:-  .-  * /Quick Overview/: <src/README.md README file> in the package-  * /Detailed Tutorial/: "Streamly.Tutorial" module in the haddock documentation-  * /Reference Documentation/: Haddock documentation for the respective modules-  * /Examples/: <src/examples examples directory> in the package-  * /Guides/: <src/docs docs directory> in the package, for documentation on-    advanced topics, limitations, semantics of the library or on specific use-    cases.-  * <https://github.com/composewell/streaming-benchmarks Streaming Benchmarks>-  * <https://github.com/composewell/concurrency-benchmarks Concurrency Benchmarks>--homepage:            https://github.com/composewell/streamly-bug-reports:         https://github.com/composewell/streamly/issues-license:             BSD3-license-file:        LICENSE-tested-with:         GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3-author:              Harendra Kumar-maintainer:          harendra.kumar@gmail.com-copyright:           2017 Harendra Kumar-category:            Control, Concurrency, Streaming, Reactivity-stability:           Experimental-build-type:          Simple-cabal-version:       >= 1.10--extra-source-files:-    Changelog.md-    README.md-    docs/streamly-vs-async.md-    docs/transformers.md-    bench.sh-    stack-7.10.yaml-    stack-8.0.yaml-    stack.yaml-    src/Streamly/Streams/Instances.hs-    src/Streamly/Streams/inline.h--source-repository head-    type: git-    location: https://github.com/composewell/streamly--flag dev-  description: Development build-  manual: True-  default: False--flag no-fusion-  description: Disable rewrite rules-  manual: True-  default: False--flag streamk-  description: Use CPS style streams when possible-  manual: True-  default: False--flag examples-  description: Build including examples-  manual: True-  default: False--flag examples-sdl-  description: Build including SDL examples-  manual: True-  default: False------------------------------------------------------------------------------------ Library----------------------------------------------------------------------------------library-    hs-source-dirs:    src-    other-modules:     Streamly.SVar-                     , Streamly.Streams.StreamK-                     , Streamly.Streams.StreamD-                     , Streamly.Streams.Serial-                     , Streamly.Streams.SVar-                     , Streamly.Streams.Async-                     , Streamly.Streams.Parallel-                     , Streamly.Streams.Ahead-                     , Streamly.Streams.Zip-                     , Streamly.Streams.Prelude--    exposed-modules:   Streamly.Prelude-                     , Streamly.Time-                     , Streamly-                     , Streamly.Tutorial-                     , Streamly.Internal--    default-language: Haskell2010-    ghc-options:      -Wall--    if flag(streamk)-      cpp-options:    -DUSE_STREAMK_ONLY--    if flag(no-fusion)-      cpp-options:    -DDISABLE_FUSION--    if flag(dev)-      ghc-options:    -Wmissed-specialisations-                      -Wall-missed-specialisations-                      -fno-ignore-asserts-    if impl(ghc >= 8.0)-      ghc-options:    -Wcompat-                      -Wunrecognised-warning-flags-                      -Widentities-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wredundant-constraints-                      -Wnoncanonical-monad-instances-                      -Wnoncanonical-monadfail-instances--    build-depends:     base              >= 4.8   &&  < 5-                     , ghc-prim          >= 0.2   && < 0.6-                     , containers        >= 0.5   && < 0.7-                     , heaps             >= 0.3   && < 0.4--                    -- concurrency-                     , atomic-primops    >= 0.8   && < 0.9-                     , lockfree-queue    >= 0.2.3 && < 0.3-                     , clock             >= 0.7.1 && < 0.8--                    -- transfomers-                     , exceptions        >= 0.8   && < 0.11-                     , monad-control     >= 1.0   && < 2-                     , mtl               >= 2.2   && < 3-                     , transformers      >= 0.4   && < 0.6-                     , transformers-base >= 0.4   && < 0.5--  if impl(ghc < 8.0)-    build-depends:-        semigroups    >= 0.18   && < 0.19------------------------------------------------------------------------------------ Test suites------------------------------------------------------------------------------------ Compilation for coverage builds on CI machines takes too long without -O0--test-suite test-  type: exitcode-stdio-1.0-  main-is: Main.hs-  hs-source-dirs: test-  ghc-options:  -O0 -Wall -threaded -with-rtsopts=-N -fno-ignore-asserts-  if flag(dev)-    cpp-options:    -DDEVBUILD-    ghc-options:    -Wmissed-specialisations-                    -Wall-missed-specialisations-  if impl(ghc >= 8.0)-    ghc-options:    -Wcompat-                    -Wunrecognised-warning-flags-                    -Widentities-                    -Wincomplete-record-updates-                    -Wincomplete-uni-patterns-                    -Wredundant-constraints-                    -Wnoncanonical-monad-instances-                    -Wnoncanonical-monadfail-instances-  build-depends:-      streamly-    , base              >= 4.8   && < 5-    , hspec             >= 2.0   && < 3-    , containers        >= 0.5   && < 0.7-    , transformers      >= 0.4   && < 0.6-    , mtl               >= 2.2   && < 3-    , exceptions        >= 0.8   && < 0.11-  default-language: Haskell2010--test-suite properties-  type: exitcode-stdio-1.0-  main-is: Prop.hs-  hs-source-dirs: test-  ghc-options:  -fno-ignore-asserts -Wall -O0 -threaded -with-rtsopts=-N-  if flag(dev)-    cpp-options:    -DDEVBUILD-    ghc-options:    -Wmissed-specialisations-                    -Wall-missed-specialisations-  if impl(ghc >= 8.0)-    ghc-options:    -Wcompat-                    -Wunrecognised-warning-flags-                    -Widentities-                    -Wincomplete-record-updates-                    -Wincomplete-uni-patterns-                    -Wredundant-constraints-                    -Wnoncanonical-monad-instances-                    -Wnoncanonical-monadfail-instances-  build-depends:-      streamly-    , base              >= 4.8   && < 5-    , QuickCheck        >= 2.10  && < 2.13-    , hspec             >= 2.0   && < 3-  if impl(ghc < 8.0)-    build-depends:-        transformers  >= 0.4 && < 0.6-  default-language: Haskell2010--test-suite maxrate-  type: exitcode-stdio-1.0-  default-language: Haskell2010-  main-is: MaxRate.hs-  hs-source-dirs:  test-  ghc-options:  -fno-ignore-asserts -O2 -Wall -threaded -with-rtsopts=-N-  if flag(dev)-    buildable: True-    build-Depends:-          streamly-        , base   >= 4.8   && < 5-        , clock  >= 0.7.1 && < 0.8-        , hspec  >= 2.0   && < 3-        , random >= 1.0.0 && < 1.2-  else-    buildable: False--test-suite loops-  type: exitcode-stdio-1.0-  default-language: Haskell2010-  main-is: loops.hs-  hs-source-dirs:  test-  ghc-options:  -fno-ignore-asserts -O2 -Wall -threaded -with-rtsopts=-N-  build-Depends:-      streamly-    , base >= 4.8   && < 5--test-suite nested-loops-  type: exitcode-stdio-1.0-  default-language: Haskell2010-  main-is: nested-loops.hs-  hs-source-dirs:  test-  ghc-options:  -fno-ignore-asserts -O2 -Wall -threaded -with-rtsopts=-N-  build-Depends:-      streamly-    , base   >= 4.8   && < 5-    , random >= 1.0.0 && < 1.2--test-suite parallel-loops-  type: exitcode-stdio-1.0-  default-language: Haskell2010-  main-is: parallel-loops.hs-  hs-source-dirs:  test-  ghc-options:  -fno-ignore-asserts -O2 -Wall -threaded -with-rtsopts=-N-  build-Depends:-      streamly-    , base   >= 4.8   && < 5-    , random >= 1.0.0 && < 1.2------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------benchmark linear-  type: exitcode-stdio-1.0-  hs-source-dirs: benchmark-  main-is: Linear.hs-  other-modules: LinearOps-  default-language: Haskell2010-  ghc-options:  -O2 -Wall-  if flag(dev)-    ghc-options:    -Wmissed-specialisations-                    -Wall-missed-specialisations-                    -fno-ignore-asserts-  if impl(ghc >= 8.0)-    ghc-options:    -Wcompat-                    -Wunrecognised-warning-flags-                    -Widentities-                    -Wincomplete-record-updates-                    -Wincomplete-uni-patterns-                    -Wredundant-constraints-                    -Wnoncanonical-monad-instances-                    -Wnoncanonical-monadfail-instances-  build-depends:-      streamly-    , base                >= 4.8   && < 5-    , deepseq             >= 1.4.0 && < 1.5-    , random              >= 1.0   && < 2.0-    , gauge               >= 0.2.4 && < 0.3--benchmark linear-async-  type: exitcode-stdio-1.0-  hs-source-dirs: benchmark-  main-is: LinearAsync.hs-  other-modules: LinearOps-  default-language: Haskell2010-  ghc-options:  -O2 -Wall-  cpp-options: -DLINEAR_ASYNC-  if flag(dev)-    ghc-options:    -Wmissed-specialisations-                    -Wall-missed-specialisations-                    -fno-ignore-asserts-  if impl(ghc >= 8.0)-    ghc-options:    -Wcompat-                    -Wunrecognised-warning-flags-                    -Widentities-                    -Wincomplete-record-updates-                    -Wincomplete-uni-patterns-                    -Wredundant-constraints-                    -Wnoncanonical-monad-instances-                    -Wnoncanonical-monadfail-instances-  build-depends:-      streamly-    , base                >= 4.8   && < 5-    , deepseq             >= 1.4.0 && < 1.5-    , random              >= 1.0   && < 2.0-    , gauge               >= 0.2.4 && < 0.3--benchmark linear-rate-  type: exitcode-stdio-1.0-  hs-source-dirs: benchmark-  main-is: LinearRate.hs-  other-modules: LinearOps-  default-language: Haskell2010-  ghc-options:  -O2 -Wall-  if flag(dev)-    ghc-options:    -Wmissed-specialisations-                    -Wall-missed-specialisations-                    -fno-ignore-asserts-  if impl(ghc >= 8.0)-    ghc-options:    -Wcompat-                    -Wunrecognised-warning-flags-                    -Widentities-                    -Wincomplete-record-updates-                    -Wincomplete-uni-patterns-                    -Wredundant-constraints-                    -Wnoncanonical-monad-instances-                    -Wnoncanonical-monadfail-instances-  build-depends:-      streamly-    , base                >= 4.8   && < 5-    , deepseq             >= 1.4.0 && < 1.5-    , random              >= 1.0   && < 2.0-    , gauge               >= 0.2.4 && < 0.3--benchmark nested-  type: exitcode-stdio-1.0-  hs-source-dirs: benchmark-  main-is: Nested.hs-  other-modules: NestedOps-  default-language: Haskell2010-  ghc-options:  -O2 -Wall-  if flag(dev)-    ghc-options:    -Wmissed-specialisations-                    -Wall-missed-specialisations-                    -fno-ignore-asserts-  if impl(ghc >= 8.0)-    ghc-options:    -Wcompat-                    -Wunrecognised-warning-flags-                    -Widentities-                    -Wincomplete-record-updates-                    -Wincomplete-uni-patterns-                    -Wredundant-constraints-                    -Wnoncanonical-monad-instances-                    -Wnoncanonical-monadfail-instances-  build-depends:-      streamly-    , base                >= 4.8   && < 5-    , deepseq             >= 1.4.0 && < 1.5-    , random              >= 1.0   && < 2.0-    , gauge               >= 0.2.4 && < 0.3------------------------------------------------------------------------------------ Internal benchmarks for unexposed modules------------------------------------------------------------------------------------ We have to copy the streamly library modules here because there is no--- way to use unexposed modules from the library.--benchmark base-  type: exitcode-stdio-1.0-  hs-source-dirs: benchmark, src-  main-is: BaseStreams.hs-  other-modules:     Streamly.SVar-                   , Streamly.Streams.StreamK-                   , Streamly.Streams.StreamD-                   , Streamly.Streams.Prelude--                   , StreamDOps-                   , StreamKOps--  default-language: Haskell2010-  ghc-options:  -O2 -Wall-  if flag(dev)-    ghc-options:    -Wmissed-specialisations-                    -Wall-missed-specialisations-                    -fno-ignore-asserts-  if impl(ghc >= 8.0)-    ghc-options:    -Wcompat-                    -Wunrecognised-warning-flags-                    -Widentities-                    -Wincomplete-record-updates-                    -Wincomplete-uni-patterns-                    -Wredundant-constraints-                    -Wnoncanonical-monad-instances-                    -Wnoncanonical-monadfail-instances--  build-depends:-      base              >= 4.8   && < 5-    , deepseq           >= 1.4.0 && < 1.5-    , random            >= 1.0   && < 2.0-    , gauge             >= 0.2.4 && < 0.3--    , ghc-prim          >= 0.2   && < 0.6-    , containers        >= 0.5   && < 0.7-    , heaps             >= 0.3   && < 0.4--    -- concurrency-    , atomic-primops    >= 0.8   && < 0.9-    , lockfree-queue    >= 0.2.3 && < 0.3-    , clock             >= 0.7.1 && < 0.8--    , exceptions        >= 0.8   && < 0.11-    , monad-control     >= 1.0   && < 2-    , mtl               >= 2.2   && < 3-    , transformers      >= 0.4   && < 0.6-    , transformers-base >= 0.4   && < 0.5--  if impl(ghc < 8.0)-      build-depends:-          semigroups    >= 0.18   && < 0.19--executable chart-  default-language: Haskell2010-  hs-source-dirs: benchmark-  main-is: Chart.hs-  if flag(dev)-    buildable: True-    build-Depends:-        base >= 4.8 && < 5-      , bench-show >= 0.2 && < 0.3-      , split-      , transformers >= 0.4   && < 0.6-  else-    buildable: False------------------------------------------------------------------------------------ Examples----------------------------------------------------------------------------------executable SearchQuery-  default-language: Haskell2010-  main-is: SearchQuery.hs-  hs-source-dirs:  examples-  if flag(examples) || flag(examples-sdl)-    buildable: True-    build-Depends:-        streamly-      , base         >= 4.8   && < 5-      , http-conduit >= 2.2.2 && < 2.4-  else-    buildable: False--executable ListDir-  default-language: Haskell2010-  main-is: ListDir.hs-  hs-source-dirs:  examples-  if flag(examples) || flag(examples-sdl)-    buildable: True-    build-Depends:-        streamly-      , base    >= 4.8   && < 5-      , path-io >= 0.1.0 && < 1.4-    if impl(ghc < 8.0)-      build-depends:-          transformers  >= 0.4    && < 0.6-  else-    buildable: False--executable MergeSort-  default-language: Haskell2010-  main-is: MergeSort.hs-  hs-source-dirs:  examples-  if flag(examples) || flag(examples-sdl)-    buildable: True-    build-Depends:-        streamly-      , base   >= 4.8   && < 5-      , random >= 1.0.0 && < 1.2-  else-    buildable: False--executable AcidRain-  default-language: Haskell2010-  main-is: AcidRain.hs-  hs-source-dirs:  examples-  if flag(examples) || flag(examples-sdl)-    buildable: True-    build-Depends:-        streamly-      , base         >= 4.8   && < 5-      , mtl          >= 2.2   && < 3-    if impl(ghc < 8.0)-      build-depends:-          semigroups    >= 0.18   && < 0.19-        , transformers  >= 0.4    && < 0.6-  else-    buildable: False--executable CirclingSquare-  default-language: Haskell2010-  main-is: CirclingSquare.hs-  hs-source-dirs:  examples-  if flag(examples-sdl)-    buildable: True-    build-Depends:-        streamly-      , base >= 4.8   && < 5-      , SDL  >= 0.6.5 && < 0.7-  else-    buildable: False--executable ControlFlow-  default-language: Haskell2010-  main-is: ControlFlow.hs-  hs-source-dirs:  examples-  if flag(examples) || flag(examples-sdl)-    buildable: True-    build-Depends:-        streamly-      , base              >= 4.8   && < 5-      , exceptions        >= 0.8   && < 0.11-      , transformers      >= 0.4   && < 0.6-      , transformers-base >= 0.4   && < 0.5-    if impl(ghc < 8.0)-      build-depends:-          semigroups    >= 0.18   && < 0.19-  else-    buildable: False+cabal-version:      2.4+name:               streamly+version:            0.11.1+synopsis:           Streaming data pipelines with declarative concurrency+description:+  For upgrading to streamly-0.9.0+ please read the+  <https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md Streamly-0.9.0 upgrade guide>.+  .+  Streamly is a 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.+  .+  Streams are designed to have a list like interface — no steep+  learning curve, no complex types. Streamly is designed to build+  general purpose applications in a truly functional manner, from+  simple hello-world to advanced high-performance systems. The design+  emphasizes simplicity, modularity, and code reuse with minimal+  building blocks. Performance is on par with C, tuning is easy, and+  it’s hard to get it wrong.+  .+  Streamly is serial by default, with seamless declarative concurrency+  that scales automatically when needed. It provides prompt and safe+  resource management, works well with other streaming libraries as well+  as core libraries like bytestring and text, and is backed by solid+  documentation.+  .+  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.+  .+  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.6.5+                   , GHC==8.8.4+                   , GHC==8.10.7+                   , 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+category:+    Streamly, Concurrency, Streaming, Dataflow, Pipes, Reactivity, List,+    Logic, Non-determinism, Parsing, Array, Time, Unicode, Filesystem,+    Network+stability:           Stable+build-type:          Configure++extra-source-files:+    bench-test-lib/bench-test-lib.cabal+    bench-test-lib/src/BenchTestLib/DirIO.hs+    benchmark/*.hs+    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.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/Unicode/*.hs+    benchmark/lib/Streamly/Benchmark/*.hs+    benchmark/lib/Streamly/Benchmark/Common/*.hs+    benchmark/streamly-benchmarks.cabal+    bin/mk-hscope.sh+    bin/mk-tags.sh+    configure+    configure.ac+    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/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/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/*.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+    benchmark/Streamly/Benchmark/Unicode/data/Vietnamese.txt+    benchmark/Streamly/Benchmark/Unicode/data/Deutsch.txt+    benchmark/Streamly/Benchmark/Unicode/data/English.txt+    benchmark/Streamly/Benchmark/Unicode/data/Korean.txt++extra-doc-files:+    CONTRIBUTING.md+    CHANGELOG.md+    README.md+    benchmark/README.md+    docs/*.md+    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:+    config.log+    config.status+    autom4te.cache+    src/config.h++source-repository head+    type: git+    location: https://github.com/composewell/streamly++flag fusion-plugin+  description: Use fusion plugin for benchmarks and executables+  manual: True+  default: False++flag inspection+  description: Enable inspection testing+  manual: True+  default: False++flag debug+  description: Debug build with asserts enabled+  manual: True+  default: False++flag internal-dev+  description: DO NOT USE, ONLY FOR INTERNAL USE.+  manual: True+  default: False++flag has-llvm+  description: Use llvm backend for code generation+  manual: True+  default: False++flag opt+  description: off=GHC default, on=-O2+  manual: True+  default: True++flag limit-build-mem+  description: Limits memory when building+  manual: True+  default: False++flag internal-use-unliftio+  description: DO NOT USE, ONLY FOR INTERNAL USE.+  manual: True+  default: False++-------------------------------------------------------------------------------+-- Common stanzas+-------------------------------------------------------------------------------++common compile-options+    if os(darwin)+      cpp-options:    -DCABAL_OS_DARWIN++    if os(linux)+      cpp-options:    -DCABAL_OS_LINUX++    if os(windows)+      cpp-options:    -DCABAL_OS_WINDOWS++    if flag(internal-dev)+      cpp-options:    -DDEVBUILD++    if flag(inspection)+      cpp-options:    -DINSPECTION++    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++    if flag(has-llvm)+      ghc-options: -fllvm++    if flag(internal-dev)+      ghc-options:    -Wmissed-specialisations+                      -Wall-missed-specialisations++    if flag(limit-build-mem)+        ghc-options: +RTS -M1000M -RTS++    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+        ConstraintKinds+        DeriveDataTypeable+        DeriveGeneric+        DeriveTraversable+        ExistentialQuantification+        FlexibleContexts+        FlexibleInstances+        GeneralizedNewtypeDeriving+        InstanceSigs+        KindSignatures+        LambdaCase+        MultiParamTypeClasses+        RankNTypes+        ScopedTypeVariables+        TupleSections+        TypeApplications+        TypeOperators++    -- 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+                 -fdicts-strict+                 -fspec-constr-recursive=16+                 -fmax-worker-args=16++  -- For this to be effective it must come after the -O2 option+  if flag(internal-dev) || flag(debug) || !flag(opt)+    ghc-options: -fno-ignore-asserts+    cpp-options: -DDEBUG++common threading-options+  ghc-options:  -threaded+                -with-rtsopts=-N++-- We need optimization options here to optimize internal (non-inlined)+-- versions of functions. Also, we have some benchmarking inspection tests+-- part of the library when built with --benchmarks flag. Thos tests fail+-- if we do not use optimization options here. It was observed that due to+-- -O2 here some concurrent/nested benchmarks improved and others regressed.+-- We can investigate a bit more here why the regression occurred.+common lib-options+  import: compile-options, optimization-options, default-extensions++-------------------------------------------------------------------------------+-- Library+-------------------------------------------------------------------------------++library+    import: lib-options++    include-dirs:+          src+        , src/doctest+        , src/Streamly/Internal/Data/Stream++    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.Internal.Data.IsMap.HashMap+                     , Streamly.Internal.Data.Cont+                     , Streamly.Internal.Data.Channel+                     , Streamly.Internal.Data.Stream.MkType++                     -- streamly-concurrent+                     , Streamly.Internal.Control.Concurrent+                     , Streamly.Internal.Control.ForkLifted+                     , Streamly.Internal.Data.Atomics+                     , Streamly.Internal.Data.IOFinalizer.Lifted++                     , Streamly.Internal.Data.Stream.Prelude+                     , Streamly.Internal.Data.Unfold.Prelude+                     , Streamly.Internal.Data.Fold.Prelude+                     , Streamly.Internal.Data.Scanl.Prelude++                     -- streamly-unicode (depends on unicode-data)+                     , Streamly.Internal.Unicode.Utf8+                     , Streamly.Internal.Unicode.Char++                     -- streamly-network+                     , Streamly.Internal.Network.Socket+                     , Streamly.Internal.Network.Inet.TCP++                     -- Exposed modules+                     , Streamly.Data.Stream.MkType+                     , Streamly.Data.Stream.Prelude+                     , Streamly.Data.Fold.Prelude+                     , Streamly.Data.Scanl.Prelude++                     -- Network/IO+                     , Streamly.Network.Socket+                     , Streamly.Network.Inet.TCP++                     -- Deprecated+                     , Streamly.Data.Array.Foreign+                     , Streamly.Data.Fold.Tee+                     , Streamly.Prelude++                     -- Deprecated Internal modules+                     , Streamly.Internal.Data.SVar+                     , 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++    if !impl(ghcjs) && flag(internal-dev)+        other-modules:+                       Streamly.Internal.System.IOVec.Type+                     , Streamly.Internal.System.IOVec+                     , Streamly.Internal.FileSystem.FDIO+                     , Streamly.Internal.FileSystem.FD++    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++    if os(windows)+          exposed-modules: Streamly.Internal.FileSystem.Event.Windows++    if os(darwin)+          include-dirs:  src/Streamly/Internal+          c-sources: src/Streamly/Internal/FileSystem/Event/Darwin.c+          exposed-modules: Streamly.Internal.FileSystem.Event.Darwin++    if os(linux)+          exposed-modules: Streamly.Internal.FileSystem.Event.Linux++    if os(linux) || os(darwin) || os(windows)+          exposed-modules: Streamly.Internal.FileSystem.Event++    other-modules:+           Streamly.Internal.Data.Channel.Types+         , Streamly.Internal.Data.Channel.Dispatcher+         , Streamly.Internal.Data.Channel.Worker++         , 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++         , 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++         , Streamly.Internal.Data.Unfold.Exception+         , Streamly.Internal.Data.Unfold.SVar++         -- 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++         , Streamly.Internal.Data.Stream.SVar.Generate+         , Streamly.Internal.Data.Stream.SVar.Eliminate++         , 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+                    -- the GHC versions we support. This is to make sure that+                    -- packages depending on the "ghc" package (packages+                    -- depending on doctest is a common example) can+                    -- depend on streamly.+                       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++                     -- 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++                    -- concurrency+                     , lockfree-queue    >= 0.2.4 && < 0.3++                     , unicode-data      >= 0.1 && < 0.9++                    -- Network+                    -- network version 3.2.8 is broken on windows+                     , network           >= 2.6 && < 3.3+++    if impl(ghc < 9.10)+      build-depends:   atomic-primops    >= 0.8   && < 0.9+    else+      build-depends:   atomic-primops    >= 0.8.8 && < 0.9++    if impl(ghc < 9.6)+      build-depends:   transformers-base >= 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++    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/Main.hs 
@@ -1,1120 +0,0 @@-{-# LANGUAGE CPP                 #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where--import Control.Concurrent (threadDelay)-import Control.Exception (Exception, try, ErrorCall(..), catch, throw)-import Control.Monad (void)-import Control.Monad.Catch (throwM, MonadThrow)-import Control.Monad.Error.Class (throwError, MonadError)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Control.Monad.State (MonadState, get, modify, runStateT, StateT)-import Control.Monad.Trans.Except (runExceptT, ExceptT)-import Data.Foldable (forM_, fold)-import Data.List (sort)-import System.Mem (performMajorGC)--import Data.IORef-import Test.Hspec as H--import Streamly-import Streamly.Prelude ((.:), nil)-import qualified Streamly.Prelude as S--singleton :: IsStream t => a -> t m a-singleton a = a .: nil--toListSerial :: SerialT IO a -> IO [a]-toListSerial = S.toList . serially--toListInterleaved :: WSerialT IO a -> IO [a]-toListInterleaved = S.toList . wSerially--toListAsync :: AsyncT IO a -> IO [a]-toListAsync = S.toList . asyncly--toListParallel :: WAsyncT IO a -> IO [a]-toListParallel = S.toList . wAsyncly--main :: IO ()-main = hspec $ do-    parallelTests--    describe "restricts concurrency and cleans up extra tasks" $ do-        it "take 1 asyncly" $ checkCleanup 2 asyncly (S.take 1)-        it "take 1 wAsyncly" $ checkCleanup 2 wAsyncly (S.take 1)-        it "take 1 aheadly" $ checkCleanup 2 aheadly (S.take 1)--        it "takeWhile (< 0) asyncly" $ checkCleanup 2 asyncly (S.takeWhile (< 0))-        it "takeWhile (< 0) wAsyncly" $ checkCleanup 2 wAsyncly (S.takeWhile (< 0))-        it "takeWhile (< 0) aheadly" $ checkCleanup 2 aheadly (S.takeWhile (< 0))--#ifdef DEVBUILD-    let timed :: (IsStream t, Monad (t IO)) => Int -> t IO Int-        timed x = S.yieldM (threadDelay (x * 100000)) >> return x--    -- These are not run parallely because the timing gets affected-    -- unpredictably when other tests are running on the same machine.-    ---    -- Also, they fail intermittently due to scheduling delays, so not run on-    -- CI machines.-    describe "Nested parallel and serial compositions" $ do-        let t = timed-            p = wAsyncly-            s = serially-        {--        -- This is not correct, the result can also be [4,4,8,0,8,0,2,2]-        -- because of parallelism of [8,0] and [8,0].-        it "Nest <|>, <>, <|> (1)" $-            let t = timed-             in toListSerial (-                    ((t 8 <|> t 4) <> (t 2 <|> t 0))-                <|> ((t 8 <|> t 4) <> (t 2 <|> t 0)))-            `shouldReturn` ([4,4,8,8,0,0,2,2])-        -}-        it "Nest <|>, <>, <|> (2)" $-            (S.toList . wAsyncly) (-                   s (p (t 4 <> t 8) <> p (t 1 <> t 2))-                <> s (p (t 4 <> t 8) <> p (t 1 <> t 2)))-            `shouldReturn` ([4,4,8,8,1,1,2,2])-        -- FIXME: These two keep failing intermittently on Mac OS X-        -- Need to examine and fix the tests.-        {--        it "Nest <|>, <=>, <|> (1)" $-            let t = timed-             in toListSerial (-                    ((t 8 <|> t 4) <=> (t 2 <|> t 0))-                <|> ((t 9 <|> t 4) <=> (t 2 <|> t 0)))-            `shouldReturn` ([4,4,0,0,8,2,9,2])-        it "Nest <|>, <=>, <|> (2)" $-            let t = timed-             in toListSerial (-                    ((t 4 <|> t 8) <=> (t 1 <|> t 2))-                <|> ((t 4 <|> t 9) <=> (t 1 <|> t 2)))-            `shouldReturn` ([4,4,1,1,8,2,9,2])-        -}-        it "Nest <|>, <|>, <|>" $-            (S.toList . wAsyncly) (-                    ((t 4 <> t 8) <> (t 0 <> t 2))-                <> ((t 4 <> t 8) <> (t 0 <> t 2)))-            `shouldReturn` ([0,0,2,2,4,4,8,8])--        -- parallely fails on CI machines, may need more difference in times of-        -- the events, but that would make tests even slower.-        it "take 1 parallely" $ checkCleanup 3 parallely (S.take 1)-        it "takeWhile (< 0) parallely" $ checkCleanup 3 parallely (S.takeWhile (< 0))--        testFoldOpsCleanup "head" S.head-        testFoldOpsCleanup "null" S.null-        testFoldOpsCleanup "elem" (S.elem 0)-        testFoldOpsCleanup "notElem" (S.notElem 0)-        testFoldOpsCleanup "elemIndex" (S.elemIndex 0)-        -- S.lookup-        testFoldOpsCleanup "notElem" (S.notElem 0)-        testFoldOpsCleanup "find" (S.find (==0))-        testFoldOpsCleanup "findIndex" (S.findIndex (==0))-        testFoldOpsCleanup "all" (S.all (==1))-        testFoldOpsCleanup "any" (S.any (==0))-        testFoldOpsCleanup "and" (S.and . S.map (==1))-        testFoldOpsCleanup "or" (S.or . S.map (==0))-#endif--    ----------------------------------------------------------------------------    -- Semigroup/Monoidal Composition strict ordering checks-    -----------------------------------------------------------------------------    -- test both (<>) and mappend to make sure we are using correct instance-    -- for Monoid that is using the right version of semigroup. Instance-    -- deriving can cause us to pick wrong instances sometimes.--    describe "WSerial interleaved (<>) ordering check" $ interleaveCheck wSerially (<>)-    describe "WSerial interleaved mappend ordering check" $ interleaveCheck wSerially mappend--    -- describe "WAsync interleaved (<>) ordering check" $ interleaveCheck wAsyncly (<>)-    -- describe "WAsync interleaved mappend ordering check" $ interleaveCheck wAsyncly mappend--    describe "Async (<>) time order check" $ parallelCheck asyncly (<>)-    describe "Async mappend time order check" $ parallelCheck asyncly mappend--    -- XXX this keeps failing intermittently, need to investigate-    -- describe "WAsync (<>) time order check" $ parallelCheck wAsyncly (<>)-    -- describe "WAsync mappend time order check" $ parallelCheck wAsyncly mappend--    describe "Parallel (<>) time order check" $ parallelCheck parallely (<>)-    describe "Parallel mappend time order check" $ parallelCheck parallely mappend--checkCleanup :: IsStream t-    => Int-    -> (t IO Int -> SerialT IO Int)-    -> (t IO Int -> t IO Int)-    -> IO ()-checkCleanup d t op = do-    r <- newIORef (-1 :: Int)-    runStream . serially $ do-        _ <- t $ op $ delay r 0 S.|: delay r 1 S.|: delay r 2 S.|: S.nil-        return ()-    performMajorGC-    threadDelay 500000-    res <- readIORef r-    res `shouldBe` 0-    where-    delay ref i = threadDelay (i*d*100000) >> writeIORef ref i >> return i--#ifdef DEVBUILD-checkCleanupFold :: IsStream t-    => (t IO Int -> SerialT IO Int)-    -> (SerialT IO Int -> IO (Maybe Int))-    -> IO ()-checkCleanupFold t op = do-    r <- newIORef (-1 :: Int)-    _ <- op $ t $ delay r 0 S.|: delay r 1 S.|: delay r 2 S.|: S.nil-    performMajorGC-    threadDelay 500000-    res <- readIORef r-    res `shouldBe` 0-    where-    delay ref i = threadDelay (i*200000) >> writeIORef ref i >> return i--testFoldOpsCleanup :: String -> (SerialT IO Int -> IO a) -> Spec-testFoldOpsCleanup name f = do-    let testOp op x = op x >> return Nothing-    it (name <> " asyncly") $ checkCleanupFold asyncly (testOp f)-    it (name <> " wAsyncly") $ checkCleanupFold wAsyncly (testOp f)-    it (name <> " aheadly") $ checkCleanupFold aheadly (testOp f)-    it (name <> " parallely") $ checkCleanupFold parallely (testOp f)-#endif--parallelTests :: SpecWith ()-parallelTests = H.parallel $ do-    describe "Runners" $ do-        -- XXX move these to property tests-        -- XXX use an IORef to store and check the side effects-        it "simple serially" $-            (runStream . serially) (return (0 :: Int)) `shouldReturn` ()-        it "simple serially with IO" $-            (runStream . serially) (S.yieldM $ putStrLn "hello") `shouldReturn` ()--    describe "Empty" $ -- do-        it "Monoid - mempty" $-            toListSerial mempty `shouldReturn` ([] :: [Int])-        -- it "Alternative - empty" $-        --     (toListSerial empty) `shouldReturn` ([] :: [Int])-        -- it "MonadPlus - mzero" $-        --     (toListSerial mzero) `shouldReturn` ([] :: [Int])--    ----------------------------------------------------------------------------    -- Functor-    -----------------------------------------------------------------------------    describe "Functor (fmap)" $ do-        -- XXX we should do these through property tests by using a-        -- construction via list fold construction method.-        it "fmap on composed (<>)" $-            toListSerial (fmap (+1) (return 1 <> return 2))-                `shouldReturn` ([2,3] :: [Int])--        it "fmap on composed (<>)" $-            sort <$> toListParallel (fmap (+1) (return 1 <> return 2))-                `shouldReturn` ([2,3] :: [Int])--    ----------------------------------------------------------------------------    -- Applicative-    -----------------------------------------------------------------------------    describe "Applicative" $ do-        -- XXX we should do these through property tests by using a-        -- construction via list fold construction method.-        it "Apply - serial composed first argument" $-            toListSerial ((,) <$> (return 1 <> return 2) <*> return 3)-                `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])--        it "Apply - serial composed second argument" $-            toListSerial ((,) <$> return 1 <*> (return 2 <> return 3))-                `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])--        it "Apply - parallel composed first argument" $-            sort <$> toListParallel ((,) <$> (return 1 <> return 2) <*> return 3)-                `shouldReturn` ([(1,3),(2,3)] :: [(Int, Int)])--        it "Apply - parallel composed second argument" $-            sort <$> toListParallel ((,) <$> return 1 <*> (return 2 <> return 3))-                `shouldReturn` ([(1,2),(1,3)] :: [(Int, Int)])--    ----------------------------------------------------------------------------    -- Monoidal Compositions, multiset equality checks-    -----------------------------------------------------------------------------    describe "Serial Composition" $ compose serially mempty id-    describe "Ahead Composition" $ compose aheadly mempty id-    describe "WSerial Composition" $ compose wSerially mempty sort-    describe "Async Composition" $ compose asyncly mempty sort-    describe "WAsync Composition" $ compose wAsyncly mempty sort-    describe "Parallel Composition" $ compose parallely mempty sort-    describe "Semigroup Composition for ZipSerial" $ compose zipSerially mempty id-    describe "Semigroup Composition for ZipAsync" $ compose zipAsyncly mempty id-    -- XXX need to check alternative compositions as well--    ----------------------------------------------------------------------------    -- TBD Monoidal composition combinations-    -----------------------------------------------------------------------------    -- TBD need more such combinations to be tested.-    describe "serial <> and serial <>" $-        composeAndComposeSimple serially serially (repeat [1 .. 9])-    describe "ahead <> and ahead <>" $-        composeAndComposeSimple aheadly aheadly (repeat [1 .. 9])-    describe "ahead <> and serial <>" $-        composeAndComposeSimple aheadly serially (repeat [1 .. 9])-    describe "serial <> and ahead <>" $-        composeAndComposeSimple serially aheadly (repeat [1 .. 9])--    describe "<> and <=>" $ composeAndComposeSimple-      serially-      wSerially-      [ [1 .. 9]-       , [1 .. 9]-       , [1, 3, 2, 4, 6, 5, 7, 9, 8]-       , [1, 3, 2, 4, 6, 5, 7, 9, 8]-      ]--    describe "<=> and <=>" $ composeAndComposeSimple-      wSerially-      wSerially-      [ [1, 4, 2, 7, 3, 5, 8, 6, 9]-       , [1, 7, 4, 8, 2, 9, 5, 3, 6]-       , [1, 4, 3, 7, 2, 6, 9, 5, 8]-       , [1, 7, 4, 9, 3, 8, 6, 2, 5]-      ]--    describe "<=> and <>" $ composeAndComposeSimple-      wSerially-      serially-      [ [1, 4, 2, 7, 3, 5, 8, 6, 9]-       , [1, 7, 4, 8, 2, 9, 5, 3, 6]-       , [1, 4, 2, 7, 3, 5, 8, 6, 9]-       , [1, 7, 4, 8, 2, 9, 5, 3, 6]-      ]--    ----------------------------------------------------------------------------    -- Monoidal composition recursion loops-    -----------------------------------------------------------------------------    describe "Serial loops" $ loops serially id reverse-    describe "Ahead loops" $ loops aheadly id reverse-    describe "Async parallel loops" $ loops asyncly sort sort-    describe "WAsync loops" $ loops wAsyncly sort sort-    describe "parallel loops" $ loops parallely sort sort--    ----------------------------------------------------------------------------    -- Bind and monoidal composition combinations-    -----------------------------------------------------------------------------    describe "Bind and compose Stream 1" $ bindAndComposeSimple serially serially-    describe "Bind and compose Stream 2" $ bindAndComposeSimple serially wSerially-    describe "Bind and compose Stream 3" $ bindAndComposeSimple serially asyncly-    describe "Bind and compose Stream 4" $ bindAndComposeSimple serially wAsyncly-    describe "Bind and compose Stream 5" $ bindAndComposeSimple serially parallely-    describe "Bind and compose Stream 6" $ bindAndComposeSimple serially aheadly--    describe "Bind and compose Ahead Stream 0" $ bindAndComposeSimple aheadly aheadly-    describe "Bind and compose Ahead Stream 1" $ bindAndComposeSimple aheadly serially-    describe "Bind and compose Ahead Stream 2" $ bindAndComposeSimple aheadly wSerially-    describe "Bind and compose Ahead Stream 3" $ bindAndComposeSimple aheadly asyncly-    describe "Bind and compose Ahead Stream 4" $ bindAndComposeSimple aheadly wAsyncly-    describe "Bind and compose Ahead Stream 5" $ bindAndComposeSimple aheadly parallely--    describe "Bind and compose Costream 1" $ bindAndComposeSimple wSerially serially-    describe "Bind and compose Costream 2" $ bindAndComposeSimple wSerially wSerially-    describe "Bind and compose Costream 3" $ bindAndComposeSimple wSerially asyncly-    describe "Bind and compose Costream 4" $ bindAndComposeSimple wSerially wAsyncly-    describe "Bind and compose Costream 5" $ bindAndComposeSimple wSerially parallely-    describe "Bind and compose Costream 6" $ bindAndComposeSimple wSerially aheadly--    describe "Bind and compose Async 1" $ bindAndComposeSimple asyncly serially-    describe "Bind and compose Async 2" $ bindAndComposeSimple asyncly wSerially-    describe "Bind and compose Async 3" $ bindAndComposeSimple asyncly asyncly-    describe "Bind and compose Async 4" $ bindAndComposeSimple asyncly wAsyncly-    describe "Bind and compose Async 5" $ bindAndComposeSimple asyncly parallely-    describe "Bind and compose Async 6" $ bindAndComposeSimple asyncly aheadly--    describe "Bind and compose WAsync 1" $ bindAndComposeSimple wAsyncly serially-    describe "Bind and compose WAsync 2" $ bindAndComposeSimple wAsyncly wSerially-    describe "Bind and compose WAsync 3" $ bindAndComposeSimple wAsyncly asyncly-    describe "Bind and compose WAsync 4" $ bindAndComposeSimple wAsyncly wAsyncly-    describe "Bind and compose WAsync 5" $ bindAndComposeSimple wAsyncly parallely-    describe "Bind and compose WAsync 6" $ bindAndComposeSimple wAsyncly aheadly--    describe "Bind and compose Parallel 1" $ bindAndComposeSimple parallely serially-    describe "Bind and compose Parallel 2" $ bindAndComposeSimple parallely wSerially-    describe "Bind and compose Parallel 3" $ bindAndComposeSimple parallely asyncly-    describe "Bind and compose Parallel 4" $ bindAndComposeSimple parallely wAsyncly-    describe "Bind and compose Parallel 5" $ bindAndComposeSimple parallely parallely-    describe "Bind and compose Parallel 6" $ bindAndComposeSimple parallely aheadly--    let fldr, fldl :: (IsStream t, Semigroup (t IO Int)) => [t IO Int] -> t IO Int-        fldr = foldr (<>) nil-        fldl = foldl (<>) nil--    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy serially serially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy serially wSerially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy serially asyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy serially wAsyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy serially parallely k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose serially aheadly" $ bindAndComposeHierarchy serially aheadly k--    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose aheadly serially" $ bindAndComposeHierarchy aheadly serially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose aheadly wSerially" $ bindAndComposeHierarchy aheadly wSerially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose aheadly asyncly" $ bindAndComposeHierarchy aheadly asyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose aheadly wAsyncly" $ bindAndComposeHierarchy aheadly wAsyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose aheadly parallely" $ bindAndComposeHierarchy aheadly parallely k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose serially aheadly" $ bindAndComposeHierarchy aheadly aheadly k--    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wSerially serially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wSerially wSerially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wSerially asyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wSerially wAsyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wSerially parallely k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose wserially aheadly" $ bindAndComposeHierarchy wSerially aheadly k--    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy asyncly serially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy asyncly wSerially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy asyncly asyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy asyncly wAsyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy asyncly parallely k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose asyncly aheadly" $ bindAndComposeHierarchy asyncly aheadly k--    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wAsyncly serially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wAsyncly wSerially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wAsyncly asyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wAsyncly wAsyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy wAsyncly parallely k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose wAsyncly aheadly" $ bindAndComposeHierarchy wAsyncly aheadly k--    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy parallely serially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy parallely wSerially k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy parallely asyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy parallely wAsyncly k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose" $ bindAndComposeHierarchy parallely parallely k-    forM_ [fldr, fldl] $ \k ->-        describe "Bind and compose parallely aheadly" $ bindAndComposeHierarchy parallely aheadly k--    -- Nest two lists using different styles of product compositions-    it "Nests two streams using monadic serial composition" nestTwoSerial-    it "Nests two streams using monadic ahead composition" nestTwoAhead-    it "Nests two streams using monadic interleaved composition" nestTwoInterleaved-    it "Nests two streams using monadic Async composition" nestTwoAsync-    it "Nests two streams using monadic WAsync composition" nestTwoWAsync-    it "Nests two streams using monadic parallel composition" nestTwoParallel--    it "Nests two streams using applicative serial composition" nestTwoSerialApp-    it "Nests two streams using applicative ahead composition" nestTwoAheadApp-    it "Nests two streams using applicative interleaved composition" nestTwoInterleavedApp-    it "Nests two streams using applicative Async composition" nestTwoAsyncApp-    it "Nests two streams using applicative WAsync composition" nestTwoWAsyncApp-    it "Nests two streams using applicative parallel composition" nestTwoParallelApp--    ----------------------------------------------------------------------------    -- TBD Bind and Bind combinations-    -----------------------------------------------------------------------------    -- TBD combine all binds and all compose in one example-    describe "Miscellaneous combined examples" mixedOps-    describe "Miscellaneous combined examples aheadly" mixedOpsAheadly-    describe "Simple MonadError and MonadThrow" simpleMonadError--    {--    describe "Composed MonadError serially" $ composeWithMonadError serially-    describe "Composed MonadError wSerially" $ composeWithMonadError wSerially-    describe "Composed MonadError asyncly" $ composeWithMonadError asyncly-    describe "Composed MonadError wAsyncly" $ composeWithMonadError wAsyncly-    -}--    describe "Composed MonadThrow serially" $ composeWithMonadThrow serially-    describe "Composed MonadThrow wSerially" $ composeWithMonadThrow wSerially-    describe "Composed MonadThrow asyncly" $ composeWithMonadThrow asyncly-    describe "Composed MonadThrow wAsyncly" $ composeWithMonadThrow wAsyncly-    describe "Composed MonadThrow parallely" $ composeWithMonadThrow parallely-    describe "Composed MonadThrow aheadly" $ composeWithMonadThrow aheadly--    describe "take on infinite concurrent stream" $ takeInfinite asyncly-    describe "take on infinite concurrent stream" $ takeInfinite wAsyncly-    describe "take on infinite concurrent stream" $ takeInfinite aheadly--    ----------------------------------------------------------------------------    -- Some ad-hoc tests that failed at times-    -----------------------------------------------------------------------------    it "takes n from stream of streams" (takeCombined 1 aheadly)-    it "takes n from stream of streams" (takeCombined 2 asyncly)-    it "takes n from stream of streams" (takeCombined 3 wAsyncly)--    ----------------------------------------------------------------------------    -- Folds are strict enough-    -----------------------------------------------------------------------------    it "foldx is strict enough" checkFoldxStrictness-    it "foldl' is strict enough" checkFoldl'Strictness-    it "scanx is strict enough" checkScanxStrictness-    it "scanl' is strict enough" checkScanl'Strictness-    it "foldxM is strict enough" (checkFoldMStrictness foldxMStrictCheck)-    it "foldlM' is strict enough" (checkFoldMStrictness foldlM'StrictCheck)-    it "scanlM' is strict enough" (checkScanlMStrictness scanlM'StrictCheck)--    ----------------------------------------------------------------------------    -- Monadic state snapshot in concurrent tasks-    -----------------------------------------------------------------------------    it "asyncly maintains independent states in concurrent tasks"-        (monadicStateSnapshot asyncly)-    it "asyncly limited maintains independent states in concurrent tasks"-        (monadicStateSnapshot (asyncly . S.take 10000))-    it "wAsyncly maintains independent states in concurrent tasks"-        (monadicStateSnapshot wAsyncly)-    it "wAsyncly limited maintains independent states in concurrent tasks"-        (monadicStateSnapshot (wAsyncly . S.take 10000))-    it "aheadly maintains independent states in concurrent tasks"-        (monadicStateSnapshot aheadly)-    it "aheadly limited maintains independent states in concurrent tasks"-        (monadicStateSnapshot (aheadly . S.take 10000))-    it "parallely maintains independent states in concurrent tasks"-        (monadicStateSnapshot parallely)--    it "async maintains independent states in concurrent tasks"-        (monadicStateSnapshotOp async)-    it "ahead maintains independent states in concurrent tasks"-        (monadicStateSnapshotOp ahead)-    it "wAsync maintains independent states in concurrent tasks"-        (monadicStateSnapshotOp wAsync)-    it "parallel maintains independent states in concurrent tasks"-        (monadicStateSnapshotOp Streamly.parallel)--    ----------------------------------------------------------------------------    -- Slower tests are at the end-    -----------------------------------------------------------------------------    ----------------------------------------------------------------------------    -- Thread limits-    -----------------------------------------------------------------------------    it "asyncly crosses thread limit (2000 threads)" $-        runStream (asyncly $ fold $-                   replicate 2000 $ S.yieldM $ threadDelay 1000000)-        `shouldReturn` ()--    it "aheadly crosses thread limit (4000 threads)" $-        runStream (aheadly $ fold $-                   replicate 4000 $ S.yieldM $ threadDelay 1000000)-        `shouldReturn` ()---- Each snapshot carries an independent state. Multiple parallel tasks should--- not affect each other's state. This is especially important when we run--- multiple tasks in a single thread.-snapshot :: (IsStream t, MonadAsync m, MonadState Int m) => t m ()-snapshot =-    -- We deliberately use a replicate count 1 here, because a lower count-    -- catches problems that a higher count doesn't.-    S.replicateM 1 $ do-        -- Even though we modify the state here it should not reflect in other-        -- parallel tasks, it is local to each concurrent task.-        modify (+1) >> get >>= liftIO . (`shouldSatisfy` (==1))-        modify (+1) >> get >>= liftIO . (`shouldSatisfy` (==2))--snapshot1 :: (IsStream t, MonadAsync m, MonadState Int m) => t m ()-snapshot1 = S.replicateM 1000 $-    modify (+1) >> get >>= liftIO . (`shouldSatisfy` (==2))--snapshot2 :: (IsStream t, MonadAsync m, MonadState Int m) => t m ()-snapshot2 = S.replicateM 1000 $-    modify (+1) >> get >>= liftIO . (`shouldSatisfy` (==2))--stateComp-    :: ( IsStream t-       , MonadAsync m-       , Semigroup (t m ())-       , MonadIO (t m)-       , MonadState Int m-       , MonadState Int (t m)-       )-    => t m ()-stateComp = do-    -- Each task in a concurrent composition inherits the state and maintains-    -- its own modifications to it, not affecting the parent computation.-    snapshot <> (modify (+1) >> (snapshot1 <> snapshot2))-    -- The above modify statement does not affect our state because that is-    -- used in a parallel composition. In a serial composition it will affect-    -- our state.-    get >>= liftIO . (`shouldSatisfy` (== (0 :: Int)))--monadicStateSnapshot-    :: ( IsStream t-       , Semigroup (t (StateT Int IO) ())-       , MonadIO (t (StateT Int IO))-       , MonadState Int (t (StateT Int IO))-       )-    => (t (StateT Int IO) () -> SerialT (StateT Int IO) ()) -> IO ()-monadicStateSnapshot t = void $ runStateT (runStream $ t stateComp) 0--stateCompOp-    :: (   AsyncT (StateT Int IO) ()-        -> AsyncT (StateT Int IO) ()-        -> AsyncT (StateT Int IO) ()-       )-    -> SerialT (StateT Int IO) ()-stateCompOp op = do-    -- Each task in a concurrent composition inherits the state and maintains-    -- its own modifications to it, not affecting the parent computation.-    asyncly (snapshot `op` (modify (+1) >> (snapshot1 `op` snapshot2)))-    -- The above modify statement does not affect our state because that is-    -- used in a parallel composition. In a serial composition it will affect-    -- our state.-    get >>= liftIO . (`shouldSatisfy` (== (0 :: Int)))--monadicStateSnapshotOp-    :: (   AsyncT (StateT Int IO) ()-        -> AsyncT (StateT Int IO) ()-        -> AsyncT (StateT Int IO) ()-       )-    -> IO ()-monadicStateSnapshotOp op = void $ runStateT (runStream $ stateCompOp op) 0--takeCombined :: (Monad m, Semigroup (t m Int), Show a, Eq a, IsStream t)-    => Int -> (t m Int -> SerialT IO a) -> IO ()-takeCombined n t = do-    let constr = S.fromFoldable-    r <- (S.toList . t) $-            S.take n (constr ([] :: [Int]) <> constr ([] :: [Int]))-    r `shouldBe` []--checkFoldxStrictness :: IO ()-checkFoldxStrictness = do-  let s = return (1 :: Int) `S.consM` error "failure"-  catch (S.foldx (\_ a -> if a == 1 then error "success" else "done")-                      "begin" id s)-    (\e -> case e of-            ErrorCall err -> return err-            _ -> throw e)-    `shouldReturn` "success"--checkFoldl'Strictness :: IO ()-checkFoldl'Strictness = do-  let s = return (1 :: Int) `S.consM` error "failure"-  catch (S.foldl' (\_ a -> if a == 1 then error "success" else "done")-                      "begin" s)-    (\e -> case e of-            ErrorCall err -> return err-            _ -> throw e)-    `shouldReturn` "success"--checkScanxStrictness :: IO ()-checkScanxStrictness = do-  let s = return (1 :: Int) `S.consM` error "failure"-  catch-    (runStream (-        S.scanx (\_ a ->-                    if a == 1-                    then error "success"-                    else "done")-                "begin" id s-        )-        >> return "finished"-    )-    (\e -> case e of-            ErrorCall err -> return err-            _ -> throw e)-    `shouldReturn` "success"--checkScanl'Strictness :: IO ()-checkScanl'Strictness = do-    let s = return (1 :: Int) `S.consM` error "failure"-    catch-        (runStream-             (S.scanl'-                  (\_ a ->-                       if a == 1-                           then error "success"-                           else "done")-                  "begin"-                  s)-             >> return "finished"-        )-        (\e -> case e of-                ErrorCall err -> return err-                _ -> throw e)-        `shouldReturn` "success"--foldlM'StrictCheck :: IORef Int -> SerialT IO Int -> IO ()-foldlM'StrictCheck ref = S.foldlM' (\_ _ -> writeIORef ref 1) ()--foldxMStrictCheck :: IORef Int -> SerialT IO Int -> IO ()-foldxMStrictCheck ref = S.foldxM (\_ _ -> writeIORef ref 1) (return ()) return--checkFoldMStrictness :: (IORef Int -> SerialT IO Int -> IO ()) -> IO ()-checkFoldMStrictness f = do-  ref <- newIORef 0-  let s = return 1 `S.consM` error "x"-  catch (f ref s) (\(_ :: ErrorCall) -> return ())-  readIORef ref `shouldReturn` 1--scanlM'StrictCheck :: IORef Int -> SerialT IO Int -> SerialT IO ()-scanlM'StrictCheck ref = S.scanlM' (\_ _ -> writeIORef ref 1) ()--checkScanlMStrictness :: (IORef Int -> SerialT IO Int -> SerialT IO ()) -> IO ()-checkScanlMStrictness f = do-  ref <- newIORef 0-  let s = return 1 `S.consM` error "x"-  catch (runStream $ f ref s) (\(_ :: ErrorCall) -> return ())-  readIORef ref `shouldReturn` 1--takeInfinite :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec-takeInfinite t =-    it "take 1" $-        runStream (t $ S.take 1 $ S.repeatM (print "hello" >> return (1::Int)))-        `shouldReturn` ()---- XXX need to test that we have promptly cleaned up everything after the error--- XXX We can also check the output that we are expected to get before the--- error occurs.--newtype ExampleException = ExampleException String deriving (Eq, Show)--instance Exception ExampleException--simpleMonadError :: Spec-simpleMonadError = do-{--    it "simple runExceptT" $ do-        (runExceptT $ runStream $ return ())-        `shouldReturn` (Right () :: Either String ())-    it "simple runExceptT with error" $ do-        (runExceptT $ runStream $ throwError "E") `shouldReturn` Left "E"-        -}-    it "simple try" $-        try (runStream $ return ())-        `shouldReturn` (Right () :: Either ExampleException ())-    it "simple try with throw error" $-        try (runStream $ throwM $ ExampleException "E")-        `shouldReturn` (Left (ExampleException "E") :: Either ExampleException ())--composeWithMonadThrow-    :: ( IsStream t-       , Semigroup (t IO Int)-       , MonadThrow (t IO)-       )-    => (t IO Int -> SerialT IO Int) -> Spec-composeWithMonadThrow t = do-    it "Compose throwM, nil" $-        try (tl (throwM (ExampleException "E") <> S.nil))-        `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])-    it "Compose nil, throwM" $-        try (tl (S.nil <> throwM (ExampleException "E")))-        `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])-    oneLevelNestedSum "serially" serially-    oneLevelNestedSum "wSerially" wSerially-    oneLevelNestedSum "asyncly" asyncly-    oneLevelNestedSum "wAsyncly" wAsyncly-    -- XXX add two level nesting--    oneLevelNestedProduct "serially"   serially-    oneLevelNestedProduct "wSerially" wSerially-    oneLevelNestedProduct "asyncly" asyncly-    oneLevelNestedProduct "wAsyncly"  wAsyncly--    where-    tl = S.toList . t-    oneLevelNestedSum desc t1 =-        it ("One level nested sum " <> desc) $ do-            let nested = S.fromFoldable [1..10] <> throwM (ExampleException "E")-                         <> S.fromFoldable [1..10]-            try (tl (S.nil <> t1 nested <> S.fromFoldable [1..10]))-            `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])--    oneLevelNestedProduct desc t1 =-        it ("One level nested product" <> desc) $ do-            let s1 = t $ foldMapWith (<>) return [1..4]-                s2 = t1 $ foldMapWith (<>) return [5..8]-            try $ tl (do-                x <- adapt s1-                y <- s2-                if x + y > 10-                then throwM (ExampleException "E")-                else return (x + y)-                )-            `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])--_composeWithMonadError-    :: ( IsStream t-       , Semigroup (t (ExceptT String IO) Int)-       , MonadError String (t (ExceptT String IO))-       )-    => (t (ExceptT String IO) Int -> SerialT (ExceptT String IO) Int) -> Spec-_composeWithMonadError t = do-    let tl = S.toList . t-    it "Compose throwError, nil" $-        runExceptT (tl (throwError "E" <> S.nil)) `shouldReturn` Left "E"-    it "Compose nil, error" $-        runExceptT (tl (S.nil <> throwError "E")) `shouldReturn` Left "E"--nestTwoSerial :: Expectation-nestTwoSerial =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in toListSerial (do-        x <- s1-        y <- s2-        return (x + y)-        ) `shouldReturn` ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])--nestTwoAhead :: Expectation-nestTwoAhead =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in (S.toList . aheadly) (do-        x <- s1-        y <- s2-        return (x + y)-        ) `shouldReturn` ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])--nestTwoSerialApp :: Expectation-nestTwoSerialApp =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in toListSerial ((+) <$> s1 <*> s2)-        `shouldReturn` ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])--nestTwoAheadApp :: Expectation-nestTwoAheadApp =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in (S.toList . aheadly) ((+) <$> s1 <*> s2)-        `shouldReturn` ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])--nestTwoInterleaved :: Expectation-nestTwoInterleaved =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in toListInterleaved (do-        x <- s1-        y <- s2-        return (x + y)-        ) `shouldReturn` ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])--nestTwoInterleavedApp :: Expectation-nestTwoInterleavedApp =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in toListInterleaved ((+) <$> s1 <*> s2)-        `shouldReturn` ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])--nestTwoAsync :: Expectation-nestTwoAsync =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in sort <$> toListAsync (do-        x <- s1-        y <- s2-        return (x + y))-    `shouldReturn` sort ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])--nestTwoAsyncApp :: Expectation-nestTwoAsyncApp =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in sort <$> toListAsync ((+) <$> s1 <*> s2)-        `shouldReturn` sort ([6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12] :: [Int])--nestTwoWAsync :: Expectation-nestTwoWAsync =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in sort <$> (S.toList . wAsyncly) (do-        x <- s1-        y <- s2-        return (x + y))-    `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])--nestTwoParallel :: Expectation-nestTwoParallel =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in sort <$> (S.toList . parallely) (do-        x <- s1-        y <- s2-        return (x + y))-    `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])--nestTwoWAsyncApp :: Expectation-nestTwoWAsyncApp =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in sort <$> (S.toList . wAsyncly) ((+) <$> s1 <*> s2)-        `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])--nestTwoParallelApp :: Expectation-nestTwoParallelApp =-    let s1 = foldMapWith (<>) return [1..4]-        s2 = foldMapWith (<>) return [5..8]-    in sort <$> (S.toList . parallely) ((+) <$> s1 <*> s2)-        `shouldReturn` sort ([6,7,7,8,8,8,9,9,9,9,10,10,10,11,11,12] :: [Int])--interleaveCheck :: IsStream t-    => (t IO Int -> SerialT IO Int)-    -> (t IO Int -> t IO Int -> t IO Int)-    -> Spec-interleaveCheck t f =-    it "Interleave four" $-        (S.toList . t) ((singleton 0 `f` singleton 1) `f` (singleton 100 `f` singleton 101))-            `shouldReturn` [0, 100, 1, 101]--parallelCheck :: (IsStream t, Monad (t IO))-    => (t IO Int -> SerialT IO Int)-    -> (t IO Int -> t IO Int -> t IO Int)-    -> Spec-parallelCheck t f = do-    it "Parallel ordering left associated" $-        (S.toList . t) (((event 4 `f` event 3) `f` event 2) `f` event 1)-            `shouldReturn` [1..4]--    it "Parallel ordering right associated" $-        (S.toList . t) (event 4 `f` (event 3 `f` (event 2 `f` event 1)))-            `shouldReturn` [1..4]--    where event n = S.yieldM (threadDelay (n * 200000)) >> return n--compose :: (IsStream t, Semigroup (t IO Int))-    => (t IO Int -> SerialT IO Int) -> t IO Int -> ([Int] -> [Int]) -> Spec-compose t z srt = do-    -- XXX these should get covered by the property tests-    it "Compose mempty, mempty" $-        tl (z <> z) `shouldReturn` ([] :: [Int])-    it "Compose empty at the beginning" $-        tl (z <> singleton 1) `shouldReturn` [1]-    it "Compose empty at the end" $-        tl (singleton 1 <> z) `shouldReturn` [1]-    it "Compose two" $-        srt <$> tl (singleton 0 <> singleton 1)-            `shouldReturn` [0, 1]-    it "Compose many" $-        srt <$> tl (forEachWith (<>) [1..100] singleton)-            `shouldReturn` [1..100]--    -- These are not covered by the property tests-    it "Compose three - empty in the middle" $-        srt <$> tl (singleton 0 <> z <> singleton 1)-            `shouldReturn` [0, 1]-    it "Compose left associated" $-        srt <$> tl (((singleton 0 <> singleton 1) <> singleton 2) <> singleton 3)-            `shouldReturn` [0, 1, 2, 3]-    it "Compose right associated" $-        srt <$> tl (singleton 0 <> (singleton 1 <> (singleton 2 <> singleton 3)))-            `shouldReturn` [0, 1, 2, 3]-    it "Compose hierarchical (multiple levels)" $-        srt <$> tl (((singleton 0 <> singleton 1) <> (singleton 2 <> singleton 3))-                <> ((singleton 4 <> singleton 5) <> (singleton 6 <> singleton 7)))-            `shouldReturn` [0..7]-    where tl = S.toList . t--composeAndComposeSimple-    :: ( IsStream t1, Semigroup (t1 IO Int)-       , IsStream t2, Monoid (t2 IO Int), Monad (t2 IO)-#if __GLASGOW_HASKELL__ < 804-       , Semigroup (t2 IO Int)-#endif-       )-    => (t1 IO Int -> SerialT IO Int)-    -> (t2 IO Int -> t2 IO Int)-    -> [[Int]] -> Spec-composeAndComposeSimple t1 t2 answer = do-    let rfold = adapt . t2 . foldMapWith (<>) return-    it "Compose right associated outer expr, right folded inner" $-         (S.toList . t1) (rfold [1,2,3] <> (rfold [4,5,6] <> rfold [7,8,9]))-            `shouldReturn` head answer--    it "Compose left associated outer expr, right folded inner" $-         (S.toList . t1) ((rfold [1,2,3] <> rfold [4,5,6]) <> rfold [7,8,9])-            `shouldReturn` (answer !! 1)--    let lfold xs = adapt $ t2 $ foldl (<>) mempty $ fmap return xs-    it "Compose right associated outer expr, left folded inner" $-         (S.toList . t1) (lfold [1,2,3] <> (lfold [4,5,6] <> lfold [7,8,9]))-            `shouldReturn` (answer !! 2)--    it "Compose left associated outer expr, left folded inner" $-         (S.toList . t1) ((lfold [1,2,3] <> lfold [4,5,6]) <> lfold [7,8,9])-            `shouldReturn` (answer !! 3)--loops-    :: (IsStream t, Semigroup (t IO Int), Monad (t IO))-    => (t IO Int -> t IO Int)-    -> ([Int] -> [Int])-    -> ([Int] -> [Int])-    -> Spec-loops t tsrt hsrt = do-    it "Tail recursive loop" $ (tsrt <$> (S.toList . adapt) (loopTail 0))-            `shouldReturn` [0..3]--    it "Head recursive loop" $ (hsrt <$> (S.toList . adapt) (loopHead 0))-            `shouldReturn` [0..3]--    where-        loopHead x = do-            -- this print line is important for the test (causes a bind)-            S.yieldM $ putStrLn "LoopHead..."-            t $ (if x < 3 then loopHead (x + 1) else nil) <> return x--        loopTail x = do-            -- this print line is important for the test (causes a bind)-            S.yieldM $ putStrLn "LoopTail..."-            t $ return x <> (if x < 3 then loopTail (x + 1) else nil)--bindAndComposeSimple-    :: ( IsStream t1, IsStream t2, Semigroup (t2 IO Int), Monad (t2 IO))-    => (t1 IO Int -> SerialT IO Int)-    -> (t2 IO Int -> t2 IO Int)-    -> Spec-bindAndComposeSimple t1 t2 = do-    -- XXX need a bind in the body of forEachWith instead of a simple return-    it "Compose many (right fold) with bind" $-        (sort <$> (S.toList . t1)-                    (adapt . t2 $ forEachWith (<>) [1..10 :: Int] return))-            `shouldReturn` [1..10]--    it "Compose many (left fold) with bind" $-        let forL xs k = foldl (<>) nil $ fmap k xs-         in (sort <$> (S.toList . t1) (adapt . t2 $ forL [1..10 :: Int] return))-            `shouldReturn` [1..10]--bindAndComposeHierarchy-    :: ( IsStream t1, Monad (t1 IO)-       , IsStream t2, Monad (t2 IO))-    => (t1 IO Int -> SerialT IO Int)-    -> (t2 IO Int -> t2 IO Int)-    -> ([t2 IO Int] -> t2 IO Int)-    -> Spec-bindAndComposeHierarchy t1 t2 g =-    it "Bind and compose nested" $-        (sort <$> (S.toList . t1) bindComposeNested)-            `shouldReturn` (sort (-                   [12, 18]-                <> replicate 3 13-                <> replicate 3 17-                <> replicate 6 14-                <> replicate 6 16-                <> replicate 7 15) :: [Int])--    where--    -- bindComposeNested :: WAsyncT IO Int-    bindComposeNested =-        let c1 = tripleCompose (return 1) (return 2) (return 3)-            c2 = tripleCompose (return 4) (return 5) (return 6)-            c3 = tripleCompose (return 7) (return 8) (return 9)-            b = tripleBind c1 c2 c3--- it seems to be causing a huge space leak in hspec so disabling this for now---            c = tripleCompose b b b---            m = tripleBind c c c---         in m-         in b--    tripleCompose a b c = adapt . t2 $ g [a, b, c]-    tripleBind mx my mz =-        mx >>= \x -> my-           >>= \y -> mz-           >>= \z -> return (x + y + z)--mixedOps :: Spec-mixedOps =-    it "Compose many ops" $-        (sort <$> toListSerial composeMixed)-            `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11-                            ,11,11,11,11,11,11,11,11,12,12,12,12,12,13-                            ] :: [Int])-    where--    composeMixed :: SerialT IO Int-    composeMixed = do-        S.yieldM $ return ()-        S.yieldM $ putStr ""-        let x = 1-        let y = 2-        z <- do-                x1 <- wAsyncly $ return 1 <> return 2-                S.yieldM $ return ()-                S.yieldM $ putStr ""-                y1 <- asyncly $ return 1 <> return 2-                z1 <- do-                    x11 <- return 1 <> return 2-                    y11 <- asyncly $ return 1 <> return 2-                    z11 <- wSerially $ return 1 <> return 2-                    S.yieldM $ return ()-                    S.yieldM $ putStr ""-                    return (x11 + y11 + z11)-                return (x1 + y1 + z1)-        return (x + y + z)--mixedOpsAheadly :: Spec-mixedOpsAheadly =-    it "Compose many ops" $-        (sort <$> toListSerial composeMixed)-            `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11-                            ,11,11,11,11,11,11,11,11,12,12,12,12,12,13-                            ] :: [Int])-    where--    composeMixed :: SerialT IO Int-    composeMixed = do-        S.yieldM $ return ()-        S.yieldM $ putStr ""-        let x = 1-        let y = 2-        z <- do-                x1 <- wAsyncly $ return 1 <> return 2-                S.yieldM $ return ()-                S.yieldM $ putStr ""-                y1 <- aheadly $ return 1 <> return 2-                z1 <- do-                    x11 <- return 1 <> return 2-                    y11 <- aheadly $ return 1 <> return 2-                    z11 <- parallely $ return 1 <> return 2-                    S.yieldM $ return ()-                    S.yieldM $ putStr ""-                    return (x11 + y11 + z11)-                return (x1 + y1 + z1)-        return (x + y + z)
− test/MaxRate.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--import Streamly-import qualified Streamly.Prelude as S-import Control.Concurrent-import Control.Monad-import System.Clock-import Test.Hspec-import System.Random--durationShouldBe :: (Double, Double) -> IO () -> Expectation-durationShouldBe d@(tMin, tMax) action = do-        t0 <- getTime Monotonic-        action-        t1 <- getTime Monotonic-        let t = fromIntegral (toNanoSecs (t1 - t0)) / 1e9-            -- tMax = fromNanoSecs (round $ d*10^9*1.2)-            -- tMin = fromNanoSecs (round $ d*10^9*0.8)-        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' :: IsStream t-    => String-    -> (t IO Int -> SerialT IO Int)-    -> Double-    -> Int-    -> (Double, Double)-    -> (Double, Double)-    -> Spec-measureRate' desc t rval consumerDelay producerDelay dur =-    it (desc <> " rate: " <> show rval-             <> ", consumer latency: " <> show consumerDelay-             <> ", producer latency: " <> show producerDelay)-    $ durationShouldBe dur $-        runStream-            $ (if consumerDelay > 0-              then S.mapM $ \x ->-                        threadDelay (toMicroSecs consumerDelay) >> return x-              else id)-            $ t-            $ maxBuffer  (-1)-            $ maxThreads (-1)-            $ avgRate rval-            $ S.take  (round $ rval * 10)-            $ S.repeatM $ 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-                return 1--measureRate :: IsStream t-    => String-    -> (t IO Int -> SerialT IO Int)-    -> Double-    -> Int-    -> Int-    -> (Double, Double)-    -> Spec-measureRate desc t rval consumerDelay producerDelay dur =-    let d = fromIntegral producerDelay-    in measureRate' desc t rval consumerDelay (d, d) dur--main :: IO ()-main = hspec $ do-    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 = [1, 10, 100, 1000, 10000, 100000, 1000000]-     in describe "asyncly no consumer delay no producer delay" $-            forM_ rates (\r -> measureRate "asyncly" asyncly r 0 0 range)--    -- XXX try staggering the dispatches to achieve higher rates-    let rates = [1, 10, 100, 1000, 10000, 25000]-     in describe "asyncly no consumer delay and 1 sec producer delay" $-            forM_ rates (\r -> measureRate "asyncly" asyncly 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, 1000, 10000, 25000]-     in describe "asyncly no consumer delay and variable producer delay" $-            forM_ rates $ \r ->-                measureRate' "asyncly" asyncly r 0 (0.1, 3) range--    let rates = [1, 10, 100, 1000, 10000, 100000, 1000000]-     in describe "wAsyncly no consumer delay no producer delay" $-            forM_ rates (\r -> measureRate "wAsyncly" wAsyncly r 0 0 range)--    let rates = [1, 10, 100, 1000, 10000, 25000]-     in describe "wAsyncly no consumer delay and 1 sec producer delay" $-            forM_ rates (\r -> measureRate "wAsyncly" wAsyncly r 0 1 range)--    let rates = [1, 10, 100, 1000, 10000, 100000, 1000000]-     in describe "aheadly no consumer delay no producer delay" $-            forM_ rates (\r -> measureRate "aheadly" aheadly 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 = [1, 10, 100, 1000, 10000, 12500]-     in describe "aheadly no consumer delay and 1 sec producer delay" $-            forM_ rates (\r -> measureRate "aheadly" aheadly r 0 1 range)--    describe "asyncly with 1 sec producer delay and some consumer delay" $ do-        -- ideally it should take 10 x 1 + 1 seconds-        forM_ [1] (\r -> measureRate "asyncly" asyncly r 1 1 (11, 16))-        -- ideally it should take 10 x 2 + 1 seconds-        forM_ [1] (\r -> measureRate "asyncly" asyncly r 2 1 (21, 23))-        -- ideally it should take 10 x 3 + 1 seconds-        forM_ [1] (\r -> measureRate "asyncly" asyncly r 3 1 (31, 33))--    describe "aheadly with 1 sec producer delay and some consumer delay" $ do-        forM_ [1] (\r -> measureRate "aheadly" aheadly r 1 1 (11, 16))-        forM_ [1] (\r -> measureRate "aheadly" aheadly r 2 1 (21, 23))-        forM_ [1] (\r -> measureRate "aheadly" aheadly r 3 1 (31, 33))
− test/Prop.hs 
@@ -1,1003 +0,0 @@-{-# LANGUAGE CPP #-}--module Main (main) where--import Control.Applicative (ZipList(..))-import Control.Concurrent (MVar, takeMVar, putMVar, newEmptyMVar)-import Control.Exception-       (BlockedIndefinitelyOnMVar(..), catches,-        BlockedIndefinitelyOnSTM(..), Handler(..))-import Control.Monad (when, forM_, replicateM, replicateM_)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Function ((&))-import Data.IORef (readIORef, modifyIORef, newIORef)-import Data.List-       (sort, foldl', scanl', findIndices, findIndex, elemIndices,-        elemIndex, find, intersperse, foldl1', (\\))-import Data.Maybe (mapMaybe)-import GHC.Word (Word8)--import Test.Hspec.QuickCheck-import Test.QuickCheck (counterexample, Property, withMaxSuccess)-import Test.QuickCheck.Monadic (run, monadicIO, monitor, assert, PropertyM)--import Test.Hspec as H--import Streamly-import Streamly.Prelude ((.:), nil)-import qualified Streamly.Prelude as S---- Coverage build takes too long with default number of tests-maxTestCount :: Int-#ifdef DEVBUILD-maxTestCount = 100-#else-maxTestCount = 10-#endif--singleton :: IsStream t => a -> t m a-singleton a = a .: nil--sortEq :: Ord a => [a] -> [a] -> Bool-sortEq a b = sort a == sort b--equals-    :: (Show a, Monad m)-    => (a -> a -> Bool) -> a -> a -> PropertyM m ()-equals eq stream list = do-    when (not $ stream `eq` list) $-        monitor-            (counterexample $-             "stream " <> show stream-             <> "\nlist   " <> show list-            )-    assert (stream `eq` list)--listEquals-    :: (Show a, Eq a, MonadIO m)-    => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()-listEquals eq stream list = do-    when (not $ stream `eq` list) $ liftIO $ putStrLn $-                  "stream " <> show stream-             <> "\nlist   " <> show list-             <> "\nstream \\\\ list " <> show (stream \\ list)-             <> "\nlist \\\\ stream " <> show (list \\ stream)-    when (not $ stream `eq` list) $-        monitor-            (counterexample $-                  "stream " <> show stream-             <> "\nlist   " <> show list-             <> "\nstream \\\\ list " <> show (stream \\ list)-             <> "\nlist \\\\ stream " <> show (list \\ stream)-             )-    assert (stream `eq` list)--constructWithReplicateM-    :: IsStream t-    => (t IO Int -> SerialT IO Int)-    -> Word8-    -> Property-constructWithReplicateM op len = withMaxSuccess maxTestCount $-    monadicIO $ do-        let x = return (1 :: Int)-        stream <- run $ (S.toList . op) (S.replicateM (fromIntegral len) x)-        list <- run $ replicateM (fromIntegral len) x-        listEquals (==) stream list--transformFromList-    :: (Eq b, Show b) =>-       ([a] -> t IO a)-    -> ([b] -> [b] -> Bool)-    -> ([a] -> [b])-    -> (t IO a -> SerialT IO b)-    -> [a]-    -> Property-transformFromList constr eq listOp op a =-    monadicIO $ do-        stream <- run ((S.toList . op) (constr a))-        let list = listOp a-        listEquals eq stream list--mvarExcHandler :: String -> BlockedIndefinitelyOnMVar -> IO ()-mvarExcHandler label BlockedIndefinitelyOnMVar =-    error $ label <> " " <> "BlockedIndefinitelyOnMVar\n"--stmExcHandler :: String -> BlockedIndefinitelyOnSTM -> IO ()-stmExcHandler label BlockedIndefinitelyOnSTM =-    error $ label <> " " <> "BlockedIndefinitelyOnSTM\n"--dbgMVar :: String -> IO () -> IO ()-dbgMVar label action =-    action `catches` [ Handler (mvarExcHandler label)-                     , Handler (stmExcHandler label)-                     ]---- | first n actions takeMVar and the last action performs putMVar n times-mvarSequenceOp :: MVar () -> Word8 -> Word8 -> IO Word8-mvarSequenceOp mv n x = do-    let msg = show x <> "/" <> show n-    if x < n-    then dbgMVar ("take mvarSequenceOp " <> msg) (takeMVar mv) >>  return x-    else dbgMVar ("put mvarSequenceOp" <> msg)-            (replicateM_ (fromIntegral n) (putMVar mv ())) >> return x--concurrentMapM-    :: ([Word8] -> t IO Word8)-    -> ([Word8] -> [Word8] -> Bool)-    -> (Word8 -> MVar () -> t IO Word8 -> SerialT IO Word8)-    -> Word8-    -> Property-concurrentMapM constr eq op n =-    monadicIO $ do-        let list = [0..n]-        stream <- run $ do-            mv <- newEmptyMVar :: IO (MVar ())-            (S.toList . op n mv) (constr list)-        listEquals eq stream list--concurrentFromFoldable-    :: IsStream t-    => ([Word8] -> [Word8] -> Bool)-    -> (t IO Word8 -> SerialT IO Word8)-    -> Word8-    -> Property-concurrentFromFoldable eq op n =-    monadicIO $ do-        let list = [0..n]-        stream <- run $ do-            mv <- newEmptyMVar :: IO (MVar ())-            (S.toList . op) (S.fromFoldableM (fmap (mvarSequenceOp mv n) list))-        listEquals eq stream list--sourceUnfoldrM :: IsStream t => MVar () -> Word8 -> t IO Word8-sourceUnfoldrM mv n = S.unfoldrM step 0-    where-    -- argument must be integer to avoid overflow of word8 at 255-    step :: Int -> IO (Maybe (Word8, Int))-    step cnt = do-        let msg = show cnt <> "/" <> show n-        if cnt > fromIntegral n-        then return Nothing-        else do-            dbgMVar ("put sourceUnfoldrM " <> msg) (putMVar mv ())-            return (Just (fromIntegral cnt, cnt + 1))---- Note that this test is not guaranteed to succeed, because there is no--- guarantee of parallelism in case of Async/Ahead streams.-concurrentUnfoldrM-    :: IsStream t-    => ([Word8] -> [Word8] -> Bool)-    -> (t IO Word8 -> SerialT IO Word8)-    -> Word8-    -> Property-concurrentUnfoldrM eq op n =-    monadicIO $ do-        -- XXX we should test empty list case as well-        let list = [0..n]-        stream <- run $ do-            -- putStrLn $ "concurrentUnfoldrM: " <> show n-            mv <- newEmptyMVar :: IO (MVar ())-            cnt <- newIORef 0-            -- since unfoldr happens in parallel with the stream processing we-            -- can do two takeMVar in one iteration. If it is not parallel then-            -- this will not work and the test will fail.-            S.toList $ do-                x <- op (sourceUnfoldrM mv n)-                -- results may not be yielded in order, in case of-                -- Async/WAsync/Parallel. So we use an increasing count-                -- instead.-                i <- S.yieldM $ readIORef cnt-                S.yieldM $ modifyIORef cnt (+1)-                let msg = show i <> "/" <> show n-                S.yieldM $-                    when (even i) $ do-                        dbgMVar ("first take concurrentUnfoldrM " <> msg)-                                (takeMVar mv)-                        when (n > i) $-                            dbgMVar ("second take concurrentUnfoldrM " <> msg)-                                     (takeMVar mv)-                return x-        listEquals eq stream list--concurrentApplication :: IsStream t-    => ([Word8] -> [Word8] -> Bool)-    -> (t IO Word8 -> SerialT IO Word8)-    -> Word8-    -> Property-concurrentApplication eq t n = withMaxSuccess maxTestCount $-    monadicIO $ do-        -- XXX we should test empty list case as well-        let list = [0..n]-        stream <- run $ do-            -- putStrLn $ "concurrentApplication: " <> show n-            mv <- newEmptyMVar :: IO (MVar ())-            -- since unfoldr happens in parallel with the stream processing we-            -- can do two takeMVar in one iteration. If it is not parallel then-            -- this will not work and the test will fail.-            (S.toList . t) $-                sourceUnfoldrM mv n |&-                    S.mapM (\x -> do-                        let msg = show x <> "/" <> show n-                        when (even x) $ do-                            dbgMVar ("first take concurrentApp " <> msg)-                                    (takeMVar mv)-                            when (n > x) $-                                dbgMVar ("second take concurrentApp " <> msg)-                                         (takeMVar mv)-                        return x)-        listEquals eq stream list--sourceUnfoldrM1 :: IsStream t => Word8 -> t IO Word8-sourceUnfoldrM1 n = S.unfoldrM step 0-    where-    -- argument must be integer to avoid overflow of word8 at 255-    step :: Int -> IO (Maybe (Word8, Int))-    step cnt =-        if cnt > fromIntegral n-        then return Nothing-        else return (Just (fromIntegral cnt, cnt + 1))--concurrentFoldlApplication :: Word8 -> Property-concurrentFoldlApplication n =-    monadicIO $ do-        -- XXX we should test empty list case as well-        let list = [0..n]-        stream <- run $-            sourceUnfoldrM1 n |&. S.foldlM' (\xs x -> return (x : xs)) []-        listEquals (==) (reverse stream) list--concurrentFoldrApplication :: Word8 -> Property-concurrentFoldrApplication n =-    monadicIO $ do-        -- XXX we should test empty list case as well-        let list = [0..n]-        stream <- run $-            sourceUnfoldrM1 n |&. S.foldrM (\x xs -> return (x : xs)) []-        listEquals (==) stream list--transformCombineFromList-    :: Semigroup (t IO Int)-    => ([Int] -> t IO Int)-    -> ([Int] -> [Int] -> Bool)-    -> ([Int] -> [Int])-    -> (t IO Int -> SerialT IO Int)-    -> (t IO Int -> t IO Int)-    -> [Int]-    -> [Int]-    -> [Int]-    -> Property-transformCombineFromList constr eq listOp t op a b c =-    withMaxSuccess maxTestCount $-        monadicIO $ do-            stream <- run ((S.toList . t) $-                constr a <> op (constr b <> constr c))-            let list = a <> listOp (b <> c)-            listEquals eq stream list--foldFromList-    :: ([Int] -> t IO Int)-    -> (t IO Int -> SerialT IO Int)-    -> ([Int] -> [Int] -> Bool)-    -> [Int]-    -> Property-foldFromList constr op eq = transformFromList constr eq id op--eliminateOp-    :: (Show a, Eq a)-    => ([s] -> t IO s)-    -> ([s] -> a)-    -> (t IO s -> IO a)-    -> [s]-    -> Property-eliminateOp constr listOp op a =-    monadicIO $ do-        stream <- run $ op (constr a)-        let list = listOp a-        equals (==) stream list--elemOp-    :: ([Word8] -> t IO Word8)-    -> (t IO Word8 -> SerialT IO Word8)-    -> (Word8 -> SerialT IO Word8 -> IO Bool)-    -> (Word8 -> [Word8] -> Bool)-    -> (Word8, [Word8])-    -> Property-elemOp constr op streamOp listOp (x, xs) =-    monadicIO $ do-        stream <- run $ (streamOp x . op) (constr xs)-        let list = listOp x xs-        equals (==) stream list--functorOps-    :: Functor (t IO)-    => ([Int] -> t IO Int)-    -> String-    -> ([Int] -> [Int] -> Bool)-    -> (t IO Int -> SerialT IO Int)-    -> Spec-functorOps constr desc eq t = do-    prop (desc <> " id") $ transformFromList constr eq id t-    prop (desc <> " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . fmap (+1)--transformOps-    :: IsStream t-    => ([Int] -> t IO Int)-    -> String-    -> ([Int] -> [Int] -> Bool)-    -> (t IO Int -> SerialT IO Int)-    -> Spec-transformOps constr desc eq t = do-    let transform = transformFromList constr eq-    -- Filtering-    prop (desc <> " filter False") $-        transform (filter (const False)) $ t . S.filter (const False)-    prop (desc <> " filter True") $-        transform (filter (const True)) $ t . S.filter (const True)-    prop (desc <> " filter even") $-        transform (filter even) $ t . S.filter even--    prop (desc <> " take maxBound") $-        transform (take maxBound) $ t . S.take maxBound-    prop (desc <> " take 0") $ transform (take 0) $ t . S.take 0-    prop (desc <> " take 1") $ transform (take 1) $ t . S.take 1-    prop (desc <> " take 10") $ transform (take 10) $ t . S.take 10--    prop (desc <> " takeWhile True") $-        transform (takeWhile (const True)) $ t . S.takeWhile (const True)-    prop (desc <> " takeWhile False") $-        transform (takeWhile (const False)) $ t . S.takeWhile (const False)-    prop (desc <> " takeWhile > 0") $-        transform (takeWhile (> 0)) $ t . S.takeWhile (> 0)--    let f x = if odd x then Just (x + 100) else Nothing-    prop (desc <> " mapMaybe") $ transform (mapMaybe f) $ t . S.mapMaybe f--    prop (desc <> " drop maxBound") $-        transform (drop maxBound) $ t . S.drop maxBound-    prop (desc <> " drop 0") $ transform (drop 0) $ t . S.drop 0-    prop (desc <> " drop 1") $ transform (drop 1) $ t . S.drop 1-    prop (desc <> " drop 10") $ transform (drop 10) $ t . S.drop 10--    prop (desc <> " dropWhile True") $-        transform (dropWhile (const True)) $ t . S.dropWhile (const True)-    prop (desc <> " dropWhile False") $-        transform (dropWhile (const False)) $ t . S.dropWhile (const False)-    prop (desc <> " dropWhile > 0") $-        transform (dropWhile (> 0)) $ t . S.dropWhile (> 0)-    prop (desc <> " scan") $ transform (scanl' (+) 0) $ t . S.scanl' (+) 0-    prop (desc <> " reverse") $ transform reverse $ t . S.reverse--    prop (desc <> " findIndices") $ transform (findIndices odd) $ t . S.findIndices odd-    prop (desc <> " elemIndices") $ transform (elemIndices 3) $ t . S.elemIndices 3--    prop (desc <> " intersperseM") $ transform (intersperse 3) $ t . S.intersperseM (return 3)---concurrentOps-    :: IsStream t-    => ([Word8] -> t IO Word8)-    -> String-    -> ([Word8] -> [Word8] -> Bool)-    -> (t IO Word8 -> SerialT IO Word8)-    -> Spec-concurrentOps constr desc eq t = do-    let prop1 d p = prop d $ withMaxSuccess maxTestCount p--    prop1 (desc <> " fromFoldableM") $ concurrentFromFoldable eq t-    prop1 (desc <> " unfoldrM") $ concurrentUnfoldrM eq t-    -- we pass it the length of the stream n and an mvar mv.-    -- The stream is [0..n]. The threads communicate in such a way that the-    -- actions coming first in the stream are dependent on the last action. So-    -- if the stream is not processed concurrently it will block forever.-    -- Note that if the size of the stream is bigger than the thread limit-    -- then it will block even if it is concurrent.-    prop1 (desc <> " mapM") $-        concurrentMapM constr eq $ \n mv stream ->-            t $ S.mapM (mvarSequenceOp mv n) stream---- XXX add tests for MonadReader and MonadError etc. In case an SVar is--- accidentally passed through them.-transformCombineOpsCommon-    :: (IsStream t, Semigroup (t IO Int))-    => ([Int] -> t IO Int)-    -> String-    -> ([Int] -> [Int] -> Bool)-    -> (t IO Int -> SerialT IO Int)-    -> Spec-transformCombineOpsCommon constr desc eq t = do-    let transform = transformCombineFromList constr eq-    -- Filtering-    prop (desc <> " filter False") $-        transform (filter (const False)) t (S.filter (const False))-    prop (desc <> " filter True") $-        transform (filter (const True)) t (S.filter (const True))-    prop (desc <> " filter even") $-        transform (filter even) t (S.filter even)--    prop (desc <> " filterM False") $-        transform (filter (const False)) t (S.filterM (const $ return False))-    prop (desc <> " filterM True") $-        transform (filter (const True)) t (S.filterM (const $ return True))-    prop (desc <> " filterM even") $-        transform (filter even) t (S.filterM (return . even))--    prop (desc <> " take maxBound") $-        transform (take maxBound) t (S.take maxBound)-    prop (desc <> " take 0") $ transform (take 0) t (S.take 0)--    prop (desc <> " takeWhile True") $-        transform (takeWhile (const True)) t (S.takeWhile (const True))-    prop (desc <> " takeWhile False") $-        transform (takeWhile (const False)) t (S.takeWhile (const False))--    prop (desc <> " takeWhileM True") $-        transform (takeWhile (const True)) t (S.takeWhileM (const $ return True))-    prop (desc <> " takeWhileM False") $-        transform (takeWhile (const False)) t (S.takeWhileM (const $ return False))--    prop (desc <> " drop maxBound") $-        transform (drop maxBound) t (S.drop maxBound)-    prop (desc <> " drop 0") $ transform (drop 0) t (S.drop 0)--    prop (desc <> " dropWhile True") $-        transform (dropWhile (const True)) t (S.dropWhile (const True))-    prop (desc <> " dropWhile False") $-        transform (dropWhile (const False)) t (S.dropWhile (const False))--    prop (desc <> " dropWhileM True") $-        transform (dropWhile (const True)) t (S.dropWhileM (const $ return True))-    prop (desc <> " dropWhileM False") $-        transform (dropWhile (const False)) t (S.dropWhileM (const $ return False))--    prop (desc <> " mapM (+1)") $-        transform (fmap (+1)) t (S.mapM (\x -> return (x + 1)))--    prop (desc <> " scan") $ transform (scanl' (flip const) 0) t-                                       (S.scanl' (flip const) 0)-    prop (desc <> " scanlM'") $ transform (scanl' (flip const) 0) t-                                       (S.scanlM' (\_ a -> return a) 0)-    prop (desc <> " reverse") $ transform reverse t S.reverse--    prop (desc <> " intersperseM") $-        transform (intersperse 3) t (S.intersperseM $ return 3)--transformCombineOpsOrdered-    :: (IsStream t, Semigroup (t IO Int))-    => ([Int] -> t IO Int)-    -> String-    -> ([Int] -> [Int] -> Bool)-    -> (t IO Int -> SerialT IO Int)-    -> Spec-transformCombineOpsOrdered constr desc eq t = do-    let transform = transformCombineFromList constr eq-    -- Filtering-    prop (desc <> " take 1") $ transform (take 1) t (S.take 1)-#ifdef DEVBUILD-    prop (desc <> " take 2") $ transform (take 2) t (S.take 2)-    prop (desc <> " take 3") $ transform (take 3) t (S.take 3)-    prop (desc <> " take 4") $ transform (take 4) t (S.take 4)-    prop (desc <> " take 5") $ transform (take 5) t (S.take 5)-#endif-    prop (desc <> " take 10") $ transform (take 10) t (S.take 10)--    prop (desc <> " takeWhile > 0") $-        transform (takeWhile (> 0)) t (S.takeWhile (> 0))--    prop (desc <> " drop 1") $ transform (drop 1) t (S.drop 1)-    prop (desc <> " drop 10") $ transform (drop 10) t (S.drop 10)--    prop (desc <> " dropWhile > 0") $-        transform (dropWhile (> 0)) t (S.dropWhile (> 0))-    prop (desc <> " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)--    -- XXX this does not fail when the SVar is shared, need to fix.-    prop (desc <> " concurrent application") $-        transform (& fmap (+1)) t (|& S.map (+1))--    prop (desc <> " findIndices") $-        transform (findIndices odd) t (S.findIndices odd)-    prop (desc <> " elemIndices") $-        transform (elemIndices 0) t (S.elemIndices 0)--wrapMaybe :: ([a1] -> a2) -> [a1] -> Maybe a2-wrapMaybe f x = if null x then Nothing else Just (f x)--eliminationOps-    :: ([Int] -> t IO Int)-    -> String-    -> (t IO Int -> SerialT IO Int)-    -> Spec-eliminationOps constr desc t = do-    -- Elimination-    prop (desc <> " null") $ eliminateOp constr null $ S.null . t-    prop (desc <> " foldl'") $-        eliminateOp constr (foldl' (+) 0) $ S.foldl' (+) 0 . t-    prop (desc <> " foldl1'") $-        eliminateOp constr (wrapMaybe $ foldl1' (+)) $ S.foldl1' (+) . t-    prop (desc <> " foldr1") $-        eliminateOp constr (wrapMaybe $ foldr1 (+)) $ S.foldr1 (+) . t-    prop (desc <> " all") $ eliminateOp constr (all even) $ S.all even . t-    prop (desc <> " any") $ eliminateOp constr (any even) $ S.any even . t-    prop (desc <> " and") $ eliminateOp constr (and . fmap (> 0)) $-        (S.and . S.map (> 0)) . t-    prop (desc <> " or") $ eliminateOp constr (or . fmap (> 0)) $-        (S.or . S.map (> 0)) . t-    prop (desc <> " length") $ eliminateOp constr length $ S.length . t-    prop (desc <> " sum") $ eliminateOp constr sum $ S.sum . t-    prop (desc <> " product") $ eliminateOp constr product $ S.product . t--    prop (desc <> " maximum") $ eliminateOp constr (wrapMaybe maximum) $ S.maximum . t-    prop (desc <> " minimum") $ eliminateOp constr (wrapMaybe minimum) $ S.minimum . t--    prop (desc <> " findIndex") $ eliminateOp constr (findIndex odd) $ S.findIndex odd . t-    prop (desc <> " elemIndex") $ eliminateOp constr (elemIndex 3) $ S.elemIndex 3 . t--    prop (desc <> " find") $ eliminateOp constr (find even) $ S.find even . t-    prop (desc <> " lookup") $-        eliminateOp constr (lookup 3 . flip zip [1..]) $-            S.lookup 3 . S.zipWith (\a b -> (b, a)) (S.fromList [(1::Int)..]) . t---- head/tail/last may depend on the order in case of parallel streams--- so we test these only for serial streams.-serialEliminationOps-    :: ([Int] -> t IO Int)-    -> String-    -> (t IO Int -> SerialT IO Int)-    -> Spec-serialEliminationOps constr desc t = do-    prop (desc <> " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t-    prop (desc <> " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do-        r <- S.tail (t x)-        case r of-            Nothing -> return Nothing-            Just s -> Just <$> S.toList s-    prop (desc <> " last") $ eliminateOp constr (wrapMaybe last) $ S.last . t-    prop (desc <> " init") $ eliminateOp constr (wrapMaybe init) $ \x -> do-        r <- S.init (t x)-        case r of-            Nothing -> return Nothing-            Just s -> Just <$> S.toList s--transformOpsWord8-    :: ([Word8] -> t IO Word8)-    -> String-    -> (t IO Word8 -> SerialT IO Word8)-    -> Spec-transformOpsWord8 constr desc t = do-    prop (desc <> " elem") $ elemOp constr t S.elem elem-    prop (desc <> " elem") $ elemOp constr t S.notElem notElem---- 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))-    => String-    -> ([Int] -> [Int] -> Bool)-    -> (t IO Int -> SerialT IO Int)-    -> Spec-semigroupOps desc eq t = do-    prop (desc <> " <>") $ foldFromList (foldMapWith (<>) singleton) t eq-    prop (desc <> " mappend") $ foldFromList (foldMapWith mappend singleton) t eq--applicativeOps-    :: Applicative (t IO)-    => ([Int] -> t IO Int)-    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)-    -> (t IO (Int, Int) -> SerialT IO (Int, Int))-    -> ([Int], [Int])-    -> Property-applicativeOps constr eq t (a, b) = withMaxSuccess maxTestCount $-    monadicIO $ do-        stream <- run ((S.toList . t) ((,) <$> constr a <*> constr b))-        let list = (,) <$> a <*> b-        listEquals eq stream list--zipApplicative-    :: (IsStream t, Applicative (t IO))-    => ([Int] -> t IO Int)-    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)-    -> (t IO (Int, Int) -> SerialT IO (Int, Int))-    -> ([Int], [Int])-    -> Property-zipApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $-    monadicIO $ do-        stream1 <- run ((S.toList . t) ((,) <$> constr a <*> constr b))-        stream2 <- run ((S.toList . t) (pure (,) <*> constr a <*> constr b))-        stream3 <- run ((S.toList . t) (S.zipWith (,) (constr a) (constr b)))-        let list = getZipList $ (,) <$> ZipList a <*> ZipList b-        listEquals eq stream1 list-        listEquals eq stream2 list-        listEquals eq stream3 list--zipMonadic-    :: IsStream t-    => ([Int] -> t IO Int)-    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)-    -> (t IO (Int, Int) -> SerialT IO (Int, Int))-    -> ([Int], [Int])-    -> Property-zipMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $-    monadicIO $ do-        stream1 <--            run-                ((S.toList . t)-                     (S.zipWithM (curry return) (constr a) (constr b)))-        let list = getZipList $ (,) <$> ZipList a <*> ZipList b-        listEquals eq stream1 list--zipAsyncMonadic-    :: IsStream t-    => ([Int] -> t IO Int)-    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)-    -> (t IO (Int, Int) -> SerialT IO (Int, Int))-    -> ([Int], [Int])-    -> Property-zipAsyncMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $-    monadicIO $ do-        stream1 <--            run-                ((S.toList . t)-                     (S.zipWithM (curry return) (constr a) (constr b)))-        stream2 <--            run-                ((S.toList . t)-                     (S.zipAsyncWithM (curry return) (constr a) (constr b)))-        let list = getZipList $ (,) <$> ZipList a <*> ZipList b-        listEquals eq stream1 list-        listEquals eq stream2 list--monadThen-    :: Monad (t IO)-    => ([Int] -> t IO Int)-    -> ([Int] -> [Int] -> Bool)-    -> (t IO Int -> SerialT IO Int)-    -> ([Int], [Int])-    -> Property-monadThen constr eq t (a, b) = withMaxSuccess maxTestCount $ monadicIO $ do-    stream <- run ((S.toList . t) (constr a >> constr b))-    let list = a >> b-    listEquals eq stream list--monadBind-    :: Monad (t IO)-    => ([Int] -> t IO Int)-    -> ([Int] -> [Int] -> Bool)-    -> (t IO Int -> SerialT IO Int)-    -> ([Int], [Int])-    -> Property-monadBind constr eq t (a, b) = withMaxSuccess maxTestCount $-    monadicIO $ do-        stream <--            run-                ((S.toList . t)-                     (constr a >>= \x -> (+ x) <$> constr b))-        let list = a >>= \x -> (+ x) <$> b-        listEquals eq stream list--constructWithIterate :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec-constructWithIterate t = do-    it "iterate" $-        (S.toList . t . S.take 100) (S.iterate (+ 1) (0 :: Int))-        `shouldReturn` take 100 (iterate (+ 1) 0)-    it "iterateM" $ do-        let addM y = return (y + 1)-        S.toList . t . S.take 100 $ S.iterateM addM (0 :: Int)-        `shouldReturn` take 100 (iterate (+ 1) 0)--main :: IO ()-main = hspec-    $ H.parallel-#ifdef COVERAGE_BUILD-    $ modifyMaxSuccess (const 10)-#endif-    $ do-    let folded :: IsStream t => [a] -> t IO a-        folded = serially . (\xs ->-            case xs of-                [x] -> return x -- singleton stream case-                _ -> foldMapWith (<>) return xs-            )--    let makeOps t =-            [ ("default", t)-#ifndef COVERAGE_BUILD-            , ("rate AvgRate 10000", t . avgRate 10000)-            , ("rate Nothing", t . rate Nothing)-            , ("maxBuffer 0", t . maxBuffer 0)-            , ("maxBuffer 1", t . maxBuffer 1)-            , ("maxThreads 0", t . maxThreads 0)-            , ("maxThreads 1", t . maxThreads 1)-            , ("maxThreads -1", t . maxThreads (-1))-#endif-            ]--    let mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)-    let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec-        serialOps spec = mapOps spec $ makeOps serially-#ifndef COVERAGE_BUILD-            <> [("rate AvgRate 0.00000001", serially . avgRate 0.00000001)]-            <> [("maxBuffer -1", serially . maxBuffer (-1))]-#endif-    let wSerialOps :: IsStream t => ((WSerialT IO a -> t IO a) -> Spec) -> Spec-        wSerialOps spec = mapOps spec $ makeOps wSerially-#ifndef COVERAGE_BUILD-            <> [("rate AvgRate 0.00000001", wSerially . avgRate 0.00000001)]-            <> [("maxBuffer (-1)", wSerially . maxBuffer (-1))]-#endif-    let asyncOps :: IsStream t => ((AsyncT IO a -> t IO a) -> Spec) -> Spec-        asyncOps spec = mapOps spec $ makeOps asyncly-#ifndef COVERAGE_BUILD-            <> [("maxBuffer (-1)", asyncly . maxBuffer (-1))]-#endif-    let wAsyncOps :: IsStream t => ((WAsyncT IO a -> t IO a) -> Spec) -> Spec-        wAsyncOps spec = mapOps spec $ makeOps wAsyncly-#ifndef COVERAGE_BUILD-            <> [("maxBuffer (-1)", wAsyncly . maxBuffer (-1))]-#endif-    let aheadOps :: IsStream t => ((AheadT IO a -> t IO a) -> Spec) -> Spec-        aheadOps spec = mapOps spec $ makeOps aheadly-#ifndef COVERAGE_BUILD-              <> [("maxBuffer (-1)", aheadly . maxBuffer (-1))]-#endif-    let parallelOps :: IsStream t => ((ParallelT IO a -> t IO a) -> Spec) -> Spec-        parallelOps spec = mapOps spec $ makeOps parallely-#ifndef COVERAGE_BUILD-            <> [("rate AvgRate 0.00000001", parallely . avgRate 0.00000001)]-            <> [("maxBuffer (-1)", parallely . maxBuffer (-1))]-#endif-    let zipSerialOps :: IsStream t => ((ZipSerialM IO a -> t IO a) -> Spec) -> Spec-        zipSerialOps spec = mapOps spec $ makeOps zipSerially-#ifndef COVERAGE_BUILD-            <> [("rate AvgRate 0.00000001", zipSerially . avgRate 0.00000001)]-            <> [("maxBuffer (-1)", zipSerially . maxBuffer (-1))]-#endif-    -- Note, the "pure" of applicative Zip streams generates and infinite-    -- stream and therefore maxBuffer (-1) must not be used for that case.-    let zipAsyncOps :: IsStream t => ((ZipAsyncM IO a -> t IO a) -> Spec) -> Spec-        zipAsyncOps spec = mapOps spec $ makeOps zipAsyncly--    describe "Construction" $ do-        serialOps   $ prop "serially replicateM" . constructWithReplicateM-        wSerialOps  $ prop "wSerially replicateM" . constructWithReplicateM-        aheadOps    $ prop "aheadly replicateM" . constructWithReplicateM-        asyncOps    $ prop "asyncly replicateM" . constructWithReplicateM-        wAsyncOps   $ prop "wAsyncly replicateM" . constructWithReplicateM-        parallelOps $ prop "parallely replicateM" .  constructWithReplicateM-        -- XXX test for all types of streams-        constructWithIterate serially--    describe "Functor operations" $ do-        serialOps    $ functorOps S.fromFoldable "serially" (==)-        serialOps    $ functorOps folded "serially folded" (==)-        wSerialOps   $ functorOps S.fromFoldable "wSerially" (==)-        wSerialOps   $ functorOps folded "wSerially folded" (==)-        aheadOps     $ functorOps S.fromFoldable "aheadly" (==)-        aheadOps     $ functorOps folded "aheadly folded" (==)-        asyncOps     $ functorOps S.fromFoldable "asyncly" sortEq-        asyncOps     $ functorOps folded "asyncly folded" sortEq-        wAsyncOps    $ functorOps S.fromFoldable "wAsyncly" sortEq-        wAsyncOps    $ functorOps folded "wAsyncly folded" sortEq-        parallelOps  $ functorOps S.fromFoldable "parallely" sortEq-        parallelOps  $ functorOps folded "parallely folded" sortEq-        zipSerialOps $ functorOps S.fromFoldable "zipSerially" (==)-        zipSerialOps $ functorOps folded "zipSerially folded" (==)-        zipAsyncOps  $ functorOps S.fromFoldable "zipAsyncly" (==)-        zipAsyncOps  $ functorOps folded "zipAsyncly folded" (==)--    describe "Semigroup operations" $ do-        serialOps    $ semigroupOps "serially" (==)-        wSerialOps   $ semigroupOps "wSerially" (==)-        aheadOps     $ semigroupOps "aheadly" (==)-        asyncOps     $ semigroupOps "asyncly" sortEq-        wAsyncOps    $ semigroupOps "wAsyncly" sortEq-        parallelOps  $ semigroupOps "parallely" sortEq-        zipSerialOps $ semigroupOps "zipSerially" (==)-        zipAsyncOps  $ semigroupOps "zipAsyncly" (==)--    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   $ prop "serially applicative" . applicativeOps S.fromFoldable (==)-        serialOps   $ prop "serially applicative folded" . applicativeOps folded (==)-        wSerialOps  $ prop "wSerially applicative" . applicativeOps S.fromFoldable sortEq-        wSerialOps  $ prop "wSerially applicative folded" . applicativeOps folded sortEq-        aheadOps    $ prop "aheadly applicative" . applicativeOps S.fromFoldable (==)-        aheadOps    $ prop "aheadly applicative folded" . applicativeOps folded (==)-        asyncOps    $ prop "asyncly applicative" . applicativeOps S.fromFoldable sortEq-        asyncOps    $ prop "asyncly applicative folded" . applicativeOps folded sortEq-        wAsyncOps   $ prop "wAsyncly applicative" . applicativeOps S.fromFoldable sortEq-        wAsyncOps   $ prop "wAsyncly applicative folded" . applicativeOps folded sortEq-        parallelOps $ prop "parallely applicative folded" . applicativeOps folded sortEq--    describe "Zip operations" $ do-        zipSerialOps $ prop "zipSerially applicative" . zipApplicative S.fromFoldable (==)-        zipSerialOps $ prop "zipSerially applicative folded" . zipApplicative folded (==)-        zipAsyncOps  $ prop "zipAsyncly applicative" . zipApplicative S.fromFoldable (==)-        zipAsyncOps  $ prop "zipAsyncly applicative folded" . zipApplicative folded (==)--        -- 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 folded" . zipMonadic folded (==)-        wSerialOps  $ prop "zip monadic wSerially" . zipMonadic S.fromFoldable (==)-        wSerialOps  $ prop "zip monadic wSerially folded" . zipMonadic folded (==)-        aheadOps    $ prop "zip monadic aheadly" . zipAsyncMonadic S.fromFoldable (==)-        aheadOps    $ prop "zip monadic aheadly folded" . zipAsyncMonadic folded (==)-        asyncOps    $ prop "zip monadic asyncly" . zipAsyncMonadic S.fromFoldable (==)-        asyncOps    $ prop "zip monadic asyncly folded" . zipAsyncMonadic folded (==)-        wAsyncOps   $ prop "zip monadic wAsyncly" . zipAsyncMonadic S.fromFoldable (==)-        wAsyncOps   $ prop "zip monadic wAsyncly folded" . zipAsyncMonadic folded (==)-        parallelOps $ prop "zip monadic parallely" . zipMonadic S.fromFoldable (==)-        parallelOps $ prop "zip monadic parallely folded" . zipMonadic folded (==)--    describe "Monad operations" $ do-        serialOps   $ prop "serially monad then" . monadThen S.fromFoldable (==)-        wSerialOps  $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq-        aheadOps    $ prop "aheadly monad then" . monadThen S.fromFoldable (==)-        asyncOps    $ prop "asyncly monad then" . monadThen S.fromFoldable sortEq-        wAsyncOps   $ prop "wAsyncly monad then" . monadThen S.fromFoldable sortEq-        parallelOps $ prop "parallely monad then" . monadThen S.fromFoldable sortEq--        serialOps   $ prop "serially monad then folded" . monadThen folded (==)-        wSerialOps  $ prop "wSerially monad then folded" . monadThen folded sortEq-        aheadOps    $ prop "aheadly monad then folded" . monadThen folded (==)-        asyncOps    $ prop "asyncly monad then folded" . monadThen folded sortEq-        wAsyncOps   $ prop "wAsyncly monad then folded" . monadThen folded sortEq-        parallelOps $ prop "parallely monad then folded" . monadThen folded sortEq--        serialOps   $ prop "serially monad bind" . monadBind S.fromFoldable (==)-        wSerialOps  $ prop "wSerially monad bind" . monadBind S.fromFoldable sortEq-        aheadOps    $ prop "aheadly monad bind" . monadBind S.fromFoldable (==)-        asyncOps    $ prop "asyncly monad bind" . monadBind S.fromFoldable sortEq-        wAsyncOps   $ prop "wAsyncly monad bind" . monadBind S.fromFoldable sortEq-        parallelOps $ prop "parallely monad bind" . monadBind S.fromFoldable sortEq--        serialOps   $ prop "serially monad bind folded"  . monadBind folded (==)-        wSerialOps  $ prop "wSerially monad bind folded" . monadBind folded sortEq-        aheadOps    $ prop "aheadly monad bind folded"   . monadBind folded (==)-        asyncOps    $ prop "asyncly monad bind folded"   . monadBind folded sortEq-        wAsyncOps   $ prop "wAsyncly monad bind folded"  . monadBind folded sortEq-        parallelOps $ prop "parallely monad bind folded" . monadBind folded sortEq--    describe "Stream transform operations" $ do-        serialOps    $ transformOps S.fromFoldable "serially" (==)-        wSerialOps   $ transformOps S.fromFoldable "wSerially" (==)-        aheadOps     $ transformOps S.fromFoldable "aheadly" (==)-        asyncOps     $ transformOps S.fromFoldable "asyncly" sortEq-        wAsyncOps    $ transformOps S.fromFoldable "wAsyncly" sortEq-        parallelOps  $ transformOps S.fromFoldable "parallely" sortEq-        zipSerialOps $ transformOps S.fromFoldable "zipSerially" (==)-        zipAsyncOps  $ transformOps S.fromFoldable "zipAsyncly" (==)--        serialOps    $ transformOps folded "serially folded" (==)-        wSerialOps   $ transformOps folded "wSerially folded" (==)-        aheadOps     $ transformOps folded "aheadly folded" (==)-        asyncOps     $ transformOps folded "asyncly folded" sortEq-        wAsyncOps    $ transformOps folded "wAsyncly folded" sortEq-        parallelOps  $ transformOps folded "parallely folded" sortEq-        zipSerialOps $ transformOps folded "zipSerially folded" (==)-        zipAsyncOps  $ transformOps folded "zipAsyncly folded" (==)--        serialOps    $ transformOpsWord8 S.fromFoldable "serially"-        wSerialOps   $ transformOpsWord8 S.fromFoldable "wSerially"-        aheadOps     $ transformOpsWord8 S.fromFoldable "aheadly"-        asyncOps     $ transformOpsWord8 S.fromFoldable "asyncly"-        wAsyncOps    $ transformOpsWord8 S.fromFoldable "wAsyncly"-        parallelOps  $ transformOpsWord8 S.fromFoldable "parallely"-        zipSerialOps $ transformOpsWord8 S.fromFoldable "zipSerially"-        zipAsyncOps  $ transformOpsWord8 S.fromFoldable "zipAsyncly"--        serialOps    $ transformOpsWord8 folded "serially folded"-        wSerialOps   $ transformOpsWord8 folded "wSerially folded"-        aheadOps     $ transformOpsWord8 folded "aheadly folded"-        asyncOps     $ transformOpsWord8 folded "asyncly folded"-        wAsyncOps    $ transformOpsWord8 folded "wAsyncly folded"-        parallelOps  $ transformOpsWord8 folded "parallely folded"-        zipSerialOps $ transformOpsWord8 folded "zipSerially folded"-        zipAsyncOps  $ transformOpsWord8 folded "zipAsyncly folded"--    -- These tests won't work with maxBuffer or maxThreads set to 1, so we-    -- exclude those cases from these.-    let mkOps t =-            [ ("default", t)-#ifndef COVERAGE_BUILD-            , ("rate Nothing", t . rate Nothing)-            , ("maxBuffer 0", t . maxBuffer 0)-            , ("maxThreads 0", t . maxThreads 0)-            , ("maxThreads 0", t . maxThreads (-1))-#endif-            ]--    let forOps ops spec = forM_ ops (\(desc, f) -> describe desc $ spec f)-    describe "Stream concurrent operations" $ do-        forOps (mkOps aheadly)   $ concurrentOps S.fromFoldable "aheadly" (==)-        forOps (mkOps asyncly)   $ concurrentOps S.fromFoldable "asyncly" sortEq-        forOps (mkOps wAsyncly)  $ concurrentOps S.fromFoldable "wAsyncly" sortEq-        forOps (mkOps parallely) $ concurrentOps S.fromFoldable "parallely" sortEq--        forOps (mkOps aheadly)   $ concurrentOps folded "aheadly folded" (==)-        forOps (mkOps asyncly)   $ concurrentOps folded "asyncly folded" sortEq-        forOps (mkOps wAsyncly)  $ concurrentOps folded "wAsyncly folded" sortEq-        forOps (mkOps parallely) $ concurrentOps folded "parallely folded" sortEq--    describe "Concurrent application" $ do-        serialOps $ prop "serial" . concurrentApplication (==)-        asyncOps $ prop "async" . concurrentApplication sortEq-        aheadOps $ prop "ahead" . concurrentApplication (==)-        parallelOps $ prop "parallel" . concurrentApplication sortEq--        prop "concurrent foldr application" $ withMaxSuccess maxTestCount-            concurrentFoldrApplication-        prop "concurrent foldl application" $ withMaxSuccess maxTestCount-            concurrentFoldlApplication--    -- These tests are specifically targeted towards detecting illegal sharing-    -- of SVar across conurrent streams. All transform ops must be added here.-    describe "Stream transform and combine operations" $ do-        serialOps    $ transformCombineOpsCommon S.fromFoldable "serially" (==)-        wSerialOps   $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq-        aheadOps     $ transformCombineOpsCommon S.fromFoldable "aheadly" (==)-        asyncOps     $ transformCombineOpsCommon S.fromFoldable "asyncly" sortEq-        wAsyncOps    $ transformCombineOpsCommon S.fromFoldable "wAsyncly" sortEq-        parallelOps  $ transformCombineOpsCommon S.fromFoldable "parallely" sortEq-        zipSerialOps $ transformCombineOpsCommon S.fromFoldable "zipSerially" (==)-        zipAsyncOps  $ transformCombineOpsCommon S.fromFoldable "zipAsyncly" (==)--        serialOps    $ transformCombineOpsCommon folded "serially" (==)-        wSerialOps   $ transformCombineOpsCommon folded "wSerially" sortEq-        aheadOps     $ transformCombineOpsCommon folded "aheadly" (==)-        asyncOps     $ transformCombineOpsCommon folded "asyncly" sortEq-        wAsyncOps    $ transformCombineOpsCommon folded "wAsyncly" sortEq-        parallelOps  $ transformCombineOpsCommon folded "parallely" sortEq-        zipSerialOps $ transformCombineOpsCommon folded "zipSerially" (==)-        zipAsyncOps  $ transformCombineOpsCommon folded "zipAsyncly" (==)--        serialOps    $ transformCombineOpsOrdered S.fromFoldable "serially" (==)-        aheadOps     $ transformCombineOpsOrdered S.fromFoldable "aheadly" (==)-        zipSerialOps $ transformCombineOpsOrdered S.fromFoldable "zipSerially" (==)-        zipAsyncOps  $ transformCombineOpsOrdered S.fromFoldable "zipAsyncly" (==)--        serialOps    $ transformCombineOpsOrdered folded "serially" (==)-        aheadOps     $ transformCombineOpsOrdered folded "aheadly" (==)-        zipSerialOps $ transformCombineOpsOrdered folded "zipSerially" (==)-        zipAsyncOps  $ transformCombineOpsOrdered folded "zipAsyncly" (==)--    describe "Stream elimination operations" $ do-        serialOps    $ eliminationOps S.fromFoldable "serially"-        wSerialOps   $ eliminationOps S.fromFoldable "wSerially"-        aheadOps     $ eliminationOps S.fromFoldable "aheadly"-        asyncOps     $ eliminationOps S.fromFoldable "asyncly"-        wAsyncOps    $ eliminationOps S.fromFoldable "wAsyncly"-        parallelOps  $ eliminationOps S.fromFoldable "parallely"-        zipSerialOps $ eliminationOps S.fromFoldable "zipSerially"-        zipAsyncOps  $ eliminationOps S.fromFoldable "zipAsyncly"--        serialOps    $ eliminationOps folded "serially folded"-        wSerialOps   $ eliminationOps folded "wSerially folded"-        aheadOps     $ eliminationOps folded "aheadly folded"-        asyncOps     $ eliminationOps folded "asyncly folded"-        wAsyncOps    $ eliminationOps folded "wAsyncly folded"-        parallelOps  $ eliminationOps folded "parallely folded"-        zipSerialOps $ eliminationOps folded "zipSerially folded"-        zipAsyncOps  $ eliminationOps folded "zipAsyncly folded"--    -- 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    $ serialEliminationOps S.fromFoldable "serially"-        wSerialOps   $ serialEliminationOps S.fromFoldable "wSerially"-        aheadOps     $ serialEliminationOps S.fromFoldable "aheadly"-        zipSerialOps $ serialEliminationOps S.fromFoldable "zipSerially"-        zipAsyncOps  $ serialEliminationOps S.fromFoldable "zipAsyncly"--        serialOps    $ serialEliminationOps folded "serially folded"-        wSerialOps   $ serialEliminationOps folded "wSerially folded"-        aheadOps     $ serialEliminationOps folded "aheadly folded"-        zipSerialOps $ serialEliminationOps folded "zipSerially folded"-        zipAsyncOps  $ serialEliminationOps folded "zipAsyncly folded"
+ test/README.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.
+ test/Streamly/Test/Data/Array.hs view
@@ -0,0 +1,343 @@+-- |+-- Module      : Streamly.Test.Data.Array+-- Copyright   : (c) 2019 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Array (main) where++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+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)++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 $+    H.parallel $+    modifyMaxSuccess (const maxTestCount) $ do+      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
@@ -0,0 +1,101 @@++#include "MachDeps.h"++-- Coverage build takes too long with default number of tests+maxTestCount :: Int+#ifdef DEVBUILD+maxTestCount = 100+#else+maxTestCount = 10+#endif++maxArrLen :: Int+maxArrLen = defaultChunkSize * 8++genericTestFrom ::+       (Int -> Stream IO Int -> IO (Array Int))+    -> Property+genericTestFrom arrFold =+    forAll (choose (0, maxArrLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->+            monadicIO $ do+                arr <- run $ arrFold len $ S.fromList list+                assert (A.length arr == len)++testLength :: Property+testLength = genericTestFrom (S.fold . A.createOf)++testLengthFromStreamN :: Property+testLengthFromStreamN = genericTestFrom A.fromStreamN++genericTestFromTo ::+       (Int -> Stream IO Int -> IO (Array Int))+    -> (Array Int -> Stream IO Int)+    -> ([Int] -> [Int] -> Bool)+    -> Property+genericTestFromTo arrFold arrUnfold listEq =+    forAll (choose (0, maxArrLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->+            monadicIO $ do+                arr <- run $ arrFold len $ S.fromList list+                xs <- run $ S.fold Fold.toList $ arrUnfold arr+                assert (listEq xs list)+++testFoldNUnfold :: Property+testFoldNUnfold =+    genericTestFromTo (S.fold . A.createOf) (S.unfold A.reader) (==)++testFoldNToStream :: Property+testFoldNToStream =+    genericTestFromTo (S.fold . A.createOf) A.read (==)++testFoldNToStreamRev :: Property+testFoldNToStreamRev =+    genericTestFromTo+        (S.fold . A.createOf)+        A.readRev+        (\xs list -> xs == reverse list)++testFromStreamNUnfold :: Property+testFromStreamNUnfold =+    genericTestFromTo A.fromStreamN (S.unfold A.reader) (==)++testFromStreamNToStream :: Property+testFromStreamNToStream = genericTestFromTo A.fromStreamN A.read (==)++testFromListN :: Property+testFromListN =+    forAll (choose (0, maxArrLen)) $ \len ->+        forAll (choose (0, len)) $ \n ->+            forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->+                monadicIO $ do+                    let arr = A.fromListN n list+                    xs <- run $ S.fold Fold.toList $ S.unfold A.reader arr+                    listEquals (==) xs (take n list)++foldManyWith :: (Int -> Fold IO Int (Array Int)) -> Property+foldManyWith f =+    forAll (choose (0, maxArrLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->+            monadicIO $ do+                xs <- run+                    $ S.fold Fold.toList+                    $ S.unfoldEach A.reader+                    $ S.foldMany (f 240)+                    $ S.fromList list+                assert (xs == list)++commonMain :: SpecWith ()+commonMain = do+    describe "Construction" $ do+        prop "length . writeN n === n" testLength+        prop "length . fromStreamN n === n" testLengthFromStreamN+        prop "read . writeN === id " testFoldNUnfold+        prop "toStream . writeN === id" testFoldNToStream+        prop "toStreamRev . writeN === reverse" testFoldNToStreamRev+        prop "read . fromStreamN === id" testFromStreamNUnfold+        prop "toStream . fromStreamN === id" testFromStreamNToStream+        prop "fromListN" testFromListN+        prop "foldMany with writeN concats to original"+            (foldManyWith A.createOf)
+ test/Streamly/Test/Data/Array/CommonImports.hs view
@@ -0,0 +1,13 @@++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.Internal.Data.Stream (Stream)+import Streamly.Internal.System.IO (defaultChunkSize)+import Streamly.Test.Common (listEquals)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as S
+ 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/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/Fold.hs view
@@ -0,0 +1,815 @@+{-# 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+    ( Gen+    , Property+    , arbitrary+    , choose+    , forAll+    , listOf+    , listOf1+    , 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.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)+import Test.Hspec as H+import Test.Hspec.QuickCheck++maxStreamLen :: Int+maxStreamLen = 1000++intMin :: Int+intMin = minBound++intMax :: Int+intMax = maxBound++min_value :: Int+min_value = 0++max_value :: Int+max_value = 10000++chooseInt :: (Int, Int) -> Gen Int+chooseInt = choose++{-# INLINE maxStreamLen #-}+{-# INLINE intMin #-}+{-# INLINE intMax #-}++rollingHashFirstN :: Property+rollingHashFirstN =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (choose (0, len)) $ \n ->+            forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec ->+                monadicIO $ do+                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 = 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 = Stream.fold Fold.length (Stream.fromList  ls) `shouldReturn` Prelude.length ls++sum :: [Int] -> Expectation+sum ls = Stream.fold Fold.sum (Stream.fromList  ls) `shouldReturn` Prelude.sum ls++product :: [Int] -> Expectation+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++greater :: (a -> a -> Ordering) -> a -> a -> a+greater f x y = if f x y == GT then x else y++foldMaybe :: (b -> a -> b) -> b -> [a] -> Maybe b+foldMaybe f acc ls =+    case ls of+        [] -> Nothing+        _ -> Just (foldl f acc ls)++maximumBy :: (Ord a, Show a) => a -> (a -> a -> Ordering) -> [a] -> Expectation+maximumBy genmin f 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 =+    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 =+    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 =+    Stream.fold Fold.minimum (Stream.fromList  ls)+        `shouldReturn` foldMaybe (lesser compare) genmax ls++toList :: [Int] -> Expectation+toList ls = Stream.fold Fold.toList (Stream.fromList  ls) `shouldReturn` ls++toListRev :: [Int] -> Expectation+toListRev ls = Stream.fold Fold.toListRev (Stream.fromList  ls) `shouldReturn` reverse ls++safeLast :: [a] -> Maybe a+safeLast [] = Nothing+safeLast (x:[]) = Just x+safeLast (_:xs) = safeLast xs++last :: [String] -> Expectation+last ls = Stream.fold Fold.last (Stream.fromList  ls) `shouldReturn` safeLast ls++mapMaybe :: [Int] -> Expectation+mapMaybe ls =+    let maybeEven x =+            if even x+            then Just x+            else Nothing+        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)+    | idx == 0 = Just x+    | idx < 0 = Nothing+    | otherwise = nth (idx - 1) xs+nth _ [] = Nothing++index :: Int -> [String] -> Expectation+index idx 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 <- Stream.fold (Fold.findIndex f) (Stream.fromList  ls)+    case y of+        Nothing ->+            let fld = Stream.fold (Fold.find f) (Stream.fromList  ls)+            in fld `shouldReturn` Nothing+        Just idx ->+            let fld = Stream.fold (Fold.any f) (Stream.fromList  $ Prelude.take idx ls)+            in fld `shouldReturn` False++neg :: (a -> Bool) -> a -> Bool+neg f x = not (f x)++findIndex :: (a -> Bool) -> [a] -> Expectation+findIndex f ls = do+    y <- Stream.fold (Fold.findIndex f) (Stream.fromList  ls)+    case y of+        Nothing  ->+            let fld = Stream.fold (Fold.all $ neg f) (Stream.fromList  ls)+            in fld `shouldReturn` True+        Just idx ->+            if idx == 0+            then+                Stream.fold (Fold.all f) (Stream.fromList  []) `shouldReturn` True+            else+                Stream.fold (Fold.all f) (Stream.fromList  $ Prelude.take idx ls)+                    `shouldReturn` False++predicate :: Int -> Bool+predicate x = x * x < 100++elemIndex :: Int -> [Int] -> Expectation+elemIndex elm ls = do+    y <- Stream.fold (Fold.elemIndex elm) (Stream.fromList  ls)+    case y of+        Nothing ->+            let fld = Stream.fold (Fold.any (== elm)) (Stream.fromList  ls)+            in fld `shouldReturn` False+        Just idx ->+            let fld =+                    Stream.fold+                        (Fold.any (== elm))+                        (Stream.fromList  $ Prelude.take idx ls)+            in fld `shouldReturn` False++null :: [Int] -> Expectation+null ls =+    Stream.fold Fold.null (Stream.fromList  ls)+        `shouldReturn`+            case ls of+                [] -> True+                _ -> False++elem :: Int -> [Int] -> Expectation+elem elm ls = do+    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 <- 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 =+    Stream.fold (Fold.all f) (Stream.fromList  ls) `shouldReturn` Prelude.all f ls++any :: (a -> Bool) -> [a] -> Expectation+any f ls = Stream.fold (Fold.any f) (Stream.fromList  ls) `shouldReturn` Prelude.any f ls++and :: [Bool] -> Expectation+and ls = Stream.fold Fold.and (Stream.fromList  ls) `shouldReturn` Prelude.and ls++or :: [Bool] -> Expectation+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 ->+            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 = Fold.takeEndBy_ p Fold.toList+            ys = Prelude.takeWhile (not . p) ls+         in case Stream.fold f (Stream.fromList  ls) of+            Right xs -> checkListEqual xs ys+            Left _ -> property False++takeEndByOrMax :: Property+takeEndByOrMax =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (0, 1))) $ \ls ->+            let p = (== 1)+                f = Fold.takeEndBy_ p (Fold.take n Fold.toList)+                ys = Prelude.take n (Prelude.takeWhile (not . p) ls)+             in case Stream.fold f (Stream.fromList  ls) of+                    Right xs -> checkListEqual xs ys+                    Left _ -> property False++chooseFloat :: (Float, Float) -> Gen Float+chooseFloat = choose++drain :: [Int] -> Expectation+drain ls = Stream.fold Fold.drain (Stream.fromList  ls) `shouldReturn` ()++drainBy :: [Int] -> Expectation+drainBy ls = Stream.fold (Fold.drainBy return) (Stream.fromList  ls) `shouldReturn` ()++mean :: Property+mean =+    forAll (listOf1 (chooseFloat (-100.0, 100.0)))+        $ \ls0 -> withMaxSuccess 1000 $ monadicIO $ action ls0++    where++    action ls = do+        v1 <- run $ Stream.fold Fold.mean (Stream.fromList  ls)+        let v2 = Prelude.sum ls / fromIntegral (Prelude.length ls)+        assert (abs (v1 - v2) < 0.0001)++stdDev :: Property+stdDev =+    forAll (listOf1 (chooseFloat (-100.0, 100.0)))+        $ \ls0 -> withMaxSuccess 1000 $ monadicIO $ action ls0++    where++    action ls = do+        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)+        assert (abs (v1 - sd) < 0.0001 )++variance :: Property+variance =+    forAll (listOf1 (chooseFloat (-100.0, 100.0)))+        $ \ls0 -> withMaxSuccess 1000 $ monadicIO $ action ls0++    where++    action ls = do+        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)+        assert (abs (v1 - vr) < 0.01 )++mconcat :: Property+mconcat =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        v1 <- run $ Stream.fold Fold.mconcat (fmap Sum $ Stream.fromList  ls)+        let v2 = Prelude.sum ls+        assert (getSum v1 == v2)++foldMap :: Property+foldMap =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        v1 <- run $ Stream.fold (Fold.foldMap Sum) $ Stream.fromList  ls+        let v2 = Prelude.sum ls+        assert (getSum v1 == v2)++foldMapM :: Property+foldMapM =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        v1 <- run $ Stream.fold (Fold.foldMapM (return . Sum)) $ Stream.fromList  ls+        let v2 = Prelude.sum ls+        assert (getSum v1 == v2)++lookup :: Property+lookup =+    forAll (chooseInt (1, 15))+        $ \key0 ->monadicIO $ action key0++    where++    action key = do+        let ls = [ (1, "first"), (2, "second"), (3, "third"), (4, "fourth")+                 , (5, "fifth"), (6, "fifth+first"), (7, "fifth+second")+                 , (8, "fifth+third"), (9, "fifth+fourth")+                 , (10, "fifth+fifth")+                 ]+        v1 <- run $ Stream.fold (Fold.lookup key) $ Stream.fromList  ls+        let v2 = Prelude.lookup key ls+        assert (v1 == v2)++rmapM :: Property+rmapM =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        let addLen x = return $ x + Prelude.length ls+            fld = Fold.rmapM addLen Fold.sum+            v2 = foldl (+) (Prelude.length ls) ls+        v1 <- run $ Stream.fold fld $ Stream.fromList  ls+        assert (v1 == v2)++teeWithLength :: Property+teeWithLength =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        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))++teeWithFstLength :: Property+teeWithFstLength =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        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))++partitionByM :: Property+partitionByM =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        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))++partitionByFstM :: Property+partitionByFstM =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action _ = do+        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))++partitionByMinM1 :: Property+partitionByMinM1 =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action _ = do+        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))++partitionByMinM2 :: Property+partitionByMinM2 =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action _ = do+        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))++teeWithMinLength1 :: Property+teeWithMinLength1 =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        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))+++teeWithMinLength2 :: Property+teeWithMinLength2 =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        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)))+       $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        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))++distribute :: Property+distribute =+    forAll (listOf1 (chooseInt (intMin, intMax)))+        $ \ls0 -> monadicIO $ action ls0++    where++    action ls = do+        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])++partition :: Property+partition =+    monadicIO $ do+        v1 :: (Int, [String]) <-+            run+                $ 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)++unzip :: Property+unzip =+    monadicIO $ do+    v1 :: (Int, [String]) <-+        run+            $ 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 = 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 = Fold.take i Fold.toList++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)++    where++    taill :: [a] -> [a]+    taill [] = []+    taill (_:xs) = xs++demux :: Expectation+demux =+    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+        (Fold.demuxKvToMap table)+        input+        `shouldReturn`+        Data.Map.fromList [("PRODUCT", 8),("SUM", 4),("abc",3),("xyz",2)]+++demuxWith :: Expectation+demuxWith =+    let getKey x | even x = "SUM"+                 | otherwise = "PRODUCT"++        getFold "SUM" = return Fold.sum+        getFold "PRODUCT" = return Fold.product+        getFold _ = error "demuxWith: bug"++        input = Stream.fromList  [1, 2, 3, 4 :: Int]+    in Stream.fold+        (Fold.demuxToContainer getKey (getFold . getKey))+        input+        `shouldReturn`+        Data.Map.fromList  [("PRODUCT",3),("SUM",6)]++classifyWith :: Expectation+classifyWith =+    let input = Stream.fromList  [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]+    in Stream.fold+        (Fold.toContainer fst (Fold.lmap snd Fold.toList))+        input+        `shouldReturn`+        Data.Map.fromList+        [("ONE",[1.0, 1.1 :: Double]), ("TWO",[2.0, 2.2])]++classify :: Expectation+classify =+    let input =+            Stream.fromList+            [+              ("ONE", (1::Int, 1))+            , ("ONE", (1, 1.1:: Double))+            , ("TWO", (2, 2))+            , ("TWO",(2, 2.2))+            ]+    in Stream.fold+        (Fold.kvToMap (Fold.lmap snd Fold.toList))+        input+        `shouldReturn`+        Data.Map.fromList+        [("ONE",[1.0, 1.1 :: Double]), ("TWO",[2.0, 2.2])]++splitAt :: Expectation+splitAt =+    Stream.fold+    (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"++main :: IO ()+main = hspec $ do+    describe moduleName $ do+        -- Folds+        -- Accumulators+        prop "mconcat" Main.mconcat+        prop "foldMap" Main.foldMap+        prop "foldMapM" Main.foldMapM++        prop "drain" Main.drain+        prop "drainBy" Main.drainBy+        prop "last" last+        prop "length" Main.length+        prop "sum" sum+        prop "product" product+        prop "maximumBy" $ maximumBy intMin compare+        prop "maximum" $ maximum intMin+        prop "minimumBy" $ minimumBy intMax compare+        prop "minimum" $ minimum intMax+        prop "mean" Main.mean+        prop "stdDev" Main.stdDev+        prop "variance" Main.variance+        prop "rollingHashFirstN" rollingHashFirstN++        prop "toList" toList+        prop "toListRev" toListRev+        prop "demux" demux+        prop "demuxWith" demuxWith+        prop "classifyWith" classifyWith+        prop "classify" classify++        -- Terminating folds+        prop "index" index+        prop "head" head+        prop "find" $ find predicate+        prop "lookup" Main.lookup+        prop "findIndex" $ findIndex predicate+        prop "elemIndex" $ elemIndex 10+        prop "null" null+        prop "elem" $ elem 10+        prop "notElem" $ notElem 10+        prop "all" $ Main.all predicate+        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+        -- lmap/lmapM++        -- Filtering+        -- filter/filterM+        -- catMaybes+        prop "mapMaybe" mapMaybe++        -- Trimming+        prop "take" take+        -- takeEndBy+        prop "takeEndBy_" takeEndBy_+        prop "takeEndByOrMax" takeEndByOrMax++        -- Appending+        -- splitWith++        -- Distributing+        -- tee+        prop "teeWithLength" Main.teeWithLength+        prop "teeWithFstLength" Main.teeWithFstLength+        prop "teeWithMinLength1" Main.teeWithMinLength1+        prop "teeWithMinLength2" Main.teeWithMinLength2+        prop "teeWithMax" Main.teeWithMax+        prop "partitionByM" Main.partitionByM+        prop "partitionByFstM" Main.partitionByFstM+        prop "partitionByMinM1" Main.partitionByMinM1+        prop "partitionByMinM2" Main.partitionByMinM2+        prop "distribute" Main.distribute++        -- Partitioning+        prop "partition" Main.partition+        prop "partitionByM" partitionByM++        -- Unzipping+        prop "unzip" Main.unzip+        prop "splitAt" Main.splitAt++        -- Nesting+        prop "many" Main.many+        -- concatMap+        -- chunksOf++        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
@@ -0,0 +1,220 @@+{-# LANGUAGE MonadComprehensions #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}++module Main (main) where++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.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as S+#else+import Prelude -- to suppress compiler warning++type List = []++pattern Nil :: [a]+pattern Nil <- [] where Nil = []++pattern Cons :: a -> [a] -> [a]+pattern Cons x xs = x : xs+infixr 5 `Cons`++{-# COMPLETE Nil, Cons #-}+#endif++moduleName :: String+#ifdef USE_STREAMLY_LIST+moduleName = "Data.List+Data.List.Base"+#else+moduleName = "Data.List.Base"+#endif++main :: IO ()+main = hspec $+  describe moduleName $ do+#ifdef USE_STREAMLY_LIST+    describe "OverloadedLists for 'Stream Identity' type" $ do+        it "Overloaded lists" $ do+            ([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] :: Stream Identity Int)+                `shouldBe` "fromList [1,2,3]"+        it "Read instance" $ do+            (read "fromList [1,2,3]" :: Stream Identity Int) `shouldBe` [1..3]++        it "Eq instance" $ do+            ([1,2,3] :: Stream Identity Int) == [1,2,3] `shouldBe` True++        it "Ord instance" $ do+            ([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)] :: List (Int, Int))++        it "Foldable (sum)" $ sum ([1..3] :: Stream Identity Int)+            `shouldBe` 6++        it "Traversable (mapM)" $+            mapM return ([1..10] :: Stream Identity Int)+                `shouldReturn` [1..10]++    describe "OverloadedStrings for 'Stream Identity' type" $ do+        it "overloaded strings" $ do+            ("hello" :: Stream Identity Char) `shouldBe` S.fromList "hello"+#endif++    describe "OverloadedLists for List type" $ do+        it "overloaded lists" $ do+            ([1..3] :: List Int) `shouldBe` GHC.fromList [1..3]+            GHC.toList ([1..3] :: List Int) `shouldBe` [1..3]++        it "Construct empty list" $ (Nil :: List Int) `shouldBe` []++        it "Construct a list" $ do+            (Nil :: List Int) `shouldBe` []+            ('x' `Cons` Nil) `shouldBe` ['x']+            (1 `Cons` [2 :: Int]) `shouldBe` [1,2]+            (1 `Cons` 2 `Cons` 3 `Cons` Nil :: List Int) `shouldBe` [1,2,3]++        it "pattern matches" $ do+            case [] of+                Nil -> return ()+                _ -> expectationFailure "not reached"++            case ['x'] of+                Cons 'x' Nil -> return ()+                _ -> expectationFailure "not reached"++            case [1..10 :: Int] of+                Cons x xs -> do+                    x `shouldBe` 1+                    xs `shouldBe` [2..10]+                _ -> expectationFailure "not reached"++            case [1..10 :: Int] of+                x `Cons` y `Cons` xs -> do+                    x `shouldBe` 1+                    y `shouldBe` 2+                    xs `shouldBe` [3..10]+                _ -> expectationFailure "not reached"++        it "Show instance" $ do+            show ([1..3] :: List Int) `shouldBe`+#ifdef USE_STREAMLY_LIST+                "fromList [1,2,3]"+#else+                "[1,2,3]"+#endif++        it "Read instance" $ do+            (read+#ifdef USE_STREAMLY_LIST+                "fromList [1,2,3]"+#else+                "[1,2,3]"+#endif+                :: List Int) `shouldBe` [1..3]++        it "Eq instance" $ do+            ([1,2,3] :: List Int) == [1,2,3] `shouldBe` True++        it "Ord instance" $ do+            ([1,2,3] :: List 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)] :: List (Int, Int))++        it "Foldable (sum)" $ sum ([1..3] :: List Int) `shouldBe` 6++        it "Traversable (mapM)" $+            mapM return ([1..10] :: List Int)+                `shouldReturn` [1..10]++    describe "OverloadedStrings for List type" $ do+        it "overloaded strings" $ do+            ("hello" :: List Char) `shouldBe` GHC.fromList "hello"++        it "pattern matches" $ do+            case "" of+                Nil -> return ()+                _ -> expectationFailure "not reached"++            case "a" of+                Cons x Nil -> x `shouldBe` 'a'+                _ -> expectationFailure "not reached"++            case "hello" <> "world" of+                Cons x1 (Cons x2 xs) -> do+                    x1 `shouldBe` 'h'+                    x2 `shouldBe` 'e'+                    xs `shouldBe` "lloworld"+                _ -> expectationFailure "not reached"++#ifdef USE_STREAMLY_LIST+    describe "OverloadedLists for ZipList type" $ do+        it "overloaded lists" $ do+            ([1..3] :: ZipList Int) `shouldBe` GHC.fromList [1..3]+            GHC.toList ([1..3] :: ZipList Int) `shouldBe` [1..3]++        it "toZipList" $ do+            toZipList (Nil :: List Int) `shouldBe` []+            toZipList ('x' `Cons` Nil) `shouldBe` ['x']+            toZipList (1 `Cons` [2 :: Int]) `shouldBe` [1,2]+            toZipList (1 `Cons` 2 `Cons` 3 `Cons` Nil :: List Int) `shouldBe` [1,2,3]++        it "fromZipList" $ do+            case fromZipList [] of+                Nil -> return ()+                _ -> expectationFailure "not reached"++            case fromZipList ['x'] of+                Cons 'x' Nil -> return ()+                _ -> expectationFailure "not reached"++            case fromZipList [1..10 :: Int] of+                Cons x xs -> do+                    x `shouldBe` 1+                    xs `shouldBe` [2..10]+                _ -> expectationFailure "not reached"++            case fromZipList [1..10 :: Int] of+                x `Cons` y `Cons` xs -> do+                    x `shouldBe` 1+                    y `shouldBe` 2+                    xs `shouldBe` [3..10]+                _ -> expectationFailure "not reached"++        it "Show instance" $ do+            show ([1..3] :: ZipList Int) `shouldBe`+                "ZipList {toZipStream = fromList [1,2,3]}"++        it "Read instance" $ do+            (read "ZipList {toZipStream = fromList [1,2,3]}" :: ZipList Int)+                `shouldBe` [1..3]++        it "Eq instance" $ do+            ([1,2,3] :: ZipList Int) == [1,2,3] `shouldBe` True++        it "Ord instance" $ do+            ([1,2,3] :: ZipList Int) > [1,2,1] `shouldBe` True++        it "Foldable (sum)" $ sum ([1..3] :: ZipList Int) `shouldBe` 6++        it "Traversable (mapM)" $+            mapM return ([1..10] :: ZipList Int)+                `shouldReturn` [1..10]++        it "Applicative Zip" $ do+            (,) <$> "abc" <*> [1..3] `shouldBe`+                ([('a',1),('b',2),('c',3)] :: ZipList (Char, Int))+#endif
+ 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
@@ -0,0 +1,470 @@+{-# 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/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
@@ -0,0 +1,29 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Data.SmallArray+-- Copyright   : (c) 2020 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.SmallArray (main) where++#include "Streamly/Test/Data/Array/CommonImports.hs"++import qualified Streamly.Internal.Data.SmallArray as A+type Array = A.SmallArray++moduleName :: String+moduleName = "Data.SmallArray"++#include "Streamly/Test/Data/Array/Common.hs"++main :: IO ()+main =+    hspec $+    H.parallel $+    modifyMaxSuccess (const maxTestCount) $ do+      describe moduleName $ do+        commonMain
+ 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
@@ -0,0 +1,701 @@+-- |+-- Module      : Main+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Main (main) where++import Streamly.Internal.Data.Unfold (Unfold)++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 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 Test.Hspec as H+import Test.Hspec.QuickCheck+import Test.QuickCheck+import Test.QuickCheck.Function++-------------------------------------------------------------------------------+-- Helper functions+-------------------------------------------------------------------------------++-- | @testUnfoldM unf seed initial final xs@, runs an unfold under state monad+-- using @initial@ as the initial state. @final@ is the expected state after+-- running it and @xs@ is the list of elements the stream must produce.+testUnfoldM ::+       (Eq s, Eq b) => Unfold (State s) a b -> a -> s -> s -> [b] -> Bool+testUnfoldM unf seed si sf lst = evalState action si++    where++    action = do+        x <- S.fold Fold.toList $ S.unfold unf seed+        y <- get+        return $ x == lst && y == sf++testUnfoldMD :: Unfold (State Int) a Int -> a -> Int -> Int -> [Int] -> Bool+testUnfoldMD = testUnfoldM++-- | This is similar to 'testUnfoldM' but without the state monad.+testUnfold :: Eq b => Unfold Identity a b -> a -> [b] -> Bool+testUnfold unf seed lst = runIdentity action++    where++    action = do+        x <- S.fold Fold.toList $ S.unfold unf seed+        return $ x == lst++testUnfoldD :: Unfold Identity a Int -> a -> [Int] -> Bool+testUnfoldD = testUnfold++-------------------------------------------------------------------------------+-- Operations on input+-------------------------------------------------------------------------------++lmapM :: Bool+lmapM =+    let unf = UF.lmapM (\x -> modify (+ 1) >> return x) (UF.function id)+     in testUnfoldMD unf 1 0 1 [1]++both :: Bool+both =+    let unf = UF.supply 1 (UF.function id)+     in testUnfold unf () ([1] :: [Int])++first :: Bool+first =+    let unf = UF.first 1 (UF.function id)+     in testUnfold unf 2 ([(1, 2)] :: [(Int, Int)])++second :: Bool+second =+    let unf = UF.second 1 (UF.function id)+     in testUnfold unf 2 ([(2, 1)] :: [(Int, Int)])++discardFirst :: Bool+discardFirst =+    let unf = UF.discardFirst (UF.function id)+     in testUnfold unf ((1, 2) :: (Int, Int)) [2]++discardSecond :: Bool+discardSecond =+    let unf = UF.discardSecond (UF.function id)+     in testUnfold unf ((1, 2) :: (Int, Int)) [1]++swap :: Bool+swap =+    let unf = UF.swap (UF.function id)+     in testUnfold unf ((1, 2) :: (Int, Int)) [(2, 1)]++-------------------------------------------------------------------------------+-- Stream generation+-------------------------------------------------------------------------------++fromStream :: Property+fromStream =+    property+        $ \list ->+              testUnfoldD+                  UF.fromStream+                  (S.fromList list :: S.Stream Identity Int)+                  list++fromStreamD :: Property+fromStreamD =+    property+        $ \list -> testUnfoldD UF.fromStreamD (D.fromList list) (list :: [Int])++fromStreamK :: Property+fromStreamK =+    property+        $ \list -> testUnfoldD UF.fromStreamK (K.fromList list) (list :: [Int])++nilM :: Bool+nilM =+    let unf = UF.nilM put+     in testUnfoldMD unf 1 0 1 []++consM :: Bool+consM =+    let cns = UF.consM (\a -> modify (+ a) >> get)+        unf = cns $ cns $ UF.nilM $ \a -> modify (+ a)+     in testUnfoldMD unf 1 0 3 [1, 2]++functionM :: Bool+functionM =+    let unf = UF.functionM (\a -> modify (+ a) >> get)+     in testUnfoldMD unf 1 0 1 [1]++const :: Bool+const =+    let unf = UF.fromEffect (modify (+ 1) >> get)+     in testUnfoldMD unf (0 :: Int) 0 1 [1]++unfoldrM :: Property+unfoldrM =+    property+        $ \gen ->+              let genA = apply gen :: Int -> Maybe (Int, Int)+                  genM x = modify (+ 1) >> return (genA x)+                  list = Prelude.take 100 $ List.unfoldr genA 1+                  unf = UF.take 100 $ UF.unfoldrM genM+                  ll = length list+                  fs = if ll < 100 then ll + 1 else 100+               in testUnfoldMD unf 1 0 fs list++fromListM :: Property+fromListM =+    property+        $ \list ->+              let listM = Prelude.map (\x -> modify (+ 1) >> return x) list+               in testUnfoldMD UF.fromListM listM 0 (length list) list++replicateM :: Property+replicateM =+    property+        $ \i ->+              let ns = max 0 i+                  seed = (i, modify (+ 1) >> get)+               in testUnfoldMD UF.replicateM seed 0 ns [1 .. i]++repeatM :: Bool+repeatM =+    testUnfoldMD (UF.take 10 UF.repeatM) (modify (+ 1) >> get) 0 10 [1 .. 10]++iterateM :: Property+iterateM =+    property+        $ \next ->+              let nextA = apply next :: Int -> Int+                  nextM x = modify (+ 1) >> return (nextA x)+                  list = Prelude.take 100 $ List.iterate nextA 1+                  unf = UF.take 100 $ UF.iterateM nextM+               in testUnfoldMD unf (modify (+ 10) >> return 1) 0 110 list++fromIndicesM :: Property+fromIndicesM =+    property+        $ \indF ->+              let indFA = apply indF :: Int -> Int+                  indFM x = modify (+ 1) >> return (indFA x)+                  list = Prelude.take 100 $ Prelude.map indFA [1 ..]+                  unf = UF.take 100 $ UF.fromIndicesM indFM+               in testUnfoldMD unf 1 0 (length list) list++-------------------------------------------------------------------------------+-- Test for Num type+-------------------------------------------------------------------------------+enumerateFromNum :: Property+enumerateFromNum =+    property+        $ \f ->+                let unf = UF.take 50 UF.enumerateFromNum+                in testUnfold unf (f :: Int) $+                    Prelude.take 50 $ Prelude.enumFrom f++enumerateFromThenNum :: Property+enumerateFromThenNum =+    property+        $ \f th ->+                let unf = UF.take 50 UF.enumerateFromThenNum+                in testUnfold unf (f :: Int, th) $+                    Prelude.take 50 $ Prelude.enumFromThen f th++-------------------------------------------------------------------------------+-- Test for Integral type+-------------------------------------------------------------------------------+enumerateFromIntegral :: Property+enumerateFromIntegral =+    property+        $ \f ->+                let unf = UF.take 50 UF.enumerateFromIntegral+                in testUnfold unf (f :: Integer) $+                    Prelude.take 50 $ Prelude.enumFrom f++enumerateFromThenIntegral :: Property+enumerateFromThenIntegral =+    property+        $ \f th ->+                let unf = UF.take 50 UF.enumerateFromThenIntegral+                in testUnfold unf (f :: Integer, th) $+                    Prelude.take 50 $ Prelude.enumFromThen f th++enumerateFromThenToIntegral :: Property+enumerateFromThenToIntegral =+    property+        $ \f th to ->+                let unf = UF.take 50 UF.enumerateFromThenToIntegral+                in testUnfold unf (f :: Integer, th, to) $+                    Prelude.take 50 $ Prelude.enumFromThenTo f th to++enumerateFromToIntegral :: Property+enumerateFromToIntegral =+    property+        $ \f to ->+                let unf = UF.take 50 UF.enumerateFromToIntegral+                in testUnfold unf (f :: Integer, to) $+                    Prelude.take 50 $ Prelude.enumFromTo f to++enumerateFromIntegralBounded :: Property+enumerateFromIntegralBounded =+    property+        $ \f ->+                let unf = UF.take 50 UF.enumerateFromIntegralBounded+                in testUnfold unf (f :: Int) $+                    Prelude.take 50 $ Prelude.enumFrom f++enumerateFromThenIntegralBounded :: Property+enumerateFromThenIntegralBounded =+    property+        $ \f th ->+                let unf = UF.take 50 UF.enumerateFromThenIntegralBounded+                in testUnfold unf (f :: Int, th) $+                    Prelude.take 50 $ Prelude.enumFromThen f th++enumerateFromToIntegralBounded :: Property+enumerateFromToIntegralBounded =+    property+        $ \f to ->+                let unf = UF.take 50 UF.enumerateFromToIntegralBounded+                in testUnfold unf (f :: Int, to) $+                    Prelude.take 50 $ Prelude.enumFromTo f to++enumerateFromThenToIntegralBounded :: Property+enumerateFromThenToIntegralBounded =+    property+        $ \f th to ->+                let unf = UF.take 50 UF.enumerateFromThenToIntegralBounded+                in testUnfold unf (f :: Int, th, to) $+                    Prelude.take 50 $ Prelude.enumFromThenTo f th to++enumerateFromSmallBounded :: Property+enumerateFromSmallBounded =+    property+        $ \f ->+                let unf = UF.take 50 UF.enumerateFromSmallBounded+                in testUnfold unf (f :: Char) $+                    Prelude.take 50 $ Prelude.enumFrom f++enumerateFromThenSmallBounded :: Property+enumerateFromThenSmallBounded =+    property+        $ \f th ->+                let unf = UF.take 50 UF.enumerateFromThenSmallBounded+                in testUnfold unf (f :: Char, th) $+                    Prelude.take 50 $ Prelude.enumFromThen f th++enumerateFromToSmall :: Property+enumerateFromToSmall =+    property+        $ \f to ->+                let unf = UF.take 50 UF.enumerateFromToSmall+                in testUnfold unf (f :: Char, to) $+                    Prelude.take 50 $ Prelude.enumFromTo f to++enumerateFromThenToSmall :: Property+enumerateFromThenToSmall =+    property+        $ \f th to ->+                let unf = UF.take 50 UF.enumerateFromThenToSmall+                in testUnfold unf (f :: Char, th, to) $+                    Prelude.take 50 $ Prelude.enumFromThenTo f th to++enumerateFromSmallBoundedOrd :: Property+enumerateFromSmallBoundedOrd =+    property+        $ \f ->+                let unf = UF.take 3 UF.enumerateFromSmallBounded+                in testUnfold unf (f :: Ordering) $+                    Prelude.take 3 $ Prelude.enumFrom f++enumerateFromThenSmallBoundedOrd :: Property+enumerateFromThenSmallBoundedOrd =+    property+        $ \f th  ->+                let unf = UF.take 3 UF.enumerateFromThenSmallBounded+                in testUnfold unf (f :: Ordering, th) $+                    Prelude.take 3 $ Prelude.enumFromThen f th++enumerateFromToSmallOrd :: Property+enumerateFromToSmallOrd =+    property+        $ \f to ->+                let unf = UF.take 3 UF.enumerateFromToSmall+                in testUnfold unf (f :: Ordering, to) $+                    Prelude.take 3 $ Prelude.enumFromTo f to++enumerateFromThenToSmallOrd :: Property+enumerateFromThenToSmallOrd =+    property+        $ \f th to ->+                let unf = UF.take 3 UF.enumerateFromThenToSmall+                in testUnfold unf (f :: Ordering, th, to) $+                    Prelude.take 3 $ Prelude.enumFromThenTo f th to++-------------------------------------------------------------------------------+enumerateFromSmallBoundedBool :: Property+enumerateFromSmallBoundedBool =+    property+        $ \f ->+                let unf = UF.take 2 UF.enumerateFromSmallBounded+                in testUnfold unf (f :: Bool) $+                    Prelude.take 2 $ Prelude.enumFrom f++enumerateFromThenSmallBoundedBool :: Property+enumerateFromThenSmallBoundedBool =+    property+        $ \f th  ->+                let unf = UF.take 2 UF.enumerateFromThenSmallBounded+                in testUnfold unf (f :: Bool, th) $+                    Prelude.take 2 $ Prelude.enumFromThen f th++enumerateFromToSmallBool :: Property+enumerateFromToSmallBool =+    property+        $ \f to ->+                let unf = UF.take 2 UF.enumerateFromToSmall+                in testUnfold unf (f :: Bool, to) $+                    Prelude.take 2 $ Prelude.enumFromTo f to++enumerateFromThenToSmallBool :: Property+enumerateFromThenToSmallBool =+    property+        $ \f th to ->+                let unf = UF.take 2 UF.enumerateFromThenToSmall+                in testUnfold unf (f :: Bool, th, to) $+                    Prelude.take 2 $ Prelude.enumFromThenTo f th to+-------------------------------------------------------------------------------+enumerateFromSmallBoundedUnit :: Property+enumerateFromSmallBoundedUnit =+    property+        $ \f ->+                let unf = UF.take 1 UF.enumerateFromSmallBounded+                in testUnfold unf (f :: ()) $+                    Prelude.take 1 $ Prelude.enumFrom f++enumerateFromThenSmallBoundedUnit :: Property+enumerateFromThenSmallBoundedUnit =+    property+        $ \f th  ->+                let unf = UF.take 1 UF.enumerateFromThenSmallBounded+                in testUnfold unf (f :: (), th) $+                    Prelude.take 1 $ Prelude.enumFromThen f th++enumerateFromToSmallUnit :: Property+enumerateFromToSmallUnit =+    property+        $ \f to ->+                let unf = UF.take 1 UF.enumerateFromToSmall+                in testUnfold unf (f :: (), to) $+                    Prelude.take 1 $ Prelude.enumFromTo f to++enumerateFromThenToSmallUnit :: Property+enumerateFromThenToSmallUnit =+    property+        $ \f th to ->+                let unf = UF.take 1 UF.enumerateFromThenToSmall+                in testUnfold unf (f :: (), th, to) $+                    Prelude.take 1 $ Prelude.enumFromThenTo f th to++enumerateFromFractional :: Property+enumerateFromFractional =+    property+        $ \f ->+                let unf = UF.take 50 UF.enumerateFromFractional+                in testUnfold unf (f :: Double) $+                    Prelude.take 50 $ Prelude.enumFrom f++enumerateFromThenFractional :: Property+enumerateFromThenFractional =+    property+        $ \f th ->+                let unf = UF.take 50 UF.enumerateFromThenFractional+                in testUnfold unf (f :: Double, th) $+                    Prelude.take 50 $ Prelude.enumFromThen f th++enumerateFromThenToFractional :: Property+enumerateFromThenToFractional =+    property+        $ \f th to ->+                let unf = UF.take 50 UF.enumerateFromThenToFractional+                in testUnfold  unf (f :: Double, th, to) $+                    Prelude.take 50 $ Prelude.enumFromThenTo f th to++enumerateFromToFractional :: Property+enumerateFromToFractional =+    property+        $ \f t ->+                let unf = UF.enumerateFromToFractional+                in testUnfold unf (f :: Double, t) [f..(t :: Double)]++-------------------------------------------------------------------------------+-- 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+        $ \f list ->+              let fA = apply f :: Int -> Int+                  fM x = modify (+ 1) >> return (fA x)+                  unf = UF.mapM fM UF.fromList+                  mList = Prelude.map fA list+               in testUnfoldMD unf list 0 (length list) mList++mapM2 :: Property+mapM2 =+    property+        $ \f list ->+              let fA = applyFun2 f :: [Int] -> Int -> Int+                  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++take :: Property+take =+    property+        $ \i ->+              testUnfoldD+                  (UF.take i UF.repeatM)+                  (return 1)+                  (Prelude.take i (Prelude.repeat 1))++takeWhileM :: Property+takeWhileM =+    property+        $ \f list ->+              let fM x =+                      if apply f x+                      then modify (+ 1) >> return True+                      else return False+                  unf = UF.takeWhileM fM UF.fromList+                  fL = Prelude.takeWhile (apply f) list+                  fS = Prelude.length fL+               in testUnfoldMD unf list 0 fS fL++filterM :: Property+filterM =+    property+        $ \f list ->+              let fM x =+                      if apply f x+                      then modify (+ 1) >> return True+                      else return False+                  unf = UF.filterM fM UF.fromList+                  fL = Prelude.filter (apply f) list+                  fS = Prelude.length fL+               in testUnfoldMD unf list 0 fS fL++drop :: Property+drop =+    property+        $ \i list ->+              let unf = UF.drop i UF.fromList+                  fL = Prelude.drop i list+               in testUnfoldD unf list fL++dropWhileM :: Property+dropWhileM =+    property+        $ \f list ->+              let fM x =+                      if apply f x+                      then modify (+ 1) >> return True+                      else return False+                  unf = UF.dropWhileM fM UF.fromList+                  fL = Prelude.dropWhile (apply f) list+                  fS = Prelude.length list - Prelude.length fL+               in testUnfoldMD unf list 0 fS fL++-------------------------------------------------------------------------------+-- Stream combination+-------------------------------------------------------------------------------++zipWithM :: Property+zipWithM =+    property+        $ \f ->+            let unf1 = UF.enumerateFromToIntegral+                unf2 = UF.enumerateFromToIntegral+                fA = applyFun2 f :: Int -> Int -> Int+                fM a b = modify (+ 1) >> return (fA a b)+                unf = UF.zipWithM fM (UF.lmap fst unf1) (UF.lmap snd unf2)+                lst = Prelude.zipWith fA [1 .. 10] [1 .. 20]+            in testUnfoldMD unf ((1,10), (1,20)) 0 10 lst++concat :: Bool+concat =+    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++outerProduct :: Bool+outerProduct =+    let unf1 = UF.enumerateFromToIntegral+        unf2 = UF.enumerateFromToIntegral+        unf = crossProduct unf1 unf2+        lst = [(a, b) :: (Int, Int) | a <- [0 .. 10], b <- [0 .. 20]]+     in testUnfold unf (((0,10) ,(0,20)) :: ((Int, Int), (Int, Int))) lst++    where++    crossProduct u1 u2 = UF.cross (UF.lmap fst u1) (UF.lmap snd u2)++concatMapM :: Bool+concatMapM =+    let inner b =+          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]+     in testUnfoldMD unf (1, 10) 0 110 list++-------------------------------------------------------------------------------+-- Test groups+-------------------------------------------------------------------------------++testInputOps :: Spec+testInputOps =+    describe "Input"+        $ do+            -- prop "lmap" lmap+            prop "lmapM" lmapM+            prop "both" both+            prop "first" first+            prop "second" second+            prop "discardFirst" discardFirst+            prop "discardSecond" discardSecond+            prop "swap" swap++testGeneration :: Spec+testGeneration =+    describe "Generation"+        $ do+            prop "fromStream" fromStream+            prop "fromStreamK" fromStreamK+            prop "fromStreamD" fromStreamD+            prop "nilM" nilM+            prop "consM" consM+            prop "functionM" functionM+            -- prop "function" function+            -- prop "identity" identity+            prop "const" const+            prop "unfoldrM" unfoldrM+            -- prop "fromList" fromList+            prop "fromListM" fromListM+            -- prop "fromSVar" fromSVar+            -- prop "fromProducer" fromProducer+            prop "replicateM" replicateM+            prop "repeatM" repeatM+            prop "iterateM" iterateM+            prop "fromIndicesM" fromIndicesM+            ----------- Enumerate from Num ------------------------------------+            prop "enumerateFromNum" enumerateFromNum+            prop "enumerateFromThenNum" enumerateFromThenNum+            ----------- Enumerate from Integral -------------------------------+            prop "enumerateFromIntegral" enumerateFromIntegral+            prop "enumerateFromThenIntegral" enumerateFromThenIntegral+            prop "enumerateFromToIntegral" enumerateFromToIntegral+            prop "enumerateFromThenToIntegral" enumerateFromThenToIntegral++            prop "enumerateFromIntegralBounded" enumerateFromIntegralBounded+            prop "enumerateFromThenIntegralBounded" enumerateFromThenIntegralBounded+            prop "enumerateFromToIntegralBounded" enumerateFromToIntegralBounded+            prop "enumerateFromThenToIntegralBounded" enumerateFromThenToIntegralBounded+            ----------- Enumerate from Small Integral -------------------------+            prop "enumerateFromSmallBounded" enumerateFromSmallBounded+            prop "enumerateFromThenSmallBounded" enumerateFromThenSmallBounded+            prop "enumerateFromToSmall" enumerateFromToSmall+            prop "enumerateFromThenToSmall" enumerateFromThenToSmall+            --+            prop "enumerateFromSmallBoundedOrd" enumerateFromSmallBoundedOrd+            prop "enumerateFromThenSmallBoundedOrd" enumerateFromThenSmallBoundedOrd+            prop "enumerateFromToSmallOrd" enumerateFromToSmallOrd+            prop "enumerateFromThenToSmallOrd" enumerateFromThenToSmallOrd++            prop "enumerateFromSmallBoundedUnit" enumerateFromSmallBoundedUnit+            prop "enumerateFromThenSmallBoundedUnit" enumerateFromThenSmallBoundedUnit+            prop "enumerateFromToSmallUnit" enumerateFromToSmallUnit+            prop "enumerateFromThenToSmallUnit" enumerateFromThenToSmallUnit++            prop "enumerateFromSmallBoundedUnit" enumerateFromSmallBoundedBool+            prop "enumerateFromThenSmallBoundedBool" enumerateFromThenSmallBoundedBool+            prop "enumerateFromToSmallBool" enumerateFromToSmallBool+            prop "enumerateFromThenToSmallBool" enumerateFromThenToSmallBool++            prop "enumerateFromFractional" enumerateFromFractional+            prop "enumerateFromThenFractional" enumerateFromThenFractional+            prop "enumerateFromToFractional" enumerateFromToFractional+            prop "enumerateFromThenToFractional" enumerateFromThenToFractional++testTransformation :: Spec+testTransformation =+    describe "Transformation"+        $ do+            -- prop "map" map+            prop "postscan" postscan+            prop "mapM" mapM+            prop "mapM2" mapM2+            prop "takeWhileM" takeWhileM+            -- prop "takeWhile" takeWhile+            prop "take" take+            -- prop "filter" filter+            prop "filterM" filterM+            prop "drop" drop+            -- prop "dropWhile" dropWhile+            prop "dropWhileM" dropWhileM++testCombination :: Spec+testCombination =+    describe "Transformation"+        $ do+            prop "zipWithM" zipWithM+            -- prop "zipWith" zipWith+            -- prop "teeZipWith" teeZipWith+            prop "concat" concat+            prop "concatMapM" concatMapM+            prop "outerProduct" outerProduct+            -- prop "ap" ap+            -- prop "apDiscardFst" apDiscardFst+            -- prop "apDiscardSnd" apDiscardSnd++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Unfold"++main :: IO ()+main =+    hspec+        $ describe moduleName+        $ do+            testInputOps+            testGeneration+            testTransformation+            testCombination
+ 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
@@ -0,0 +1,30 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.FileSystem.Event+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Test.FileSystem.Event (main) where++import qualified Streamly.Internal.FileSystem.Event as Event+import Streamly.Test.FileSystem.Event.Common++moduleName :: String+moduleName = "FileSystem.Event"++main :: IO ()+main = do+    let run = runTests moduleName "non-recursive" Event.watch+    run DirType commonTests+    run+#if defined(CABAL_OS_DARWIN)+        SymLinkResolvedPath+#else+        SymLinkOrigPath+#endif+        commonTests
+ test/Streamly/Test/FileSystem/Event/Common.hs view
@@ -0,0 +1,448 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.FileSystem.Event.Common+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Test.FileSystem.Event.Common+    ( TestDesc++    -- * Running tests+    , runTests+    , WatchRootType (..)++    -- * Event predicates+    , dirEvent+    , fileEvent++    -- * Tests+    , dirCreate+    , dirCreateWithParent+    , dirDelete+    , dirMove+    , rootDirMove++    , fileCreate+    , fileCreateWithParent+    , fileDelete+    , fileModify+    , fileMove+    , rootFileMove++    , commonTests+    , commonRecTests+    )++where++import Debug.Trace (trace)+import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar, threadDelay)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO)+import Data.Bifunctor (first)+import Data.Function ((&))+import Data.Functor.Identity (runIdentity)+import Data.List.NonEmpty (NonEmpty)+import Data.Word (Word8)+import Streamly.Data.Array (Array)+import System.Directory+    ( createDirectory+    , createDirectoryIfMissing+    , createDirectoryLink+    , doesDirectoryExist+    , doesFileExist+    , removeFile+    , removePathForcibly+    , renameDirectory+    , renamePath+    )+import System.FilePath ((</>), takeDirectory)+import System.IO+    ( BufferMode(..), hSetBuffering, stdout, IOMode (WriteMode), openFile+    , hClose)+import System.IO.Temp (withSystemTempDirectory)++import qualified Data.List.NonEmpty as NonEmpty+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)+import Streamly.Internal.FileSystem.Event.Linux (Event)+import qualified Streamly.Internal.FileSystem.Event.Linux as Event+#elif defined(FILESYSTEM_EVENT_DARWIN)+import Streamly.Internal.FileSystem.Event.Darwin (Event)+import qualified Streamly.Internal.FileSystem.Event.Darwin as Event+#elif defined(FILESYSTEM_EVENT_WINDOWS)+import Streamly.Internal.FileSystem.Event.Windows (Event)+import qualified Streamly.Internal.FileSystem.Event.Windows as Event+#else+import Streamly.Internal.FileSystem.Event (Event)+import qualified Streamly.Internal.FileSystem.Event as Event+#endif++import Test.Hspec++-------------------------------------------------------------------------------+-- Check generated events+-------------------------------------------------------------------------------++type EventChecker =+       FilePath  -- watch root+    -> FilePath  -- watch target, target dir if root is a symlink+    -> MVar ()   -- mvar to sync file system ops and the watch+    -> [(String, Event -> Bool)] -- expected events+    -> IO ()+type EventWatcher = NonEmpty (Array Word8) -> Stream.Stream IO Event.Event++eventMatches :: Event -> (String, Event -> Bool) -> Bool+eventMatches ev (expectedPath, f) =+    trace ("paths: " ++ show evPath ++ " " ++ show expectedPath)+        (evPath == expectedPath && f ev)++    where++    utf8ToString :: Array Word8 -> String+    utf8ToString =+        runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.read++    evPath = utf8ToString (Event.getAbsPath ev)++toUtf8 :: MonadIO m => String -> m (Array Word8)+toUtf8 = Array.fromStream . Unicode.encodeUtf8' . Stream.fromList++checkEvents :: EventWatcher -> EventChecker+checkEvents watcher rootPath targetPath mvar matchList = do+    putStrLn ("Watching on root [" <> rootPath+             <> "] for [" <> targetPath <> "]")++    let matchList1 = fmap (first (targetPath </>)) matchList+        finder xs ev = filter (not . eventMatches ev) xs++    paths <- mapM toUtf8 [rootPath]+    watcher (NonEmpty.fromList paths)+        & Stream.before (putMVar mvar ())+        & Stream.trace (putStrLn . Event.showEvent)+        & Stream.scanl' finder matchList1+        & Stream.takeWhile (not . null)+        & Stream.drain++-------------------------------------------------------------------------------+-- Run tests+-------------------------------------------------------------------------------++type TestDesc =+    ( String            -- test description+    , FilePath -> IO () -- pre test operation, arg is path of the watch root.+    , FilePath -> IO () -- file system action, arg is path of the watch root.+    , [(String, Event -> Bool)] -- expected events (Absolute Path, predicate)+    )++-- | Whether watch root is a symlink and if so then what's the behavior+data WatchRootType =+      DirType             -- watch root is a directory+    | FileType            -- watch root is a file+    | SymLinkResolvedPath -- symlink to a directory,+                          -- Event contains path via the resolved dir+    | SymLinkOrigPath     -- symlink to a directory,+                          -- Event contains path via the original symlink+    deriving Show++driver :: EventChecker -> WatchRootType -> TestDesc -> SpecWith ()+driver checker symlinkStyle (desc, pre, ops, expected) =+    it desc $ runOneTest `shouldReturn` ()++    where++    fseventDir :: String+    fseventDir = "fsevent_dir"++    runOneTest = do+            sync <- newEmptyMVar+            withSystemTempDirectory fseventDir $ \fp -> do+                let root = fp </> "watch-root"+                target <-+                    case symlinkStyle of+                        DirType -> do+                            createDirectory root+                            return root+                        FileType -> do+                            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+                            return root++                -- XXX On macOS we seem to get the watch root create events+                -- even though they occur before the watch is started.  Even if+                -- we add a delay here.+                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.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 $ fp <> ": Time out occurred before event watcher could terminate"++-------------------------------------------------------------------------------+-- Test descriptions+-------------------------------------------------------------------------------++dirEvent, fileEvent :: (Event -> Bool) -> Event -> Bool++#if defined(FILESYSTEM_EVENT_DARWIN)+dirEvent f ev = Event.isDir ev && f ev+fileEvent f ev = Event.isFile ev && f ev+#elif defined(FILESYSTEM_EVENT_LINUX)+dirEvent f ev = Event.isDir ev && f ev+fileEvent f ev = not (Event.isDir ev) && f ev+#else+dirEvent = id+fileEvent = id+#endif++-- XXX Tests for root as a regular file instead of dir?+-- XXX Add symlink and hardlink tests+-- XXX Add exception condition tests++-------------------------------------------------------------------------------+-- Dir tests+-------------------------------------------------------------------------------++createParent :: FilePath -> FilePath -> IO ()+createParent file parent = do+    createDirectoryIfMissing True (takeDirectory (parent </> file))++createDirWithParent :: FilePath -> FilePath -> IO ()+createDirWithParent dir parent =+    when (not (null dir)) $ createDirectoryIfMissing True (parent </> dir)++createDir :: FilePath -> FilePath -> IO ()+createDir dir parent =+    when (not (null dir)) $ createDirectory (parent </> dir)++-- | Create the dir along with its parent dir during the test. This is+-- especially useful to detect a race in Linux case where the watch for a+-- directory is added in event processing, so if the the child directory is+-- created before the watch was installed then we may miss some events.+dirCreateWithParent ::+    String -> (String -> [([Char], Event -> Bool)]) -> TestDesc+dirCreateWithParent dir events =+    ( "dir created (" ++ dir ++ ")"+    , const (return ())+    , createDirWithParent dir+    , events dir+    )++dirCreate :: String -> (String -> [([Char], Event -> Bool)]) -> TestDesc+dirCreate dir events =+    ( "dir created (" ++ dir ++ ")"+    , createParent dir+    , createDir dir+    , events dir+    )++dirDelete :: String -> (String -> [([Char], Event -> Bool)]) -> TestDesc+dirDelete dir events =+      ( "dir deleted (" ++ dir ++ ")"+      , createDirWithParent dir+      , \fp -> removePathForcibly (fp </> dir)+      , events dir+      )++dirMove ::+       String+    -> String+    -> (String -> String -> [(String, Event -> Bool)])+    -> TestDesc+dirMove dir1 dir2 events =+      ( "dir moved (" ++ dir1 ++ " " ++ dir2 ++ ")"+      , createDirWithParent dir1+      , \fp -> renameDirectory (fp </> dir1) (fp </> dir2)+      , events dir1 dir2+      )++rootDirMove ::+       String+    -> (String -> [(String, Event -> Bool)])+    -> TestDesc+rootDirMove suffix events =+      ( "root dir moved" ++ "(" ++ suffix ++ ")"+      , const (return ())+      , \fp -> renameDirectory fp (fp <> suffix)+      , events ""+      )++-------------------------------------------------------------------------------+-- File tests+-------------------------------------------------------------------------------++createFileWithParent :: FilePath -> FilePath -> IO ()+createFileWithParent file parent = do+    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 =+    openFile (parent </> file) WriteMode >>= hClose++fileCreate :: String -> (String -> [(String, Event -> Bool)]) -> TestDesc+fileCreate file1 events =+    ( "File created (" ++ file1 ++ ")"+    , createParent file1+    , createFile file1+    , (file1, fileEvent Event.isCreated) : events file1+    )++-- | See comments in dirCreateWithParent+fileCreateWithParent ::+    String -> (String -> [(String, Event -> Bool)]) -> TestDesc+fileCreateWithParent file1 events =+    ( "File created (" ++ file1 ++ ")"+    , const (return ())+    , createFileWithParent  file1+    , (file1, fileEvent Event.isCreated) : events file1+    )++fileDelete :: String -> (String -> [(String, Event -> Bool)]) -> TestDesc+fileDelete file1 events =+    ( "File deleted (" ++ file1 ++ ")"+    , createFileWithParent file1+    , \fp -> removeFile (fp </> file1)+    , events file1+    )++fileModify :: String -> (String -> [(String, Event -> Bool)]) -> TestDesc+fileModify file1 events =+    ( "File modified (" ++ file1 ++ ")"+    , createFileWithParent file1+    , \fp -> writeFile (fp </> file1) "Test Data"+    , (file1, fileEvent Event.isModified) : events file1+    )++fileMove ::+       String+    -> String+    -> (String -> String -> [(String, Event -> Bool)])+    -> TestDesc+fileMove file1 file2 events =+    ( "File moved (" ++ file1 ++ " " ++ file2 ++ ")"+    , createFileWithParent file1+    , \fp -> renamePath (fp </> file1) (fp </> file2)+    ,     (file1, fileEvent Event.isMoved)+        : (file2, fileEvent Event.isMoved)+        : events file1 file2+    )++rootFileMove :: String -> (String -> [(String, Event -> Bool)]) -> TestDesc+rootFileMove suffix events =+    ( "File moved (" ++ suffix ++ ")"+    , const (return ())+    , \fp -> renamePath fp (fp <> suffix)+    , events ""+    )++-------------------------------------------------------------------------------+-- Common test bundles+-------------------------------------------------------------------------------++withParent :: [Char] -> [Char] -> [Char]+withParent parent file = if null parent then file else parent </> file++testsWithParent :: String -> [TestDesc]+testsWithParent p =+    [ dirCreate+        (withParent p "dir") (\dir -> [(dir, dirEvent Event.isCreated)])+    , dirDelete+        (withParent p "dir") (\dir -> [(dir, dirEvent Event.isDeleted)])+    , dirMove+        (withParent p "dir1")+        (withParent p "dir2")+        (\dir1 dir2 ->+            [ (dir1, dirEvent Event.isMoved)+            , (dir2, dirEvent Event.isMoved)+            ]+        )+    , fileCreate (withParent p "file1") (const [])+    , fileDelete+        (withParent p "file1")+        (\file -> [(file, fileEvent Event.isDeleted)])+    , fileModify (withParent p "file1") (const [])+    , fileMove (withParent p "file1") (withParent p "file2") (\_ _ -> [])+    ]++commonTests :: [TestDesc]+commonTests = testsWithParent ""++commonRecTests :: [TestDesc]+commonRecTests = testsWithParent "subdir"++-------------------------------------------------------------------------------+-- Running tests+-------------------------------------------------------------------------------++runTests ::+       String+    -> String+    -> EventWatcher+    -> WatchRootType+    -> [TestDesc]+    -> IO ()+runTests modName watchType watcher rootType tests = do+    hSetBuffering stdout NoBuffering+    hspec+        $ describe modName+        $ describe watchType+        $ do+            let checker = checkEvents watcher+            describe ("Root type " ++ show rootType)+                    $ mapM_ (driver checker rootType) tests
+ test/Streamly/Test/FileSystem/Event/Darwin.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.FileSystem.Event.Darwin+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Test.FileSystem.Event.Darwin (main) where++import qualified Streamly.Internal.FileSystem.Event.Darwin as Event++import Streamly.Test.FileSystem.Event.Common++moduleName :: String+moduleName = "FileSystem.Event.Darwin"++-- TODO:+-- Creation/deletion/move of hard links+-- Deletion of last hard link+-- If a directory is a symlink is it followed in recursive mode?++main :: IO ()+main = do+    let symLinkRootTests =+              dirCreateWithParent "subdir/dir"+                (\dir -> [(dir, dirEvent Event.isCreated)])+            : fileCreateWithParent "subdir/file"+                (\file ->+                    [ (file, fileEvent Event.isCreated)+                    , (file, fileEvent Event.isAttrsModified)+                    ]+                )+            : fileCreate "file-create-attrs"+                (\file ->+                    [ (file, fileEvent Event.isCreated)+                    , (file, fileEvent Event.isAttrsModified)+                    ]+                )+            : fileModify+                    "file-mod-attrs"+                    (\file -> [(file, fileEvent Event.isAttrsModified)])+            : dirDelete "dir-sec" (\dir ->+                [ (dir, dirEvent Event.isDeleted)+                , (dir, dirEvent Event.isSecurityModified)+                ]+                )+            : commonTests+            ++ commonRecTests+    let regularRootTests =+              dirDelete "" (\dir ->+                [ (dir, dirEvent Event.isDeleted)+                , (dir, dirEvent Event.isSecurityModified)+                , (dir, Event.isRootPathEvent)+                ]+                )+            -- The watch root create event always seems to come even though the+            -- root is created before the watch is started. That may be because+            -- of batching?+            -- XXX Need to create watch root after adding the watch, otherwise+            -- it fails intermittently.+            -- : dirCreate "" (\dir -> [(dir, dirEvent Event.isCreated)])+            : rootDirMove "moved" (\src ->+                [ (src, Event.isRootPathEvent)+                , (src, Event.isMoved)+                ])+            : symLinkRootTests++    let fileRootTests =+            [ fileDelete "" (\path ->+                [ (path, Event.isRootPathEvent)+                , (path, Event.isDeleted)+                ])+            , rootFileMove "moved" (\path ->+                [(path, Event.isRootPathEvent)+                , (path, Event.isMoved)+                ])+            , fileModify "" (const [])+            ]++    let w = Event.watchWith (Event.setAllEvents True)+        run = runTests moduleName "recursive" w++    run DirType regularRootTests+    run SymLinkResolvedPath symLinkRootTests+    run FileType fileRootTests
+ test/Streamly/Test/FileSystem/Event/Linux.hs view
@@ -0,0 +1,210 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.FileSystem.Event.Linux+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+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"++dirTouchEvents :: String -> [([Char], Event -> Bool)]+dirTouchEvents dir =+    [ (dir, dirEvent Event.isOpened)+    , (dir, dirEvent Event.isAccessed)+    , (dir, dirEvent Event.isNonWriteClosed)+    ]++dirDelEvents :: String -> [([Char], Event -> Bool)]+dirDelEvents dir =+      (dir, dirEvent Event.isDeleted)+    : (dir, dirEvent Event.isAttrsModified)+    : dirTouchEvents dir++rootDirDelEvents :: String -> [([Char], Event -> Bool)]+rootDirDelEvents root =+      (root, Event.isRootUnwatched)+    : (root, Event.isRootDeleted)+    : (root, dirEvent Event.isAttrsModified)+    : dirTouchEvents root++dirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]+dirMoveEvents src dst =+    [ (src, dirEvent Event.isMoved)+    , (src, dirEvent Event.isMovedFrom)+    , (dst, dirEvent Event.isMoved)+    , (dst, dirEvent Event.isMovedTo)+    ]++#ifdef DEVBUILD+-- In recursive mode all subdirectories are roots therefore they will generate+-- isRootMoved.+rootDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]+rootDirMoveEvents root _ =+      (root, Event.isRootMoved)+    : dirTouchEvents root++recDirMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]+recDirMoveEvents src dst = dirMoveEvents src dst ++ rootDirMoveEvents src dst+#endif++fileTouchEvents :: String -> [([Char], Event -> Bool)]+fileTouchEvents file =+    [ (file, fileEvent Event.isOpened)+    , (file, fileEvent Event.isModified)+    , (file, fileEvent Event.isWriteClosed)+    ]++fileMoveEvents :: [Char] -> [Char] -> [([Char], Event -> Bool)]+fileMoveEvents src dst =+    [ (src, fileEvent Event.isMoved)+    , (src, fileEvent Event.isMovedFrom)+    , (dst, fileEvent Event.isMoved)+    , (dst, fileEvent Event.isMovedTo)+    ]++-- TODO: add fileRoot tests from macOS test suite++main :: IO ()+main = do+    -- We ignore the events on root/parent dir during regular non-root dir/file+    -- tests.++    -- Tests common to regular root and symlink root cases+    let regSymTests =+              fileCreate "file" fileTouchEvents+            : fileMove "file1" "file2" fileMoveEvents+            : dirMove "dir1" "dir2" dirMoveEvents+            : dirDelete "dir" dirDelEvents+            : commonTests++    let regTests =+              dirDelete "" rootDirDelEvents+            : rootDirMove "moved" (\src -> [(src, Event.isRootMoved)])+            : regSymTests++    let symTests =+#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)])+            :+#endif+            regSymTests++    let w = Event.watchWith (Event.setAllEvents True)+        run = runTests moduleName "non-recursive" w++#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)+                , (path, Event.isRootDeleted)+                , (path, Event.isRootUnwatched)+                ])+            , rootFileMove "moved" (\path -> [(path, Event.isRootMoved)])+            , fileModify "" (\path -> [(path, Event.isOpened)])+            ]++    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+    -- self watch as a root of the watch. Therefore, additional touchEvents are+    -- generated in this case.+    --+    -- XXX We can possibly filter out the duplicate events either from the+    -- parent or self.+    let regSymRecTests =+            -- XXX Nested file create misses the create event due to a race+            -- : fileCreateWithParent "subdir/file" fileTouchEvents+              fileCreate "subdir/file" fileTouchEvents+            : fileMove "subdir/file1" "subdir/file2" fileMoveEvents+            : dirMove "dir1" "dir2" recDirMoveEvents+            : dirMove "subdir/dir1" "subdir/dir2" recDirMoveEvents+            : dirDelete "dir" (\d -> rootDirDelEvents d ++ dirDelEvents d)+            : dirDelete "subdir/dir" (\d -> rootDirDelEvents d ++ dirDelEvents d)+            -- XXX Nested dir create misses the create event due to a race+            -- : dirCreateWithParent "subdir/dir" dirTouchEvents+            : dirCreate "subdir/dir"+                (\dir -> (dir, dirEvent Event.isCreated) : dirTouchEvents dir)+            : dirCreate "dir"+                (\dir -> (dir, dirEvent Event.isCreated) : dirTouchEvents dir)+            : commonRecTests+        recRegTests = regTests ++ regSymRecTests+        recSymTests = symTests ++ regSymRecTests++    -- 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)++#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
@@ -0,0 +1,53 @@+{-# OPTIONS_GHC -Wno-deprecations #-}
+
+-- |
+-- Module      : Streamly.Test.FileSystem.Event.Windows
+-- Copyright   : (c) 2020 Composewell Technologies
+-- License     : BSD-3-Clause
+-- Maintainer  : streamly@composewell.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+module Streamly.Test.FileSystem.Event.Windows (main) where
+
+import qualified Streamly.Internal.FileSystem.Event.Windows as Event
+import Streamly.Test.FileSystem.Event.Common
+
+moduleName :: String
+moduleName = "FileSystem.Event.Windows"
+
+-- TODO Test isModified event for parent directories when a file is created or
+-- deleted.
+
+main :: IO ()
+main = do
+    let regularRootTests =
+            commonTests
+        -- The following watch-root deletion test results in:
+        -- C:\tmp\fsevent_dir-e061f0b0a00e1696\watch-root:
+        -- removePathForcibly:RemoveDirectory
+        -- "\\\\?\\C:\\tmp\\fsevent_dir-e061f0b0a00e1696\\watch-root":
+        -- permission denied (The process cannot access the file because it is
+        -- being used by another process.)
+        --
+        -- ++ dirDelete "" (\dir -> [(dir, Event.isDeleted)])
+
+    let w = Event.watchWith (Event.setAllEvents True)
+        run = runTests moduleName "non-recursive" w
+
+    run DirType regularRootTests
+    run SymLinkOrigPath commonTests
+
+    let recTests =
+            [ dirCreateWithParent "subdir\\dir"
+                (\dir -> [(dir, dirEvent Event.isCreated)])
+            , fileCreateWithParent "subdir\\file"
+                (\file -> [(file, fileEvent Event.isCreated)])
+            ] ++ commonRecTests
+
+    let recw = Event.watchWith
+                (Event.setAllEvents True . Event.setRecursiveMode True)
+        runRec = runTests moduleName "recursive" recw
+
+    runRec DirType (regularRootTests ++ recTests)
+    runRec SymLinkOrigPath (commonTests ++ recTests)
+ test/Streamly/Test/FileSystem/Handle.hs view
@@ -0,0 +1,239 @@+-- |+-- Module      : Streamly.Test.FileSystem.Handle+-- Copyright   : (c) 2020 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.FileSystem.Handle (main) where++import Data.Functor.Identity (runIdentity)+import Data.Word (Word8)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.System.IO (defaultChunkSize)+import System.FilePath ((</>))+import System.IO+    ( Handle+    , IOMode(..)+    , SeekMode(..)+    , hClose+    , hFlush+    , hSeek+    , 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 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++writeFile :: Path -> String -> IO ()+writeFile fpath val = withFile fpath WriteMode (`hPutStr` val)++maxArrLen :: Int+maxArrLen = defaultChunkSize * 8++maxTestCount :: Int+maxTestCount = 10++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 . toList . Unicode.decodeUtf8' . Array.read++testData :: String+testData = "This is the test data for FileSystem.Handle ??`!@#$%^&*~~))`]"++testDataLarge :: String+testDataLarge = concat $ replicate 6000 testData++testBinData :: String+testBinData = "01234567890123456789012345678901234567890123456789"++executor :: (Handle -> Stream IO Char) -> IO (Stream IO Char)+executor f =+    withSystemTempDirectory "fs_handle" $ \fp -> do+        fpath <- Path.fromString $ fp </> "tmp_read.txt"+        writeFile fpath testDataLarge+        h <- openFile fpath ReadMode+        return $ f h++readFromHandle :: IO (Stream IO Char)+readFromHandle =+    let f = Unicode.decodeUtf8 . Stream.unfold Handle.reader+    in executor f++readWithBufferFromHandle :: IO (Stream IO Char)+readWithBufferFromHandle =+    let f1 h = (1024, h)+        f2 = Unicode.decodeUtf8 . Stream.unfold Handle.readerWith . f1+    in executor f2++readChunksFromHandle :: IO (Stream IO Char)+readChunksFromHandle =+    let f =   Unicode.decodeUtf8+            . Stream.concatMap Array.read+            . Stream.unfold Handle.chunkReader+    in executor f++readChunksWithBuffer :: IO (Stream IO Char)+readChunksWithBuffer =+    let f1 h = (1024, h)+        f2 =+              Unicode.decodeUtf8+            . Stream.concatMap Array.read+            . Stream.unfold Handle.chunkReaderWith+            . f1+    in executor f2++testRead :: IO (Stream IO Char) -> Property+testRead fn = monadicIO $ do+    let v2 = Stream.fromList testDataLarge+    v1 <- run fn+    res <- run $ Stream.eqBy (==) v1 v2+    assert res++testWrite :: (Handle -> Fold.Fold IO Word8 ()) -> Property+testWrite hfold =+    forAll (choose (0, maxArrLen)) $ \len ->+        forAll (vectorOf len $ chooseWord8 (0, 255)) $ \list0 ->+            monadicIO $ do+                res <- run $ go list0+                assert res++                where++                go list =+                    withSystemTempDirectory "fs_handle" $ \fp -> do+                        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 <- toList $ Stream.unfold Handle.reader h+                        hClose h+                        return (ls == list)++testWriteWithChunk :: Property+testWriteWithChunk =+    monadicIO $ do+        res <- run go+        assert res++        where++        go =+            withSystemTempDirectory "fs_handle" $ \fp -> do+                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.chunkReaderWith (1024, hr)+                hFlush hw+                hSeek hw AbsoluteSeek 0+                ls <- toList $ Stream.unfold Handle.reader hw+                let arr = Array.fromList ls+                return (testDataLarge == utf8ToString arr)++testReadChunksFromToWith :: Int -> Int -> Int -> [[Word8]] -> Property+testReadChunksFromToWith from to buffSize res = monadicIO $ run go++    where++    go =+        withSystemTempDirectory "fs_handle" $ \fp -> do+            fpathRead <- Path.fromString $ fp </> "tmp_read.txt"+            writeFile fpathRead testBinData+            h <- openFile fpathRead ReadMode+            ls <-+                toList+                    $ Stream.unfold+                        Handle.chunkReaderFromToWith (from, to, buffSize, h)+            return (res `shouldBe` fmap Array.toList ls)++-- Test for first byte+testReadChunksFromToWithFirstByte :: Property+testReadChunksFromToWithFirstByte = testReadChunksFromToWith 0 0 15 [[48]]++-- Test for second byte+testReadChunksFromToWithSecondByte :: Property+testReadChunksFromToWithSecondByte = testReadChunksFromToWith 1 1 15 [[49]]++-- Test for second to 10th bytes+testReadChunksFromToWithSecondToTenthBytes :: Property+testReadChunksFromToWithSecondToTenthBytes =+    testReadChunksFromToWith 1 10 15 [[49,50,51,52,53,54,55,56,57,48]]++-- Test for offset of buffer size+testReadChunksFromToWithBuffSizeOffset :: Property+testReadChunksFromToWithBuffSizeOffset =+    testReadChunksFromToWith 15 25 15 [[53,54,55,56,57,48,49,50,51,52,53]]++-- Test with multi buffer size+testReadChunksFromToWithMultiBuff :: Property+testReadChunksFromToWithMultiBuff =+    testReadChunksFromToWith+        5 22 5 [[53,54,55,56,57],[48,49,50,51,52],[53,54,55,56,57],[48,49,50]]++testReadChunksFromToWithRangeInvalid :: Property+testReadChunksFromToWithRangeInvalid = testReadChunksFromToWith 15 5 15 []++moduleName :: String+moduleName = "FileSystem.Handle"++main :: IO ()+main =+    hspec $+    H.parallel $+    modifyMaxSuccess (const maxTestCount) $ do+      describe moduleName $ do+        describe "Read From Handle" $ do+            prop "read" $ testRead readFromHandle+            prop "readWith" $ testRead readWithBufferFromHandle+            prop "readChunks" $ testRead readChunksFromHandle+            prop "readChunksWith" $ testRead readChunksWithBuffer+            prop "readChunksFromToWith (0,0,n)"+                testReadChunksFromToWithFirstByte+            prop "readChunksFromToWith (1,1,n)"+                testReadChunksFromToWithSecondByte+            prop "readChunksFromToWith (1,10,n)"+                testReadChunksFromToWithSecondToTenthBytes+            prop "readChunksFromToWith (n,<2n,n)"+                testReadChunksFromToWithBuffSizeOffset+            prop "readChunksFromToWith (n,>2n,n)"+                testReadChunksFromToWithMultiBuff+            prop "readChunksFromToWith (n,<n,n)"+                testReadChunksFromToWithRangeInvalid+        describe "Write To Handle" $ do+            prop "write" $ testWrite Handle.write+            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
@@ -0,0 +1,143 @@++-- |+-- Module      : Streamly.Test.Network.Socket+-- Copyright   : (c) 2020 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Main (main) where++import Control.Concurrent (threadDelay, killThread, forkIO)+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)+import Control.Monad.IO.Class (liftIO)+import Data.Function ((&))+import Data.Word (Word8)+import Network.Socket (Socket, PortNumber)+import Streamly.Internal.Control.Monad (discard)+import Streamly.Internal.System.IO (defaultChunkSize)+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 Test.Hspec+import Test.Hspec.QuickCheck++------------------------------------------------------------------------------+-- Command Handlers+------------------------------------------------------------------------------+testData :: String+testData = "Test data 1234567891012131415!@#$%^&*()`~ABCD"++testDataSource :: String+testDataSource = concat $ replicate 1000 testData++------------------------------------------------------------------------------+-- Read and Write data on a socket+------------------------------------------------------------------------------+handlerRW :: Socket -> IO ()+handlerRW sk =+          Stream.unfold Socket.reader sk+        & Stream.fold (Socket.write sk)+        & discard++------------------------------------------------------------------------------+-- Accept connections and handle connected sockets+------------------------------------------------------------------------------++-- Ideally we should choose an available port automatically.  However, to test+-- the APIs that do not allow choosing a port automatically we still need to+-- use a hardcoded port or search an available port on the system.+--+-- This is unreliable and the test may fail on systems where this port is not+-- available. We choose a higher port number so that the likelihood of it being+-- available is more.+--+-- Also, we cannot run the test after running it once until the timeout.+basePort :: PortNumber+basePort = 64100++server+    :: Unfold.Unfold IO PortNumber Socket+    -> PortNumber+    -> MVar ()+    -> (Socket -> IO ())+    -> IO ()+server listener port sem handler = do+    putMVar sem ()+    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 () -> 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 (Stream IO Char)+execute listener port size handler = do+    sem <- newEmptyMVar+    tid <- forkIO $ server listener port sem handler+    let lst = sender port sem+                & Stream.take size+                & Stream.finally (killThread tid)+    return lst++validateOnPort :: Property+validateOnPort = monadicIO $ do+    res <- run $ do+        ls2 <-+            execute TCP.acceptor basePort defaultChunkSize handlerRW+        let dataChunk = take defaultChunkSize testDataSource+        Stream.eqBy (==) (Stream.fromList dataChunk) ls2+    assert res++validateOnPortLocal :: Property+validateOnPortLocal = monadicIO $ do+    res <- run $ do+        ls2 <-+            execute+                TCP.acceptorLocal+                (basePort + 1)+                defaultChunkSize+                handlerRW+        let dataChunk = take defaultChunkSize testDataSource+        Stream.eqBy (==) (Stream.fromList dataChunk) ls2+    assert res++moduleName :: String+moduleName = "Network.Inet.TCP"++main :: IO ()+main = hspec $ do+    modifyMaxSuccess (const 1) $ do+      describe moduleName $ do+        describe "Accept Connections" $ do+            prop "acceptOnPort" validateOnPort+            prop "acceptOnPortLocal" validateOnPortLocal+        --  prop "acceptOnAddr/connect" Tested as part of above test cases
+ test/Streamly/Test/Network/Socket.hs view
@@ -0,0 +1,159 @@++-- |+-- Module      : Streamly.Test.Network.Socket+-- Copyright   : (c) 2020 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Main (main) where++import Control.Concurrent (threadDelay, killThread, forkIO)+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)+import Control.Monad.IO.Class (liftIO)+import Data.Function ((&))+import Data.Word (Word8)+import Network.Socket (Socket, PortNumber)+import Streamly.Internal.Control.Monad (discard)+import Streamly.Internal.System.IO (defaultChunkSize)+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 Test.Hspec+import Test.Hspec.QuickCheck++------------------------------------------------------------------------------+-- Command Handlers+------------------------------------------------------------------------------+testData :: String+testData = "Test data 1234567891012131415!@#$%^&*()`~ABCD"++testDataSource :: String+testDataSource = concat $ replicate 1000 testData++------------------------------------------------------------------------------+-- Parse and handle commands on a socket+------------------------------------------------------------------------------++handlerChunksWithBuffer :: Socket -> IO ()+handlerChunksWithBuffer sk =+          Stream.unfold Socket.chunkReaderWith (100, sk)+        & Stream.fold (Socket.writeChunks sk)+        & discard++handlerChunks :: Socket -> IO ()+handlerChunks sk =+          Stream.unfold Socket.chunkReader sk+        & Stream.fold (Socket.writeChunks sk)+        & discard++handlerwithbuffer :: Socket -> IO ()+handlerwithbuffer sk =+          Stream.unfold Socket.readerWith (100, sk)+        & Stream.fold (Socket.writeWith 100 sk)+        & discard++handlerRW :: Socket -> IO ()+handlerRW sk =+          Stream.unfold Socket.reader sk+        & Stream.fold (Socket.write sk)+        & discard++------------------------------------------------------------------------------+-- Accept connections and handle connected sockets+------------------------------------------------------------------------------++-- Ideally we should choose an available port automatically.  However, to test+-- the APIs that do not allow choosing a port automatically we still need to+-- use a hardcoded port or search an available port on the system.+--+-- This is unreliable and the test may fail on systems where this port is not+-- available. We choose a higher port number so that the likelihood of it being+-- available is more.+--+-- Also, we cannot run the test after running it once until the timeout.+basePort :: PortNumber+basePort = 64000++server :: PortNumber -> MVar () -> (Socket -> IO ()) -> IO ()+server port sem handler = do+    putMVar sem ()+    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 () -> 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 :: PortNumber -> Int -> (Socket -> IO ()) -> IO (Stream IO Char)+execute port size handler = do+    sem <- newEmptyMVar+    tid <- forkIO $ server port sem handler+    let lst = sender port sem+                & Stream.take size+                & Stream.finally (killThread tid)+    return lst++validateWith :: Property+validateWith = monadicIO $ do+    res <- run $ do+        ls2 <- execute basePort 45000 handlerwithbuffer+        Stream.eqBy (==) (Stream.fromList testDataSource) ls2+    assert res++validateRW :: Property+validateRW = monadicIO $ do+    res <- run $ do+        ls2 <- execute (basePort + 1) defaultChunkSize handlerRW+        let dataChunk = take defaultChunkSize testDataSource+        Stream.eqBy (==) (Stream.fromList dataChunk) ls2+    assert res++validateChunks :: Property+validateChunks = monadicIO $ do+    res <- run $ do+        ls2 <- execute (basePort + 2) 45000 handlerChunks+        Stream.eqBy (==) (Stream.fromList testDataSource) ls2+    assert res++validateChunksWith :: Property+validateChunksWith = monadicIO $ do+    res <- run $ do+        ls2 <- execute (basePort + 3) 45000 handlerChunksWithBuffer+        Stream.eqBy (==) (Stream.fromList testDataSource) ls2+    assert res++moduleName :: String+moduleName = "Network.Socket"++main :: IO ()+main = hspec $ do+    modifyMaxSuccess (const 1) $ do+      describe moduleName $ do+        describe "Read/Write" $ do+            prop "read/write" validateRW+            prop "readWith/writeWith" validateWith+            prop "readChunks/writeChunks" validateChunks+            prop "readChunksWith" validateChunksWith
+ test/Streamly/Test/Prelude.hs view
@@ -0,0 +1,188 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude (main) where++import Control.Concurrent (myThreadId, threadDelay)+import Control.Exception (Exception, try)+import Control.Monad.Catch (throwM)+import Control.Monad.Error.Class (throwError, MonadError)+import Control.Monad.Trans.Except (runExceptT, ExceptT)+import Data.List (sort)+import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))+import System.Random (randomIO)+import Test.Hspec as H++import Streamly.Prelude (SerialT, IsStream)++import qualified Streamly.Prelude as S++toListSerial :: SerialT IO a -> IO [a]+toListSerial = S.toList . S.fromSerial++-- XXX need to test that we have promptly cleaned up everything after the error+-- XXX We can also check the output that we are expected to get before the+-- error occurs.++newtype ExampleException = ExampleException String deriving (Eq, Show)++instance Exception ExampleException++simpleMonadError :: Spec+simpleMonadError = do+{-+    it "simple runExceptT" $ do+        (runExceptT $ S.drain $ return ())+        `shouldReturn` (Right () :: Either String ())+    it "simple runExceptT with error" $ do+        (runExceptT $ S.drain $ throwError "E") `shouldReturn` Left "E"+        -}+    it "simple try" $+        try (S.drain $ return ())+        `shouldReturn` (Right () :: Either ExampleException ())+    it "simple try with throw error" $+        try (S.drain $ throwM $ ExampleException "E")+        `shouldReturn` (Left (ExampleException "E") :: Either ExampleException ())++_composeWithMonadError+    :: ( IsStream t+       , Semigroup (t (ExceptT String IO) Int)+       , MonadError String (t (ExceptT String IO))+       )+    => (t (ExceptT String IO) Int -> SerialT (ExceptT String IO) Int) -> Spec+_composeWithMonadError t = do+    let tl = S.toList . t+    it "Compose throwError, nil" $+        runExceptT (tl (throwError "E" <> S.nil)) `shouldReturn` Left "E"+    it "Compose nil, error" $+        runExceptT (tl (S.nil <> throwError "E")) `shouldReturn` Left "E"++mixedOps :: Spec+mixedOps =+    it "Compose many ops" $+        (sort <$> toListSerial composeMixed)+            `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11+                            ,11,11,11,11,11,11,11,11,12,12,12,12,12,13+                            ] :: [Int])+    where++    composeMixed :: SerialT IO Int+    composeMixed = do+        S.fromEffect $ return ()+        S.fromEffect $ putStr ""+        let x = 1+        let y = 2+        z <- do+                x1 <- S.fromWAsync $ return 1 <> return 2+                S.fromEffect $ return ()+                S.fromEffect $ putStr ""+                y1 <- S.fromAsync $ return 1 <> return 2+                z1 <- do+                    x11 <- return 1 <> return 2+                    y11 <- S.fromAsync $ return 1 <> return 2+                    z11 <- S.fromWSerial $ return 1 <> return 2+                    S.fromEffect $ return ()+                    S.fromEffect $ putStr ""+                    return (x11 + y11 + z11)+                return (x1 + y1 + z1)+        return (x + y + z)++mixedOpsAheadly :: Spec+mixedOpsAheadly =+    it "Compose many ops" $+        (sort <$> toListSerial composeMixed)+            `shouldReturn` ([8,9,9,9,9,9,10,10,10,10,10,10,10,10,10,10,11,11+                            ,11,11,11,11,11,11,11,11,12,12,12,12,12,13+                            ] :: [Int])+    where++    composeMixed :: SerialT IO Int+    composeMixed = do+        S.fromEffect $ return ()+        S.fromEffect $ putStr ""+        let x = 1+        let y = 2+        z <- do+                x1 <- S.fromWAsync $ return 1 <> return 2+                S.fromEffect $ return ()+                S.fromEffect $ putStr ""+                y1 <- S.fromAhead $ return 1 <> return 2+                z1 <- do+                    x11 <- return 1 <> return 2+                    y11 <- S.fromAhead $ return 1 <> return 2+                    z11 <- S.fromParallel $ return 1 <> return 2+                    S.fromEffect $ return ()+                    S.fromEffect $ putStr ""+                    return (x11 + y11 + z11)+                return (x1 + y1 + z1)+        return (x + y + z)++-- XXX Merge both the loops.+nestedLoops :: IO ()+nestedLoops = S.drain $ do+    S.fromEffect $ hSetBuffering stdout LineBuffering+    x <- loop "A " 2+    y <- loop "B " 2+    S.fromEffect $ myThreadId >>= putStr . show+             >> putStr " "+             >> print (x, y)++    where++    -- we can just use+    -- fromParallel $ mconcat $ replicate n $ fromEffect (...)+    loop :: String -> Int -> SerialT IO String+    loop name n = do+        rnd <- S.fromEffect (randomIO :: IO Int)+        let result = name <> show rnd+            repeatIt = if n > 1 then loop name (n - 1) else S.nil+         in return result `S.wAsync` repeatIt++parallelLoops :: IO ()+parallelLoops = do+    hSetBuffering stdout LineBuffering+    S.drain $ do+        x <- S.take 10 $ loop "A" `S.parallel` loop "B"+        S.fromEffect $ myThreadId >>= putStr . show+               >> putStr " got "+               >> print x++    where++    -- we can just use+    -- fromParallel $ cycle1 $ fromEffect (...)+    loop :: String -> SerialT IO (String, Int)+    loop name = do+        S.fromEffect $ threadDelay 1000000+        rnd <- S.fromEffect (randomIO :: IO Int)+        S.fromEffect $ myThreadId >>= putStr . show+               >> putStr " yielding "+               >> print rnd+        return (name, rnd) `S.parallel` loop name++moduleName :: String+moduleName = "Prelude"++main :: IO ()+main = hspec $ H.parallel $ do+  describe moduleName $ do+    describe "Miscellaneous combined examples" mixedOps+    describe "Miscellaneous combined examples fromAhead" mixedOpsAheadly+    describe "Simple MonadError and MonadThrow" simpleMonadError++    it "Nested loops" nestedLoops+    it "Parallel loops" parallelLoops+    {-+    describe "Composed MonadError fromSerial" $ composeWithMonadError fromSerial+    describe "Composed MonadError fromWSerial" $ composeWithMonadError fromWSerial+    describe "Composed MonadError fromAsync" $ composeWithMonadError fromAsync+    describe "Composed MonadError fromWAsync" $ composeWithMonadError fromWAsync+    -}
+ test/Streamly/Test/Prelude/Ahead.hs view
@@ -0,0 +1,137 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.Ahead+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.Ahead (main) where++import Test.QuickCheck (Property)+import Test.Hspec.QuickCheck+import Test.QuickCheck.Monadic (monadicIO, run)+import Test.Hspec as H++import Streamly.Prelude (IsStream, SerialT, AheadT)+import qualified Streamly.Prelude as S++import Streamly.Test.Common+import Streamly.Test.Prelude.Common++associativityCheck+    :: String+    -> (AheadT IO Int -> SerialT IO Int)+    -> Spec+associativityCheck desc t = prop desc assocCheckProp+  where+    assocCheckProp :: [Int] -> [Int] -> [Int] -> Property+    assocCheckProp xs ys zs =+        monadicIO $ do+            let xStream = S.fromList xs+                yStream = S.fromList ys+                zStream = S.fromList zs+            infixAssocstream <-+                run $ S.toList $ t $ xStream `S.ahead` yStream `S.ahead` zStream+            assocStream <- run $ S.toList $ t $ xStream <> yStream <> zStream+            listEquals (==) infixAssocstream assocStream++moduleName :: String+moduleName = "Prelude.Ahead"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    let aheadOps :: IsStream t => ((AheadT IO a -> t IO a) -> Spec) -> Spec+        aheadOps spec = mapOps spec $ makeOps S.fromAhead+#ifndef COVERAGE_BUILD+              <> [("maxBuffer (-1)", S.fromAhead . S.maxBuffer (-1))]+#endif++    describe "Construction" $ do+        aheadOps    $ prop "aheadly replicateM" . constructWithReplicateM+        aheadOps $ prop "aheadly cons" . constructWithCons S.cons+        aheadOps $ prop "aheadly consM" . constructWithConsM S.consM id+        aheadOps $ prop "aheadly (.:)" . constructWithCons (S..:)+        aheadOps $ prop "aheadly (|:)" . constructWithConsM (S.|:) id++    describe "Functor operations" $ do+        aheadOps     $ functorOps S.fromFoldable "aheadly" (==)+        aheadOps     $ functorOps folded "aheadly folded" (==)++    describe "Monoid operations" $ do+        aheadOps     $ monoidOps "aheadly" mempty (==)++    describe "Ahead loops" $ loops S.fromAhead id reverse++    describe "Bind and Monoidal composition combinations" $ do+        aheadOps $ bindAndComposeSimpleOps "Ahead" sortEq+        aheadOps $ bindAndComposeHierarchyOps "Ahead"+        aheadOps $ nestTwoStreams "Ahead" id id+        aheadOps $ nestTwoStreamsApp "Ahead" id id+        composeAndComposeSimpleSerially "Ahead <> " (repeat [1..9]) S.fromAhead+        composeAndComposeSimpleAheadly "Ahead <> " (repeat [1 .. 9]) S.fromAhead+        composeAndComposeSimpleWSerially+            "Ahead <> "+            [[1..9], [1..9], [1,3,2,4,6,5,7,9,8], [1,3,2,4,6,5,7,9,8]]+            S.fromAhead++    describe "Semigroup operations" $ do+        aheadOps $ semigroupOps "aheadly" (==)+        aheadOps $ associativityCheck "ahead == <>"++    describe "Applicative operations" $ do+        aheadOps $ applicativeOps S.fromFoldable "aheadly applicative" (==)+        aheadOps $ applicativeOps folded "aheadly applicative 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.+        aheadOps    $ prop "zip applicative aheadly" . zipAsyncApplicative S.fromFoldable (==)+        aheadOps    $ prop "zip applicative aheadly folded" . zipAsyncApplicative folded (==)+        aheadOps    $ prop "zip monadic aheadly" . zipAsyncMonadic S.fromFoldable (==)+        aheadOps    $ prop "zip monadic aheadly folded" . zipAsyncMonadic 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+        aheadOps    $ prop "aheadly monad then" . monadThen S.fromFoldable (==)+        aheadOps    $ prop "aheadly monad then folded" . monadThen folded (==)+        aheadOps    $ prop "aheadly monad bind" . monadBind S.fromFoldable (==)+        aheadOps    $ prop "aheadly monad bind folded"   . monadBind folded (==)++    describe "Stream transform and combine operations" $ do+        aheadOps     $ transformCombineOpsCommon S.fromFoldable "aheadly" (==)+        aheadOps     $ transformCombineOpsCommon folded "aheadly" (==)+        aheadOps     $ transformCombineOpsOrdered S.fromFoldable "aheadly" (==)+        aheadOps     $ transformCombineOpsOrdered folded "aheadly" (==)++    describe "Stream elimination operations" $ do+        aheadOps     $ eliminationOps S.fromFoldable "aheadly"+        aheadOps     $ eliminationOps folded "aheadly folded"+        aheadOps     $ eliminationOpsWord8 S.fromFoldable "aheadly"+        aheadOps     $ eliminationOpsWord8 folded "aheadly folded"++    -- 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+        aheadOps     $ eliminationOpsOrdered S.fromFoldable "aheadly"+        aheadOps     $ eliminationOpsOrdered folded "aheadly folded"++    describe "Tests for exceptions" $ aheadOps $ exceptionOps "aheadly"+    describe "Composed MonadThrow aheadly" $ composeWithMonadThrow S.fromAhead++    -- Ad-hoc tests+    it "takes n from stream of streams" $ takeCombined 1 S.fromAhead
+ test/Streamly/Test/Prelude/Async.hs view
@@ -0,0 +1,147 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.Async+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.Async (main) where++import Control.Concurrent (threadDelay)+import Data.List (sort)+import Test.Hspec.QuickCheck+import Test.QuickCheck (Property, withMaxSuccess)+import Test.QuickCheck.Monadic (monadicIO, run)+import Test.Hspec as H++import Streamly.Prelude+import qualified Streamly.Prelude as S++import Data.IORef+import Streamly.Test.Common+import Streamly.Test.Prelude.Common+++moduleName :: String+moduleName = "Prelude.Async"++constructfromAsyncSingleThread ::+    S.AsyncT IO Int -> S.AsyncT IO Int-> [Int] -> Property+constructfromAsyncSingleThread s1 s2 res =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        x <-  run+            $ S.toList+            $ S.fromAsync+            $ S.maxThreads 1+            $ s1 `S.async` s2+        equals (==) x res++concurrentApplicative :: IO ()+concurrentApplicative = do+    ref <- newIORef []+    let action i = modifyIORef ref (++ [i]) >> return (i :: Int)+        s1 = S.fromEffect (threadDelay 2000000 >> action 1)+        s2 = S.fromEffect (threadDelay 1000000 >> action 2)+    res <- S.toList $ S.fromZipAsync $ (,) <$> s1 <*> s2+    refVal <- readIORef ref+    res `shouldBe` [(1, 2)]+    refVal `shouldBe` [2, 1]++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    let asyncOps :: IsStream t => ((AsyncT IO a -> t IO a) -> Spec) -> Spec+        asyncOps spec = mapOps spec $ makeOps fromAsync+#ifndef COVERAGE_BUILD+            <> [("maxBuffer (-1)", fromAsync . maxBuffer (-1))]+#endif++    describe "Construction" $ do+        asyncOps    $ prop "asyncly replicateM" . constructWithReplicateM+        asyncOps $ prop "asyncly cons" . constructWithCons S.cons+        asyncOps $ prop "asyncly consM" . constructWithConsM S.consM sort+        asyncOps $ prop "asyncly (.:)" . constructWithCons (S..:)+        asyncOps $ prop "asyncly (|:)" . constructWithConsM (S.|:) sort+        prop "asyncSingleThreaded" $+            constructfromAsyncSingleThread+            (S.fromList [1,2,3,4,5])+            (S.fromList [6,7,8,9,10])+            [1,2,3,4,5,6,7,8,9,10]++    describe "Functor operations" $ do+        asyncOps     $ functorOps S.fromFoldable "asyncly" sortEq+        asyncOps     $ functorOps folded "asyncly folded" sortEq++    describe "Monoid operations" $ do+        asyncOps     $ monoidOps "asyncly" mempty sortEq++    describe "Async loops" $ loops fromAsync sort sort++    describe "Bind and Monoidal composition combinations" $ do+        asyncOps $ bindAndComposeSimpleOps "Async" sortEq+        asyncOps $ bindAndComposeHierarchyOps "Async"+        asyncOps $ nestTwoStreams "Async" sort sort+        asyncOps $ nestTwoStreamsApp "Async" sort sort++    describe "Semigroup operations" $ do+        asyncOps     $ semigroupOps "asyncly" sortEq++    describe "Applicative operations" $ do+        asyncOps $ applicativeOps S.fromFoldable "asyncly applicative" sortEq+        asyncOps $ applicativeOps folded "asyncly applicative folded" sortEq++    -- 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.+        asyncOps    $ prop "zip applicative asyncly" . zipAsyncApplicative S.fromFoldable (==)+        asyncOps    $ prop "zip applicative asyncly folded" . zipAsyncApplicative folded (==)+        asyncOps    $ prop "zip monadic asyncly" . zipAsyncMonadic S.fromFoldable (==)+        asyncOps    $ prop "zip monadic asyncly folded" . zipAsyncMonadic folded (==)+        it "zip monadic asyncly order" concurrentApplicative++    -- 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+        asyncOps    $ prop "asyncly monad then" . monadThen S.fromFoldable sortEq+        asyncOps    $ prop "asyncly monad then folded" . monadThen folded sortEq+        asyncOps    $ prop "asyncly monad bind" . monadBind S.fromFoldable sortEq+        asyncOps    $ prop "asyncly monad bind folded"   . monadBind folded sortEq++    describe "Stream transform and combine operations" $ do+        asyncOps     $ transformCombineOpsCommon S.fromFoldable "asyncly" sortEq+        asyncOps     $ transformCombineOpsCommon folded "asyncly" sortEq++    describe "Stream elimination operations" $ do+        asyncOps     $ eliminationOps S.fromFoldable "asyncly"+        asyncOps     $ eliminationOps folded "asyncly folded"+        asyncOps     $ eliminationOpsWord8 S.fromFoldable "asyncly"+        asyncOps     $ eliminationOpsWord8 folded "asyncly folded"++    -- test both (<>) and mappend to make sure we are using correct instance+    -- for Monoid that is using the right version of semigroup. Instance+    -- deriving can cause us to pick wrong instances sometimes.++#ifdef DEVBUILD+    describe "Async (<>) time order check" $ parallelCheck fromAsync (<>)+    describe "Async mappend time order check" $ parallelCheck fromAsync mappend+#endif++    describe "Tests for exceptions" $ asyncOps $ exceptionOps "asyncly"+    describe "Composed MonadThrow asyncly" $ composeWithMonadThrow fromAsync++    -- Ad-hoc tests+    it "takes n from stream of streams" $ takeCombined 2 fromAsync
+ test/Streamly/Test/Prelude/Concurrent.hs view
@@ -0,0 +1,510 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.Concurrent+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE OverloadedLists #-}++module Streamly.Test.Prelude.Concurrent (main) where++import Control.Concurrent (MVar, takeMVar, threadDelay, putMVar, newEmptyMVar)+import Control.Exception+       (BlockedIndefinitelyOnMVar(..), catches,+        BlockedIndefinitelyOnSTM(..), Handler(..))+import Control.Monad (void, when, forM_, replicateM_)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.State (MonadState, get, modify, runStateT+                           , StateT(..), evalStateT)+import Data.Foldable (fold)+import Data.IORef (readIORef, modifyIORef, newIORef)+import GHC.Word (Word8)+import Test.Hspec.QuickCheck+import Test.Hspec as H+import Test.QuickCheck+       (Property, withMaxSuccess)+import Test.QuickCheck.Monadic (monadicIO, run)++import Streamly.Prelude hiding (fold, replicate, replicateM, reverse, runStateT)+import qualified Streamly.Prelude as S++import Streamly.Test.Common+import Streamly.Test.Prelude.Common++-------------------------------------------------------------------------------+-- Concurrent generation+-------------------------------------------------------------------------------++mvarExcHandler :: String -> BlockedIndefinitelyOnMVar -> IO ()+mvarExcHandler label BlockedIndefinitelyOnMVar =+    error $ label <> " " <> "BlockedIndefinitelyOnMVar\n"++stmExcHandler :: String -> BlockedIndefinitelyOnSTM -> IO ()+stmExcHandler label BlockedIndefinitelyOnSTM =+    error $ label <> " " <> "BlockedIndefinitelyOnSTM\n"++dbgMVar :: String -> IO () -> IO ()+dbgMVar label action =+    action `catches` [ Handler (mvarExcHandler label)+                     , Handler (stmExcHandler label)+                     ]++-- | first n actions takeMVar and the last action performs putMVar n times+mvarSequenceOp :: MVar () -> Word8 -> Word8 -> IO Word8+mvarSequenceOp mv n x = do+    let msg = show x <> "/" <> show n+    if x < n+    then dbgMVar ("take mvarSequenceOp " <> msg) (takeMVar mv) >>  return x+    else dbgMVar ("put mvarSequenceOp" <> msg)+            (replicateM_ (fromIntegral n) (putMVar mv ())) >> return x++concurrentMapM+    :: ([Word8] -> t IO Word8)+    -> ([Word8] -> [Word8] -> Bool)+    -> (Word8 -> MVar () -> t IO Word8 -> SerialT IO Word8)+    -> Word8+    -> Property+concurrentMapM constr eq op n =+    monadicIO $ do+        let list = [0..n]+        stream <- run $ do+            mv <- newEmptyMVar :: IO (MVar ())+            (S.toList . op n mv) (constr list)+        listEquals eq stream list++concurrentFromFoldable+    :: IsStream t+    => ([Word8] -> [Word8] -> Bool)+    -> (t IO Word8 -> SerialT IO Word8)+    -> Word8+    -> Property+concurrentFromFoldable eq op n =+    monadicIO $ do+        let list = [0..n]+        stream <- run $ do+            mv <- newEmptyMVar :: IO (MVar ())+            (S.toList . op) (S.fromFoldableM (fmap (mvarSequenceOp mv n) list))+        listEquals eq stream list++sourceUnfoldrM :: IsStream t => MVar () -> Word8 -> t IO Word8+sourceUnfoldrM mv n = S.unfoldrM step 0+    where+    -- argument must be integer to avoid overflow of word8 at 255+    step :: Int -> IO (Maybe (Word8, Int))+    step cnt = do+        let msg = show cnt <> "/" <> show n+        if cnt > fromIntegral n+        then return Nothing+        else do+            dbgMVar ("put sourceUnfoldrM " <> msg) (putMVar mv ())+            return (Just (fromIntegral cnt, cnt + 1))++-- Note that this test is not guaranteed to succeed, because there is no+-- guarantee of parallelism in case of Async/Ahead streams.+concurrentUnfoldrM+    :: IsStream t+    => ([Word8] -> [Word8] -> Bool)+    -> (t IO Word8 -> SerialT IO Word8)+    -> Word8+    -> Property+concurrentUnfoldrM eq op n =+    monadicIO $ do+        -- XXX we should test empty list case as well+        let list = [0..n]+        stream <- run $ do+            -- putStrLn $ "concurrentUnfoldrM: " <> show n+            mv <- newEmptyMVar :: IO (MVar ())+            cnt <- newIORef 0+            -- since unfoldr happens in parallel with the stream processing we+            -- can do two takeMVar in one iteration. If it is not parallel then+            -- this will not work and the test will fail.+            S.toList $ do+                x <- op (sourceUnfoldrM mv n)+                -- results may not be yielded in order, in case of+                -- Async/WAsync/Parallel. So we use an increasing count+                -- instead.+                i <- S.fromEffect $ readIORef cnt+                S.fromEffect $ modifyIORef cnt (+1)+                let msg = show i <> "/" <> show n+                S.fromEffect $+                    when (even i) $ do+                        dbgMVar ("first take concurrentUnfoldrM " <> msg)+                                (takeMVar mv)+                        when (n > i) $+                            dbgMVar ("second take concurrentUnfoldrM " <> msg)+                                     (takeMVar mv)+                return x+        listEquals eq stream list++concurrentOps+    :: IsStream t+    => ([Word8] -> t IO Word8)+    -> String+    -> ([Word8] -> [Word8] -> Bool)+    -> (t IO Word8 -> SerialT IO Word8)+    -> Spec+concurrentOps constr desc eq t = do+    let prop1 d p = prop d $ withMaxSuccess maxTestCount p++    prop1 (desc <> " fromFoldableM") $ concurrentFromFoldable eq t+    prop1 (desc <> " unfoldrM") $ concurrentUnfoldrM eq t+    -- we pass it the length of the stream n and an mvar mv.+    -- The stream is [0..n]. The threads communicate in such a way that the+    -- actions coming first in the stream are dependent on the last action. So+    -- if the stream is not processed concurrently it will block forever.+    -- Note that if the size of the stream is bigger than the thread limit+    -- then it will block even if it is concurrent.+    prop1 (desc <> " mapM") $+        concurrentMapM constr eq $ \n mv stream ->+            t $ S.mapM (mvarSequenceOp mv n) stream++    prop1 (desc <> " sequence") $+        concurrentMapM constr eq $ \n mv stream ->+            t $ S.sequence $ S.map (mvarSequenceOp mv n) stream++-------------------------------------------------------------------------------+-- Concurrent Application+-------------------------------------------------------------------------------++concurrentApplication :: IsStream t+    => ([Word8] -> [Word8] -> Bool)+    -> (t IO Word8 -> SerialT IO Word8)+    -> Word8+    -> Property+concurrentApplication eq t n = withMaxSuccess maxTestCount $+    monadicIO $ do+        -- XXX we should test empty list case as well+        let list = [0..n]+        stream <- run $ do+            -- putStrLn $ "concurrentApplication: " <> show n+            mv <- newEmptyMVar :: IO (MVar ())+            -- since unfoldr happens in parallel with the stream processing we+            -- can do two takeMVar in one iteration. If it is not parallel then+            -- this will not work and the test will fail.+            (S.toList . t) $+                sourceUnfoldrM mv n |&+                    S.mapM (\x -> do+                        let msg = show x <> "/" <> show n+                        when (even x) $ do+                            dbgMVar ("first take concurrentApp " <> msg)+                                    (takeMVar mv)+                            when (n > x) $+                                dbgMVar ("second take concurrentApp " <> msg)+                                         (takeMVar mv)+                        return x)+        listEquals eq stream list++sourceUnfoldrM1 :: IsStream t => Word8 -> t IO Word8+sourceUnfoldrM1 n = S.unfoldrM step 0+    where+    -- argument must be integer to avoid overflow of word8 at 255+    step :: Int -> IO (Maybe (Word8, Int))+    step cnt =+        if cnt > fromIntegral n+        then return Nothing+        else return (Just (fromIntegral cnt, cnt + 1))++concurrentFoldlApplication :: Word8 -> Property+concurrentFoldlApplication n =+    monadicIO $ do+        -- XXX we should test empty list case as well+        let list = [0..n]+        stream <- run $+            sourceUnfoldrM1 n |&. S.foldlM' (\xs x -> return (x : xs)) (return [])+        listEquals (==) (reverse stream) list++concurrentFoldrApplication :: Word8 -> Property+concurrentFoldrApplication n =+    monadicIO $ do+        -- XXX we should test empty list case as well+        let list = [0..n]+        stream <- run $+            sourceUnfoldrM1 n |&. S.foldrM (\x xs -> xs >>= return . (x :))+                                           (return [])+        listEquals (==) stream list++-- Each snapshot carries an independent state. Multiple parallel tasks should+-- not affect each other's state. This is especially important when we run+-- multiple tasks in a single thread.+snapshot :: (IsStream t, MonadAsync m, MonadState Int m) => t m ()+snapshot =+    -- We deliberately use a replicate count 1 here, because a lower count+    -- catches problems that a higher count doesn't.+    S.replicateM 1 $ do+        -- Even though we modify the state here it should not reflect in other+        -- parallel tasks, it is local to each concurrent task.+        modify (+1) >> get >>= liftIO . (`shouldSatisfy` (==1))+        modify (+1) >> get >>= liftIO . (`shouldSatisfy` (==2))++snapshot1 :: (IsStream t, MonadAsync m, MonadState Int m) => t m ()+snapshot1 = S.replicateM 1000 $+    modify (+1) >> get >>= liftIO . (`shouldSatisfy` (==2))++snapshot2 :: (IsStream t, MonadAsync m, MonadState Int m) => t m ()+snapshot2 = S.replicateM 1000 $+    modify (+1) >> get >>= liftIO . (`shouldSatisfy` (==2))++stateComp+    :: ( IsStream t+       , MonadAsync m+       , Semigroup (t m ())+       , MonadIO (t m)+       , MonadState Int m+       , MonadState Int (t m)+       )+    => t m ()+stateComp = do+    -- Each task in a concurrent composition inherits the state and maintains+    -- its own modifications to it, not affecting the parent computation.+    snapshot <> (modify (+1) >> (snapshot1 <> snapshot2))+    -- The above modify statement does not affect our state because that is+    -- used in a parallel composition. In a serial composition it will affect+    -- our state.+    get >>= liftIO . (`shouldSatisfy` (== (0 :: Int)))++monadicStateSnapshot+    :: ( IsStream t+       , Semigroup (t (StateT Int IO) ())+       , MonadIO (t (StateT Int IO))+       , MonadState Int (t (StateT Int IO))+       )+    => (t (StateT Int IO) () -> SerialT (StateT Int IO) ()) -> IO ()+monadicStateSnapshot t = void $ runStateT (S.drain $ t stateComp) 0++stateCompOp+    :: (   AsyncT (StateT Int IO) ()+        -> AsyncT (StateT Int IO) ()+        -> AsyncT (StateT Int IO) ()+       )+    -> SerialT (StateT Int IO) ()+stateCompOp op = do+    -- Each task in a concurrent composition inherits the state and maintains+    -- its own modifications to it, not affecting the parent computation.+    fromAsync (snapshot `op` (modify (+1) >> (snapshot1 `op` snapshot2)))+    -- The above modify statement does not affect our state because that is+    -- used in a parallel composition. In a serial composition it will affect+    -- our state.+    get >>= liftIO . (`shouldSatisfy` (== (0 :: Int)))++checkMonadicStateTransfer+    :: (IsStream t1, IsStream t2)+    => (    t1 (StateT Int IO) ()+        ->  t2 (StateT Int IO) ()+        ->  SerialT (StateT Int IO) a3 )+    -> IO ()+checkMonadicStateTransfer op = evalStateT str (0 :: Int)+  where+    str =+        S.drain $+        maxBuffer 1 $+        (fromSerial $ S.mapM snapshoti $ S.fromList [1..10]) `op`+        (fromSerial $ S.mapM snapshoti $ S.fromList [1..10])+    snapshoti y = do+        modify (+ 1)+        x <- get+        lift1 $ x `shouldBe` y+    lift1 m = StateT $ \s -> do+        a <- m+        return (a, s)++monadicStateSnapshotOp+    :: (   AsyncT (StateT Int IO) ()+        -> AsyncT (StateT Int IO) ()+        -> AsyncT (StateT Int IO) ()+       )+    -> IO ()+monadicStateSnapshotOp op = void $ runStateT (S.drain $ stateCompOp op) 0++takeInfinite :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec+takeInfinite t =+    it "take 1" $+        S.drain (t $ S.take 1 $ S.repeatM (print "hello" >> return (1::Int)))+        `shouldReturn` ()++moduleName :: String+moduleName = "Prelude.Concurrent"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    -- We can have these in Test.Prelude, but I think it's unnecessary.+    let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec+        serialOps spec = mapOps spec $ makeOps fromSerial+#ifndef COVERAGE_BUILD+            <> [("rate AvgRate 0.00000001", fromSerial . avgRate 0.00000001)]+            <> [("maxBuffer -1", fromSerial . maxBuffer (-1))]+#endif++    let aheadOps :: IsStream t => ((AheadT IO a -> t IO a) -> Spec) -> Spec+        aheadOps spec = mapOps spec $ makeOps fromAhead+#ifndef COVERAGE_BUILD+              <> [("maxBuffer (-1)", fromAhead . maxBuffer (-1))]+#endif++    let asyncOps :: IsStream t => ((AsyncT IO a -> t IO a) -> Spec) -> Spec+        asyncOps spec = mapOps spec $ makeOps fromAsync+#ifndef COVERAGE_BUILD+            <> [("maxBuffer (-1)", fromAsync . maxBuffer (-1))]+#endif++    -- For concurrent application test we need a buffer of at least size 2 to+    -- allow two threads to run.+#ifndef COVERAGE_BUILD+    let makeConcurrentAppOps :: IsStream t+            => (t m a -> c) -> [(String, t m a -> c)]+#endif+        makeConcurrentAppOps t = makeCommonOps t +++            [+#ifndef COVERAGE_BUILD+              ("maxBuffer 2", t . maxBuffer 2)+#endif+            ]++#ifndef COVERAGE_BUILD+    let parallelCommonOps :: IsStream t => [(String, ParallelT m a -> t m a)]+#else+    let parallelCommonOps :: [(String, ParallelT m a -> t m a)]+#endif+        parallelCommonOps = []+#ifndef COVERAGE_BUILD+            <> [("rate AvgRate 0.00000001", fromParallel . avgRate 0.00000001)]+            <> [("maxBuffer (-1)", fromParallel . maxBuffer (-1))]+#endif++    let parallelConcurrentAppOps :: IsStream t+            => ((ParallelT IO a -> t IO a) -> Spec) -> Spec+        parallelConcurrentAppOps spec =+            mapOps spec $ makeConcurrentAppOps fromParallel <> parallelCommonOps++    -- These tests won't work with maxBuffer or maxThreads set to 1, so we+    -- exclude those cases from these.+#ifndef COVERAGE_BUILD+    let mkOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]+#else+    let mkOps :: t -> [(String, t)]+    -- let mkOps :: (t m a -> c) -> [(String, t m a -> c)]+#endif+        mkOps t =+            [ ("default", t)+#ifndef COVERAGE_BUILD+            , ("rate Nothing", t . rate Nothing)+            , ("maxBuffer 0", t . maxBuffer 0)+            , ("maxThreads 0", t . maxThreads 0)+            , ("maxThreads 0", t . maxThreads (-1))+#endif+            ]++    let forOps ops spec = forM_ ops (\(desc, f) -> describe desc $ spec f)+    describe "Stream concurrent operations" $ do+        forOps (mkOps fromAhead)   $ concurrentOps S.fromFoldable "aheadly" (==)+        forOps (mkOps fromAsync)   $ concurrentOps S.fromFoldable "asyncly" sortEq+        forOps (mkOps fromWAsync)  $ concurrentOps S.fromFoldable "wAsyncly" sortEq+        forOps (mkOps fromParallel) $ concurrentOps S.fromFoldable "parallely" sortEq++        forOps (mkOps fromAhead)   $ concurrentOps folded "aheadly folded" (==)+        forOps (mkOps fromAsync)   $ concurrentOps folded "asyncly folded" sortEq+        forOps (mkOps fromWAsync)  $ concurrentOps folded "wAsyncly folded" sortEq+        forOps (mkOps fromParallel) $ concurrentOps folded "parallely folded" sortEq++    describe "Concurrent application" $ do+        serialOps $ prop "serial" . concurrentApplication (==)+        asyncOps  $ prop "async" . concurrentApplication sortEq+        aheadOps  $ prop "ahead" . concurrentApplication (==)++        parallelConcurrentAppOps $+            prop "parallel" . concurrentApplication sortEq++        prop "concurrent foldr application" $ withMaxSuccess maxTestCount+            concurrentFoldrApplication+        prop "concurrent foldl application" $ withMaxSuccess maxTestCount+            concurrentFoldlApplication++    describe "take on infinite concurrent stream" $ takeInfinite fromAsync+    describe "take on infinite concurrent stream" $ takeInfinite fromWAsync+    describe "take on infinite concurrent stream" $ takeInfinite fromAhead++    ---------------------------------------------------------------------------+    -- Monadic state transfer in concurrent tasks+    ---------------------------------------------------------------------------++    describe "Monadic state transfer in concurrent tasks" $ do+        -- XXX Can we write better test cases to hit every case?+        it "async: state is saved and used if the work is partially enqueued"+            (checkMonadicStateTransfer async)+        it "wAsync: state is saved and used if the work is partially enqueued"+            (checkMonadicStateTransfer wAsync)+        it "ahead: state is saved and used if the work is partially enqueued"+            (checkMonadicStateTransfer ahead)++    ---------------------------------------------------------------------------+    -- Monadic state snapshot in concurrent tasks+    ---------------------------------------------------------------------------++    describe "Monadic state snapshot in concurrent tasks" $ do+        it "asyncly maintains independent states in concurrent tasks"+            (monadicStateSnapshot fromAsync)+        it "asyncly limited maintains independent states in concurrent tasks"+            (monadicStateSnapshot (fromAsync . S.take 10000))++        it "wAsyncly maintains independent states in concurrent tasks"+            (monadicStateSnapshot fromWAsync)+        it "wAsyncly limited maintains independent states in concurrent tasks"+            (monadicStateSnapshot (fromWAsync . S.take 10000))++        it "aheadly maintains independent states in concurrent tasks"+            (monadicStateSnapshot fromAhead)+        it "aheadly limited maintains independent states in concurrent tasks"+            (monadicStateSnapshot (fromAhead . S.take 10000))+        it "parallely maintains independent states in concurrent tasks"+            (monadicStateSnapshot fromParallel)+++        it "async maintains independent states in concurrent tasks"+            (monadicStateSnapshotOp async)+        it "ahead maintains independent states in concurrent tasks"+            (monadicStateSnapshotOp ahead)+        it "wAsync maintains independent states in concurrent tasks"+            (monadicStateSnapshotOp wAsync)+        it "parallel maintains independent states in concurrent tasks"+            (monadicStateSnapshotOp S.parallel)++    ---------------------------------------------------------------------------+    -- Slower tests are at the end+    ---------------------------------------------------------------------------++    ---------------------------------------------------------------------------+    -- Thread limits+    ---------------------------------------------------------------------------++    it "asyncly crosses thread limit (2000 threads)" $+        S.drain (fromAsync $ fold $+                   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+        it "take 1 asyncly" $ checkCleanup 2 fromAsync (S.take 1)+        it "take 1 wAsyncly" $ checkCleanup 2 fromWAsync (S.take 1)+        it "take 1 aheadly" $ checkCleanup 2 fromAhead (S.take 1)++        it "takeWhile (< 0) asyncly" $ checkCleanup 2 fromAsync (S.takeWhile (< 0))+        it "takeWhile (< 0) wAsyncly" $ checkCleanup 2 fromWAsync (S.takeWhile (< 0))+        it "takeWhile (< 0) aheadly" $ checkCleanup 2 fromAhead (S.takeWhile (< 0))+#endif
+ test/Streamly/Test/Prelude/Fold.hs view
@@ -0,0 +1,201 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.Fold+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.Fold (main) where++#ifdef DEVBUILD+import Control.Concurrent (threadDelay)+#endif+import Control.Exception (ErrorCall(..), catch)+import Data.IORef (newIORef, readIORef, writeIORef, IORef)+#ifdef COVERAGE_BUILD+import Test.Hspec.QuickCheck (modifyMaxSuccess)+#endif+import Test.Hspec as H+#ifdef DEVBUILD+import Data.IORef (modifyIORef)+import System.Mem (performMajorGC)+#endif++import qualified Streamly.Internal.Data.Stream.IsStream as IS+import qualified Streamly.Prelude as S++import Streamly.Prelude (SerialT)+#ifdef DEVBUILD+import Streamly.Prelude (IsStream)+#endif++#ifdef DEVBUILD+checkFoldxStrictness :: IO ()+checkFoldxStrictness = do+  let s = return (1 :: Int) `S.consM` error "failure"+  catch (S.foldx (\_ a -> if a == 1 then error "success" else "done")+                      "begin" id s)+    (\(ErrorCall err) -> return err)+    `shouldReturn` "success"++checkScanxStrictness :: IO ()+checkScanxStrictness = do+  let s = return (1 :: Int) `S.consM` error "failure"+  catch+    (S.drain (+        S.scanx (\_ a ->+                    if a == 1+                    then error "success"+                    else "done")+                "begin" id s+        )+        >> return "finished"+    )+    (\(ErrorCall err) -> return err)+    `shouldReturn` "success"++foldxMStrictCheck :: IORef Int -> SerialT IO Int -> IO ()+foldxMStrictCheck ref = S.foldxM (\_ _ -> writeIORef ref 1) (return ()) return++checkCleanupFold :: IsStream t+    => (t IO Int -> SerialT IO Int)+    -> (SerialT IO Int -> IO (Maybe Int))+    -> IO ()+checkCleanupFold t op = do+    r <- newIORef ([] :: [Int])+    _ <- op $ t $ delay r 0 S.|: delay r 2 S.|: delay r 3 S.|: S.nil+    performMajorGC+    -- In case the actions are not killed let them fire before we check so that+    -- the test fails.+    threadDelay (4 * delayUnit)+    res <- readIORef r+    res `shouldBe` [0]++    where++    delayUnit = 400000+    delay ref i =+        threadDelay (i * delayUnit) >> modifyIORef ref (i :) >> return i++testFoldOpsCleanup :: String -> (SerialT IO Int -> IO a) -> Spec+testFoldOpsCleanup name f = do+    let testOp op x = op x >> return Nothing+    it (name <> " asyncly") $ checkCleanupFold S.fromAsync (testOp f)+    it (name <> " wAsyncly") $ checkCleanupFold S.fromWAsync (testOp f)+    it (name <> " aheadly") $ checkCleanupFold S.fromAhead (testOp f)+#ifdef INCLUDE_FLAKY_TESTS+    it (name <> " parallely") $ checkCleanupFold S.fromParallel (testOp f)+#endif+#endif++checkFoldMStrictness :: (IORef Int -> SerialT IO Int -> IO ()) -> IO ()+checkFoldMStrictness f = do+  ref <- newIORef 0+  let s = return 1 `S.consM` error "x"+  catch (f ref s) (\(_ :: ErrorCall) -> return ())+  readIORef ref `shouldReturn` 1++checkFoldl'Strictness :: IO ()+checkFoldl'Strictness = do+  let s = return (1 :: Int) `S.consM` error "failure"+  catch (S.foldl' (\_ a -> if a == 1 then error "success" else "done")+                      "begin" s)+    (\(ErrorCall err) -> return err)+    `shouldReturn` "success"++checkScanl'Strictness :: IO ()+checkScanl'Strictness = do+    let s = return (1 :: Int) `S.consM` error "failure"+    catch+        (S.drain+             (S.scanl'+                  (\_ a ->+                       if a == 1+                           then error "success"+                           else "done")+                  "begin"+                  s)+             >> return "finished"+        )+        (\(ErrorCall err) -> return err)+        `shouldReturn` "success"++foldlM'StrictCheck :: IORef Int -> SerialT IO Int -> IO ()+foldlM'StrictCheck ref = S.foldlM' (\_ _ -> writeIORef ref 1) (return ())++scanlM'StrictCheck :: IORef Int -> SerialT IO Int -> SerialT IO ()+scanlM'StrictCheck ref = S.scanlM' (\_ _ -> writeIORef ref 1) (return ())++checkScanlMStrictness :: (IORef Int -> SerialT IO Int -> SerialT IO ()) -> IO ()+checkScanlMStrictness f = do+  ref <- newIORef 0+  let s = return 1 `S.consM` error "x"+  catch (S.drain $ f ref s) (\(_ :: ErrorCall) -> return ())+  readIORef ref `shouldReturn` 1++checkFoldrLaziness :: IO ()+checkFoldrLaziness = do+    S.foldrM (\x xs -> if odd x then return True else xs)+             (return False) (S.fromList (2:4:5:undefined :: [Int]))+        `shouldReturn` True++    S.toList (IS.foldrS (\x xs -> if odd x then return True else xs)+                        (return False)+                        $ (S.fromList (2:4:5:undefined) :: SerialT IO Int))+        `shouldReturn` [True]++    S.toList (IS.foldrT (\x xs -> if odd x then return True else xs)+                        (return False)+                        $ (S.fromList (2:4:5:undefined) :: SerialT IO Int))+        `shouldReturn` [True]++moduleName :: String+moduleName = "Prelude.Fold"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do++    ---------------------------------------------------------------------------+    -- Left folds are strict enough+    ---------------------------------------------------------------------------++#ifdef DEVBUILD+    it "foldx is strict enough" checkFoldxStrictness+    it "scanx is strict enough" checkScanxStrictness+    it "foldxM is strict enough" (checkFoldMStrictness foldxMStrictCheck)+#endif+    it "foldl' is strict enough" checkFoldl'Strictness+    it "scanl' is strict enough" checkScanl'Strictness+    it "foldlM' is strict enough" (checkFoldMStrictness foldlM'StrictCheck)+    it "scanlM' is strict enough" (checkScanlMStrictness scanlM'StrictCheck)++    ---------------------------------------------------------------------------+    -- Right folds are lazy enough+    ---------------------------------------------------------------------------++    it "foldrM is lazy enough" checkFoldrLaziness++#ifdef DEVBUILD+    testFoldOpsCleanup "head" S.head+    testFoldOpsCleanup "null" S.null+    testFoldOpsCleanup "elem" (S.elem 0)+    testFoldOpsCleanup "notElem" (S.notElem 0)+    testFoldOpsCleanup "elemIndex" (S.elemIndex 0)+    -- S.lookup+    testFoldOpsCleanup "notElem" (S.notElem 0)+    testFoldOpsCleanup "find" (S.find (==0))+    testFoldOpsCleanup "findIndex" (S.findIndex (==0))+    testFoldOpsCleanup "all" (S.all (==1))+    testFoldOpsCleanup "any" (S.any (==0))+    testFoldOpsCleanup "and" (S.and . S.map (==1))+    testFoldOpsCleanup "or" (S.or . S.map (==0))+#endif
+ test/Streamly/Test/Prelude/Parallel.hs view
@@ -0,0 +1,121 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.Parallel+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.Parallel (main) where++import Data.List (sort)+import Test.Hspec.QuickCheck+import Test.Hspec as H++import Streamly.Prelude+import qualified Streamly.Prelude as S++import Streamly.Test.Prelude.Common++moduleName :: String+moduleName = "Prelude.Parallel"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    let+#ifndef COVERAGE_BUILD+        parallelCommonOps :: IsStream t => [(String, ParallelT m a -> t m a)]+#endif+        parallelCommonOps = []+#ifndef COVERAGE_BUILD+            <> [("rate AvgRate 0.00000001", fromParallel . avgRate 0.00000001)]+            <> [("maxBuffer (-1)", fromParallel . maxBuffer (-1))]+#endif+    let parallelOps :: IsStream t+            => ((ParallelT IO a -> t IO a) -> Spec) -> Spec+        parallelOps spec = mapOps spec $ makeOps fromParallel <> parallelCommonOps++    describe "Construction" $ do+        parallelOps $ prop "parallely replicateM" . constructWithReplicateM+        parallelOps $ prop "parallely cons" . constructWithCons S.cons+--      parallelOps $ prop "parallely consM" . constructWithConsM S.consM sort+        parallelOps $ prop "parallely (.:)" . constructWithCons (S..:)+--      parallelOps $ prop "parallely (|:)" . constructWithConsM (S.|:) sort++    describe "Functor operations" $ do+        parallelOps $ functorOps S.fromFoldable "parallely" sortEq+        parallelOps $ functorOps folded "parallely folded" sortEq++    describe "Monoid operations" $ do+        parallelOps $ monoidOps "parallely" mempty sortEq++    describe "Parallel loops" $ loops fromParallel sort sort++    describe "Bind and Monoidal composition combinations" $ do+        -- XXX Taking a long time when parallelOps is used.+        bindAndComposeSimpleOps "Parallel" sortEq fromParallel+        bindAndComposeHierarchyOps "Parallel" fromParallel+        parallelOps $ nestTwoStreams "Parallel" sort sort+        parallelOps $ nestTwoStreamsApp "Parallel" sort sort++    describe "Semigroup operations" $ do+        parallelOps $ semigroupOps "parallely" sortEq++    describe "Applicative operations" $ do+        parallelOps $ applicativeOps folded "parallely applicative folded" sortEq++    -- 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.+        parallelOps $ prop "zip monadic parallely" . zipMonadic S.fromFoldable (==)+        parallelOps $ prop "zip monadic parallely 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+        parallelOps $ prop "parallely monad then" . monadThen S.fromFoldable sortEq+        parallelOps $ prop "parallely monad then folded" . monadThen folded sortEq+        parallelOps $ prop "parallely monad bind" . monadBind S.fromFoldable sortEq+        parallelOps $ prop "parallely monad bind folded" . monadBind folded sortEq++    describe "Stream transform and combine operations" $ do+        parallelOps $ transformCombineOpsCommon S.fromFoldable "parallely" sortEq+        parallelOps $ transformCombineOpsCommon folded "parallely" sortEq++    describe "Stream elimination operations" $ do+        parallelOps $ eliminationOps S.fromFoldable "parallely"+        parallelOps $ eliminationOps folded "parallely folded"+        parallelOps $ eliminationOpsWord8 S.fromFoldable "parallely"+        parallelOps $ eliminationOpsWord8 folded "parallely folded"++    -- test both (<>) and mappend to make sure we are using correct instance+    -- for Monoid that is using the right version of semigroup. Instance+    -- deriving can cause us to pick wrong instances sometimes.++#ifdef DEVBUILD+    describe "Parallel (<>) time order check" $ parallelCheck fromParallel (<>)+    describe "Parallel mappend time order check" $ parallelCheck fromParallel mappend+#endif++    describe "Tests for exceptions" $ parallelOps $ exceptionOps "parallely"+    describe "Composed MonadThrow parallely" $ composeWithMonadThrow fromParallel++#ifdef DEVBUILD+    -- fromParallel fails on CI machines, may need more difference in times of+    -- the events, but that would make tests even slower.+    it "take 1 parallely" $ checkCleanup 3 fromParallel (S.take 1)+    it "takeWhile (< 0) parallely" $ checkCleanup 3 fromParallel (S.takeWhile (< 0))+#endif
+ test/Streamly/Test/Prelude/Rate.hs view
@@ -0,0 +1,248 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.MaxRate+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.Rate (main) where++import qualified Streamly.Prelude as S++import Streamly.Prelude+    ( fromAhead, fromAsync, fromWAsync, avgRate, maxBuffer, maxThreads, rate,+      SerialT, IsStream )+import Streamly.Internal.Data.Time.Clock (getTime, Clock(..))+import Streamly.Internal.Data.Time.Units+    (NanoSecond64, diffAbsTime64, fromRelTime64)++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' :: IsStream t+    => String+    -> (t IO Int -> SerialT IO Int)+    -> Int -- buffers+    -> Int -- threads+    -> Either Double Int  -- either rate or count of actions+    -> Int+    -> (Double, Double)+    -> (Double, Double)+    -> Spec+measureRate' desc t buffers threads rval consumerDelay producerDelay expectedRange = do++    let threadAction =+            case rval of+                Left r -> S.take (round $ 10 * r) . S.repeatM+                Right n -> S.replicateM n++        rateDesc = case rval of+            Left r ->  " rate: " <> show r+            Right n -> " count: " <> show n++    it (desc <> rateDesc+             <> " buffers: " <> show buffers+             <> " threads: " <> show threads+             <> ", consumer latency: " <> show consumerDelay+             <> ", producer latency: " <> show producerDelay)+        $ durationShouldBe expectedRange $+            S.drain+                $ (if consumerDelay > 0+                  then S.mapM $ \x ->+                            threadDelay (toMicroSecs consumerDelay) >> return x+                  else id)+                $ t+                $ maxBuffer  buffers+                $ maxThreads threads+                $ (case rval of {Left r -> avgRate r; Right _ -> rate Nothing})+                $ threadAction $ 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+                    return 1++measureRateVariable :: IsStream t+    => String+    -> (t IO Int -> SerialT IO Int)+    -> Double+    -> Int+    -> (Double, Double)+    -> (Double, Double)+    -> Spec+measureRateVariable desc t rval consumerDelay producerDelay dur =+    measureRate' desc t (-1) (-1) (Left rval)+                 consumerDelay producerDelay dur++measureRate :: IsStream t+    => String+    -> (t IO Int -> SerialT IO Int)+    -> Double+    -> Int+    -> Int+    -> (Double, Double)+    -> Spec+measureRate desc t rval consumerDelay producerDelay dur =+    let d = fromIntegral producerDelay+    in measureRateVariable desc t rval consumerDelay (d, d) dur++measureThreads :: IsStream t+    => String+    -> (t IO Int -> SerialT IO Int)+    -> Int -- threads+    -> Int -- count of actions+    -> Spec+measureThreads desc t 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 t (-1) threads (Right count) 0 (1,1) duration++measureBuffers :: IsStream t+    => String+    -> (t IO Int -> SerialT IO Int)+    -> Int -- buffers+    -> Int -- count of actions+    -> Spec+measureBuffers desc t 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 t buffers (-1) (Right count) 0 (1,1) duration++moduleName :: String+moduleName = "Prelude.Rate"++main :: IO ()+main = hspec $ do+  describe moduleName $ do++    describe "maxBuffers" $ do+        measureBuffers "asyncly" fromAsync (-1) 5+        -- XXX this test fails due to a known issue+        -- measureBuffers "maxBuffers" fromAsync 1 5+        measureBuffers "asyncly" fromAsync 5 5++    describe "maxThreads" $ do+        measureThreads "asyncly" fromAsync (-1) 5+        measureThreads "asyncly" fromAsync 1 5+        measureThreads "asyncly" fromAsync 5 5++        measureThreads "aheadly" fromAhead (-1) 5+        measureThreads "aheadly" fromAhead 1 5+        measureThreads "aheadly" fromAhead 5 5++    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 = [1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "asyncly no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "asyncly" fromAsync 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 = [1, 10, 100+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                1000, 10000, 25000+#endif+                ]+     in describe "asyncly no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "asyncly" fromAsync 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 "asyncly, no consumer delay and variable producer delay" $+            forM_ rates $ \r ->+                measureRateVariable "asyncly" fromAsync r 0 (0.1, 3) range++    let rates = [1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "fromWAsync, no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "fromWAsync" fromWAsync r 0 0 range)++    let rates = [1, 10, 100, 1000+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                , 10000, 25000+#endif+                ]+     in describe "fromWAsync, no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "fromWAsync" fromWAsync r 0 1 range)++    let rates = [1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "aheadly, no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "aheadly" fromAhead 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 = [1, 10, 100, 1000+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                , 10000, 12500+#endif+                ]+     in describe "aheadly, no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "aheadly" fromAhead r 0 1 range)++    describe "asyncly, some consumer delay and 1 sec producer delay" $ do+        -- ideally it should take 10 x 1 + 1 seconds+        forM_ [1] (\r -> measureRate "asyncly" fromAsync r 1 1 (11, 16))+        -- ideally it should take 10 x 2 + 1 seconds+        forM_ [1] (\r -> measureRate "asyncly" fromAsync r 2 1 (21, 23))+        -- ideally it should take 10 x 3 + 1 seconds+        forM_ [1] (\r -> measureRate "asyncly" fromAsync r 3 1 (31, 33))++    describe "aheadly, some consumer delay and 1 sec producer delay" $ do+        forM_ [1] (\r -> measureRate "aheadly" fromAhead r 1 1 (11, 16))+        forM_ [1] (\r -> measureRate "aheadly" fromAhead r 2 1 (21, 23))+        forM_ [1] (\r -> measureRate "aheadly" fromAhead r 3 1 (31, 33))
+ test/Streamly/Test/Prelude/Serial.hs view
@@ -0,0 +1,740 @@+{-# 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+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.Serial (checkTakeDropTime, main) where++import Control.Concurrent ( threadDelay )+import Control.Monad ( when, forM_ )+import Data.Function ( (&) )+import Data.IORef ( newIORef, readIORef, writeIORef, modifyIORef' )+import Data.Int (Int64)+import Data.List (sort, group, intercalate)+import Data.Maybe ( isJust, fromJust )+import Data.Word (Word8)+import Data.Semigroup (Sum(..), getSum)+import Streamly.Internal.Data.MutByteArray (Unbox)+import Test.Hspec.QuickCheck+import Test.QuickCheck+    ( Gen+    , Property+    , Arbitrary(..)+    , choose+    , elements+    , forAll+    , frequency+    , listOf+    , listOf1+    , suchThat+    , vectorOf+    , withMaxSuccess+    )+import Test.QuickCheck.Monadic (assert, monadicIO, pick, run)+import Test.Hspec as H++import Streamly.Prelude (SerialT, IsStream, serial, fromSerial)+#ifndef COVERAGE_BUILD+import Streamly.Prelude (avgRate, maxBuffer)+#endif+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 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)++#ifdef DEVBUILD+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+#endif++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"]++    where++    splitOnSeq_ pat xs = toList $+        splitOnSeq' (A.fromList pat) FL.toList (S.fromList xs)++splitOnSuffixSeq :: Spec+splitOnSuffixSeq = do+    describe "Tests for splitOnSuffixSeq" $ do+        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", ""]++    where++    splitSuffixOn_ pat xs = toList $+        splitOnSuffixSeq' (A.fromList pat) FL.toList (S.fromList xs)++splitterProperties ::+       forall a. (Arbitrary a, Eq a, Show a, Unbox a, Enum a)+    => a+    -> String+    -> Spec+splitterProperties sep desc = do+    describe (desc <> " splitOnSeq")+        $ do++            forM_ [0, 1, 2, 4]+                $ intercalateSplitEqId splitOnSeq_ intercalate IS.intercalate++            forM_ [0, 1, 2, 4]+                $ concatSplitIntercalateEqConcat+                      splitOnSeq_+                      intercalate+                      IS.intercalate++            -- Exclusive case+            splitIntercalateEqId splitOnSeq_ intercalate IS.intercalate++    describe (desc <> " splitOn")+        $ do++            intercalateSplitEqId splitOn_ intercalate IS.intercalate 1++            concatSplitIntercalateEqConcat+                splitOn_ intercalate IS.intercalate 1++            -- Exclusive case+            splitIntercalateEqId splitOn_ intercalate IS.intercalate++    describe (desc <> " splitOnSuffixSeq")+        $ do++            forM_ [0, 1, 2, 4]+                $ intercalateSplitEqIdNoSepEnd+                      splitOnSuffixSeq_+                      intercalate+                      IS.intercalate++            forM_ [0, 1, 2, 4]+                $ concatSplitIntercalateEqConcat+                      splitOnSuffixSeq_+                      intercalateSuffix+                      IS.intercalateSuffix++            -- Exclusive case+            splitIntercalateEqId+                splitOnSuffixSeq_+                intercalateSuffix+                IS.intercalateSuffix++    describe (desc <> " splitOnSuffix")+        $ do++            intercalateSplitEqIdNoSepEnd+                splitOnSuffix_ intercalate IS.intercalate 1++            concatSplitIntercalateEqConcat+                splitOnSuffix_ intercalateSuffix IS.intercalateSuffix 1++            -- Exclusive case+            splitIntercalateEqId+                splitOnSuffix_ intercalateSuffix IS.intercalateSuffix++    where++    splitOnSeq_ xs pat =+        toList $ splitOnSeq' (A.fromList pat) FL.toList (S.fromList xs)++    splitOnSuffixSeq_ xs pat =+        toList $ splitOnSuffixSeq' (A.fromList pat) FL.toList (S.fromList xs)++    splitOn_ xs pat =+        toList $ splitOn (== (head pat)) FL.toList (S.fromList xs)++    splitOnSuffix_ xs pat =+        toList $ splitOnSuffix (== (head pat)) FL.toList (S.fromList xs)++    intercalateSuffix xs yss = intercalate xs yss ++ xs++    nonSepElem :: Gen a+    nonSepElem = suchThat arbitrary (/= sep)++    listWithSep :: Gen [a]+    listWithSep = listOf $ frequency [(3, arbitrary), (1, elements [sep])]++    listWithoutSep :: Gen [a]+    listWithoutSep = vectorOf 4 nonSepElem++    listsWithoutSep :: Gen [[a]]+    listsWithoutSep = listOf listWithoutSep++    listsWithoutSep1 :: Gen [[a]]+    listsWithoutSep1 = listOf1 listWithoutSep++    intercalateSplitEqId splitter lIntercalater sIntercalater i =+        let name =+                "intercalater . splitter == id ("+                    <> show i <> " element separator)"+         in prop name+                $ forAll listWithSep+                $ \xs -> withMaxSuccess maxTestCount $ monadicIO $ testCase xs++        where++        testCase xs = do+            ys <- splitter xs (replicate i sep)+            szs <-+                toList+                    $ sIntercalater UF.fromList (replicate i sep)+                    $ IS.fromList ys+            let lzs = lIntercalater (replicate i sep) ys+            listEquals (==) szs xs+            listEquals (==) lzs xs++    intercalateSplitEqIdNoSepEnd splitter lIntercalater sIntercalater i =+        let name =+                "intercalater . splitter . (++ [x \\= sep]) == id ("+                    <> show i <> " element separator)"+         in prop name+                $ forAll ((,) <$> listWithSep <*> nonSepElem)+                $ \(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 UF.fromList (replicate i sep)+                    $ IS.fromList ys+            let lzs = lIntercalater (replicate i sep) ys+            listEquals (==) szs xs+            listEquals (==) lzs xs++    concatSplitIntercalateEqConcat splitter lIntercalater sIntercalater i =+        let name =+                "concat . splitter . S.intercalater == "+                    <> "concat ("+                    <> show i <> " element separator/possibly empty list)"+         in prop name+                $ forAll listsWithoutSep+                $ \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 UF.fromList (replicate i sep)+                    $ S.fromList xss+            sys <- splitter sxs (replicate i sep)+            listEquals (==) (concat lys) (concat xss)+            listEquals (==) (concat sys) (concat xss)++    splitIntercalateEqId splitter lIntercalater sIntercalater =+        let name =+                "splitter . intercalater == id"+                    <> " (exclusive separator/non-empty list)"+         in prop name+                $ forAll listsWithoutSep1+                $ \xss -> do+                      withMaxSuccess maxTestCount $ monadicIO $ testCase xss++        where++        testCase xss = do+            let lxs = lIntercalater [sep] xss+            lys <- splitter lxs [sep]+            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+    splitOnSeq+    splitOnSuffixSeq++    -- splitting properties+    splitterProperties (0 :: Int) desc+    splitterProperties (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 $ S.fold (FL.all (\ls ->+                case ls of+                    [] -> True+                    (x:_) -> x == minimum ls))+                $ groupsBy (<) FL.toList+                $ S.fromList vec+            assert r++testGroups :: Property+testGroups =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            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 <- toList $ groupsByRolling (==) FL.toList $ S.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 = all (== True) $ 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 (<) FL.toList+                    $ S.fromList vec+            assert $ decreasing a++groupingOps :: Spec+groupingOps = do+    prop "groupsBy" testGroupsBy+    prop "S.groups = groups" testGroups+    prop "S.groupsByRolling = groups" testGroupsByRolling+    prop "testGroupsBySep" testGroupsBySep++associativityCheck+    :: String+    -> (SerialT IO Int -> SerialT IO Int)+    -> Spec+associativityCheck desc t = prop desc assocCheckProp+  where+    assocCheckProp :: [Int] -> [Int] -> [Int] -> Property+    assocCheckProp xs ys zs =+        monadicIO $ do+            let xStream = SP.fromList xs+                yStream = SP.fromList ys+                zStream = SP.fromList zs+            infixAssocstream <-+                run $ SP.toList $ t $ xStream `serial` yStream `serial` zStream+            assocStream <- run $ SP.toList $ t $ xStream <> yStream <> zStream+            listEquals (==) infixAssocstream assocStream++max_length :: Int+max_length = 1000++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++#ifdef DEVBUILD+testTakeInterval :: IO Bool+testTakeInterval = do+    r <-+          S.fold (FL.tee FL.head FL.last)+        $ S.takeInterval (fromIntegral takeDropTime * 10**(-9))+        $ S.repeatM (threadDelay 1000 >> getTime Monotonic)+    checkTakeDropTime r++testDropInterval :: IO Bool+testDropInterval = do+    t0 <- getTime Monotonic+    mt1 <-+          S.fold FL.head+        $ S.dropInterval (fromIntegral takeDropTime * 10**(-9))+        $ S.repeatM (threadDelay 1000 >> getTime Monotonic)+    checkTakeDropTime (Just t0, mt1)+#endif++unfold :: Property+unfold = monadicIO $ do+    a <- pick $ choose (0, max_length `div` 2)+    b <- pick $ choose (0, max_length)+    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.parList (S.eager True)+                [ fmap Just (S.fromCallback (setCallback ref))+                , runCallback ref+                ]+    S.fold FL.sum $ fmap fromJust $ S.takeWhile isJust stream++    where++    setCallback ref cb = do+        writeIORef ref (Just cb)++    runCallback ref = S.fromEffect $ do+        cb <-+              S.repeatM (readIORef ref)+                & IS.delayPost 0.1+                & S.mapMaybe id+                & S.fold FL.head++        S.fromList [1..100]+            & IS.delayPost 0.001+            & drainMapM (fromJust cb)+        threadDelay 100000+        return Nothing++foldIterateM :: Property+foldIterateM =+    forAll (listOf (chooseInt (0, max_length))) $ \lst -> monadicIO $ do+        let s1 = Prelude.sum lst+            strm = S.fromList lst+        ms2 <-+            S.fold FL.last+                $ fmap getSum+                $ IS.foldIterateM+                      (return . FL.take 1 . FL.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 $ K.toStream (K.sortBy compare $ K.fromStream $ S.fromList lst)+        assert $ s1 == s2++moduleName :: String+moduleName = "Prelude.Serial"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec+        serialOps spec = mapOps spec $ makeOps fromSerial+#ifndef COVERAGE_BUILD+            <> [("rate AvgRate 0.00000001", fromSerial . avgRate 0.00000001)]+            <> [("maxBuffer -1", fromSerial . maxBuffer (-1))]+#endif+    let toListSerial :: SerialT IO a -> IO [a]+        toListSerial = SP.toList++    describe "Runners" $ do+        -- XXX use an IORef to store and check the side effects+        it "simple serially" $+            (SP.fold FL.drain . fromSerial)+            (return (0 :: Int)) `shouldReturn` ()+        it "simple serially with IO" $+            (S.fold FL.drain)+            (S.fromEffect $ putStrLn "hello") `shouldReturn` ()++    describe "Empty" $+        it "Monoid - mempty" $+            toListSerial mempty `shouldReturn` ([] :: [Int])+        -- it "Alternative - empty" $+        --     (toListSerial empty) `shouldReturn` ([] :: [Int])+        -- it "MonadPlus - mzero" $+        --     (toListSerial mzero) `shouldReturn` ([] :: [Int])++    describe "Construction" $ do+        -- 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 SP.cons+        serialOps $ prop "serially consM" . constructWithConsM SP.consM id++        describe "From Generators" $ do+            prop "unfold" unfold++    describe "Simple Operations" $ serialOps simpleOps++    describe "Functor operations" $ do+        serialOps    $ functorOps (SP.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 (SP.fromFoldable) "serially" (==)+        serialOps $ applicativeOps folded "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 (SP.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 (SP.fromFoldable) (==)+        serialOps   $ prop "serially monad then folded" . monadThen folded (==)+        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 (SP.fromFoldable) "serially" (==)+        serialOps    $ transformCombineOpsCommon folded "serially" (==)+        serialOps    $ transformCombineOpsOrdered (SP.fromFoldable) "serially" (==)+        serialOps    $ transformCombineOpsOrdered folded "serially" (==)++#ifdef DEVBUILD+        describe "Filtering" $ do+            it "takeInterval" (testTakeInterval `shouldReturn` True)+            it "dropInterval" (testDropInterval `shouldReturn` True)+#endif++    -- 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 =+            toList (K.toStream (K.mergeMapWith g K.fromList (K.fromList inp)))+                `shouldReturn` out+     in do+        it "concatPairsWith serial"+            $ mustBe K.append input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+        it "concatPairsWith wSerial"+            $ 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+                (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+                (K.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 (SP.fromFoldable) "serially"+        serialOps    $ eliminationOps folded "serially folded"+        serialOps    $ eliminationOpsWord8 (SP.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 $+                            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 (SP.fromFoldable) "serially"+        serialOps    $ eliminationOpsOrdered folded "serially folded"++    describe "Tests for S.groupsBy" groupingOps++    describe "Tests for exceptions" $ serialOps $ exceptionOps "serially"++    describe "Composed MonadThrow serially" $ composeWithMonadThrow fromSerial++    it "fromCallback" $ testFromCallback `shouldReturn` (50*101)++    describe "Nesting" $ do+        prop "foldIterateM" foldIterateM
+ test/Streamly/Test/Prelude/Top.hs view
@@ -0,0 +1,224 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++module Main (main) where++import Data.List (elem, intersect, nub, sort)+import Data.Maybe (isNothing)+import Streamly.Prelude (SerialT)+import Test.QuickCheck+    ( Gen+    , Property+    , choose+    , forAll+    , listOf+    )+import Test.QuickCheck.Monadic (monadicIO, assert, run)+import qualified Streamly.Prelude as S+import qualified Streamly.Internal.Data.Stream.IsStream as Top++import Prelude hiding+    (maximum, minimum, elem, notElem, null, product, sum, head, last, take)+import Test.Hspec as H+import Test.Hspec.QuickCheck++min_value :: Int+min_value = 0++max_value :: Int+max_value = 10000++chooseInt :: (Int, Int) -> Gen Int+chooseInt = choose++eq :: Int -> Int -> Bool+eq = (==)++joinInner :: Property+joinInner =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 ->+            monadicIO $ action ls0 ls1++            where++            action ls0 ls1 = do+                v1 <-+                    run+                    $ S.toList+                    $ Top.joinInner eq (S.fromList ls0) (S.fromList $ sort ls1)+                let v2 = [ (i,j) | i <- ls0, j <- ls1, i == j ]+                assert (v1 == v2)++joinInnerMap :: Property+joinInnerMap =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 ->+            monadicIO $+                action+                (map (\a -> (a,a)) ls0)+                (map (\a -> (a,a)) ls1)++            where++            action ls0 ls1 = do+                v1 <-+                    run+                    $ S.toList+                    $ Top.joinInnerMap (S.fromList ls0) (S.fromList ls1)+                let v2 = [+                            (fst i, fst i, fst j)+                            | i <- ls0, j <- nub ls1+                            , fst i == fst j+                          ]+                assert (sort v1 == sort v2)++joinOuterList :: [(Int, Int)] -> [(Int, Int)] -> [(Int, Maybe Int, Maybe Int)]+joinOuterList ls0 ls1 =+    let v2 = do+            i <- ls0+            if i `elem` ls1+            then return (fst i, Just (fst i), Just (fst i))+            else return (fst i, Just (fst i), Nothing)+        v3 = do+            j <- ls1+            if j `elem` ls0+            then return (fst j, Just (fst j), Just (fst j))+            else return (fst j, Nothing, Just (fst j))+        v4 = filter (\(_, a2, _) -> isNothing a2)  v3+    in v2 ++ v4++{-+joinOuter :: Property+joinOuter =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 ->+            monadicIO $ action ls0 (nub ls1)+            where+            action ls0 ls1 = do+                v1 <-+                    run+                    $ S.toList+                    $ Top.joinOuter eq (S.fromList ls0) (S.fromList ls1)+                let v2 = joinOuterList+                         (map (\a -> (a, a)) ls0)+                         (map (\a -> (a, a)) ls1)+                    v3 = map (\(_, v10, v20) -> (v10, v20)) v2+                assert (sort v1 == sort v3)+-}+++joinOuterMap :: Property+joinOuterMap =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 ->+            monadicIO $+                action+                (map (\a -> (a,a)) (nub ls0))+                (map (\a -> (a,a)) (nub ls1))++            where++            action ls0 ls1 = do+                v1 <-+                    run+                    $ S.toList+                    $ Top.joinOuterMap (S.fromList ls0) (S.fromList ls1)+                let v2 = joinOuterList ls0 ls1+                assert (sort v1 == sort v2)++joinLeftList :: [(Int, Int)] -> [(Int, Int)] -> [(Int, Int, Maybe Int)]+joinLeftList ls0 ls1 =+    let v = do+            i <- ls0+            if i `elem` ls1+            then return (fst i, fst i, Just (fst i))+            else return (fst i, fst i, Nothing)+    in v++{-+joinLeft :: Property+joinLeft =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 ->+            -- nub the second list as no way to validate using list functions+            monadicIO $ action ls0 (nub ls1)++            where++            action ls0 ls1 = do+                v1 <-+                    run+                    $ S.toList+                    $ Top.joinLeft eq (S.fromList ls0) (S.fromList ls1)+                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 =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 ->+            -- nub the second list as no way to validate using list functions+            monadicIO $+                action (map (\a -> (a,a)) ls0) (map (\a -> (a,a)) (nub ls1))++            where++            action ls0 ls1 = do+                v1 <-+                    run+                    $ S.toList+                    $ Top.joinLeftMap  (S.fromList ls0) (S.fromList ls1)+                let v2 = joinLeftList ls0 ls1+                assert (v1 == v2)++intersectBy ::+       ([Int] -> [Int])+    -> (   (Int -> Int -> a)+        -> SerialT IO Int+        -> SerialT IO Int+        -> SerialT IO Int+       )+    -> (Int -> Int -> a)+    -> Property+intersectBy srt intersectFunc cmp =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls0 ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls1 ->+            monadicIO $ action (srt ls0) (srt ls1)++            where++            action ls0 ls1 = do+                v1 <-+                    run+                    $ S.toList+                    $ intersectFunc+                        cmp+                        (S.fromList ls0)+                        (S.fromList ls1)+                let v2 = ls0 `intersect` ls1+                assert (sort v1 == sort v2)++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Prelude.Top"++main :: IO ()+main = hspec $ do+    describe moduleName $ do+        -- Joins+        prop "joinInner" Main.joinInner+        prop "joinInnerMap" Main.joinInnerMap+        -- prop "joinOuter" Main.joinOuter+        prop "joinOuterMap" Main.joinOuterMap+        -- prop "joinLeft" Main.joinLeft+        prop "joinLeftMap" Main.joinLeftMap+        -- intersect+        prop "intersectBy"+            (intersectBy id Top.intersectBy (==))+        prop "intersectBySorted"+            (intersectBy sort Top.intersectBySorted compare)
+ test/Streamly/Test/Prelude/WAsync.hs view
@@ -0,0 +1,222 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.WAsync+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.WAsync (main) where++#ifdef DEVBUILD+import Control.Concurrent ( threadDelay )+#endif+import Data.List (sort)+import Test.Hspec.QuickCheck+import Test.QuickCheck (Property, withMaxSuccess)+import Test.QuickCheck.Monadic (monadicIO, run)+import Test.Hspec as H++import Streamly.Prelude+import qualified Streamly.Prelude as S++import Streamly.Test.Common+import Streamly.Test.Prelude.Common++moduleName :: String+moduleName = "Prelude.WAsync"++constructfromWAsync ::+    S.WAsyncT IO Int -> S.WAsyncT IO Int-> [Int] -> Property+constructfromWAsync s1 s2 res =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        x <-  run+            $ S.toList+            $ S.fromWAsync+            $ S.maxThreads 1+            $ s1 `S.wAsync` s2+        equals (==) x res++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    let wAsyncOps :: IsStream t => ((WAsyncT IO a -> t IO a) -> Spec) -> Spec+        wAsyncOps spec = mapOps spec $ makeOps fromWAsync+#ifndef COVERAGE_BUILD+            <> [("maxBuffer (-1)", fromWAsync . maxBuffer (-1))]+#endif++    describe "Construction" $ do+        wAsyncOps $ prop "wAsyncly replicateM" . constructWithReplicateM+        -- XXX add tests for fromIndices+        wAsyncOps $ prop "wAsyncly cons" . constructWithCons S.cons+        wAsyncOps $ prop "wAsyncly consM" . constructWithConsM S.consM sort+        wAsyncOps $ prop "wAsyncly (.:)" . constructWithCons (S..:)+        wAsyncOps $ prop "wAsyncly (|:)" . constructWithConsM (S.|:) sort+        prop "wAsync1" $+            constructfromWAsync+            (S.fromList [1,2,3,4,5])+            (S.fromList [6,7,8,9,10])+            [1,6,2,7,3,8,4,9,5,10]++        prop "wAsync2" $+            constructfromWAsync+            (S.fromList [1,2,3,4,5,6,7])+            (S.fromList [8,9,10])+            [1,8,2,9,3,10,4,5,6,7]++        prop "wAsync3" $+            constructfromWAsync+            (S.fromList [1,2,3,4])+            (S.fromList [5,6,7,8,9,10])+            [1,5,2,6,3,7,4,8,9,10]++        prop "wAsync4" $+            constructfromWAsync+            (S.fromList [])+            (S.fromList [5,6,7,8,9,10])+            [5,6,7,8,9,10]++        prop "wAsync5" $+            constructfromWAsync+            (S.fromList [1,2,3,4])+            (S.fromList [])+            [1,2,3,4]++        prop "wAsync6" $+            constructfromWAsync+            (S.fromList [])+            (S.fromList [])+            []+++    describe "Functor operations" $ do+        wAsyncOps $ functorOps S.fromFoldable "wAsyncly" sortEq+        wAsyncOps $ functorOps folded "wAsyncly folded" sortEq++    describe "Monoid operations" $ do+        wAsyncOps $ monoidOps "wAsyncly" mempty sortEq++    describe "WAsync loops" $ loops fromWAsync sort sort++    describe "Bind and Monoidal composition combinations" $ do+        wAsyncOps $ bindAndComposeSimpleOps "WAsync" sortEq+        wAsyncOps $ bindAndComposeHierarchyOps "WAsync"+        wAsyncOps $ nestTwoStreams "WAsync" sort sort+        wAsyncOps $ nestTwoStreamsApp "WAsync" sort sort++    describe "Semigroup operations" $ do+        wAsyncOps $ semigroupOps "wAsyncly" sortEq++    describe "Applicative operations" $ do+        wAsyncOps $ applicativeOps S.fromFoldable "wAsyncly applicative" sortEq+        wAsyncOps $ applicativeOps folded "wAsyncly applicative folded" sortEq++    -- XXX add tests for indexed/indexedR+    describe "Zip operations" $+        -- We test only the serial zip with serial streams and the parallel+        -- stream, because the rate setting in these streams can slow down+        -- zipAsync.+     do+        wAsyncOps $ prop "zip applicative wAsyncly" . zipAsyncApplicative S.fromFoldable (==)+        wAsyncOps $ prop "zip applicative wAsyncly folded" . zipAsyncApplicative folded (==)+        wAsyncOps $+            prop "zip monadic wAsyncly" . zipAsyncMonadic S.fromFoldable (==)+        wAsyncOps $ prop "zip monadic wAsyncly folded" . zipAsyncMonadic 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+        wAsyncOps $ prop "wAsyncly monad then" . monadThen S.fromFoldable sortEq+        wAsyncOps $ prop "wAsyncly monad then folded" . monadThen folded sortEq+        wAsyncOps $ prop "wAsyncly monad bind" . monadBind S.fromFoldable sortEq+        wAsyncOps $ prop "wAsyncly monad bind folded" . monadBind folded sortEq++    describe "Stream transform and combine operations" $ do+        wAsyncOps $ transformCombineOpsCommon S.fromFoldable "wAsyncly" sortEq+        wAsyncOps $ transformCombineOpsCommon folded "wAsyncly folded" sortEq++    describe "Stream elimination operations" $ do+        wAsyncOps $ eliminationOps S.fromFoldable "wAsyncly"+        wAsyncOps $ eliminationOps folded "wAsyncly folded"+        wAsyncOps $ eliminationOpsWord8 S.fromFoldable "wAsyncly"+        wAsyncOps $ eliminationOpsWord8 folded "wAsyncly folded"++    -- describe "WAsync interleaved (<>) ordering check" $+    --     interleaveCheck fromWAsync (<>)+    -- describe "WAsync interleaved mappend ordering check" $+    --     interleaveCheck fromWAsync mappend++    -- XXX this keeps failing intermittently, need to investigate+    -- describe "WAsync (<>) time order check" $+    --     parallelCheck fromWAsync (<>)+    -- describe "WAsync mappend time order check" $+    --     parallelCheck fromWAsync mappend++    describe "Tests for exceptions" $ wAsyncOps $ exceptionOps "wAsyncly"+    describe "Composed MonadThrow wAsyncly" $ composeWithMonadThrow fromWAsync++    -- Ad-hoc tests+    it "takes n from stream of streams" (takeCombined 3 fromWAsync)++#ifdef DEVBUILD+    let timed :: (IsStream t, Monad (t IO)) => Int -> t IO Int+        timed x = S.fromEffect (threadDelay (x * 100000)) >> return x++    -- These are not run fromParallel because the timing gets affected+    -- unpredictably when other tests are running on the same machine.+    --+    -- Also, they fail intermittently due to scheduling delays, so not run on+    -- CI machines.+    describe "Nested parallel and serial compositions" $ do+        let t = timed+            p = fromWAsync+            s = fromSerial+        {-+        -- This is not correct, the result can also be [4,4,8,0,8,0,2,2]+        -- because of parallelism of [8,0] and [8,0].+        it "Nest <|>, <>, <|> (1)" $+            let t = timed+             in toListSerial (+                    ((t 8 <|> t 4) <> (t 2 <|> t 0))+                <|> ((t 8 <|> t 4) <> (t 2 <|> t 0)))+            `shouldReturn` ([4,4,8,8,0,0,2,2])+        -}+        it "Nest <|>, <>, <|> (2)" $+            (S.toList . fromWAsync) (+                   s (p (t 4 <> t 8) <> p (t 1 <> t 2))+                <> s (p (t 4 <> t 8) <> p (t 1 <> t 2)))+            `shouldReturn` ([4,4,8,8,1,1,2,2])+        -- FIXME: These two keep failing intermittently on Mac OS X+        -- Need to examine and fix the tests.+        {-+        it "Nest <|>, <=>, <|> (1)" $+            let t = timed+             in toListSerial (+                    ((t 8 <|> t 4) <=> (t 2 <|> t 0))+                <|> ((t 9 <|> t 4) <=> (t 2 <|> t 0)))+            `shouldReturn` ([4,4,0,0,8,2,9,2])+        it "Nest <|>, <=>, <|> (2)" $+            let t = timed+             in toListSerial (+                    ((t 4 <|> t 8) <=> (t 1 <|> t 2))+                <|> ((t 4 <|> t 9) <=> (t 1 <|> t 2)))+            `shouldReturn` ([4,4,1,1,8,2,9,2])+        -}+        it "Nest <|>, <|>, <|>" $+            (S.toList . fromWAsync) (+                    ((t 4 <> t 8) <> (t 0 <> t 2))+                <> ((t 4 <> t 8) <> (t 0 <> t 2)))+            `shouldReturn` ([0,0,2,2,4,4,8,8])+#endif
+ test/Streamly/Test/Prelude/WSerial.hs view
@@ -0,0 +1,184 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.WSerial+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.WSerial (main) where++import Data.List (sort)+import Test.QuickCheck (Property, forAll)+import Test.Hspec.QuickCheck+import Test.QuickCheck.Monadic (monadicIO, run)+import Test.Hspec as H++import qualified Streamly.Internal.Data.Stream.Serial as Serial++import Streamly.Prelude hiding (repeat)+import qualified Streamly.Prelude as S++import Streamly.Test.Common+import Streamly.Test.Prelude.Common++associativityCheck+    :: String+    -> (WSerialT IO Int -> SerialT IO Int)+    -> Spec+associativityCheck desc t = prop desc assocCheckProp+  where+    assocCheckProp :: [Int] -> [Int] -> [Int] -> Property+    assocCheckProp xs ys zs =+        monadicIO $ do+            let xStream = S.fromList xs+                yStream = S.fromList ys+                zStream = S.fromList zs+            infixAssocstream <-+                run $ S.toList $ t $ xStream `wSerial` yStream `wSerial` zStream+            assocStream <- run $ S.toList $ t $ xStream <> yStream <> zStream+            listEquals (==) infixAssocstream assocStream++interleaveCheck :: IsStream t+    => (t IO Int -> SerialT IO Int)+    -> (t IO Int -> t IO Int -> t IO Int)+    -> Spec+interleaveCheck t f =+    it "Interleave four" $+        (S.toList . t) ((singleton 0 `f` singleton 1) `f` (singleton 100 `f` singleton 101))+            `shouldReturn` [0, 100, 1, 101]++    where++    singleton :: IsStream t => a -> t m a+    singleton a = a .: nil++wSerialMinLengthProp :: Property+wSerialMinLengthProp =+    forAll (chooseInt (0, 10))+        $ \len ->+            S.length (fromWSerial $ combined len) `shouldReturn` 2 * len + 1++    where++    finiteStream len = S.take len $ S.repeat (1 :: Int)+    infiniteStream = S.repeat 1+    combined len = infiniteStream `Serial.wSerialMin` finiteStream len++moduleName :: String+moduleName = "Prelude.WSerial"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    let wSerialOps :: IsStream t => ((WSerialT IO a -> t IO a) -> Spec) -> Spec+        wSerialOps spec = mapOps spec $ makeOps fromWSerial+#ifndef COVERAGE_BUILD+            <> [("rate AvgRate 0.00000001", fromWSerial . avgRate 0.00000001)]+            <> [("maxBuffer (-1)", fromWSerial . maxBuffer (-1))]+#endif++    describe "Construction" $ do+        wSerialOps  $ prop "wSerially repeat" . constructWithRepeat+        wSerialOps  $ prop "wSerially repeatM" . constructWithRepeatM+        wSerialOps  $ prop "wSerially replicateM" . constructWithReplicate+        wSerialOps  $ prop "wSerially replicateM" . constructWithReplicateM+        wSerialOps $ prop "wSerially cons" . constructWithCons S.cons+        wSerialOps $ prop "wSerially consM" . constructWithConsM S.consM id+        wSerialOps $ prop "wSerially (.:)" . constructWithCons (S..:)+        wSerialOps $ prop "wSerially (|:)" . constructWithConsM (S.|:) id++    describe "Functor operations" $ do+        wSerialOps   $ functorOps S.fromFoldable "wSerially" (==)+        wSerialOps   $ functorOps folded "wSerially folded" (==)++    describe "Monoid operations" $ do+        wSerialOps   $ monoidOps "wSerially" mempty sortEq++    describe "Bind and Monoidal composition combinations" $ do+        -- XXX Taking a long time when wSerialOps is used.+        bindAndComposeSimpleOps "WSerial" sortEq fromWSerial+        bindAndComposeHierarchyOps "WSerial" fromWSerial+        wSerialOps $ nestTwoStreams "WSerial" id sort+        wSerialOps $ nestTwoStreamsApp "WSerial" id sort+        composeAndComposeSimpleSerially+            "WSerial <> "+            [ [1, 4, 2, 7, 3, 5, 8, 6, 9]+            , [1, 7, 4, 8, 2, 9, 5, 3, 6]+            , [1, 4, 2, 7, 3, 5, 8, 6, 9]+            , [1, 7, 4, 8, 2, 9, 5, 3, 6]+            ]+            fromWSerial+        composeAndComposeSimpleWSerially+            "WSerial <> "+            [ [1, 4, 2, 7, 3, 5, 8, 6, 9]+            , [1, 7, 4, 8, 2, 9, 5, 3, 6]+            , [1, 4, 3, 7, 2, 6, 9, 5, 8]+            , [1, 7, 4, 9, 3, 8, 6, 2, 5]+            ]+            fromWSerial++    describe "Semigroup operations" $ do+        wSerialOps $ semigroupOps "wSerially" (==)+        wSerialOps $ associativityCheck "wSerial == <>"++    describe "Applicative operations" $ do+        wSerialOps $ applicativeOps S.fromFoldable "wSerially applicative" sortEq+        wSerialOps $ applicativeOps folded "wSerially applicative folded" sortEq++    -- 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.+        wSerialOps  $ prop "zip monadic wSerially" . zipMonadic S.fromFoldable (==)+        wSerialOps  $ prop "zip monadic wSerially folded" . zipMonadic folded (==)++    describe "Monad operations" $ do+        wSerialOps  $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq+        wSerialOps  $ prop "wSerially monad then folded" . monadThen folded sortEq+        wSerialOps  $ prop "wSerially monad bind" . monadBind S.fromFoldable sortEq+        wSerialOps  $ prop "wSerially monad bind folded" . monadBind folded sortEq++    describe "Stream transform and combine operations" $ do+        wSerialOps   $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq+        wSerialOps   $ transformCombineOpsCommon folded "wSerially" sortEq++    describe "Stream elimination operations" $ do+        wSerialOps   $ eliminationOps S.fromFoldable "wSerially"+        wSerialOps   $ eliminationOps folded "wSerially folded"+        wSerialOps   $ eliminationOpsWord8 S.fromFoldable "wSerially"+        wSerialOps   $ eliminationOpsWord8 folded "wSerially folded"++    -- 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+        wSerialOps   $ eliminationOpsOrdered S.fromFoldable "wSerially"+        wSerialOps   $ eliminationOpsOrdered folded "wSerially folded"++    ---------------------------------------------------------------------------+    -- Semigroup/Monoidal Composition strict ordering checks+    ---------------------------------------------------------------------------++    describe "WSerial interleaved (<>) ordering check" $+        interleaveCheck fromWSerial (<>)+    describe "WSerial interleaved mappend ordering check" $+        interleaveCheck fromWSerial mappend++    describe "Tests for exceptions" $ wSerialOps $ exceptionOps "wSerially"+    describe "Composed MonadThrow wSerially" $ composeWithMonadThrow fromWSerial++    ---------------------------------------------------------------------------+    -- Termination checks+    ---------------------------------------------------------------------------++    describe "wSerialMin termination" $+             prop "len (infinite `wSerialMin` finite) = 2 * len(finite) + 1"+                  wSerialMinLengthProp
+ test/Streamly/Test/Prelude/ZipAsync.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.ZipAsync+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.ZipAsync  (main) where++import Test.Hspec.QuickCheck+import Test.Hspec as H++import Streamly.Prelude+import qualified Streamly.Prelude as S++import Streamly.Test.Prelude.Common++moduleName :: String+moduleName = "Prelude.ZipAsync"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    -- Note, the "pure" of applicative Zip streams generates and infinite+    -- stream and therefore maxBuffer (-1) must not be used for that case.+    let zipAsyncOps :: IsStream t => ((ZipAsyncM IO a -> t IO a) -> Spec) -> Spec+        zipAsyncOps spec = mapOps spec $ makeOps fromZipAsync++    describe "Functor operations" $ do+        zipAsyncOps  $ functorOps S.fromFoldable "zipAsyncly" (==)+        zipAsyncOps  $ functorOps folded "zipAsyncly folded" (==)++    describe "Monoid operations" $ do+        zipAsyncOps  $ monoidOps "zipAsyncly" mempty (==)++    describe "Semigroup operations" $ do+        zipAsyncOps  $ semigroupOps "zipAsyncly" (==)++    -- XXX add tests for indexed/indexedR+    describe "Zip operations" $ do+        zipAsyncOps $+            prop "zipAsyncly applicative" . zipApplicative S.fromFoldable (==)+        zipAsyncOps $+            prop "zipAsyncly applicative folded" . zipApplicative folded (==)++    describe "Stream transform and combine operations" $ do+        zipAsyncOps  $ transformCombineOpsCommon S.fromFoldable "zipAsyncly" (==)+        zipAsyncOps  $ transformCombineOpsCommon folded "zipAsyncly" (==)+        zipAsyncOps  $ transformCombineOpsOrdered S.fromFoldable "zipAsyncly" (==)+        zipAsyncOps  $ transformCombineOpsOrdered folded "zipAsyncly" (==)++    describe "Stream elimination operations" $ do+        zipAsyncOps  $ eliminationOps S.fromFoldable "zipAsyncly"+        zipAsyncOps  $ eliminationOps folded "zipAsyncly folded"+        zipAsyncOps  $ eliminationOpsWord8 S.fromFoldable "zipAsyncly"+        zipAsyncOps  $ eliminationOpsWord8 folded "zipAsyncly folded"++    -- 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+        zipAsyncOps  $ eliminationOpsOrdered S.fromFoldable "zipAsyncly"+        zipAsyncOps  $ eliminationOpsOrdered folded "zipAsyncly folded"
+ test/Streamly/Test/Prelude/ZipSerial.hs view
@@ -0,0 +1,73 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- Module      : Streamly.Test.Prelude.ZipSerial+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.ZipSerial (main) where++import Test.Hspec.QuickCheck+import Test.Hspec as H++import Streamly.Prelude+import qualified Streamly.Prelude as S++import Streamly.Test.Prelude.Common++moduleName :: String+moduleName = "Prelude.ZipSerial"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    let zipSerialOps :: IsStream t+            => ((ZipSerialM IO a -> t IO a) -> Spec) -> Spec+        zipSerialOps spec = mapOps spec $ makeOps fromZipSerial+#ifndef COVERAGE_BUILD+            <> [("rate AvgRate 0.00000001", fromZipSerial . avgRate 0.00000001)]+            <> [("maxBuffer (-1)", fromZipSerial . maxBuffer (-1))]+#endif++    describe "Functor operations" $ do+        zipSerialOps $ functorOps S.fromFoldable "zipSerially" (==)+        zipSerialOps $ functorOps folded "zipSerially folded" (==)++    describe "Monoid operations" $ do+        zipSerialOps $ monoidOps "zipSerially" mempty (==)++    describe "Semigroup operations" $ do+        zipSerialOps $ semigroupOps "zipSerially" (==)++    -- XXX add tests for indexed/indexedR+    describe "Zip operations" $ do+        zipSerialOps $+            prop "zipSerially applicative" . zipApplicative S.fromFoldable (==)+        zipSerialOps $+            prop "zipSerially applicative folded" . zipApplicative folded (==)++    describe "Stream transform and combine operations" $ do+        zipSerialOps $ transformCombineOpsCommon S.fromFoldable "zipSerially" (==)+        zipSerialOps $ transformCombineOpsCommon folded "zipSerially" (==)+        zipSerialOps $ transformCombineOpsOrdered S.fromFoldable "zipSerially" (==)+        zipSerialOps $ transformCombineOpsOrdered folded "zipSerially" (==)++    describe "Stream elimination operations" $ do+        zipSerialOps $ eliminationOps S.fromFoldable "zipSerially"+        zipSerialOps $ eliminationOps folded "zipSerially folded"+        zipSerialOps $ eliminationOpsWord8 S.fromFoldable "zipSerially"+        zipSerialOps $ eliminationOpsWord8 folded "zipSerially folded"++    -- 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+        zipSerialOps $ eliminationOpsOrdered S.fromFoldable "zipSerially"+        zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"
+ 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
@@ -0,0 +1,133 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}++-- |+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Test.Unicode.Char (main) where++import Control.Monad (when)+import Data.Char (chr, isSpace, ord, toUpper)+import Data.List (intercalate, isPrefixOf)+import Data.Function ((&))+import Streamly.Internal.Unicode.Char+    ( NormalizationMode(NFC, NFD, NFKC, NFKD)+    , normalize+    )+import Streamly.Internal.Data.Stream (Stream)+import Text.Printf (printf)+import System.FilePath.Posix ((</>))++import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Fold as FL+import qualified System.Directory as Dir++chrToHex :: Char -> [Char]+chrToHex = map toUpper . printf "%.4x" . ord++strToHex :: [Char] -> String+strToHex = unwords . map chrToHex++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 <- toList mc1+    c2 <- toList mc2+    opc2 <- toList $ op mc2+    if c1 /= opc2 then do+        putStrLn $ opName ++ " "            ++ strToHex c2+                          ++ " = "          ++ strToHex opc2+                          ++ "; Expected: " ++ strToHex c1+        return False+    else return True++checkOp :: String -> NormalizationMode -> [(Text, Text)] -> IO Bool+checkOp name op pairs = do+    res <- mapM (checkEqual name (normalize op)) pairs+    return $ and res++checkNFC :: (Text, Text, Text, Text, Text) -> IO Bool+checkNFC (c1, c2, c3, c4, c5) =+    checkOp "toNFC" NFC $ map (c2, ) [c1, c2, c3] ++ map (c4, ) [c4, c5]++checkNFD :: (Text, Text, Text, Text, Text) -> IO Bool+checkNFD (c1, c2, c3, c4, c5) =+    checkOp "toNFD" NFD $ map (c3, ) [c1, c2, c3] ++ map (c5, ) [c4, c5]++checkNFKC :: (Text, Text, Text, Text, Text) -> IO Bool+checkNFKC (c1, c2, c3, c4, c5) =+    checkOp "toNFKC" NFKC $ map (c4,) [c1, c2, c3, c4, c5]++checkNFKD :: (Text, Text, Text, Text, Text) -> IO Bool+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 <- 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]+            mapM_ (checkOneTestCase cps)+                  [checkNFD, checkNFKD, checkNFC, checkNFKC]+        _ -> error $ "Unrecognized line: " ++ line+    where+        cpToText xs = S.fromList $ map (chr . read . ("0x" ++)) (words xs)++        checkOneTestCase cps f = do+            res <- f (tuplify cps)+            when (not res) $ do+                strs <- mapM toList cps+                let codes = intercalate ";" $ map strToHex strs+                    txt = intercalate "; " strs+                putStrLn ("Failed at line: " ++ show lineno)+                putStrLn line+                putStrLn $ codes ++ "; # (" ++ txt+                error "Bailing out"++        tuplify [c1, c2, c3, c4, c5] = (c1, c2, c3, c4, c5)+        tuplify _ = error "tuplify bad arguments"++checkLine :: (Int, String) -> IO ()+checkLine (lineno, line) = do+    -- marker lines indicating a test block start with @+    if "@" `isPrefixOf` line+        then+            putStrLn line+        else+            checkAllTestCases lineno line++testNormalize :: FilePath -> IO ()+testNormalize file = do+    contents <- readFile file+    let ls = lines contents                        -- split into lines+         & map (dropWhile isSpace)                 -- trim leading spaces+         & zip [1..]                               -- add numbering+         & filter (not . null . snd)               -- remove blank lines+         & filter (not . ("#" `isPrefixOf`) . snd) -- remove comments+    checkAll ls+    where+        checkAll (x:xs) = checkLine x >> checkAll xs+        checkAll []     = return ()++filesDir :: String+filesDir = "test/Streamly/Test/Unicode"++main :: IO ()+main = do+    cdir <- Dir.getCurrentDirectory+    testNormalize $ cdir </> filesDir </> "ucd/NormalizationTest.txt"+    -- Additional test cases not in the unicode standard suite+    testNormalize $ cdir </> filesDir </> "extra/NormalizationTest.txt"
+ 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
@@ -0,0 +1,237 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++module Streamly.Test.Unicode.Stream (main) where++import Control.Monad (when)+import Data.Char (ord, chr)+import Data.Word (Word8, Word16)+import Test.QuickCheck+    ( Property+    , forAll+    , Gen+    , listOf+    , arbitraryASCIIChar+    , arbitraryUnicodeChar+    , arbitrary+    , expectFailure+    , vectorOf+    , choose+    )+import Test.QuickCheck.Monadic (run, monadicIO, assert, PropertyM)+import Streamly.Data.Stream (Stream)++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 as IUA+import qualified Test.Hspec as H++import Test.Hspec.QuickCheck++-- Coverage build takes too long with default number of tests+{-+maxTestCount :: Int+#ifdef DEVBUILD+maxTestCount = 100+#else+maxTestCount = 10+#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++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' $ 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 $ Stream.fromList list+            chrs <- Stream.toList $ SS.decodeUtf8 wrds+            assertEq chrs list++propDecodeEncodeIdArrays :: Property+propDecodeEncodeIdArrays =+    forAll genUnicode $ \list ->+        monadicIO $ do+            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 ."++latin1TestData :: [Char]+latin1TestData = "z\214\f;L$Wz| ?_i/J ."++propASCIIToLatin1 :: Property+propASCIIToLatin1 =+    forAll (choose (1, 1000)) $ \len ->+        forAll (vectorOf len arbitraryASCIIChar) $ \list ->+            monadicIO $ do+                let wrds = SS.decodeLatin1+                            $ SS.encodeLatin1+                            $ Stream.fromList list+                lst <- run $  Stream.toList wrds+                assertEq list lst++propUnicodeToLatin1 :: Property+propUnicodeToLatin1 =+    monadicIO $ do+        let wrds =+                SS.decodeLatin1+                    $ SS.encodeLatin1+                    $ Stream.fromList unicodeTestData+        lst <- run $ Stream.toList wrds+        assertEq latin1TestData lst++propUnicodeToLatin1' :: Property+propUnicodeToLatin1' =+    monadicIO $ do+        let wrds =+                SS.decodeLatin1+                    $ SS.encodeLatin1'+                    $ Stream.fromList unicodeTestData+        lst <- run $ Stream.toList wrds+        assertEq latin1TestData lst++testLines :: Property+testLines =+    forAll genUnicode $ \list ->+        monadicIO $ do+            xs <- Stream.toList+                $ fmap A.toList+                $ IUA.lines+                $ Stream.fromList list+            assertEq xs (lines list)++testLinesArray :: Property+testLinesArray =+    forAll genWord8List $ \list ->+        monadicIO $ do+            xs <- Stream.toList+                    $ fmap A.toList+                    $ AS.splitOnSuffix 10+                    $ 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 <- Stream.toList+                $ Stream.map A.toList+                $ IUA.words+                $ Stream.fromList list+            assertEq xs (words list)++testUnlines :: Property+testUnlines =+  forAll genUnicode $ \list ->+      monadicIO $ do+          xs <- Stream.toList+              $ IUA.unlines+              $ IUA.lines+              $ Stream.fromList list+          assertEq xs (unlines (lines list))++testUnwords :: Property+testUnwords =+  forAll genUnicode $ \list ->+      monadicIO $ do+          xs <- run+              $ Stream.toList+              $ IUA.unwords+              $ IUA.words+              $ Stream.fromList list+          assertEq xs (unwords (words list))++moduleName :: String+moduleName = "Unicode.Stream"++main :: IO ()+main = H.hspec+  $ H.parallel+  $ modifyMaxSuccess (const 1000)+  $ H.describe moduleName $ do+    H.describe "UTF8 - Encoding / Decoding" $ do+        prop "decodeUtf8' . encodeUtf8' == id" propDecodeEncodeId'+        prop "decodeUtf8 . encodeUtf8' == id" propDecodeEncodeId+        prop "decodeUtf8Arrays . encodeUtf8' == id"+                propDecodeEncodeIdArrays+        prop "Streamly.Data.String.lines == Prelude.lines" testLines+        prop "Arrays Streamly.Data.String.lines == Prelude.lines"+            testLinesArray+        prop "Streamly.Data.String.words == Prelude.words" testWords+        prop+            "Streamly.Data.String.unlines . Streamly.Data.String.lines == unlines . lines"+            testUnlines+        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+        prop "Unicode to Latin1" propUnicodeToLatin1+        prop "Unicode to Latin1'" $ expectFailure  propUnicodeToLatin1'
+ test/Streamly/Test/Unicode/extra/NormalizationTest.txt view
@@ -0,0 +1,9 @@+#   Columns (c1, c2,...) are separated by semicolons+#   They have the following meaning:+#      source; NFC; NFD; NFKC; NFKD++@Extra test cases not in the unicode standard test suite+AC00 11A7;AC00 11A7;1100 1161 11A7;AC00 11A7;1100 1161 11A7; # 11A7 is not a valid T and should not be combined with LV AC00 to give AC00 as NFC.+AC00 11A8;AC01;1100 1161 11A8;AC01;1100 1161 11A8; # Combine precomposed LV and a T i.e <LV,T> sequence.+1100 11A8;1100 11A8;1100 11A8;1100 11A8;1100 11A8; # Invalid <L,T> sequence+2FA1E;2FA1E;2FA1E;2FA1E;2FA1E; # Beyond decomposable max
+ test/Streamly/Test/Unicode/ucd/NormalizationTest.txt view

file too large to diff

+ test/lib/Streamly/Test/Common.hs view
@@ -0,0 +1,77 @@+-- |+-- Module      : Streamly.Test.Common+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Common+    ( equals+    , listEquals+    , checkListEqual+    , chooseInt+    , chooseDouble+    , performGCSweep+    ) where++import Control.Monad (when, void, replicateM_)+import Control.Monad.IO.Class (MonadIO(..))+import Data.List ((\\))+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 ()+equals eq stream list = do+    when (not $ stream `eq` list) $+        monitor+            (counterexample $+             "stream " <> show stream+             <> "\nlist   " <> show list+            )+    assert (stream `eq` list)++listEquals+    :: (Show a, Eq a, MonadIO m)+    => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()+listEquals eq stream list = do+    when (not $ stream `eq` list) $ liftIO $ putStrLn $+                  "stream " <> show stream+             <> "\nlist   " <> show list+             <> "\nstream length  " <> show (length stream)+             <> "\nlist length  " <> show (length list)+             <> "\nstream \\\\ list " <> show (stream \\ list)+             <> "\nlist \\\\ stream " <> show (list \\ stream)+    when (not $ stream `eq` list) $+        monitor+            (counterexample $+                  "stream " <> show stream+             <> "\nlist   " <> show list+             <> "\nstream length  " <> show (length stream)+             <> "\nlist length  " <> show (length list)+             <> "\nstream \\\\ list " <> show (stream \\ list)+             <> "\nlist \\\\ stream " <> show (list \\ stream)+             )+    assert (stream `eq` list)++checkListEqual :: (Show a, Eq a) => [a] -> [a] -> Property+checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)++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
@@ -0,0 +1,1761 @@+{-# 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+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Prelude.Common+    (+    -- * Construction operations+      constructWithRepeat+    , constructWithRepeatM+    , constructWithReplicate+    , constructWithReplicateM+    , constructWithIntFromThenTo+    , constructWithDoubleFromThenTo+    , constructWithIterate+    , constructWithIterateM+    , constructWithEnumerate+    , constructWithEnumerateTo+    , constructWithFromIndices+    , constructWithFromIndicesM+    , constructWithFromList+    , constructWithFromListM+    , constructWithUnfoldr+    , constructWithCons+    , constructWithConsM+    , constructWithFromPure+    , constructWithFromEffect+    , simpleOps+    -- * Applicative operations+    , applicativeOps+    , applicativeOps1+    -- * Elimination operations+    , eliminationOpsOrdered+    , eliminationOpsWord8+    , eliminationOps+    -- * Functor operations+    , functorOps+    -- * Monoid operations+    , monoidOps+    , loops+    , bindAndComposeSimpleOps+    , bindAndComposeHierarchyOps+    , nestTwoStreams+    , nestTwoStreamsApp+    , composeAndComposeSimpleSerially+    , composeAndComposeSimpleAheadly+    , composeAndComposeSimpleWSerially+    -- * Semigroup operations+    , semigroupOps+    , parallelCheck+    -- * Transformation operations+    , transformCombineOpsOrdered+    , transformCombineOpsCommon+    , toListFL+    -- * Monad operations+    , monadBind+    , monadThen+    -- * Zip operations+    , zipApplicative+    , zipMonadic+    , zipAsyncApplicative+    , zipAsyncMonadic+    -- * Exception operations+    , exceptionOps+    -- * MonadThrow operations+    , composeWithMonadThrow+    -- * Cleanup tests+    , checkCleanup+    -- * Adhoc tests+    , takeCombined+    -- * Default values+    , maxTestCount+    , maxStreamLen+    -- * Helper operations+    , folded+    , makeCommonOps+    , makeOps+    , mapOps+    , sortEq+    ) where++#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)+#ifdef DEVBUILD+import Control.Monad (when)+#endif+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+    , elemIndex+    , elemIndices+    , find+    , findIndex+    , findIndices+    , foldl'+    , foldl1'+    , insert+    , intersperse+    , isPrefixOf+    , isSubsequenceOf+    , maximumBy+    , minimumBy+    , scanl'+    , sort+    , stripPrefix+    , unfoldr+    )+import Data.Maybe (mapMaybe)+import GHC.Word (Word8)+import System.Mem (performMajorGC)+import Test.Hspec.QuickCheck+import Test.Hspec+import Test.QuickCheck (Property, choose, forAll, listOf, withMaxSuccess)+import Test.QuickCheck.Monadic (assert, monadicIO, run)++import Streamly.Prelude (SerialT, IsStream, (.:), nil, (|&), fromSerial)+#ifndef COVERAGE_BUILD+import Streamly.Prelude (avgRate, rate, maxBuffer, maxThreads)+#endif+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 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++-- Coverage build takes too long with default number of tests+maxTestCount :: Int+#ifdef DEVBUILD+maxTestCount = 100+#else+maxTestCount = 10+#endif++singleton :: IsStream t => a -> t m a+singleton a = a .: nil++sortEq :: Ord a => [a] -> [a] -> Bool+sortEq a b = sort a == sort b++-------------------------------------------------------------------------------+-- Construction operations+-------------------------------------------------------------------------------++constructWithLen+    :: (Show a, Eq a)+    => (Int -> t IO a)+    -> (Int -> [a])+    -> (t IO a -> SerialT IO a)+    -> Word8+    -> Property+constructWithLen mkStream mkList op len = withMaxSuccess maxTestCount $+    monadicIO $ do+        stream <- run $ (S.toList . op) (mkStream (fromIntegral len))+        let list = mkList (fromIntegral len)+        listEquals (==) stream list++constructWithLenM+    :: (Int -> t IO Int)+    -> (Int -> IO [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithLenM mkStream mkList op len = withMaxSuccess maxTestCount $+    monadicIO $ do+        stream <- run $ (S.toList . op) (mkStream (fromIntegral len))+        list <- run $ mkList (fromIntegral len)+        listEquals (==) stream list++constructWithReplicate, constructWithReplicateM, constructWithIntFromThenTo+    :: IsStream t+    => (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property++constructWithReplicateM = constructWithLenM stream list+    where list = flip replicateM (return 1 :: IO Int)+          stream = flip S.replicateM (return 1 :: IO Int)++constructWithReplicate = constructWithLen stream list+    where list = flip replicate (1 :: Int)+          stream = flip S.replicate (1 :: Int)++constructWithIntFromThenTo op l =+    forAll (choose (minBound, maxBound)) $ \from ->+    forAll (choose (minBound, maxBound)) $ \next ->+    forAll (choose (minBound, maxBound)) $ \to ->+        let list len = take len [from,next..to]+            stream len = S.take len $ S.enumerateFromThenTo from next to+        in constructWithLen stream list op l++constructWithRepeat, constructWithRepeatM+    :: IsStream t+    => (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithRepeat = constructWithLenM stream list+  where+    stream n = S.take n $ S.repeat 1+    list n = return $ replicate n 1++constructWithRepeatM = constructWithLenM stream list+  where+    stream n = S.take n $ S.repeatM (return 1)+    list n = return $ replicate n 1++-- XXX try very small steps close to 0+constructWithDoubleFromThenTo+    :: IsStream t+    => (t IO Double -> SerialT IO Double)+    -> Word8+    -> Property+constructWithDoubleFromThenTo op l =+    forAll (choose (-9007199254740999,9007199254740999)) $ \from ->+    forAll (choose (-9007199254740999,9007199254740999)) $ \next ->+    forAll (choose (-9007199254740999,9007199254740999)) $ \to ->+        let list len = take len [from,next..to]+            stream len = S.take len $ S.enumerateFromThenTo from next to+        in constructWithLen stream list op l++constructWithIterate ::+       IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property+constructWithIterate op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        stream <-+            run $+            (S.toList . op . S.take (fromIntegral len))+                (S.iterate (+ 1) (0 :: Int))+        let list = take (fromIntegral len) (iterate (+ 1) 0)+        listEquals (==) stream list++constructWithIterateM ::+       IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property+constructWithIterateM op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        mvl <- run (newIORef [] :: IO (IORef [Int]))+        let addM mv x y = modifyIORef' mv (++ [y + x]) >> return (y + x)+            list = take (fromIntegral len) (iterate (+ 1) 0)+        run $+            S.drain . op $+            S.take (fromIntegral len) $+            S.iterateM (addM mvl 1) (addM mvl 0 0 :: IO Int)+        streamEffect <- run $ readIORef mvl+        listEquals (==) streamEffect list++constructWithFromIndices ::+       IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property+constructWithFromIndices op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        stream <-+            run $ (S.toList . op . S.take (fromIntegral len)) (S.fromIndices id)+        let list = take (fromIntegral len) (iterate (+ 1) 0)+        listEquals (==) stream list++constructWithFromIndicesM ::+       IsStream t => (t IO Int -> SerialT IO Int) -> Word8 -> Property+constructWithFromIndicesM op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        mvl <- run (newIORef [] :: IO (IORef [Int]))+        let addIndex mv i = modifyIORef' mv (++ [i]) >> return i+            list = take (fromIntegral len) (iterate (+ 1) 0)+        run $+            S.drain . op $+            S.take (fromIntegral len) $ S.fromIndicesM (addIndex mvl)+        streamEffect <- run $ readIORef mvl+        listEquals (==) streamEffect list++constructWithCons ::+       IsStream t+    => (Int -> t IO Int -> t IO Int)+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithCons cons op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        strm <-+            run+               $ S.toList . op . S.take (fromIntegral len)+               $ foldr cons S.nil (repeat 0)+        let list = replicate (fromIntegral len) 0+        listEquals (==) strm list++constructWithConsM ::+       IsStream t+    => (IO Int -> t IO Int -> t IO Int)+    -> ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithConsM consM listT op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        strm <-+            run $+            S.toList . op . S.take (fromIntegral len) $+            foldr consM S.nil (repeat (return 0))+        let list = replicate (fromIntegral len) 0+        listEquals (==) (listT strm) list++constructWithEnumerate ::+       IsStream t+    => ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithEnumerate listT op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        strm <- run $ S.toList . op . S.take (fromIntegral len) $ S.enumerate+        let list = take (fromIntegral len) (enumFrom minBound)+        listEquals (==) (listT strm) list++constructWithEnumerateTo ::+       IsStream t+    => ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithEnumerateTo listT op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        -- It takes forever to enumerate from minBound to len, so+        -- instead we just do till len elements+        strm <- run $ S.toList . op $ S.enumerateTo (minBound + fromIntegral len)+        let list = enumFromTo minBound (minBound + fromIntegral len)+        listEquals (==) (listT strm) list++constructWithFromList ::+       IsStream t+    => ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithFromList listT op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        strm <- run $ S.toList . op . S.fromList $ [0 .. fromIntegral len]+        let list = [0 .. fromIntegral len]+        listEquals (==) (listT strm) list++constructWithFromListM ::+       IsStream t+    => ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithFromListM listT op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        strm <-+            run $+            S.toList . op . S.fromListM . fmap pure $ [0 .. fromIntegral len]+        let list = [0 .. fromIntegral len]+        listEquals (==) (listT strm) list++constructWithUnfoldr ::+       IsStream t+    => ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithUnfoldr listT op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        strm <- run $ S.toList . op $ S.unfoldr unfoldStep 0+        let list = unfoldr unfoldStep 0+        listEquals (==) (listT strm) list+  where+    unfoldStep seed =+        if seed > fromIntegral len+        then Nothing+        else Just (seed, seed + 1)++constructWithFromPure ::+       (IsStream t, Monoid (t IO Int))+    => ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithFromPure listT op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        strm <-+            run+                $ S.toList . op . S.take (fromIntegral len)+                $ foldMap S.fromPure (repeat 0)+        let list = replicate (fromIntegral len) 0+        listEquals (==) (listT strm) list++constructWithFromEffect ::+       (IsStream t, Monoid (t IO Int))+    => ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Word8+    -> Property+constructWithFromEffect listT op len =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        strm <-+            run+                $ S.toList . op . S.take (fromIntegral len)+                $ foldMap S.fromEffect (repeat (return 0))+        let list = replicate (fromIntegral len) 0+        listEquals (==) (listT strm) list++simpleProps ::+       (Int -> t IO Int)+    -> (t IO Int -> SerialT IO Int)+    -> Int+    -> Property+simpleProps constr op a = monadicIO $ do+  strm <- run $ S.toList . op . constr $ a+  listEquals (==) strm [a]++simpleOps :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec+simpleOps op = do+  prop "fromPure a = a" $ simpleProps S.fromPure op+  prop "fromEffect a = a" $ simpleProps (S.fromEffect . return) op++-------------------------------------------------------------------------------+-- Applicative operations+-------------------------------------------------------------------------------++applicativeOps+    :: (Applicative (t IO), Semigroup (t IO Int))+    => ([Int] -> t IO Int)+    -> String+    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)+    -> (t IO (Int, Int) -> SerialT IO (Int, Int))+    -> Spec+applicativeOps constr desc eq t = do+    prop (desc <> " <*>") $+        transformFromList2+            constr+            eq+            (\a b -> (,) <$> a <*> b)+            (\a b -> t ((,) <$> a <*> b))+    prop (desc <> " liftA2") $+        transformFromList2 constr eq (liftA2 (,)) (\a b -> t $ liftA2 (,) a b)+    prop (desc <> " Apply - composed first argument") $+        sort <$>+        (S.toList . t) ((,) <$> (pure 1 <> pure 2) <*> pure 3) `shouldReturn`+        [(1, 3), (2, 3)]+    prop (desc <> " Apply - composed second argument") $+        sort <$>+        (S.toList . t) (pure ((,) 1) <*> (pure 2 <> pure 3)) `shouldReturn`+        [(1, 2), (1, 3)]++-- XXX we can combine this with applicativeOps by making the type sufficiently+-- polymorphic.+applicativeOps1+    :: Applicative (t IO)+    => ([Int] -> t IO Int)+    -> String+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> Spec+applicativeOps1 constr desc eq t = do+    prop (desc <> " *>") $+        transformFromList2 constr eq (*>) (\a b -> t (a *> b))+    prop (desc <> " <*") $+        transformFromList2 constr eq (<*) (\a b -> t (a <* b))++transformFromList2+  :: (Eq c, Show c)+  => ([a] -> t IO a)+  -> ([c] -> [c] -> Bool)+  -> ([a] -> [a] -> [c])+  -> (t IO a -> t IO a -> SerialT IO c)+  -> ([a], [a])+  -> Property+transformFromList2 constr eq listOp op (a, b) =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        stream <- run (S.toList $ op (constr a) (constr b))+        let list = listOp a b+        listEquals eq stream list++-------------------------------------------------------------------------------+-- Elimination operations+-------------------------------------------------------------------------------++eliminateOp+    :: (Show a, Eq a)+    => ([s] -> t IO s)+    -> ([s] -> a)+    -> (t IO s -> IO a)+    -> [s]+    -> Property+eliminateOp constr listOp op a =+    monadicIO $ do+        stream <- run $ op (constr a)+        let list = listOp a+        equals (==) stream list++wrapMaybe :: ([a1] -> a2) -> [a1] -> Maybe a2+wrapMaybe f x = if null x then Nothing else Just (f x)++wrapOutOfBounds :: ([a1] -> Int -> a2) -> Int -> [a1] -> Maybe a2+wrapOutOfBounds f i x | null x = Nothing+                      | i >= length x = Nothing+                      | otherwise = Just (f x i)++wrapThe :: Eq a => [a] -> Maybe a+wrapThe (x:xs)+    | all (x ==) xs = Just x+    | otherwise = Nothing+wrapThe [] = Nothing++-- This is the reference uniq implementation to compare uniq against,+-- we can use uniq from vector package, but for now this should+-- suffice.+referenceUniq :: Eq a => [a] -> [a]+referenceUniq = go+  where+    go [] = []+    go (x:[]) = [x]+    go (x:y:xs)+        | x == y = go (x : xs)+        | otherwise = x : go (y : xs)++eliminationOps+    :: ([Int] -> t IO Int)+    -> String+    -> (t IO Int -> SerialT IO Int)+    -> Spec+eliminationOps constr desc t = do+    -- Elimination+    prop (desc <> " null") $ eliminateOp constr null $ S.null . t+    prop (desc <> " foldl'") $+        eliminateOp constr (foldl' (+) 0) $ S.foldl' (+) 0 . t+    prop (desc <> " foldl1'") $+        eliminateOp constr (wrapMaybe $ foldl1' (+)) $ S.foldl1' (+) . t+#ifdef DEVBUILD+    prop (desc <> " foldr1") $+        eliminateOp constr (wrapMaybe $ foldr1 (+)) $ S.foldr1 (+) . t+#endif+    prop (desc <> " all") $ eliminateOp constr (all even) $ S.all even . t+    prop (desc <> " any") $ eliminateOp constr (any even) $ S.any even . t+    prop (desc <> " and") $ eliminateOp constr (and . fmap (> 0)) $+        (S.and . S.map (> 0)) . t+    prop (desc <> " or") $ eliminateOp constr (or . fmap (> 0)) $+        (S.or . S.map (> 0)) . t+    prop (desc <> " length") $ eliminateOp constr length $ S.length . t+    prop (desc <> " sum") $ eliminateOp constr sum $ S.sum . t+    prop (desc <> " product") $ eliminateOp constr product $ S.product . t+    prop (desc <> " mapM_ sumIORef") $+        eliminateOp constr sum $+        (\strm -> do+             ioRef <- newIORef 0+             let sumInRef a = modifyIORef' ioRef (a +)+             S.mapM_ sumInRef strm+             readIORef ioRef) .+        t+    prop (desc <> "trace sumIORef") $+        eliminateOp constr sum $+        (\strm -> do+             ioRef <- newIORef 0+             let sumInRef a = modifyIORef' ioRef (a +)+             S.drain $ S.trace sumInRef strm+             readIORef ioRef) .+        t++    prop (desc <> " maximum") $+        eliminateOp constr (wrapMaybe maximum) $ S.maximum . t+    prop (desc <> " minimum") $+        eliminateOp constr (wrapMaybe minimum) $ S.minimum . t++    prop (desc <> " maximumBy compare") $+        eliminateOp constr (wrapMaybe maximum) $+        S.maximumBy compare . t+    prop (desc <> " maximumBy flip compare") $+        eliminateOp constr (wrapMaybe $ maximumBy $ flip compare) $+        S.maximumBy (flip compare) . t+    prop (desc <> " minimumBy compare") $+        eliminateOp constr (wrapMaybe minimum) $+        S.minimumBy compare . t+    prop (desc <> " minimumBy flip compare") $+        eliminateOp constr (wrapMaybe $ minimumBy $ flip compare) $+        S.minimumBy (flip compare) . t++    prop (desc <> " findIndex") $+        eliminateOp constr (findIndex odd) $ S.findIndex odd . t+    prop (desc <> " elemIndex") $+        eliminateOp constr (elemIndex 3) $ S.elemIndex 3 . t++    prop (desc <> " !! 5") $+        eliminateOp constr (wrapOutOfBounds (!!) 5) $ (S.!! 5) . t+    prop (desc <> " !! 4") $+        eliminateOp constr (wrapOutOfBounds (!!) 0) $ (S.!! 0) . t++    prop (desc <> " find") $ eliminateOp constr (find even) $ S.find even . t+    prop (desc <> " findM") $ eliminateOp constr (find even) $ S.findM (return . even) . t+    prop (desc <> " lookup") $+        eliminateOp constr (lookup 3 . flip zip [1..]) $+            S.lookup 3 . S.zipWith (\a b -> (b, a)) (S.fromList [(1::Int)..]) . t+    prop (desc <> " the") $ eliminateOp constr wrapThe $ S.the . t++    -- Multi-stream eliminations+    -- XXX Write better tests for substreams.+    prop (desc <> " eqBy (==) t t") $+        eliminateOp constr (\s -> s == s) $ (\s -> S.eqBy (==) s s) . t+    prop (desc <> " cmpBy (==) t t") $+        eliminateOp constr (\s -> compare s s) $ (\s -> S.cmpBy compare s s) . t+    prop (desc <> " isPrefixOf 10") $ eliminateOp constr (isPrefixOf [1..10]) $+        S.isPrefixOf (S.fromList [(1::Int)..10]) . t+    prop (desc <> " isSubsequenceOf 10") $+        eliminateOp constr (isSubsequenceOf $ filter even [1..10]) $+        S.isSubsequenceOf (S.fromList $ filter even [(1::Int)..10]) . t+    prop (desc <> " stripPrefix 10") $ eliminateOp constr (stripPrefix [1..10]) $+        (\s -> s >>= maybe (return Nothing) (fmap Just . S.toList)) .+        S.stripPrefix (S.fromList [(1::Int)..10]) . t++-- head/tail/last may depend on the order in case of parallel streams+-- so we test these only for serial streams.+eliminationOpsOrdered+    :: ([Int] -> t IO Int)+    -> String+    -> (t IO Int -> SerialT IO Int)+    -> Spec+eliminationOpsOrdered constr desc t = do+    prop (desc <> " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t+    prop (desc <> " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do+        r <- S.tail (t x)+        case r of+            Nothing -> return Nothing+            Just s -> Just <$> S.toList s+    prop (desc <> " last") $ eliminateOp constr (wrapMaybe last) $ S.last . t+    prop (desc <> " init") $ eliminateOp constr (wrapMaybe init) $ \x -> do+        r <- S.init (t x)+        case r of+            Nothing -> return Nothing+            Just s -> Just <$> S.toList s++elemOp+    :: ([Word8] -> t IO Word8)+    -> (t IO Word8 -> SerialT IO Word8)+    -> (Word8 -> SerialT IO Word8 -> IO Bool)+    -> (Word8 -> [Word8] -> Bool)+    -> (Word8, [Word8])+    -> Property+elemOp constr op streamOp listOp (x, xs) =+    monadicIO $ do+        stream <- run $ (streamOp x . op) (constr xs)+        let list = listOp x xs+        equals (==) stream list++eliminationOpsWord8+    :: ([Word8] -> t IO Word8)+    -> String+    -> (t IO Word8 -> SerialT IO Word8)+    -> Spec+eliminationOpsWord8 constr desc t = do+    prop (desc <> " elem") $ elemOp constr t S.elem elem+    prop (desc <> " notElem") $ elemOp constr t S.notElem notElem++-------------------------------------------------------------------------------+-- Functor operations+-------------------------------------------------------------------------------++functorOps+    :: (Functor (t IO), Semigroup (t IO Int))+    => ([Int] -> t IO Int)+    -> String+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> Spec+functorOps constr desc eq t = do+    prop (desc <> " id") $ transformFromList constr eq id t+    prop (desc <> " fmap (+1)") $+        transformFromList constr eq (fmap (+ 1)) $ t . fmap (+ 1)+    prop (desc <> " fmap on composed (<>)") $+        sort <$>+        (S.toList . t) (fmap (+ 1) (constr [1] <> constr [2])) `shouldReturn`+        ([2, 3] :: [Int])++transformFromList+    :: (Eq b, Show b) =>+       ([a] -> t IO a)+    -> ([b] -> [b] -> Bool)+    -> ([a] -> [b])+    -> (t IO a -> SerialT IO b)+    -> [a]+    -> Property+transformFromList constr eq listOp op a =+    monadicIO $ do+        stream <- run ((S.toList . op) (constr a))+        let list = listOp a+        listEquals eq stream list+++------------------------------------------------------------------------------+-- Monoid operations+------------------------------------------------------------------------------++monoidOps+    :: (IsStream t, Semigroup (t IO Int))+    => String+    -> t IO Int+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> Spec+monoidOps desc z eq t = do+    -- XXX these should get covered by the property tests+    prop (desc <> " Compose mempty, mempty") $ spec (z <> z) []+    prop (desc <> " Compose empty at the beginning") $ spec (z <> singleton 1) [1]+    prop (desc <> " Compose empty at the end") $ spec (singleton 1 <> z) [1]+    prop (desc <> " Compose two") $ spec (singleton 0 <> singleton 1) [0, 1]+    prop (desc <> " Compose many") $+        spec (S.concatForFoldableWith (<>) [1 .. 100] singleton) [1 .. 100]++    -- These are not covered by the property tests+    prop (desc <> " Compose three - empty in the middle") $+        spec (singleton 0 <> z <> singleton 1) [0, 1]+    prop (desc <> " Compose left associated") $+        spec+            (((singleton 0 <> singleton 1) <> singleton 2) <> singleton 3)+            [0, 1, 2, 3]+    prop (desc <> " Compose right associated") $+        spec+            (singleton 0 <> (singleton 1 <> (singleton 2 <> singleton 3)))+            [0, 1, 2, 3]+    prop (desc <> " Compose hierarchical (multiple levels)") $+        spec+            (((singleton 0 <> singleton 1) <> (singleton 2 <> singleton 3)) <>+             ((singleton 4 <> singleton 5) <> (singleton 6 <> singleton 7)))+            [0 .. 7]++    where++    tl = S.toList . t+    spec s list =+        monadicIO $ do+            stream <- run $ tl s+            listEquals eq stream list++---------------------------------------------------------------------------+-- Monoidal composition recursion loops+---------------------------------------------------------------------------++loops+    :: (IsStream t, Semigroup (t IO Int), Monad (t IO))+    => (t IO Int -> t IO Int)+    -> ([Int] -> [Int])+    -> ([Int] -> [Int])+    -> Spec+loops t tsrt hsrt = do+    it "Tail recursive loop" $ (tsrt <$> (S.toList . S.adapt) (loopTail 0))+            `shouldReturn` [0..3]++    it "Head recursive loop" $ (hsrt <$> (S.toList . S.adapt) (loopHead 0))+            `shouldReturn` [0..3]++    where+        loopHead x = do+            -- this print line is important for the test (causes a bind)+            S.fromEffect $ putStrLn "LoopHead..."+            t $ (if x < 3 then loopHead (x + 1) else nil) <> return x++        loopTail x = do+            -- this print line is important for the test (causes a bind)+            S.fromEffect $ putStrLn "LoopTail..."+            t $ return x <> (if x < 3 then loopTail (x + 1) else nil)++---------------------------------------------------------------------------+-- Bind and monoidal composition combinations+---------------------------------------------------------------------------++bindAndComposeSimpleOps+    :: IsStream t+    => String+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> Spec+bindAndComposeSimpleOps desc eq t = do+    bindAndComposeSimple+        ("Bind and compose " <> desc <> " Stream serially/")+        S.fromSerial+    bindAndComposeSimple+        ("Bind and compose " <> desc <> " Stream wSerially/")+        S.fromWSerial+    bindAndComposeSimple+        ("Bind and compose " <> desc <> " Stream aheadly/")+        S.fromAhead+    bindAndComposeSimple+        ("Bind and compose " <> desc <> " Stream asyncly/")+        S.fromAsync+    bindAndComposeSimple+        ("Bind and compose " <> desc <> " Stream wAsyncly/")+        S.fromWAsync+    bindAndComposeSimple+        ("Bind and compose " <> desc <> " Stream parallely/")+        S.fromParallel++    where++    bindAndComposeSimple+        :: (IsStream t2, Semigroup (t2 IO Int), Monad (t2 IO))+        => String+        -> (t2 IO Int -> t2 IO Int)+        -> Spec+    bindAndComposeSimple idesc t2 = do+      -- XXX need a bind in the body of forEachWith instead of a simple return+      prop (idesc <> " Compose many (right fold) with bind") $ \list ->+          monadicIO $ do+              stream <-+                  run $+                  (S.toList . t)+                      (S.adapt . t2 $ S.concatForFoldableWith (<>) list return)+              listEquals eq stream list++      prop (idesc <> " Compose many (left fold) with bind") $ \list ->+          monadicIO $ do+              let forL xs k = foldl (<>) nil $ fmap k xs+              stream <-+                  run $ (S.toList . t) (S.adapt . t2 $ forL list return)+              listEquals eq stream list++---------------------------------------------------------------------------+-- Bind and monoidal composition combinations+---------------------------------------------------------------------------++bindAndComposeHierarchyOps ::+       (IsStream t, Monad (t IO))+    => String+    -> (t IO Int -> SerialT IO Int)+    -> Spec+bindAndComposeHierarchyOps desc t1 = do+    let fldldesc = "Bind and compose foldl, " <> desc <> " Stream "+        fldrdesc = "Bind and compose foldr, " <> desc <> " Stream "++    bindAndComposeHierarchy+        (fldldesc <> "serially") S.fromSerial fldl+    bindAndComposeHierarchy+        (fldrdesc <> "serially") S.fromSerial fldr+    bindAndComposeHierarchy+        (fldldesc <> "wSerially") S.fromWSerial fldl+    bindAndComposeHierarchy+        (fldrdesc <> "wSerially") S.fromWSerial fldr+    bindAndComposeHierarchy+        (fldldesc <> "aheadly") S.fromAhead fldl+    bindAndComposeHierarchy+        (fldrdesc <> "aheadly") S.fromAhead fldr+    bindAndComposeHierarchy+        (fldldesc <> "asyncly") S.fromAsync fldl+    bindAndComposeHierarchy+        (fldrdesc <> "asyncly") S.fromAsync fldr+    bindAndComposeHierarchy+        (fldldesc <> "wAsyncly") S.fromWAsync fldl+    bindAndComposeHierarchy+        (fldrdesc <> "wAsyncly") S.fromWAsync fldr+    bindAndComposeHierarchy+        (fldldesc <> "parallely") S.fromParallel fldl+    bindAndComposeHierarchy+        (fldrdesc <> "parallely")  S.fromParallel fldr++  where++    bindAndComposeHierarchy+        :: (IsStream t2, Monad (t2 IO))+        => String+        -> (t2 IO Int -> t2 IO Int)+        -> ([t2 IO Int] -> t2 IO Int)+        -> Spec+    bindAndComposeHierarchy specdesc t2 g =+        describe specdesc $+        it "Bind and compose nested" $+            (sort <$> (S.toList . t1) bindComposeNested)+                `shouldReturn` (sort (+                    [12, 18]+                    <> replicate 3 13+                    <> replicate 3 17+                    <> replicate 6 14+                    <> replicate 6 16+                    <> replicate 7 15) :: [Int])++        where++        -- bindComposeNested :: WAsyncT IO Int+        bindComposeNested =+            let c1 = tripleCompose (return 1) (return 2) (return 3)+                c2 = tripleCompose (return 4) (return 5) (return 6)+                c3 = tripleCompose (return 7) (return 8) (return 9)+                b = tripleBind c1 c2 c3+        -- it seems to be causing a huge space leak in hspec so disabling this for now+        --            c = tripleCompose b b b+        --            m = tripleBind c c c+        --         in m+            in b++        tripleCompose a b c = S.adapt . t2 $ g [a, b, c]+        tripleBind mx my mz =+            mx >>= \x -> my+            >>= \y -> mz+            >>= \z -> return (x + y + z)++    fldr, fldl :: (IsStream t, Semigroup (t IO Int))+                => [t IO Int] -> t IO Int+    fldr = foldr (<>) nil+    fldl = foldl (<>) nil++-- Nest two lists using different styles of product compositions+nestTwoStreams+    :: (IsStream t, Semigroup (t IO Int), Monad (t IO))+    => String+    -> ([Int] -> [Int])+    -> ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Spec+nestTwoStreams desc streamListT listT t =+    it ("Nests two streams using monadic " <> desc <> " composition") $ do+    let s1 = S.concatMapFoldableWith (<>) return [1..4]+        s2 = S.concatMapFoldableWith (<>) return [5..8]+    r <- (S.toList . t) $ do+                x <- s1+                y <- s2+                return $ x + y+    streamListT r `shouldBe` listT [6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12]++nestTwoStreamsApp+    :: (IsStream t, Semigroup (t IO Int), Monad (t IO))+    => String+    -> ([Int] -> [Int])+    -> ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> Spec+nestTwoStreamsApp desc streamListT listT t =+    it ("Nests two streams using applicative " <> desc <> " composition") $ do+    let s1 = S.concatMapFoldableWith (<>) return [1..4]+        s2 = S.concatMapFoldableWith (<>) return [5..8]+        r  = (S.toList . t) ((+) <$> s1 <*> s2)+    streamListT <$> r+        `shouldReturn` listT [6,7,8,9,7,8,9,10,8,9,10,11,9,10,11,12]+++-- TBD need more such combinations to be tested.+composeAndComposeSimple+    :: ( IsStream t1, Semigroup (t1 IO Int)+       , IsStream t2, Monoid (t2 IO Int), Monad (t2 IO)+       )+    => (t1 IO Int -> SerialT IO Int)+    -> (t2 IO Int -> t2 IO Int)+    -> [[Int]] -> Spec+composeAndComposeSimple t1 t2 answer = do+    let rfold = S.adapt . t2 . S.concatMapFoldableWith (<>) return+    it "Compose right associated outer expr, right folded inner" $+         (S.toList . t1) (rfold [1,2,3] <> (rfold [4,5,6] <> rfold [7,8,9]))+            `shouldReturn` head answer++    it "Compose left associated outer expr, right folded inner" $+         (S.toList . t1) ((rfold [1,2,3] <> rfold [4,5,6]) <> rfold [7,8,9])+            `shouldReturn` (answer !! 1)++    let lfold xs = S.adapt $ t2 $ foldl (<>) mempty $ fmap return xs+    it "Compose right associated outer expr, left folded inner" $+         (S.toList . t1) (lfold [1,2,3] <> (lfold [4,5,6] <> lfold [7,8,9]))+            `shouldReturn` (answer !! 2)++    it "Compose left associated outer expr, left folded inner" $+         (S.toList . t1) ((lfold [1,2,3] <> lfold [4,5,6]) <> lfold [7,8,9])+            `shouldReturn` (answer !! 3)++composeAndComposeSimpleSerially+    :: (IsStream t, Semigroup (t IO Int))+    => String+    -> [[Int]]+    -> (t IO Int -> SerialT IO Int)+    -> Spec+composeAndComposeSimpleSerially desc answer t = do+    describe (desc <> " and Serial <>") $ composeAndComposeSimple t S.fromSerial answer++composeAndComposeSimpleAheadly+    :: (IsStream t, Semigroup (t IO Int))+    => String+    -> [[Int]]+    -> (t IO Int -> SerialT IO Int)+    -> Spec+composeAndComposeSimpleAheadly desc answer t = do+    describe (desc <> " and Ahead <>") $ composeAndComposeSimple t S.fromAhead answer++composeAndComposeSimpleWSerially+    :: (IsStream t, Semigroup (t IO Int))+    => String+    -> [[Int]]+    -> (t IO Int -> SerialT IO Int)+    -> Spec+composeAndComposeSimpleWSerially desc answer t = do+    describe (desc <> " and WSerial <>") $ composeAndComposeSimple t S.fromWSerial answer++-------------------------------------------------------------------------------+-- Semigroup operations+-------------------------------------------------------------------------------++foldFromList+    :: ([Int] -> t IO Int)+    -> (t IO Int -> SerialT IO Int)+    -> ([Int] -> [Int] -> Bool)+    -> [Int]+    -> Property+foldFromList constr op eq = transformFromList constr eq id op++-- XXX concatenate streams of multiple elements rather than single elements+semigroupOps+    :: (IsStream t, Monoid (t IO Int))+    => String+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> Spec+semigroupOps desc eq t = do+    prop (desc <> " <>") $ foldFromList (S.concatMapFoldableWith (<>) singleton) t eq+    prop (desc <> " mappend") $ foldFromList (S.concatMapFoldableWith mappend singleton) t eq++-------------------------------------------------------------------------------+-- Transformation operations+-------------------------------------------------------------------------------++transformCombineFromList+    :: Semigroup (t IO Int)+    => ([Int] -> t IO Int)+    -> ([Int] -> [Int] -> Bool)+    -> ([Int] -> [Int])+    -> (t IO Int -> SerialT IO Int)+    -> (t IO Int -> t IO Int)+    -> [Int]+    -> [Int]+    -> [Int]+    -> Property+transformCombineFromList constr eq listOp t op a b c =+    withMaxSuccess maxTestCount $+        monadicIO $ do+            stream <- run ((S.toList . t) $+                constr a <> op (constr b <> constr c))+            let list = a <> listOp (b <> c)+            listEquals eq stream list++takeEndBy :: Property+takeEndBy = forAll (listOf (chooseInt (0, maxStreamLen))) $ \lst -> monadicIO $ do+    let (s1, s3) = span (<= 200) lst+    let s4 = [head s3 | not (null s3)]+    s2 <- run $ S.toList $ IS.takeEndBy (> 200) $ S.fromList lst+    assert $ s1 ++ s4 == s2++-- XXX add tests for MonadReader and MonadError etc. In case an SVar is+-- accidentally passed through them.+--+-- This tests transform ops along with detecting illegal sharing of SVar across+-- conurrent streams. These tests work for all stream types whereas+-- transformCombineOpsOrdered work only for ordered stream types i.e. excluding+-- the Async type.+transformCombineOpsCommon+    :: (IsStream t, Semigroup (t IO Int) , Functor (t IO))+    => ([Int] -> t IO Int)+    -> String+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> Spec+transformCombineOpsCommon constr desc eq t = do+    let transform = transformCombineFromList constr eq++    -- Filtering+    prop (desc <> " filter False") $+        transform (filter (const False)) t (S.filter (const False))+    prop (desc <> " filter True") $+        transform (filter (const True)) t (S.filter (const True))+    prop (desc <> " filter even") $+        transform (filter even) t (S.filter even)++    prop (desc <> " filterM False") $+        transform (filter (const False)) t (S.filterM (const $ return False))+    prop (desc <> " filterM True") $+        transform (filter (const True)) t (S.filterM (const $ return True))+    prop (desc <> " filterM even") $+        transform (filter even) t (S.filterM (return . even))++    prop (desc <> " take maxBound") $+        transform (take maxBound) t (S.take maxBound)+    prop (desc <> " take 0") $ transform (take 0) t (S.take 0)++    prop (desc <> " takeWhile True") $+        transform (takeWhile (const True)) t (S.takeWhile (const True))+    prop (desc <> " takeWhile False") $+        transform (takeWhile (const False)) t (S.takeWhile (const False))++    prop (desc <> " takeWhileM True") $+        transform (takeWhile (const True)) t (S.takeWhileM (const $ return True))+    prop (desc <> " takeWhileM False") $+        transform (takeWhile (const False)) t (S.takeWhileM (const $ return False))++    prop "takeEndBy" takeEndBy++    prop (desc <> " drop maxBound") $+        transform (drop maxBound) t (S.drop maxBound)+    prop (desc <> " drop 0") $ transform (drop 0) t (S.drop 0)++    prop (desc <> " dropWhile True") $+        transform (dropWhile (const True)) t (S.dropWhile (const True))+    prop (desc <> " dropWhile False") $+        transform (dropWhile (const False)) t (S.dropWhile (const False))++    prop (desc <> " dropWhileM True") $+        transform (dropWhile (const True)) t (S.dropWhileM (const $ return True))+    prop (desc <> " dropWhileM False") $+        transform (dropWhile (const False)) t (S.dropWhileM (const $ return False))++    prop (desc <> " deleteBy (<=) maxBound") $+        transform (deleteBy (<=) maxBound) t (S.deleteBy (<=) maxBound)+    prop (desc <> " deleteBy (==) 4") $+        transform (delete 4) t (S.deleteBy (==) 4)++    -- transformation+    prop (desc <> " mapM (+1)") $+        transform (fmap (+1)) t (S.mapM (\x -> return (x + 1)))++    prop (desc <> " scanl'") $ transform (scanl' (const id) 0) t+                                       (S.scanl' (const id) 0)+    prop (desc <> " postscanl'") $ transform (tail . scanl' (const id) 0) t+                                       (S.postscanl' (const id) 0)+    prop (desc <> " scanlM'") $ transform (scanl' (const id) 0) t+                                       (S.scanlM' (\_ a -> return a) (return 0))+    prop (desc <> " postscanlM'") $ transform (tail . scanl' (const id) 0) t+                                       (S.postscanlM' (\_ a -> return a) (return 0))+    prop (desc <> " scanl1'") $ transform (scanl1 (const id)) t+                                         (S.scanl1' (const id))+    prop (desc <> " scanl1M'") $ transform (scanl1 (const id)) t+                                          (S.scanl1M' (\_ a -> return a))++    let f x = if odd x then Just (x + 100) else Nothing+    prop (desc <> " mapMaybe") $ transform (mapMaybe f) t (S.mapMaybe f)+    prop (desc <> " mapMaybeM") $+        transform (mapMaybe f) t (S.mapMaybeM (return . f))++    -- tap+    prop (desc <> " tap FL.sum . map (+1)") $ \a b ->+        withMaxSuccess maxTestCount $+        monadicIO $ do+            cref <- run $ newIORef 0+            let fldstp _ e = modifyIORef' cref (e +)+                sumfoldinref = FL.foldlM' fldstp (return ())+                op = S.tap sumfoldinref . S.mapM (\x -> return (x+1))+                listOp = fmap (+1)+            stream <- run ((S.toList . t) $ op (constr a <> constr b))+            let list = listOp (a <> b)+            ssum <- run $ readIORef cref+            assert (sum list == ssum)+            listEquals eq stream list++    -- reordering+    prop (desc <> " reverse") $ transform reverse t S.reverse+    prop (desc <> " reverse'") $ transform reverse t S.reverse'++    -- inserting+    prop (desc <> " intersperseM") $+        forAll (choose (minBound, maxBound)) $ \n ->+            transform (intersperse n) t (S.intersperseM $ return n)+    prop (desc <> " intersperse") $+        forAll (choose (minBound, maxBound)) $ \n ->+            transform (intersperse n) t (S.intersperse n)+    prop (desc <> " insertBy 0") $+        forAll (choose (minBound, maxBound)) $ \n ->+            transform (insert n) t (S.insertBy compare n)++    -- multi-stream+    prop (desc <> " concatMap") $+        forAll (choose (0, 100)) $ \n ->+            transform (concatMap (const [1..n]))+                t (S.concatMap (const (S.fromList [1..n])))+    prop (desc <> " concatMapM") $+        forAll (choose (0, 100)) $ \n ->+            transform (concatMap (const [1..n]))+                t (S.concatMapM (const (return $ S.fromList [1..n])))+    prop (desc <> " unfoldMany") $+        forAll (choose (0, 100)) $ \n ->+            transform (concatMap (const [1..n]))+                t (S.unfoldMany (UF.lmap (const undefined)+                                   $ UF.both [1..n] UF.fromList))++toListFL :: Monad m => FL.Fold m a [a]+toListFL = FL.toList++-- transformation tests that can only work reliably for ordered streams i.e.+-- Serial, Ahead and Zip. For example if we use "take 1" on an async stream, it+-- might yield a different result every time.+transformCombineOpsOrdered+    :: (IsStream t, Semigroup (t IO Int))+    => ([Int] -> t IO Int)+    -> String+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> Spec+transformCombineOpsOrdered constr desc eq t = do+    let transform = transformCombineFromList constr eq++    -- Filtering+    prop (desc <> " take 1") $ transform (take 1) t (S.take 1)+#ifdef DEVBUILD+    prop (desc <> " take 2") $ transform (take 2) t (S.take 2)+    prop (desc <> " take 3") $ transform (take 3) t (S.take 3)+    prop (desc <> " take 4") $ transform (take 4) t (S.take 4)+    prop (desc <> " take 5") $ transform (take 5) t (S.take 5)+#endif+    prop (desc <> " take 10") $ transform (take 10) t (S.take 10)++    prop (desc <> " takeWhile > 0") $+        transform (takeWhile (> 0)) t (S.takeWhile (> 0))+    prop (desc <> " takeWhileM > 0") $+        transform (takeWhile (> 0)) t (S.takeWhileM (return . (> 0)))++    prop (desc <> " drop 1") $ transform (drop 1) t (S.drop 1)+    prop (desc <> " drop 10") $ transform (drop 10) t (S.drop 10)++    prop (desc <> " dropWhile > 0") $+        transform (dropWhile (> 0)) t (S.dropWhile (> 0))+    prop (desc <> " dropWhileM > 0") $+        transform (dropWhile (> 0)) t (S.dropWhileM (return . (> 0)))+    prop (desc <> " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0)++    prop (desc <> " uniq") $ transform referenceUniq t S.uniq++    prop (desc <> " deleteBy (<=) 0") $+        transform (deleteBy (<=) 0) t (S.deleteBy (<=) 0)++    prop (desc <> " findIndices") $+        transform (findIndices odd) t (S.findIndices odd)+    prop (desc <> " findIndices . filter") $+        transform (findIndices odd . filter odd)+                  t+                  (S.findIndices odd . S.filter odd)+    prop (desc <> " elemIndices") $+        transform (elemIndices 0) t (S.elemIndices 0)++    -- XXX this does not fail when the SVar is shared, need to fix.+    prop (desc <> " concurrent application") $+        transform (fmap (+1)) t (|& S.map (+1))++-------------------------------------------------------------------------------+-- Monad operations+-------------------------------------------------------------------------------++monadThen+    :: Monad (t IO)+    => ([Int] -> t IO Int)+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> ([Int], [Int])+    -> Property+monadThen constr eq t (a, b) = withMaxSuccess maxTestCount $ monadicIO $ do+    stream <- run ((S.toList . t) (constr a >> constr b))+    let list = a >> b+    listEquals eq stream list++monadBind+    :: Monad (t IO)+    => ([Int] -> t IO Int)+    -> ([Int] -> [Int] -> Bool)+    -> (t IO Int -> SerialT IO Int)+    -> ([Int], [Int])+    -> Property+monadBind constr eq t (a, b) = withMaxSuccess maxTestCount $+    monadicIO $ do+        stream <-+            run+                ((S.toList . t)+                     (constr a >>= \x -> (+ x) <$> constr b))+        let list = a >>= \x -> (+ x) <$> b+        listEquals eq stream list++-------------------------------------------------------------------------------+-- Zip operations+-------------------------------------------------------------------------------++zipApplicative+    :: (IsStream t, Applicative (t IO))+    => ([Int] -> t IO Int)+    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)+    -> (t IO (Int, Int) -> SerialT IO (Int, Int))+    -> ([Int], [Int])+    -> Property+zipApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $+    monadicIO $ do+        stream1 <- run ((S.toList . t) ((,) <$> constr a <*> constr b))+        stream2 <- run ((S.toList . t) (pure (,) <*> constr a <*> constr b))+        stream3 <- run ((S.toList . t) (S.zipWith (,) (constr a) (constr b)))+        let list = getZipList $ (,) <$> ZipList a <*> ZipList b+        listEquals eq stream1 list+        listEquals eq stream2 list+        listEquals eq stream3 list++zipMonadic+    :: IsStream t+    => ([Int] -> t IO Int)+    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)+    -> (t IO (Int, Int) -> SerialT IO (Int, Int))+    -> ([Int], [Int])+    -> Property+zipMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $+    monadicIO $ do+        stream1 <-+            run+                ((S.toList . t)+                     (S.zipWithM (curry return) (constr a) (constr b)))+        let list = getZipList $ (,) <$> ZipList a <*> ZipList b+        listEquals eq stream1 list++zipAsyncMonadic+    :: IsStream t+    => ([Int] -> t IO Int)+    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)+    -> (t IO (Int, Int) -> SerialT IO (Int, Int))+    -> ([Int], [Int])+    -> Property+zipAsyncMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $+    monadicIO $ do+        stream1 <-+            run+                ((S.toList . t)+                     (S.zipWithM (curry return) (constr a) (constr b)))+        stream2 <-+            run+                ((S.toList . t)+                     (S.zipAsyncWithM (curry return) (constr a) (constr b)))+        let list = getZipList $ (,) <$> ZipList a <*> ZipList b+        listEquals eq stream1 list+        listEquals eq stream2 list++zipAsyncApplicative+    :: IsStream t+    => ([Int] -> t IO Int)+    -> ([(Int, Int)] -> [(Int, Int)] -> Bool)+    -> (t IO (Int, Int) -> SerialT IO (Int, Int))+    -> ([Int], [Int])+    -> Property+zipAsyncApplicative constr eq t (a, b) = withMaxSuccess maxTestCount $+    monadicIO $ do+        stream <-+            run+                ((S.toList . t)+                     (S.zipAsyncWith (,) (constr a) (constr b)))+        let list = getZipList $ (,) <$> ZipList a <*> ZipList b+        listEquals eq stream list++---------------------------------------------------------------------------+-- Semigroup/Monoidal Composition strict ordering checks+---------------------------------------------------------------------------++parallelCheck :: (IsStream t, Monad (t IO))+    => (t IO Int -> SerialT IO Int)+    -> (t IO Int -> t IO Int -> t IO Int)+    -> Spec+parallelCheck t f = do+    it "Parallel ordering left associated" $+        (S.toList . t) (((event 4 `f` event 3) `f` event 2) `f` event 1)+            `shouldReturn` [1..4]++    it "Parallel ordering right associated" $+        (S.toList . t) (event 4 `f` (event 3 `f` (event 2 `f` event 1)))+            `shouldReturn` [1..4]++    where event n = S.fromEffect (threadDelay (n * 200000)) >> return n++-------------------------------------------------------------------------------+-- Exception ops+-------------------------------------------------------------------------------++beforeProp :: IsStream t => (t IO Int -> SerialT IO Int) -> [Int] -> Property+beforeProp t vec =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        ioRef <- run $ newIORef []+        run+            $ S.drain . t+            $ S.before (writeIORef ioRef [0])+            $ S.mapM (\a -> do atomicModifyIORef' ioRef (\xs -> (xs ++ [a], ()))+                               return a)+            $ S.fromList vec+        refValue <- run $ readIORef ioRef+        listEquals (==) (head refValue : sort (tail refValue)) (0:sort vec)++afterProp :: IsStream t => (t IO Int -> SerialT IO Int) -> [Int] -> Property+afterProp t vec =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        ioRef <- run $ newIORef []+        run+            $ S.drain . t+            $ S.after (modifyIORef' ioRef (0:))+            $ S.mapM (\a -> do atomicModifyIORef' ioRef (\xs -> (a:xs, ()))+                               return a)+            $ S.fromList vec+        refValue <- run $ readIORef ioRef+        listEquals (==) (head refValue : sort (tail refValue)) (0:sort vec)++bracketProp :: IsStream t => (t IO Int -> SerialT IO Int) -> [Int] -> Property+bracketProp t vec =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        ioRef <- run $ newIORef (0 :: Int)+        run $+            S.drain . t $+            S.bracket+                (return ioRef)+                (`writeIORef` 1)+                (\ioref ->+                     S.mapM+                         (\a -> writeIORef ioref 2 >> return a)+                         (S.fromList vec))+        refValue <- run $ readIORef ioRef+        assert $ refValue == 1++#ifdef DEVBUILD+bracketPartialStreamProp ::+       (IsStream t) => (t IO Int -> SerialT IO Int) -> [Int] -> Property+bracketPartialStreamProp t vec =+    forAll (choose (0, length vec)) $ \len -> do+        withMaxSuccess maxTestCount $+            monadicIO $ do+                ioRef <- run $ newIORef (0 :: Int)+                run $+                    S.drain . t $+                    S.take len $+                    S.bracket+                        (writeIORef ioRef 1 >> return ioRef)+                        (`writeIORef` 3)+                        (\ioref ->+                             S.mapM+                                 (\a -> writeIORef ioref 2 >> return a)+                                 (S.fromList vec))+                run $ do+                    performMajorGC+                    threadDelay 1000000+                refValue <- run $ readIORef ioRef+                when (refValue /= 0 && refValue /= 3) $+                    error $ "refValue == " ++ show refValue+#endif++bracketExceptionProp ::+       (IsStream t, MonadThrow (t IO), Semigroup (t IO Int))+    => (t IO Int -> SerialT IO Int)+    -> Property+bracketExceptionProp t =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        ioRef <- run $ newIORef (0 :: Int)+        res <-+            run $+            try . S.drain . t $+            S.bracket+                (return ioRef)+                (`writeIORef` 1)+                (const $ throwM (ExampleException "E") <> S.nil)+        assert $ res == Left (ExampleException "E")+        refValue <- run $ readIORef ioRef+        assert $ refValue == 1++finallyProp :: (IsStream t) => (t IO Int -> SerialT IO Int) -> [Int] -> Property+finallyProp t vec =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        ioRef <- run $ newIORef (0 :: Int)+        run $+            S.drain . t $+            S.finally+                (writeIORef ioRef 1)+                (S.mapM (\a -> writeIORef ioRef 2 >> return a) (S.fromList vec))+        refValue <- run $ readIORef ioRef+        assert $ refValue == 1++retry :: Spec+retry = do+    ref <- runIO $ newIORef (0 :: Int)+    res <- runIO $ S.toList (S.retry emap handler (stream1 ref))+    refVal <- runIO $ readIORef ref+    spec res refVal++    where++    emap = Map.singleton (ExampleException "E") 10++    stream1 ref =+        S.fromListM+            [ return 1+            , return 2+            , atomicModifyIORef' ref (\a -> (a + 1, ()))+                  >> throwM (ExampleException "E")+                  >> return 3+            , return 4+            ]++    stream2 = S.fromList [5, 6, 7 :: Int]+    handler = const stream2+    expectedRes = [1, 2, 5, 6, 7]+    expectedRefVal = 11++    spec res refVal = do+        it "Runs the exception handler properly" $ res `shouldBe` expectedRes+        it "Runs retires the exception correctly"+            $ refVal `shouldBe` expectedRefVal++#ifdef DEVBUILD+finallyPartialStreamProp ::+       (IsStream t) => (t IO Int -> SerialT IO Int) -> [Int] -> Property+finallyPartialStreamProp t vec =+    forAll (choose (0, length vec)) $ \len -> do+        withMaxSuccess maxTestCount $+            monadicIO $ do+                ioRef <- run $ newIORef (0 :: Int)+                run $+                    S.drain . t $+                    S.take len $+                    S.finally+                        (writeIORef ioRef 2)+                        (S.mapM+                             (\a -> writeIORef ioRef 1 >> return a)+                             (S.fromList vec))+                run $ do+                    performMajorGC+                    threadDelay 100000+                refValue <- run $ readIORef ioRef+                when (refValue /= 0 && refValue /= 2) $+                    error $ "refValue == " ++ show refValue+#endif++finallyExceptionProp ::+       (IsStream t, MonadThrow (t IO), Semigroup (t IO Int))+    => (t IO Int -> SerialT IO Int)+    -> Property+finallyExceptionProp t =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        ioRef <- run $ newIORef (0 :: Int)+        res <-+            run $+            try . S.drain . t $+            S.finally+                (writeIORef ioRef 1)+                (throwM (ExampleException "E") <> S.nil)+        assert $ res == Left (ExampleException "E")+        refValue <- run $ readIORef ioRef+        assert $ refValue == 1++onExceptionProp ::+       (IsStream t, MonadThrow (t IO), Semigroup (t IO Int))+    => (t IO Int -> SerialT IO Int)+    -> Property+onExceptionProp t =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        ioRef <- run $ newIORef (0 :: Int)+        res <-+            run $+            try . S.drain . t $+            S.onException+                (writeIORef ioRef 1)+                (throwM (ExampleException "E") <> S.nil)+        assert $ res == Left (ExampleException "E")+        refValue <- run $ readIORef ioRef+        assert $ refValue == 1++handleProp ::+       IsStream t+    => (t IO Int -> SerialT IO Int)+    -> [Int]+    -> Property+handleProp t vec =+    withMaxSuccess maxTestCount $+    monadicIO $ do+        res <-+            run $+            S.toList . t $+            S.handle+                (\(ExampleException i) -> read i `S.cons` S.fromList vec)+                (S.fromSerial $ S.fromList vec <> throwM (ExampleException "0"))+        assert $ res == vec ++ [0] ++ vec++exceptionOps ::+       (IsStream t, MonadThrow (t IO), Semigroup (t IO Int))+    => String+    -> (t IO Int -> SerialT IO Int)+    -> Spec+exceptionOps desc t = do+    prop (desc <> " before") $ beforeProp t+    prop (desc <> " after") $ afterProp t+    prop (desc <> " bracket end of stream") $ bracketProp t+#ifdef INCLUDE_FLAKY_TESTS+    prop (desc <> " bracket partial stream") $ bracketPartialStreamProp t+#endif+    prop (desc <> " bracket exception in stream") $ bracketExceptionProp t+    prop (desc <> " onException") $ onExceptionProp t+    prop (desc <> " finally end of stream") $ finallyProp t+#ifdef INCLUDE_FLAKY_TESTS+    prop (desc <> " finally partial stream") $ finallyPartialStreamProp t+#endif+    prop (desc <> " finally exception in stream") $ finallyExceptionProp t+    prop (desc <> " handle") $ handleProp t+    retry++-------------------------------------------------------------------------------+-- Compose with MonadThrow+-------------------------------------------------------------------------------++newtype ExampleException = ExampleException String deriving (Eq, Show, Ord)++instance Exception ExampleException++composeWithMonadThrow+    :: ( IsStream t+       , Semigroup (t IO Int)+       , MonadThrow (t IO)+       )+    => (t IO Int -> SerialT IO Int)+    -> Spec+composeWithMonadThrow t = do+    it "Compose throwM, nil" $+        try (tl (throwM (ExampleException "E") <> S.nil))+        `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])+    it "Compose nil, throwM" $+        try (tl (S.nil <> throwM (ExampleException "E")))+        `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])+    oneLevelNestedSum "serially" S.fromSerial+    oneLevelNestedSum "wSerially" S.fromWSerial+    oneLevelNestedSum "asyncly" S.fromAsync+    oneLevelNestedSum "wAsyncly" S.fromWAsync+    -- XXX add two level nesting++    oneLevelNestedProduct "serially" S.fromSerial+    oneLevelNestedProduct "wSerially" S.fromWSerial+    oneLevelNestedProduct "asyncly" S.fromAsync+    oneLevelNestedProduct "wAsyncly"  S.fromWAsync++    where+    tl = S.toList . t+    oneLevelNestedSum desc t1 =+        it ("One level nested sum " <> desc) $ do+            let nested = S.fromFoldable [1..10] <> throwM (ExampleException "E")+                         <> S.fromFoldable [1..10]+            try (tl (S.nil <> t1 nested <> S.fromFoldable [1..10]))+            `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])++    oneLevelNestedProduct desc t1 =+        it ("One level nested product" <> desc) $ do+            let s1 = t $ S.concatMapFoldableWith (<>) return [1..4]+                s2 = t1 $ S.concatMapFoldableWith (<>) return [5..8]+            try $ tl (do+                x <- S.adapt s1+                y <- s2+                if x + y > 10+                then throwM (ExampleException "E")+                else return (x + y)+                )+            `shouldReturn` (Left (ExampleException "E") :: Either ExampleException [Int])++-------------------------------------------------------------------------------+-- Cleanup tests+-------------------------------------------------------------------------------++checkCleanup :: IsStream t+    => Int+    -> (t IO Int -> SerialT IO Int)+    -> (t IO Int -> t IO Int)+    -> IO ()+checkCleanup d t op = do+    r <- newIORef (-1 :: Int)+    S.drain . fromSerial $ do+        _ <- t $ op $ delay r 0 S.|: delay r 1 S.|: delay r 2 S.|: S.nil+        return ()+    performMajorGC+    threadDelay 500000+    res <- readIORef r+    res `shouldBe` 0+    where+    delay ref i = threadDelay (i*d*100000) >> writeIORef ref i >> return i++-------------------------------------------------------------------------------+-- Some ad-hoc tests that failed at times+-------------------------------------------------------------------------------++takeCombined :: (Monad m, Semigroup (t m Int), Show a, Eq a, IsStream t)+    => Int -> (t m Int -> SerialT IO a) -> IO ()+takeCombined n t = do+    let constr = S.fromFoldable+    r <- (S.toList . t) $+            S.take n (constr ([] :: [Int]) <> constr ([] :: [Int]))+    r `shouldBe` []++-------------------------------------------------------------------------------+-- Helper operations+-------------------------------------------------------------------------------++folded :: IsStream t => [a] -> t IO a+folded =+    fromSerial .+    (\xs ->+         case xs of+             [x] -> return x -- singleton stream case+             _ -> S.concatMapFoldableWith (<>) return xs)++#ifndef COVERAGE_BUILD+makeCommonOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]+#else+makeCommonOps :: b -> [(String, b)]+#endif+makeCommonOps t =+            [ ("default", t)+#ifndef COVERAGE_BUILD+            , ("rate AvgRate 10000", t . avgRate 10000)+            , ("rate Nothing", t . rate Nothing)+            , ("maxBuffer 0", t . maxBuffer 0)+            , ("maxThreads 0", t . maxThreads 0)+            , ("maxThreads 1", t . maxThreads 1)+#ifdef USE_LARGE_MEMORY+            , ("maxThreads -1", t . maxThreads (-1))+#endif+#endif+            ]++#ifndef COVERAGE_BUILD+makeOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]+#else+makeOps :: b -> [(String, b)]+#endif+makeOps t = makeCommonOps t +++            [+#ifndef COVERAGE_BUILD+              ("maxBuffer 1", t . maxBuffer 1)+#endif+            ]++mapOps :: (a -> Spec) -> [(String, a)] -> Spec+mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)
− test/loops.hs 
@@ -1,76 +0,0 @@-import Streamly-import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))-import Streamly.Prelude (nil, yieldM)--main :: IO ()-main = do-    hSetBuffering stdout LineBuffering--    putStrLn "\nloopTail:\n"-    runStream $ do-        x <- loopTail 0-        yieldM $ print (x :: Int)--    putStrLn "\nloopHead:\n"-    runStream $ do-        x <- loopHead 0-        yieldM $ print (x :: Int)--    putStrLn "\nloopTailA:\n"-    runStream $ do-        x <- loopTailA 0-        yieldM $ print (x :: Int)--    putStrLn "\nloopHeadA:\n"-    runStream $ do-        x <- loopHeadA 0-        yieldM $ print (x :: Int)--    putStrLn "\nwSerial:\n"-    runStream $ do-        x <- (return 0 <> return 1) `wSerial` (return 100 <> return 101)-        yieldM $ print (x :: Int)--    putStrLn "\nParallel interleave:\n"-    runStream $ do-        x <- (return 0 <> return 1) `wAsync` (return 100 <> return 101)-        yieldM $ print (x :: Int)--    where------------------------------------------------------------------------------------ Serial (single-threaded) stream generator loops----------------------------------------------------------------------------------    -- Generates a value and then loops. Can be used to generate an infinite-    -- stream. Interleaves the generator and the consumer.-    loopTail :: Int -> Serial Int-    loopTail x = do-        yieldM $ putStrLn "LoopTail..."-        return x <> (if x < 3 then loopTail (x + 1) else nil)--    -- Loops and then generates a value. The consumer can run only after the-    -- loop has finished.  An infinite generator will not let the consumer run-    -- at all.-    loopHead :: Int -> Serial Int-    loopHead x = do-        yieldM $ putStrLn "LoopHead..."-        (if x < 3 then loopHead (x + 1) else nil) <> return x------------------------------------------------------------------------------------ Concurrent (multi-threaded) adaptive demand-based stream generator loops----------------------------------------------------------------------------------    loopTailA :: Int -> Serial Int-    loopTailA x = do-        yieldM $ putStrLn "LoopTailA..."-        return x `async` (if x < 3 then loopTailA (x + 1) else nil)--    loopHeadA :: Int -> Serial Int-    loopHeadA x = do-        yieldM $ putStrLn "LoopHeadA..."-        (if x < 3 then loopHeadA (x + 1) else nil) `async` return x------------------------------------------------------------------------------------ Parallel (fairly scheduled, multi-threaded) stream generator loops--------------------------------------------------------------------------------
− test/nested-loops.hs 
@@ -1,25 +0,0 @@-import Control.Concurrent (myThreadId)-import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))-import System.Random (randomIO)-import Streamly-import Streamly.Prelude (nil, yieldM)--main :: IO ()-main = runStream $ do-    yieldM $ hSetBuffering stdout LineBuffering-    x <- loop "A " 2-    y <- loop "B " 2-    yieldM $ myThreadId >>= putStr . show-             >> putStr " "-             >> print (x, y)--    where--    -- we can just use-    -- parallely $ mconcat $ replicate n $ yieldM (...)-    loop :: String -> Int -> SerialT IO String-    loop name n = do-        rnd <- yieldM (randomIO :: IO Int)-        let result = name <> show rnd-            repeatIt = if n > 1 then loop name (n - 1) else nil-         in return result `wAsync` repeatIt
− test/parallel-loops.hs 
@@ -1,27 +0,0 @@-import Control.Concurrent (myThreadId, threadDelay)-import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))-import System.Random (randomIO)-import Streamly-import qualified Streamly.Prelude as S--main :: IO ()-main = do-    hSetBuffering stdout LineBuffering-    runStream $ do-        x <- S.take 10 $ loop "A" `parallel` loop "B"-        S.yieldM $ myThreadId >>= putStr . show-               >> putStr " got "-               >> print x--    where--    -- we can just use-    -- parallely $ cycle1 $ yieldM (...)-    loop :: String -> Serial (String, Int)-    loop name = do-        S.yieldM $ threadDelay 1000000-        rnd <- S.yieldM (randomIO :: IO Int)-        S.yieldM $ myThreadId >>= putStr . show-               >> putStr " yielding "-               >> print rnd-        return (name, rnd) `parallel` loop name
+ test/streamly-tests.cabal view
@@ -0,0 +1,654 @@+cabal-version:      2.2+name:               streamly-tests+version:            0.0.0+synopsis:           Tests for streamly+description: See streamly-benchmarks for the reason why we use a separate+ package for tests.++flag fusion-plugin+  description: Use fusion plugin for benchmarks and executables+  manual: True+  default: False++flag limit-build-mem+  description: Limits memory when building the executables+  manual: True+  default: False++flag use-large-mem+  description: Include tests that require large amount of memory+  manual: True+  default: False++flag include-flaky-tests+  description: Include tests that are unpredictable+  manual: True+  default: False++flag dev+  description: Development build+  manual: True+  default: False++flag has-llvm+  description: Use llvm backend for better performance+  manual: True+  default: False++flag opt+  description: off=-O0 (faster builds), on=-O2+  manual: True+  default: True++flag use-streamly-core+  description: Test only core package+  manual: True+  default: False++-------------------------------------------------------------------------------+-- Common stanzas+-------------------------------------------------------------------------------++common compile-options+    if os(darwin)+      cpp-options:    -DCABAL_OS_DARWIN++    if os(linux)+      cpp-options:    -DCABAL_OS_LINUX++    if os(windows)+      cpp-options:    -DCABAL_OS_WINDOWS++    if flag(dev)+      cpp-options:    -DDEVBUILD++    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 flag(has-llvm)+      ghc-options: -fllvm++    if flag(dev)+      ghc-options:    -Wmissed-specialisations+                      -Wall-missed-specialisations++    if flag(limit-build-mem)+      ghc-options: +RTS -M512M -RTS++    if flag(use-large-mem)+      cpp-options: -DUSE_LARGE_MEMORY++    if flag(include-flaky-tests)+      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+        ConstraintKinds+        DeriveDataTypeable+        DeriveGeneric+        DeriveTraversable+        ExistentialQuantification+        FlexibleContexts+        FlexibleInstances+        GeneralizedNewtypeDeriving+        InstanceSigs+        KindSignatures+        LambdaCase+        MultiParamTypeClasses+        RankNTypes+        ScopedTypeVariables+        TupleSections++        -- Not in GHC2024+        CPP+        MagicHash+        PatternSynonyms+        RecordWildCards+        NoMonoLocalBinds++common threading-options+  ghc-options:  -threaded+                -with-rtsopts=-N++common optimization-options+  if flag(opt) || flag(fusion-plugin)+    ghc-options: -O2+                 -fdicts-strict+                 -fmax-worker-args=16+                 -fspec-constr-recursive=16+                 -- This must come after -O2+                 -fno-ignore-asserts+    if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)+      ghc-options: -fplugin Fusion.Plugin+  else+    ghc-options: -O0++common test-dependencies+  build-depends:+        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++-------------------------------------------------------------------------------+-- Library+-------------------------------------------------------------------------------++common lib-options+  import: compile-options+        , optimization-options+        , default-extensions+        , test-dependencies++library+    import: lib-options, test-dependencies+    hs-source-dirs: lib+    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++-------------------------------------------------------------------------------+-- Test suite options+-------------------------------------------------------------------------------++common test-options+  import: lib-options+        , threading-options+  ghc-options:+    -rtsopts+    -with-rtsopts "-t"+    -fno-ignore-asserts+  include-dirs: .+  build-depends: streamly-tests++common always-optimized+  import: compile-options+        , threading-options+        , default-extensions+        , test-dependencies+  ghc-options: -O2+               -fdicts-strict+               -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 alphabetical order+-------------------------------------------------------------------------------++test-suite Data.Array+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Array.hs+  ghc-options: -main-is Streamly.Test.Data.Array.main++test-suite Data.Array.Generic+  import: test-options+  type: exitcode-stdio-1.0+  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.Stream+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Array/Stream.hs+  if flag(use-streamly-core)+    buildable: False++test-suite Data.Binary+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Serialize/Serializable.hs++test-suite Data.Fold+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Fold.hs++test-suite Data.Fold.Window+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Fold/Window.hs+  ghc-options: -main-is Streamly.Test.Data.Fold.Window.main++-- 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/List.hs++test-suite Data.MutArray+  import: test-options+  type: exitcode-stdio-1.0+  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 -M2000M -RTS++test-suite Data.ParserK+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/ParserK.hs+  if flag(limit-build-mem)+    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+  main-is: Streamly/Test/Data/Unfold.hs++test-suite FileSystem.Event+  import: test-options+  type: exitcode-stdio-1.0+  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+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/FileSystem/Event/Darwin.hs+  other-modules: Streamly.Test.FileSystem.Event.Common+  cpp-options: -DFILESYSTEM_EVENT_DARWIN+  ghc-options: -main-is Streamly.Test.FileSystem.Event.Darwin+  if !os(darwin) || flag(use-streamly-core)+    buildable: False++test-suite FileSystem.Event.Linux+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/FileSystem/Event/Linux.hs+  other-modules: Streamly.Test.FileSystem.Event.Common+  cpp-options: -DFILESYSTEM_EVENT_LINUX+  ghc-options: -main-is Streamly.Test.FileSystem.Event.Linux+  if impl(ghc < 9.4) || !os(linux) || flag(use-streamly-core)+    buildable: False++test-suite FileSystem.Event.Windows+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/FileSystem/Event/Windows.hs+  other-modules: Streamly.Test.FileSystem.Event.Common+  cpp-options: -DFILESYSTEM_EVENT_WINDOWS+  ghc-options: -main-is Streamly.Test.FileSystem.Event.Windows+  if !os(windows) || flag(use-streamly-core)+    buildable: False++test-suite FileSystem.Handle+  import: test-options+  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 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: 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+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Prelude/Concurrent.hs+  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+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Prelude/Rate.hs+  ghc-options: -main-is Streamly.Test.Prelude.Rate.main+  if flag(dev)+    buildable: True+  else+    buildable: False+  if flag(use-streamly-core)+    buildable: False++test-suite Prelude.Serial+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Prelude/Serial.hs+  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+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Prelude/ZipAsync.hs+  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+  if flag(use-streamly-core)+    buildable: False
+ 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
+ test/version-bounds.hs view
@@ -0,0 +1,4 @@+main :: IO ()+main =+    print+        "Version bounds do not conflict when both streamly and ghc are dependencies."