streamly 0.9.0 → 0.10.0
raw patch · 202 files changed
+10752/−8472 lines, 202 filesdep ~basedep ~containersdep ~deepseq
Dependency ranges changed: base, containers, deepseq, streamly-core, template-haskell
Files
- CHANGELOG.md +29/−7
- LICENSE +0/−254
- README.md +8/−2
- benchmark/NanoBenchmarks.hs +1/−1
- benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs +2/−2
- benchmark/Streamly/Benchmark/Data/Array/Mut.hs +0/−300
- benchmark/Streamly/Benchmark/Data/Array/Stream.hs +8/−8
- benchmark/Streamly/Benchmark/Data/Fold.hs +33/−9
- benchmark/Streamly/Benchmark/Data/Fold/Window.hs +42/−42
- benchmark/Streamly/Benchmark/Data/MutArray.hs +300/−0
- benchmark/Streamly/Benchmark/Data/Parser.hs +12/−12
- benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs +0/−384
- benchmark/Streamly/Benchmark/Data/ParserK.hs +437/−0
- benchmark/Streamly/Benchmark/Data/Ring/Unboxed.hs +3/−4
- benchmark/Streamly/Benchmark/Data/Serialize.hs +596/−0
- benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hs +24/−0
- benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs +21/−0
- benchmark/Streamly/Benchmark/Data/Serialize/TH.hs +76/−0
- benchmark/Streamly/Benchmark/Data/Stream.hs +1/−1
- benchmark/Streamly/Benchmark/Data/Stream/Common.hs +11/−9
- benchmark/Streamly/Benchmark/Data/Stream/ConcurrentCommon.hs +3/−3
- benchmark/Streamly/Benchmark/Data/Stream/ConcurrentEager.hs +1/−1
- benchmark/Streamly/Benchmark/Data/Stream/ConcurrentInterleaved.hs +1/−1
- benchmark/Streamly/Benchmark/Data/Stream/ConcurrentOrdered.hs +1/−1
- benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs +6/−6
- benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs +16/−6
- benchmark/Streamly/Benchmark/Data/Stream/Expand.hs +15/−7
- benchmark/Streamly/Benchmark/Data/Stream/Generate.hs +4/−4
- benchmark/Streamly/Benchmark/Data/Stream/Lift.hs +5/−5
- benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs +40/−21
- benchmark/Streamly/Benchmark/Data/Stream/Split.hs +3/−3
- benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs +5/−3
- benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs +0/−455
- benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs +9/−8
- benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs +455/−0
- benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs +4/−5
- benchmark/Streamly/Benchmark/Data/Stream/Transform.hs +6/−6
- benchmark/Streamly/Benchmark/Data/Unfold.hs +14/−5
- benchmark/Streamly/Benchmark/FileSystem/Handle.hs +1/−1
- benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs +6/−6
- benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs +5/−5
- benchmark/Streamly/Benchmark/Prelude/Adaptive.hs +1/−1
- benchmark/Streamly/Benchmark/Prelude/Ahead.hs +1/−1
- benchmark/Streamly/Benchmark/Prelude/Async.hs +1/−1
- benchmark/Streamly/Benchmark/Prelude/Concurrent.hs +1/−1
- benchmark/Streamly/Benchmark/Prelude/Merge.hs +2/−2
- benchmark/Streamly/Benchmark/Prelude/Parallel.hs +1/−1
- benchmark/Streamly/Benchmark/Prelude/Rate.hs +1/−1
- benchmark/Streamly/Benchmark/Prelude/WAsync.hs +1/−1
- benchmark/Streamly/Benchmark/Prelude/WSerial.hs +2/−2
- benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs +1/−1
- benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs +2/−2
- benchmark/Streamly/Benchmark/Unicode/Char.hs +2/−2
- benchmark/Streamly/Benchmark/Unicode/Parser.hs +107/−0
- benchmark/Streamly/Benchmark/Unicode/Stream.hs +24/−7
- benchmark/Streamly/Benchmark/Unicode/Utf8.hs +1/−1
- benchmark/bench-runner/Main.hs +35/−7
- benchmark/lib/Streamly/Benchmark/Common.hs +2/−2
- benchmark/lib/Streamly/Benchmark/Common/Handle.hs +3/−1
- benchmark/lib/Streamly/Benchmark/Prelude.hs +1/−1
- benchmark/streamly-benchmarks.cabal +81/−46
- configure +9/−9
- configure.ac +1/−1
- docs/Developer/MAINTAINING.md +4/−7
- docs/Developer/module-organization.md +1/−1
- docs/Developer/optimization-guidelines.md +1/−1
- docs/Documentation.md +5/−0
- docs/User/HowTo/Compiling.md +25/−12
- docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt +175/−0
- docs/User/Project/ApiChangelogs/0.8.3.txt +261/−0
- docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txt +424/−0
- docs/User/Project/CONTRIBUTORS.md +164/−0
- docs/User/Project/Changelog.md +658/−0
- docs/User/Project/Credits.md +43/−0
- docs/User/Project/Github.link +1/−0
- docs/User/Project/README.md +140/−0
- docs/User/Project/Roadmap.link +1/−0
- docs/User/Project/Upgrading-0.8-to-0.9.md +384/−0
- docs/User/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt +0/−175
- docs/User/ProjectRelated/ApiChangelogs/0.8.3.txt +0/−261
- docs/User/ProjectRelated/CONTRIBUTORS.md +0/−156
- docs/User/ProjectRelated/Changelog.md +0/−636
- docs/User/ProjectRelated/Credits.md +0/−43
- docs/User/ProjectRelated/Github.link +0/−1
- docs/User/ProjectRelated/README.md +0/−134
- docs/User/ProjectRelated/Roadmap.link +0/−1
- docs/User/ProjectRelated/Upgrading.md +0/−279
- docs/User/Tutorials/before-you-begin.md +22/−3
- docs/User/Tutorials/getting-started.md +225/−0
- docs/User/Tutorials/quick-overview.md +12/−14
- docs/User/Tutorials/setup-and-usage.md +0/−226
- docs/streamly-docs.cabal +8/−7
- src/Streamly.hs +0/−624
- src/Streamly/Data/Fold/Prelude.hs +65/−0
- src/Streamly/Data/Fold/Tee.hs +1/−1
- src/Streamly/Data/Stream/Concurrent.hs +0/−191
- src/Streamly/Data/Stream/Exception.hs +0/−24
- src/Streamly/Data/Stream/MkType.hs +41/−10
- src/Streamly/Data/Stream/Prelude.hs +208/−16
- src/Streamly/Data/Stream/Time.hs +0/−37
- src/Streamly/Data/Unicode/Stream.hs +0/−99
- src/Streamly/Internal/Control/ForkLifted.hs +17/−4
- src/Streamly/Internal/Data/Array/ArrayMacros.h +0/−40
- src/Streamly/Internal/Data/Channel.hs +19/−0
- src/Streamly/Internal/Data/Channel/Dispatcher.hs +294/−0
- src/Streamly/Internal/Data/Channel/Types.hs +817/−0
- src/Streamly/Internal/Data/Channel/Worker.hs +375/−0
- src/Streamly/Internal/Data/Fold/Async.hs +6/−3
- src/Streamly/Internal/Data/Fold/Concurrent.hs +37/−49
- src/Streamly/Internal/Data/Fold/Concurrent/Channel.hs +31/−10
- src/Streamly/Internal/Data/Fold/Concurrent/Channel/Type.hs +8/−7
- src/Streamly/Internal/Data/Fold/Prelude.hs +19/−0
- src/Streamly/Internal/Data/Fold/SVar.hs +8/−7
- src/Streamly/Internal/Data/IsMap/HashMap.hs +5/−0
- src/Streamly/Internal/Data/SVar.hs +1/−0
- src/Streamly/Internal/Data/SmallArray.hs +4/−4
- src/Streamly/Internal/Data/Stream/Ahead.hs +15/−3
- src/Streamly/Internal/Data/Stream/Async.hs +22/−3
- src/Streamly/Internal/Data/Stream/Channel/Dispatcher.hs +0/−294
- src/Streamly/Internal/Data/Stream/Channel/Types.hs +0/−827
- src/Streamly/Internal/Data/Stream/Channel/Worker.hs +0/−375
- src/Streamly/Internal/Data/Stream/Common.hs +105/−0
- src/Streamly/Internal/Data/Stream/Concurrent.hs +187/−66
- src/Streamly/Internal/Data/Stream/Concurrent/Channel.hs +19/−16
- src/Streamly/Internal/Data/Stream/Concurrent/Channel/Append.hs +11/−11
- src/Streamly/Internal/Data/Stream/Concurrent/Channel/Consumer.hs +2/−2
- src/Streamly/Internal/Data/Stream/Concurrent/Channel/Dispatcher.hs +3/−3
- src/Streamly/Internal/Data/Stream/Concurrent/Channel/Interleave.hs +11/−9
- src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hs +5/−5
- src/Streamly/Internal/Data/Stream/Concurrent/Channel/Type.hs +4/−4
- src/Streamly/Internal/Data/Stream/Exception/Lifted.hs +0/−331
- src/Streamly/Internal/Data/Stream/Instances.hs +6/−9
- src/Streamly/Internal/Data/Stream/IsStream.hs +8/−2
- src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs +1/−1
- src/Streamly/Internal/Data/Stream/IsStream/Common.hs +6/−6
- src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs +7/−7
- src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs +1/−1
- src/Streamly/Internal/Data/Stream/IsStream/Exception.hs +4/−4
- src/Streamly/Internal/Data/Stream/IsStream/Expand.hs +3/−4
- src/Streamly/Internal/Data/Stream/IsStream/Generate.hs +7/−7
- src/Streamly/Internal/Data/Stream/IsStream/Lift.hs +1/−1
- src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs +8/−8
- src/Streamly/Internal/Data/Stream/IsStream/Top.hs +3/−4
- src/Streamly/Internal/Data/Stream/IsStream/Transform.hs +5/−5
- src/Streamly/Internal/Data/Stream/IsStream/Type.hs +6/−5
- src/Streamly/Internal/Data/Stream/Lifted.hs +335/−0
- src/Streamly/Internal/Data/Stream/Parallel.hs +15/−3
- src/Streamly/Internal/Data/Stream/Prelude.hs +19/−0
- src/Streamly/Internal/Data/Stream/SVar.hs +18/−0
- src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs +3/−3
- src/Streamly/Internal/Data/Stream/SVar/Generate.hs +4/−2
- src/Streamly/Internal/Data/Stream/Serial.hs +13/−5
- src/Streamly/Internal/Data/Stream/Time.hs +10/−10
- src/Streamly/Internal/Data/Stream/Zip.hs +37/−3
- src/Streamly/Internal/Data/Stream/Zip/Concurrent.hs +0/−50
- src/Streamly/Internal/Data/Stream/ZipAsync.hs +5/−4
- src/Streamly/Internal/Data/Unfold/Exception.hs +1/−3
- src/Streamly/Internal/Data/Unfold/Prelude.hs +17/−0
- src/Streamly/Internal/Data/Unfold/SVar.hs +3/−2
- src/Streamly/Internal/FileSystem/Event.hs +2/−2
- src/Streamly/Internal/FileSystem/Event/Darwin.hs +4/−4
- src/Streamly/Internal/FileSystem/Event/Linux.hs +14/−8
- src/Streamly/Internal/FileSystem/Event/Windows.hs +11/−8
- src/Streamly/Internal/FileSystem/FD.hs +12/−11
- src/Streamly/Internal/Network/Inet/TCP.hs +84/−48
- src/Streamly/Internal/Network/Socket.hs +30/−28
- src/Streamly/Internal/System/IOVec.hs +7/−7
- src/Streamly/Internal/Unicode/Char.hs +7/−5
- src/Streamly/Memory/Array.hs +0/−74
- src/Streamly/Network/Inet/TCP.hs +13/−30
- src/Streamly/Network/Socket.hs +13/−26
- src/Streamly/Prelude.hs +4/−4
- streamly.cabal +96/−74
- targets/Targets.hs +11/−5
- test/Streamly/Test/Data/Array.hs +7/−8
- test/Streamly/Test/Data/Array/Mut.hs +0/−152
- test/Streamly/Test/Data/Array/Stream.hs +1/−1
- test/Streamly/Test/Data/Fold.hs +1/−2
- test/Streamly/Test/Data/Fold/Window.hs +8/−9
- test/Streamly/Test/Data/MutArray.hs +152/−0
- test/Streamly/Test/Data/Parser.hs +264/−115
- test/Streamly/Test/Data/Parser/ParserD.hs +0/−837
- test/Streamly/Test/Data/ParserK.hs +841/−0
- test/Streamly/Test/Data/Ring/Unboxed.hs +2/−2
- test/Streamly/Test/Data/Serialize.hs +275/−0
- test/Streamly/Test/Data/Serialize/CompatV0.hs +46/−0
- test/Streamly/Test/Data/Serialize/CompatV1.hs +48/−0
- test/Streamly/Test/Data/Serialize/TH.hs +82/−0
- test/Streamly/Test/Data/Stream.hs +33/−0
- test/Streamly/Test/Data/Stream/Concurrent.hs +113/−69
- test/Streamly/Test/Data/Unbox.hs +147/−38
- test/Streamly/Test/Data/Unbox/TH.hs +146/−0
- test/Streamly/Test/Data/Unfold.hs +2/−2
- test/Streamly/Test/FileSystem/Event/Common.hs +1/−1
- test/Streamly/Test/Prelude/Serial.hs +8/−4
- test/Streamly/Test/Prelude/Top.hs +1/−1
- test/Streamly/Test/Serialize/Serializable.hs +2/−2
- test/Streamly/Test/Unicode/Parser.hs +231/−0
- test/Streamly/Test/Unicode/Stream.hs +2/−2
- test/lib/Streamly/Test/Common.hs +4/−0
- test/lib/Streamly/Test/Prelude/Common.hs +9/−2
- test/streamly-tests.cabal +94/−32
CHANGELOG.md view
@@ -2,15 +2,36 @@ <!-- See rendered changelog at https://streamly.composewell.com --> +## 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](/docs/User/ProjectRelated/Upgrading.md) or+* [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](/docs/User/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt) or+* [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](/core/docs/ApiChangelogs/0.1.0.txt) or+* [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@@ -57,8 +78,9 @@ `StreamK` types can be easily interconverted. The old code can be adapted to use the new modules with some changes.-See the [upgrade guide](/docs/User/ProjectRelated/Upgrading.md) for more-details on how to adapt your existing code to the new release.+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 @@ -139,7 +161,7 @@ ## 0.8.0 (Jun 2021) -See [API Changelog](/docs/User/ProjectRelated/ApiChangelogs/0.8.3.txt) for a complete list of signature+See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of signature changes and new APIs introduced. ### Breaking changes@@ -178,7 +200,7 @@ ### Enhancements -* See [API Changelog](/docs/User/ProjectRelated/ApiChangelogs/0.8.3.txt) for a complete list of new+* See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.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.
LICENSE view
@@ -27,172 +27,6 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. --------------------------------------------------------------------------------base-4.12.0.0 (http://hackage.haskell.org/package/base-4.12.0.0)---------------------------------------------------------------------------------This library (libraries/base) is derived from code from several-sources:-- * Code from the GHC project which is largely (c) The University of- Glasgow, and distributable under a BSD-style license (see below),-- * Code from the Haskell 98 Report which is (c) Simon Peyton Jones- and freely redistributable (but see the full license for- restrictions).-- * Code from the Haskell Foreign Function Interface specification,- which is (c) Manuel M. T. Chakravarty and freely redistributable- (but see the full license for restrictions).--The full text of these licenses is reproduced below. All of the-licenses are BSD-style or compatible.--The Glasgow Haskell Compiler License--Copyright 2004, The University Court of the University of Glasgow.-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--- Redistributions of source code must retain the above copyright notice,-this list of conditions and the following disclaimer.--- Redistributions in binary form must reproduce the above copyright notice,-this list of conditions and the following disclaimer in the documentation-and/or other materials provided with the distribution.--- Neither name of the University nor the names of its contributors may be-used to endorse or promote products derived from this software without-specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-DAMAGE.--Code derived from the document "Report on the Programming Language-Haskell 98", is distributed under the following license:-- Copyright (c) 2002 Simon Peyton Jones-- The authors intend this Report to belong to the entire Haskell- community, and so we grant permission to copy and distribute it for- any purpose, provided that it is reproduced in its entirety,- including this Notice. Modified versions of this Report may also be- copied and distributed for any purpose, provided that the modified- version is clearly presented as such, and that it does not claim to- be a definition of the Haskell 98 Language.--Code derived from the document "The Haskell 98 Foreign Function-Interface, An Addendum to the Haskell 98 Report" is distributed under-the following license:-- Copyright (c) 2002 Manuel M. T. Chakravarty-- The authors intend this Report to belong to the entire Haskell- community, and so we grant permission to copy and distribute it for- any purpose, provided that it is reproduced in its entirety,- including this Notice. Modified versions of this Report may also be- copied and distributed for any purpose, provided that the modified- version is clearly presented as such, and that it does not claim to- be a definition of the Haskell 98 Foreign Function Interface.----------------------------------------------------------------------------------bjoern-2008-2009 (http://bjoern.hoehrmann.de/utf-8/decoder/dfa/)---------------------------------------------------------------------------------Copyright (c) 2008-2009 Bjoern Hoehrmann <bjoern@hoehrmann.de>--Permission is hereby granted, free of charge, to any person obtaining a copy of-this software and associated documentation files (the "Software"), to deal in-the Software without restriction, including without limitation the rights to-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies-of the Software, and to permit persons to whom the Software is furnished to do-so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE-SOFTWARE.----------------------------------------------------------------------------------clock-0.7.2 (http://hackage.haskell.org/package/clock-0.7.2)---------------------------------------------------------------------------------Copyright (c) 2009-2012, Cetin Sert-Copyright (c) 2010, Eugene Kirpichov--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are-met:-- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above- copyright notice, this list of conditions and the following- disclaimer in the documentation and/or other materials provided- with the distribution.-- * The names of contributors may not be used to endorse or promote- products derived from this software without specific prior- written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.----------------------------------------------------------------------------------foldl-1.4.5 (http://hackage.haskell.org/package/foldl-1.4.5)---------------------------------------------------------------------------------Copyright (c) 2013 Gabriel Gonzalez-All rights reserved.--Redistribution and use in source and binary forms, with or without modification,-are permitted provided that the following conditions are met:- * Redistributions of source code must retain the above copyright notice,- this list of conditions and the following disclaimer.- * Redistributions in binary form must reproduce the above copyright notice,- this list of conditions and the following disclaimer in the documentation- and/or other materials provided with the distribution.- * Neither the name of Gabriel Gonzalez nor the names of other contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON-ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.--------------------------------------------------------------------------------- fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/) ------------------------------------------------------------------------------- Copyright (c) 2012, Mark Dittmer@@ -259,91 +93,3 @@ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.----------------------------------------------------------------------------------primitive-0.7.0.0 (https://hackage.haskell.org/package/primitive-0.7.0.0)---------------------------------------------------------------------------------Copyright (c) 2008-2009, Roman Leshchinskiy-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--- Redistributions of source code must retain the above copyright notice,-this list of conditions and the following disclaimer.--- Redistributions in binary form must reproduce the above copyright notice,-this list of conditions and the following disclaimer in the documentation-and/or other materials provided with the distribution.--- Neither name of the University nor the names of its contributors may be-used to endorse or promote products derived from this software without-specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-DAMAGE.----------------------------------------------------------------------------------transient-0.5.5 (http://hackage.haskell.org/package/transient-0.5.5)---------------------------------------------------------------------------------Copyright © 2014-2016 Alberto G. Corona <https://github.com/agocorona>--Permission is hereby granted, free of charge, to any person obtaining a copy of-this software and associated documentation files (the "Software"), to deal in-the Software without restriction, including without limitation the rights to-use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of-the Software, and to permit persons to whom the Software is furnished to do so,-subject to the following conditions:--The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS-FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR-COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER-IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN-CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.----------------------------------------------------------------------------------vector-0.12.0.2 (http://hackage.haskell.org/package/vector-0.12.0.2)---------------------------------------------------------------------------------Copyright (c) 2008-2012, Roman Leshchinskiy-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--- Redistributions of source code must retain the above copyright notice,-this list of conditions and the following disclaimer.--- Redistributions in binary form must reproduce the above copyright notice,-this list of conditions and the following disclaimer in the documentation-and/or other materials provided with the distribution.--- Neither name of the University nor the names of its contributors may be-used to endorse or promote products derived from this software without-specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF-GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND-FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE-UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH-DAMAGE.
README.md view
@@ -3,6 +3,12 @@ [](https://gitter.im/composewell/streamly) [](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@@ -17,8 +23,8 @@ * Fearless, declarative concurrency for seamless parallel execution. * A collection of ecosystem libraries for fast and efficient development. -Check out the [Streamly Setup and Usage-Guide](/docs/User/Tutorials/setup-and-usage.md) and [Quick+Check out the [Streamly Getting Started+Guide](/docs/User/Tutorials/getting-started.md) and [Quick Overview](/docs/User/Tutorials/quick-overview.md) for an introduction to the library. For more detailed documentation, visit the [Haskell Streamly website][Streamly].
benchmark/NanoBenchmarks.hs view
@@ -18,7 +18,7 @@ import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Stream.IsStream as Internal -import Gauge+import Test.Tasty.Bench import System.Random maxValue :: Int
benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs view
@@ -7,9 +7,9 @@ import qualified Streamly.Data.Fold as Fold import qualified Streamly.Data.Stream as S-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import qualified Streamly.Internal.Data.Stream as Stream -import Gauge+import Test.Tasty.Bench import Streamly.Benchmark.Common hiding (benchPureSrc) import qualified Stream.Common as P
− benchmark/Streamly/Benchmark/Data/Array/Mut.hs
@@ -1,300 +0,0 @@-{-# OPTIONS_GHC -Wno-deprecations #-}-{-# 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 ((<&>))-import System.Random (randomRIO)-import Prelude- ( IO- , Int- , Integral(..)- , Maybe(..)- , Monad(..)- , Num(..)- , Ord(..)- , String- , ($)- , (.)- , (||)- , concat- , const- , fmap- , id- , undefined- )-import Streamly.Internal.Data.Array.Mut (MutArray)--import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Array.Mut as MArray-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamD as Stream--import Gauge-import Streamly.Benchmark.Common hiding (benchPureSrc)--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.writeN 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.writeN value) $ Stream.enumerateFromTo n (n + value)--{-# INLINE sourceFromList #-}-sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)-sourceFromList value n =- Stream.fold (MArray.writeN 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.write $ 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.scan (Fold.foldl' (+) 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.writeN 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.toStreamDRev--{-# INLINE toStreamDDrain #-}-toStreamDDrain :: MonadIO m => Stream Int -> m ()-toStreamDDrain = drain . MArray.toStreamD--{-# 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 "writeN . intFromTo" (sourceIntFromTo value)- , benchIOSrc- "fromList . intFromTo"- (sourceIntFromToFromList value)- , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)- , benchIOSrc "writeN . 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 "writeN" (Stream.fold (MArray.writeN 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.strip (\x -> x < value `div` 2 || x > value `div` 2)- , benchIO' "strip (> 0)" (const (return array))- $ MArray.strip (> 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.Array.Mut"--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/Array/Stream.hs view
@@ -31,30 +31,30 @@ import Data.Functor.Identity (runIdentity) import Data.Maybe (isJust) import Data.Word (Word8)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.StreamK (StreamK)+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.Stream.Chunked as ArrayStream+import qualified Streamly.Internal.Data.Array.Stream as ArrayStream import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as Parser-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamK as StreamK+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 Gauge hiding (env)+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.Unboxed (Unbox)-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Internal.Data.Stream (Step(..)) import Test.Inspection #endif
benchmark/Streamly/Benchmark/Data/Fold.hs view
@@ -12,6 +12,11 @@ {-# 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(..))@@ -25,18 +30,18 @@ import Data.Monoid (Last(..), Sum(..)) import System.Random (randomRIO) -import Streamly.Internal.Data.Stream.StreamD (Stream)+import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Fold (Fold(..)) import Streamly.Internal.Data.IsMap.HashMap ()-import Streamly.Internal.Data.Array.Mut (MutArray)+import Streamly.Internal.Data.MutArray (MutArray) import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Fold.Container as FL+import qualified Streamly.Data.Fold.Prelude as Fold import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Pipe as Pipe-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import qualified Streamly.Internal.Data.Stream as Stream -import Gauge+import Test.Tasty.Bench import Streamly.Benchmark.Common import Prelude hiding (all, any, take, unzip, sequence_, filter) @@ -214,7 +219,7 @@ demuxToIntMap f g = Stream.fold (FL.demuxToContainer f g) {-# INLINE demuxToHashMap #-}-demuxToHashMap :: (Monad m, Ord k, Hashable k) =>+demuxToHashMap :: (Monad m, Hashable k) => (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b) demuxToHashMap f g = Stream.fold (FL.demuxToContainer f g) @@ -224,7 +229,7 @@ demuxToMapIO f g = Stream.fold (FL.demuxToContainerIO f g) {-# INLINE demuxToHashMapIO #-}-demuxToHashMapIO :: (MonadIO m, Ord k, Hashable k) =>+demuxToHashMapIO :: (MonadIO m, Hashable k) => (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b) demuxToHashMapIO f g = Stream.fold (FL.demuxToContainerIO f g) @@ -251,7 +256,7 @@ {-# INLINE toHashMapIO #-} toHashMapIO :: (MonadIO m, Ord k, Num a, Hashable k) => (a -> k) -> Stream m a -> m (HashMap k a)-toHashMapIO f = Stream.fold (FL.toContainerIO f FL.sum)+toHashMapIO f = Stream.fold (Fold.toHashMapIO f FL.sum) ------------------------------------------------------------------------------- -- unzip@@ -502,7 +507,9 @@ ------------------------------------------------------------------------------- main :: IO ()-main = runWithCLIOpts defaultStreamSize allBenchmarks+main = do+#ifndef FUSION_CHECK+ runWithCLIOpts defaultStreamSize allBenchmarks where @@ -515,3 +522,20 @@ , 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/Window.hs view
@@ -4,16 +4,16 @@ import Control.DeepSeq (NFData) import Streamly.Data.Fold (Fold)-import Streamly.Internal.Data.Stream.StreamD (Stream)+import Streamly.Internal.Data.Stream (Stream) import System.Random (randomRIO) import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Internal.Data.Ring.Unboxed as Ring-import qualified Streamly.Internal.Data.Fold.Window as Window-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import qualified Streamly.Internal.Data.Fold as Window+import qualified Streamly.Internal.Data.Ring as Ring+import qualified Streamly.Internal.Data.Stream as Stream import Streamly.Benchmark.Common-import Gauge+import Test.Tasty.Bench {-# INLINE source #-} source :: (Monad m, Num a, Stream.Enumerable a) =>@@ -70,55 +70,55 @@ o_1_space_folds numElements = [ bgroup "fold" [ benchWithFold numElements "minimum (window size 100)"- (Window.minimum 100)+ (Window.windowMinimum 100) , benchWithFold numElements "minimum (window size 1000)"- (Window.minimum 1000)+ (Window.windowMinimum 1000) , benchWith sourceDescendingInt numElements "minimum descending (window size 1000)"- (Window.minimum 1000)+ (Window.windowMinimum 1000) , benchWithFold numElements "maximum (window size 100)"- (Window.maximum 100)+ (Window.windowMaximum 100) , benchWithFold numElements "maximum (window size 1000)"- (Window.maximum 1000)+ (Window.windowMaximum 1000) , benchWith sourceDescendingInt numElements "maximum descending (window size 1000)"- (Window.maximum 1000)+ (Window.windowMaximum 1000) , benchWithFold numElements "range (window size 100)"- (Window.range 100)+ (Window.windowRange 100) , benchWithFold numElements "range (window size 1000)"- (Window.range 1000)+ (Window.windowRange 1000) , benchWith sourceDescendingInt numElements "range descending (window size 1000)"- (Window.range 1000)+ (Window.windowRange 1000) , benchWithFoldInt numElements "sumInt (window size 100)"- (Ring.slidingWindow 100 Window.sumInt)+ (Ring.slidingWindow 100 Window.windowSumInt) , benchWithFoldInt numElements "sum for Int (window size 100)"- (Ring.slidingWindow 100 Window.sum)+ (Ring.slidingWindow 100 Window.windowSum) , benchWithFold numElements "sum (window size 100)"- (Ring.slidingWindow 100 Window.sum)+ (Ring.slidingWindow 100 Window.windowSum) , benchWithFold numElements "sum (window size 1000)"- (Ring.slidingWindow 1000 Window.sum)+ (Ring.slidingWindow 1000 Window.windowSum) , benchWithFold numElements "sum (entire stream)"- (Window.cumulative Window.sum)+ (Window.cumulative Window.windowSum) , benchWithFold numElements "sum (Data.Fold)" Fold.sum , benchWithFold numElements "mean (window size 100)"- (Ring.slidingWindow 100 Window.mean)+ (Ring.slidingWindow 100 Window.windowMean) , benchWithFold numElements "mean (window size 1000)"- (Ring.slidingWindow 1000 Window.mean)+ (Ring.slidingWindow 1000 Window.windowMean) , benchWithFold numElements "mean (entire stream)"- (Window.cumulative Window.mean)+ (Window.cumulative Window.windowMean) , benchWithFold numElements "mean (Data.Fold)" Fold.mean , benchWithFold numElements "powerSum 2 (window size 100)"- (Ring.slidingWindow 100 (Window.powerSum 2))+ (Ring.slidingWindow 100 (Window.windowPowerSum 2)) , benchWithFold numElements "powerSum 2 (entire stream)"- (Window.cumulative (Window.powerSum 2))+ (Window.cumulative (Window.windowPowerSum 2)) ] ]@@ -127,51 +127,51 @@ o_1_space_scans numElements = [ bgroup "scan" [ benchWithPostscan numElements "minimum (window size 10)"- (Window.minimum 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.minimum 30)+ (Window.windowMinimum 30) , benchWithPostscan numElements "minimum (window size 1000)"- (Window.minimum 1000)+ (Window.windowMinimum 1000) , benchScanWith sourceDescendingInt numElements "minimum descending (window size 1000)"- (Window.minimum 1000)+ (Window.windowMinimum 1000) , benchWithPostscan numElements "maximum (window size 10)"- (Window.maximum 10)+ (Window.windowMaximum 10) , benchWithPostscan numElements "maximum (window size 30)"- (Window.maximum 30)+ (Window.windowMaximum 30) , benchWithPostscan numElements "maximum (window size 1000)"- (Window.maximum 1000)+ (Window.windowMaximum 1000) , benchScanWith sourceDescendingInt numElements "maximum descending (window size 1000)"- (Window.maximum 1000)+ (Window.windowMaximum 1000) , benchWithPostscan numElements "range (window size 10)"- (Window.range 10)+ (Window.windowRange 10) , benchWithPostscan numElements "range (window size 30)"- (Window.range 30)+ (Window.windowRange 30) , benchWithPostscan numElements "range (window size 1000)"- (Window.range 1000)+ (Window.windowRange 1000) , benchScanWith sourceDescendingInt numElements "range descending (window size 1000)"- (Window.range 1000)+ (Window.windowRange 1000) , benchWithPostscan numElements "sum (window size 100)"- (Ring.slidingWindow 100 Window.sum)+ (Ring.slidingWindow 100 Window.windowSum) , benchWithPostscan numElements "sum (window size 1000)"- (Ring.slidingWindow 1000 Window.sum)+ (Ring.slidingWindow 1000 Window.windowSum) , benchWithPostscan numElements "mean (window size 100)"- (Ring.slidingWindow 100 Window.mean)+ (Ring.slidingWindow 100 Window.windowMean) , benchWithPostscan numElements "mean (window size 1000)"- (Ring.slidingWindow 1000 Window.mean)+ (Ring.slidingWindow 1000 Window.windowMean) , benchWithPostscan numElements "powerSum 2 (window size 100)"- (Ring.slidingWindow 100 (Window.powerSum 2))+ (Ring.slidingWindow 100 (Window.windowPowerSum 2)) , benchWithPostscan numElements "powerSum 2 (window size 1000)"- (Ring.slidingWindow 1000 (Window.powerSum 2))+ (Ring.slidingWindow 1000 (Window.windowPowerSum 2)) ] ]
+ benchmark/Streamly/Benchmark/Data/MutArray.hs view
@@ -0,0 +1,300 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# 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 ((<&>))+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.Stream as Stream++import Test.Tasty.Bench+import Streamly.Benchmark.Common hiding (benchPureSrc)++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.writeN 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.writeN value) $ Stream.enumerateFromTo n (n + value)++{-# INLINE sourceFromList #-}+sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)+sourceFromList value n =+ Stream.fold (MArray.writeN 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.write $ 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.scan (Fold.foldl' (+) 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.writeN 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 "writeN . intFromTo" (sourceIntFromTo value)+ , benchIOSrc+ "fromList . intFromTo"+ (sourceIntFromToFromList value)+ , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)+ , benchIOSrc "writeN . 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 "writeN" (Stream.fold (MArray.writeN 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.strip (\x -> x < value `div` 2 || x > value `div` 2)+ , benchIO' "strip (> 0)" (const (return array))+ $ MArray.strip (> 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
@@ -34,7 +34,7 @@ import Streamly.Internal.Data.Fold (Fold(..)) import Streamly.Internal.Data.Parser (ParseError(..), Parser(..), Initial(..), Step(..))-import Streamly.Internal.Data.Stream.StreamD (Stream)+import Streamly.Internal.Data.Stream (Stream) import Prelude hiding (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile, span) @@ -47,10 +47,9 @@ 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.Producer.Source as Source-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import qualified Streamly.Internal.Data.Stream as Stream -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common import Streamly.Benchmark.Common.Handle @@ -349,7 +348,7 @@ -- 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 fextract) =+takeWhileFail predicate (Fold fstep finitial _ ffinal) = Parser step initial extract where@@ -370,7 +369,7 @@ Fold.Done b -> Done 0 b else return $ Error "fail" - extract s = fmap (Done 0) (fextract s)+ extract s = fmap (Done 0) (ffinal s) {-# INLINE alt2 #-} alt2 :: Monad m@@ -635,13 +634,13 @@ {-# INLINE parseManyUnfoldArrays #-} parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO () parseManyUnfoldArrays count arrays = do- let src = Source.source (Just (Producer.OuterLoop arrays))+ let src = Producer.source (Just (Producer.OuterLoop arrays)) let parser = PR.fromFold (Fold.take count Fold.drain) let readSrc =- Source.producer+ Producer.producer $ Producer.concat Producer.fromList Array.producer let streamParser =- Producer.simplify (Source.parseMany parser readSrc)+ Producer.simplify (Producer.parseMany parser readSrc) Stream.fold Fold.drain $ Stream.unfold streamParser src -------------------------------------------------------------------------------@@ -715,8 +714,6 @@ o_1_space_serial :: Int -> [Benchmark] o_1_space_serial value = [ benchIOSink value "takeBetween" $ takeBetween value- , benchIOSink value "takeEQ" $ takeEQ value- , benchIOSink value "takeGE" $ takeGE value , benchIOSink value "takeWhile" $ takeWhile value , benchIOSink value "takeWhileP" $ takeWhileP value , benchIOSink value "takeP" $ takeP value@@ -813,8 +810,11 @@ o_n_heap_serial :: Int -> [Benchmark] o_n_heap_serial value = [+ benchIOSink value "takeEQ" $ takeEQ value+ , benchIOSink value "takeGE" $ takeGE value+ -- lookahead benchmark holds the entire input till end- benchIOSink value "lookAhead" $ lookAhead value+ , benchIOSink value "lookAhead" $ lookAhead value -- o-n-heap because of backtracking , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"
− benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs
@@ -1,384 +0,0 @@--- |--- Module : Streamly.Benchmark.Data.ParserK--- Copyright : (c) 2020 Composewell Technologies------ License : BSD-3-Clause--- Maintainer : streamly@composewell.com--{-# 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)-import Streamly.Data.Array (Array, Unbox)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Data.StreamK (StreamK)-import Streamly.Internal.Data.Parser- (ParseError(..), Parser(..), Initial(..), Step(..))-import Streamly.Internal.Data.Stream.StreamD (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.Data.ParserK as PR-import qualified Streamly.Internal.Data.Stream.StreamK as StreamK--import Gauge-import Streamly.Benchmark.Common------------------------------------------------------------------------------------ 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 (Array Int) -> IO b) -> Benchmark-benchIOSink value name f =- bench name $ nfIO $ randomRIO (1,1)- >>= f- . StreamK.fromStream- . Stream.chunksOf 4000- . sourceUnfoldrM value------------------------------------------------------------------------------------ Parsers----------------------------------------------------------------------------------#define PARSE_OP StreamK.parseChunks--{-# INLINE one #-}-one :: MonadIO m =>- Int -> StreamK m (Array Int) -> m (Either ParseError (Maybe Int))-one value = StreamK.parseChunks p-- where-- p = do- m <- PR.fromFold FL.one- case m of- Just i -> if i >= value then pure m else p- Nothing -> pure Nothing--{-# INLINE satisfy #-}-satisfy :: (MonadIO m, Unbox a) => (a -> Bool) -> PR.ParserK a m a-satisfy = PR.fromParser . PRD.satisfy--{-# INLINE takeWhile #-}-takeWhile :: (MonadIO m, Unbox a) => (a -> Bool) -> PR.ParserK a m ()-takeWhile p = PR.fromParser $ PRD.takeWhile p FL.drain--{-# INLINE takeWhileK #-}-takeWhileK :: MonadIO m =>- Int -> StreamK m (Array Int) -> m (Either ParseError ())-takeWhileK value = PARSE_OP (takeWhile (<= value))--{-# INLINE splitAp2 #-}-splitAp2 :: MonadIO m- => Int -> StreamK m (Array Int) -> m (Either ParseError ((), ()))-splitAp2 value =- PARSE_OP- ((,)- <$> takeWhile (<= (value `div` 2))- <*> takeWhile (<= value)- )--{-# INLINE splitAp8 #-}-splitAp8 :: MonadIO m- => Int -> StreamK m (Array Int) -> 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 (Array Int) -> m Int-sequenceA value xs = do- let parser = satisfy (> 0)- list = Prelude.replicate value parser- x <- PARSE_OP (TR.sequenceA list) xs- return $ Prelude.length x--{-# INLINE sequenceA_ #-}-sequenceA_ :: MonadIO m =>- Int -> StreamK m (Array Int) -> 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 (Array Int) -> m Int-sequence value xs = do- let parser = satisfy (> 0)- list = Prelude.replicate value parser- x <- PARSE_OP (TR.sequence list) xs- return $ Prelude.length x--{-# INLINE sequence_ #-}-sequence_ :: MonadIO m =>- Int -> StreamK m (Array Int) -> 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 fextract) =- 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 -> Partial 0 s1- Fold.Done b -> Done 0 b- else return $ Error "fail"-- extract s = fmap (Done 0) (fextract s)--{-# INLINE takeWhileFail #-}-takeWhileFail :: (Monad m, Unbox a) =>- (a -> Bool) -> Fold m a b -> PR.ParserK a m b-takeWhileFail p f = PR.fromParser (takeWhileFailD p f)--{-# INLINE alt2 #-}-alt2 :: MonadIO m- => Int -> StreamK m (Array Int) -> m (Either ParseError ())-alt2 value =- PARSE_OP- ( takeWhileFail (<= (value `div` 2)) Fold.drain- <|> takeWhile (<= value)- )--{-# INLINE alt8 #-}-alt8 :: MonadIO m- => Int -> StreamK m (Array Int) -> 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 (Array Int) -> 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 (Array Int) -> m Int-manyAlt xs = do- x <- PARSE_OP (AP.many (satisfy (> 0))) xs- return $ Prelude.length x--{-# INLINE someAlt #-}-someAlt :: MonadIO m => StreamK m (Array Int) -> 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 (Array Int) -> m (Either ParseError Int)-choice value =- PARSE_OP (asum (replicate value (satisfy (< 0)))- AP.<|> satisfy (> 0))--{-# INLINE monad2 #-}-monad2 :: MonadIO m- => Int -> StreamK m (Array Int) -> m (Either ParseError ())-monad2 value =- PARSE_OP $ do- takeWhile (<= (value `div` 2))- takeWhile (<= value)--{-# INLINE monad4 #-}-monad4 :: MonadIO m- => Int -> StreamK m (Array Int) -> 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 (Array Int) -> 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 (Array Int) -> 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 = "Data.Parser.ParserK"--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 "alt8" $ alt8 value- , benchIOSink value "alt16" $ alt16 value- , benchIOSink value "monad2" $ monad2 value- , benchIOSink value "monad4" $ monad4 value- , benchIOSink value "monad8" $ monad8 value- , benchIOSink value "monad16" $ monad16 value- ]--{-# INLINE sepBy1 #-}-sepBy1 :: MonadIO m => StreamK m (Array Int) -> 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- ]---- 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/ParserK.hs view
@@ -0,0 +1,437 @@+-- |+-- Module : Streamly.Benchmark.Data.ParserK+-- Copyright : (c) 2020 Composewell Technologies+--+-- License : BSD-3-Clause+-- Maintainer : streamly@composewell.com++-- BENCH_CHUNKED -> adaptC+-- BENCH_CHUNKED_GENERIC -> adaptCG+-- BENCH_SINGULAR -> adapt++{-# 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)+import qualified Streamly.Internal.Data.Array.Generic as GenArr (chunksOf)+#endif+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Data.StreamK (StreamK)+import Streamly.Internal.Data.Parser+ (ParseError(..), Parser(..), Initial(..), Step(..))+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++import Test.Tasty.Bench+import Streamly.Benchmark.Common++-------------------------------------------------------------------------------+-- CPP Helpers+-------------------------------------------------------------------------------++#ifdef BENCH_CHUNKED++#define PARSE_OP StreamK.parseChunks+#define FROM_PARSER adaptC+#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 StreamK.parseChunksGeneric+#define FROM_PARSER adaptCG+#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 adapt+#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+ . Stream.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 <- PR.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 = PR.FROM_PARSER . PRD.satisfy++{-# INLINE takeWhile #-}+takeWhile :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m ()+takeWhile p = PR.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 -> Partial 0 s1+ Fold.Done b -> Done 0 b+ else return $ Error "fail"++ extract s = fmap (Done 0) (ffinal s)++{-# INLINE takeWhileFail #-}+takeWhileFail :: CONSTRAINT =>+ (a -> Bool) -> Fold m a b -> PR.ParserK INPUT m b+takeWhileFail p f = PR.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 "alt8" $ alt8 value+ , benchIOSink value "alt16" $ alt16 value+ , benchIOSink value "monad2" $ monad2 value+ , benchIOSink value "monad4" $ monad4 value+ , benchIOSink value "monad8" $ monad8 value+ , benchIOSink value "monad16" $ monad16 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+ ]++-- 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/Ring/Unboxed.hs view
@@ -12,12 +12,11 @@ import Control.Monad (void) import GHC.Ptr (Ptr(..))--import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Ring.Unboxed as Ring+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Ring as Ring import qualified Data.Foldable as P -import Gauge+import Test.Tasty.Bench import Streamly.Benchmark.Common import Prelude as P
+ benchmark/Streamly/Benchmark/Data/Serialize.hs view
@@ -0,0 +1,596 @@+{-# LANGUAGE TemplateHaskell #-}++#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 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++-------------------------------------------------------------------------------+-- 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 `seq` ()++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+-------------------------------------------------------------------------------++-- 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 = do+ if n > 0+ then f x >> go (n-1) x+ else return ()++-- 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 = do+ if n > 0+ then f e x >> go (n-1) x+ else return ()++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 = SERIALIZE_OP 0 arr val >> return ()++{-# 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+ SERIALIZE_OP 0 arr val >> return ()++{-# 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 = length lInt -- evaluate the list+#endif+#ifndef FUSION_CHECK+ -- This can take too much memory/CPU, need to restrict the test+ -- runQC+#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))+ (const (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
@@ -36,7 +36,7 @@ #ifdef FUSION_CHECK import Data.Function ((&)) import Streamly.Data.Stream (Stream)-import qualified Streamly.Internal.Data.Stream.StreamD as 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
benchmark/Streamly/Benchmark/Data/Stream/Common.hs view
@@ -71,7 +71,9 @@ ) 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)@@ -90,20 +92,20 @@ , concatStreamsWith ) #else-import Streamly.Internal.Data.Stream.StreamD (Stream)-import qualified Streamly.Internal.Data.Stream.StreamD as D+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as D #ifdef USE_STREAMK-import Streamly.Internal.Data.Stream.StreamK (StreamK)-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamK as StreamK+import Streamly.Internal.Data.StreamK (StreamK)+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.StreamK as StreamK #else-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamD as StreamK+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as StreamK #endif #endif -import Gauge-import Prelude hiding (mapM, replicate)+import Test.Tasty.Bench+import Prelude hiding (Foldable(..), mapM, replicate) #ifdef USE_STREAMK toStream :: Applicative m => StreamK m a -> Stream m a
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentCommon.hs view
@@ -14,14 +14,14 @@ import Stream.Common (composeN, benchIO, benchIOSink, benchIOSrc, sourceUnfoldrM) import Streamly.Data.Stream (Stream)-import Streamly.Internal.Data.Stream.Concurrent (MonadAsync, Config)+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.Concurrent as Async+import qualified Streamly.Internal.Data.Stream.Prelude as Async -import Gauge+import Test.Tasty.Bench import Prelude hiding (mapM) import Streamly.Benchmark.Common
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentEager.hs view
@@ -9,7 +9,7 @@ import Stream.ConcurrentCommon (allBenchmarks) import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize) -import qualified Streamly.Internal.Data.Stream.Concurrent as Async+import qualified Streamly.Internal.Data.Stream.Prelude as Async moduleName :: String moduleName = "Data.Stream.ConcurrentEager"
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentInterleaved.hs view
@@ -9,7 +9,7 @@ import Stream.ConcurrentCommon (allBenchmarks) import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize) -import qualified Streamly.Internal.Data.Stream.Concurrent as Async+import qualified Streamly.Internal.Data.Stream.Prelude as Async moduleName :: String moduleName = "Data.Stream.ConcurrentInterleaved"
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentOrdered.hs view
@@ -9,7 +9,7 @@ import Stream.ConcurrentCommon (allBenchmarks) import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize) -import qualified Streamly.Internal.Data.Stream.Concurrent as Async+import qualified Streamly.Internal.Data.Stream.Prelude as Async moduleName :: String moduleName = "Data.Stream.ConcurrentOrdered"
benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs view
@@ -37,7 +37,7 @@ #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif #ifdef USE_PRELUDE@@ -47,17 +47,17 @@ import qualified Streamly.Internal.Data.Stream.IsStream as StreamK #else import Stream.Common-import Streamly.Internal.Data.Stream.StreamD (Stream)-import qualified Streamly.Internal.Data.Stream.StreamD as S+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as S #ifdef USE_STREAMK-import Streamly.Internal.Data.Stream.StreamK (StreamK)+import Streamly.Internal.Data.StreamK (StreamK) import qualified Streamly.Data.StreamK as StreamK #else-import qualified Streamly.Internal.Data.Stream.StreamD as StreamK+import qualified Streamly.Internal.Data.Stream as StreamK #endif #endif -import Gauge+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)
benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs view
@@ -36,24 +36,25 @@ 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.Exception 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.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.Exception.Lifted as Stream+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream #endif -import Gauge hiding (env)+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.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif #ifdef USE_PRELUDE@@ -177,7 +178,8 @@ -- | Send the file contents to /dev/null with exception handling readWriteHandleExceptionStream :: Handle -> Handle -> IO () readWriteHandleExceptionStream inh devNull =- let handler (_e :: SomeException) = Stream.fromEffect (hClose inh >> return 10)+ let handler (_e :: SomeException) =+ return $ Stream.fromEffect (hClose inh >> return 10) readEx = Stream.handle handler (Stream.unfold FH.reader inh) in Stream.fold (FH.write devNull) readEx @@ -285,8 +287,12 @@ 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 ()@@ -295,7 +301,11 @@ 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 ()
benchmark/Streamly/Benchmark/Data/Stream/Expand.hs view
@@ -29,7 +29,7 @@ import GHC.Types (SPEC(..)) import Test.Inspection -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif import qualified Stream.Common as Common@@ -42,19 +42,19 @@ ( sourceFoldMapM, sourceFoldMapWith, sourceFoldMapWithM , sourceFoldMapWithStream, concatFoldableWith, concatForFoldableWith) #else-import qualified Streamly.Internal.Data.Stream.StreamD as S+import qualified Streamly.Internal.Data.Stream as S #ifdef USE_STREAMK-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.StreamK (StreamK, CrossStreamK)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.StreamK (StreamK, CrossStreamK) import qualified Control.Applicative as AP import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamK as StreamK+import qualified Streamly.Internal.Data.StreamK as StreamK #else-import qualified Streamly.Internal.Data.Stream.StreamD as StreamK+import qualified Streamly.Internal.Data.Stream as StreamK #endif #endif -import Gauge+import Test.Tasty.Bench import Stream.Common import Streamly.Benchmark.Common import Prelude hiding (concatMap)@@ -198,7 +198,11 @@ (fromStream $ sourceUnfoldr outer n) #ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]+#else inspect $ hasNoTypeClasses 'concatMapPure+#endif inspect $ 'concatMapPure `hasNoType` ''SPEC #endif @@ -211,7 +215,11 @@ (fromStream . S.replicate inner) (fromStream $ sourceUnfoldrM outer n) #ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]+#else inspect $ hasNoTypeClasses 'concatMapRepl+#endif inspect $ 'concatMapRepl `hasNoType` ''SPEC #endif
benchmark/Streamly/Benchmark/Data/Stream/Generate.hs view
@@ -31,16 +31,16 @@ import qualified Streamly.Internal.Data.Stream.IsStream as Stream #else import Stream.Common-import Streamly.Internal.Data.Stream.StreamD (Stream)-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as Stream #ifdef USE_STREAMK import System.IO.Unsafe (unsafeInterleaveIO)-import qualified Streamly.Internal.Data.Stream.StreamK as StreamK+import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Stream.Common as Common #endif #endif -import Gauge+import Test.Tasty.Bench import Streamly.Benchmark.Common import qualified Prelude
benchmark/Streamly/Benchmark/Data/Stream/Lift.hs view
@@ -27,17 +27,17 @@ #ifdef USE_PRELUDE import qualified Streamly.Internal.Data.Stream.IsStream as Stream #else-import Streamly.Internal.Data.Stream.StreamD (Stream)-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as Stream #ifdef USE_STREAMK import Stream.Common (benchIO, drain)-import Streamly.Internal.Data.Stream.StreamK (StreamK)-import qualified Streamly.Internal.Data.Stream.StreamK as StreamK+import Streamly.Internal.Data.StreamK (StreamK)+import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Control.Monad.State.Strict as State #endif #endif -import Gauge+import Test.Tasty.Bench import Streamly.Benchmark.Common import Prelude hiding (reverse, tail)
benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs view
@@ -44,24 +44,24 @@ , transformComposeMapM, transformTeeMapM, transformZipMapM) #else -import Streamly.Internal.Data.Stream.StreamD (Stream)-import qualified Streamly.Internal.Data.Stream.StreamD as S+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.Time as S+import qualified Streamly.Internal.Data.Stream.Prelude as S #endif #ifdef USE_STREAMK-import Streamly.Internal.Data.Stream.StreamK (StreamK)+import Streamly.Internal.Data.StreamK (StreamK) import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Stream.StreamK as K+import qualified Streamly.Internal.Data.StreamK as K #else-import qualified Streamly.Internal.Data.Stream.StreamD as K+import qualified Streamly.Internal.Data.Stream as K #endif #endif -import Gauge+import Test.Tasty.Bench import Streamly.Benchmark.Common import Stream.Common import Prelude hiding (reverse, tail)@@ -107,30 +107,50 @@ -- Grouping transformations ------------------------------------------------------------------------------- -#ifdef USE_PRELUDE {-# INLINE groups #-} groups :: MonadIO m => Stream m Int -> m ()-groups = Common.drain . S.groups FL.drain+groups =+#ifdef USE_PRELUDE+ Common.drain . S.groups FL.drain+#else+ Common.drain . S.groupsWhile (==) FL.drain+#endif --- XXX Change this test when the order of comparison is later changed-{-# INLINE groupsByGT #-}-groupsByGT :: MonadIO m => Stream m Int -> m ()-groupsByGT = Common.drain . S.groupsBy (>) FL.drain+{-# 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 groupsByEq #-}-groupsByEq :: MonadIO m => Stream m Int -> m ()-groupsByEq = Common.drain . S.groupsBy (==) FL.drain+{-# 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 --- XXX Change this test when the order of comparison is later changed+ {-# 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 #-}@@ -190,14 +210,13 @@ -- Buffering operations using heap proportional to group/window sizes. [ bgroup "grouping" [-#ifdef USE_PRELUDE benchIOSink value "groups" groups- , benchIOSink value "groupsByGT" groupsByGT- , benchIOSink value "groupsByEq" groupsByEq+ , benchIOSink value "groupsWhileLT" groupsWhileLT+ , benchIOSink value "groupsWhileEq" groupsWhileEq , benchIOSink value "groupsByRollingLT" groupsByRollingLT , benchIOSink value "groupsByRollingEq" groupsByRollingEq ,-#endif+ -- 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.
benchmark/Streamly/Benchmark/Data/Stream/Split.hs view
@@ -35,15 +35,15 @@ import qualified Streamly.Internal.Unicode.Stream as IUS import qualified Streamly.Prelude as S -import Gauge hiding (env)+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.StreamD.Type (Step(..))+import Streamly.Internal.Data.Stream (Step(..)) -import qualified Streamly.Internal.Data.Array.Mut.Type as MA+import qualified Streamly.Internal.Data.MutArray as MA import qualified Streamly.Internal.Data.Unfold as IUF import Test.Inspection
benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs view
@@ -22,15 +22,17 @@ module Main (main) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Control.Monad (when) import Data.Maybe (isJust)-import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain) import System.Random (randomRIO) import Prelude hiding (tail, mapM_, foldl, last, map, mapM, concatMap, zip) import qualified Prelude as P-import qualified Streamly.Internal.Data.Stream.StreamD as S+import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Unfold as UF import qualified Streamly.Internal.Data.Fold as FL @@ -461,7 +463,7 @@ ------------------------------------------------------------------------------- moduleName :: String-moduleName = "Data.Stream.StreamD"+moduleName = "Data.StreamD" o_1_space :: [Benchmark] o_1_space =
− benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
@@ -1,455 +0,0 @@-{-# OPTIONS_GHC -Wno-deprecations #-}---- |--- Module : Streamly.Benchmark.Data.Stream.StreamDK--- Copyright : (c) 2018 Composewell Technologies------ License : BSD3--- Maintainer : streamly@composewell.com--{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where---- import Control.Monad (when)--- import Data.Maybe (isJust)-import Prelude hiding ()--- import qualified Prelude as P--- import qualified Data.List as List--import qualified Streamly.Internal.Data.Stream.StreamDK as S--- import qualified Streamly.Internal.Data.Stream.Common as SP--- import qualified Streamly.Internal.Data.SVar as S--import Streamly.Benchmark.Common-import Gauge (bgroup, Benchmark, defaultMain)--value :: Int-value = 100000-{--value2, value3, value16, maxValue :: Int-value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop-value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop-value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop-maxValue = value--}------------------------------------------------------------------------------------ Benchmark ops-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.Stream m a--{-# INLINE sourceUnfoldr #-}-sourceUnfoldr :: Monad m => Int -> Stream m Int-sourceUnfoldr n = S.unfoldr step n- where- step cnt =- if cnt > n + value- then Nothing- else Just (cnt, cnt + 1)--{--{-# INLINE sourceUnfoldrN #-}-sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int-sourceUnfoldrN m n = S.unfoldr step n- where- step cnt =- if cnt > n + m- then Nothing- else Just (cnt, cnt + 1)--}--{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: Monad m => Int -> Stream m Int-sourceUnfoldrM n = S.unfoldrM step n- where- step cnt =- if cnt > n + value- then return Nothing- else return (Just (cnt, cnt + 1))--{--{-# INLINE sourceUnfoldrMN #-}-sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int-sourceUnfoldrMN m n = S.unfoldrM step n- where- step cnt =- if cnt > n + m- then return Nothing- else return (Just (cnt, cnt + 1))--}--{--{-# INLINE sourceFromEnum #-}-sourceFromEnum :: Monad m => Int -> Stream m Int-sourceFromEnum n = S.enumFromStepN n 1 value--}--{--{-# INLINE sourceFromFoldable #-}-sourceFromFoldable :: Int -> Stream m Int-sourceFromFoldable n = S.fromFoldable [n..n+value]--}--{--{-# INLINE sourceFromFoldableM #-}-sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int-sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])--}--{--{-# INLINE sourceFoldMapWith #-}-sourceFoldMapWith :: Int -> Stream m Int-sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]--{-# INLINE sourceFoldMapWithM #-}-sourceFoldMapWithM :: Monad m => Int -> Stream m Int-sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]--}------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.drain--- runStream = S.mapM_ (\_ -> return ())--{--{-# INLINE mapM_ #-}-mapM_ :: Monad m => Stream m a -> m ()-mapM_ = S.mapM_ (\_ -> return ())--}--{-# INLINE toNull #-}-toNull :: Monad m => Stream m Int -> m ()-toNull = runStream--{-# INLINE uncons #-}-uncons :: Monad m => Stream m Int -> m ()-uncons s = do- r <- S.uncons s- case r of- Nothing -> return ()- Just (_, t) -> uncons t--{--{-# INLINE init #-}-init :: (Monad m, S.IsStream t) => t m a -> m ()-init s = do- t <- S.init s- P.mapM_ S.drain t--{-# INLINE tail #-}-tail :: (Monad m, S.IsStream t) => t m a -> m ()-tail s = S.tail s >>= P.mapM_ tail--{-# INLINE nullTail #-}-{-# INLINE headTail #-}-{-# INLINE zip #-}-nullTail, headTail, zip- :: Monad m- => Stream m Int -> m ()--nullTail s = do- r <- S.null s- when (not r) $ S.tail s >>= P.mapM_ nullTail--headTail s = do- h <- S.head s- when (isJust h) $ S.tail s >>= P.mapM_ headTail--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-toList = S.toList--{-# INLINE foldl #-}-foldl :: Monad m => Stream m Int -> m Int-foldl = S.foldl' (+) 0--{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)-last = S.last--}------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{--{-# INLINE transform #-}-transform :: Monad m => Stream m a -> m ()-transform = runStream--{-# INLINE composeN #-}-composeN- :: Monad m- => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-composeN n f =- case n of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined--}--{--{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE fmap #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropOne #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE dropWhileFalse #-}-{-# INLINE foldlS #-}-{-# INLINE concatMap #-}-scan, map, fmap, filterEven, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,- dropWhileTrue, dropWhileFalse, foldlS, concatMap- :: Monad m- => Int -> Stream m Int -> m ()--{-# INLINE mapM #-}-{-# INLINE mapMSerial #-}-{-# INLINE intersperse #-}-mapM, mapMSerial, intersperse- :: S.MonadAsync m => Int -> Stream m Int -> m ()--scan n = composeN n $ S.scanl' (+) 0-map n = composeN n $ P.fmap (+1)-fmap n = composeN n $ P.fmap (+1)-mapM n = composeN n $ S.mapM return-mapMSerial n = composeN n $ S.mapMSerial return-filterEven n = composeN n $ S.filter even-filterAllOut n = composeN n $ S.filter (> maxValue)-filterAllIn n = composeN n $ S.filter (<= maxValue)-takeOne n = composeN n $ S.take 1-takeAll n = composeN n $ S.take maxValue-takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)-dropOne n = composeN n $ S.drop 1-dropAll n = composeN n $ S.drop maxValue-dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)-dropWhileFalse n = composeN n $ S.dropWhile (<= 1)-foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil--- We use a (sqrt n) element stream as source and then concat the same stream--- for each element to produce an n element stream.-concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)-intersperse n = composeN n $ S.intersperse maxValue------------------------------------------------------------------------------------ Iteration----------------------------------------------------------------------------------iterStreamLen, maxIters :: Int-iterStreamLen = 10-maxIters = 10000--{-# INLINE iterateSource #-}-iterateSource- :: S.MonadAsync m- => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int-iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)- where- f (0 :: Int) m = g m- f x m = g (f (x P.- 1) m)--{-# INLINE iterateMapM #-}-{-# INLINE iterateScan #-}-{-# INLINE iterateFilterEven #-}-{-# INLINE iterateTakeAll #-}-{-# INLINE iterateDropOne #-}-{-# INLINE iterateDropWhileFalse #-}-{-# INLINE iterateDropWhileTrue #-}-iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,- iterateDropWhileFalse, iterateDropWhileTrue- :: S.MonadAsync m- => Int -> Stream m Int---- this is quadratic-iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)-iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))- (maxIters `div` 10)--iterateMapM = iterateSource (S.mapM return) maxIters-iterateFilterEven = iterateSource (S.filter even) maxIters-iterateTakeAll = iterateSource (S.take maxValue) maxIters-iterateDropOne = iterateSource (S.drop 1) maxIters-iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters------------------------------------------------------------------------------------ Zipping and concat----------------------------------------------------------------------------------zip src = transform $ S.zipWith (,) src src--{-# INLINE concatMapRepl4xN #-}-concatMapRepl4xN :: Monad m => Stream m Int -> m ()-concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)------------------------------------------------------------------------------------ Mixed Composition----------------------------------------------------------------------------------{-# INLINE scanMap #-}-{-# INLINE dropMap #-}-{-# INLINE dropScan #-}-{-# INLINE takeDrop #-}-{-# INLINE takeScan #-}-{-# INLINE takeMap #-}-{-# INLINE filterDrop #-}-{-# INLINE filterTake #-}-{-# INLINE filterScan #-}-{-# INLINE filterMap #-}-scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,- filterTake, filterScan, filterMap- :: Monad m => Int -> Stream m Int -> m ()--scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1-takeDrop n = composeN n $ S.drop 1 . S.take maxValue-takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue-takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue-filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)-filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)-filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)------------------------------------------------------------------------------------ Nested Composition----------------------------------------------------------------------------------{-# INLINE toNullApNested #-}-toNullApNested :: Monad m => Stream m Int -> m ()-toNullApNested s = runStream $ do- (+) <$> s <*> s--{-# INLINE toNullNested #-}-toNullNested :: Monad m => Stream m Int -> m ()-toNullNested s = runStream $ do- x <- s- y <- s- return $ x + y--{-# INLINE toNullNested3 #-}-toNullNested3 :: Monad m => Stream m Int -> m ()-toNullNested3 s = runStream $ do- x <- s- y <- s- z <- s- return $ x + y + z--{-# INLINE filterAllOutNested #-}-filterAllOutNested- :: Monad m- => Stream m Int -> m ()-filterAllOutNested str = runStream $ do- x <- str- y <- str- let s = x + y- if s < 0- then return s- else S.nil--{-# INLINE filterAllInNested #-}-filterAllInNested- :: Monad m- => Stream m Int -> m ()-filterAllInNested str = runStream $ do- x <- str- y <- str- let s = x + y- if s > 0- then return s- else S.nil------------------------------------------------------------------------------------ Nested Composition Pure lists----------------------------------------------------------------------------------{-# INLINE sourceUnfoldrList #-}-sourceUnfoldrList :: Int -> Int -> [Int]-sourceUnfoldrList maxval n = List.unfoldr step n- where- step cnt =- if cnt > n + maxval- then Nothing- else Just (cnt, cnt + 1)--{-# INLINE toNullApNestedList #-}-toNullApNestedList :: [Int] -> [Int]-toNullApNestedList s = (+) <$> s <*> s--{-# INLINE toNullNestedList #-}-toNullNestedList :: [Int] -> [Int]-toNullNestedList s = do- x <- s- y <- s- return $ x + y--{-# INLINE toNullNestedList3 #-}-toNullNestedList3 :: [Int] -> [Int]-toNullNestedList3 s = do- x <- s- y <- s- z <- s- return $ x + y + z--{-# INLINE filterAllOutNestedList #-}-filterAllOutNestedList :: [Int] -> [Int]-filterAllOutNestedList str = do- x <- str- y <- str- let s = x + y- if s < 0- then return s- else []--{-# INLINE filterAllInNestedList #-}-filterAllInNestedList :: [Int] -> [Int]-filterAllInNestedList str = do- x <- str- y <- str- let s = x + y- if s > 0- then return s- else []--}------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Stream.StreamDK"--o_1_space :: [Benchmark]-o_1_space =- [ bgroup (o_1_space_prefix moduleName)- [ bgroup "generation"- [ benchFold "unfoldr" toNull sourceUnfoldr- , benchFold "unfoldrM" toNull sourceUnfoldrM- ]- , bgroup "elimination"- [ benchFold "toNull" toNull sourceUnfoldrM- , benchFold "uncons" uncons sourceUnfoldrM- ]- ]- ]--main :: IO ()-main = defaultMain $ concat [o_1_space]
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs view
@@ -21,22 +21,23 @@ 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 System.Random (randomRIO) import Prelude hiding- ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate+ ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate , repeat, replicate ) import qualified Prelude as P import qualified Data.List as List -import qualified Streamly.Internal.Data.Stream.StreamK.Type as S-import qualified Streamly.Internal.Data.Stream.StreamK as S+import qualified Streamly.Internal.Data.StreamK as S -import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain) import Streamly.Benchmark.Common @@ -167,15 +168,15 @@ {-# INLINE fromFoldableM #-} fromFoldableM :: Monad m => Int -> Int -> Stream m Int fromFoldableM streamLen n =- Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])+ List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen]) {-# INLINABLE concatMapFoldableWith #-}-concatMapFoldableWith :: Foldable f+concatMapFoldableWith :: P.Foldable f => (Stream m b -> Stream m b -> Stream m b) -> (a -> Stream m b) -> f a -> Stream m b-concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil+concatMapFoldableWith f g = P.foldr (f . g) S.nil {-# INLINE concatMapFoldableSerial #-} concatMapFoldableSerial :: Int -> Int -> Stream m Int@@ -633,7 +634,7 @@ ------------------------------------------------------------------------------- moduleName :: String-moduleName = "Data.Stream.StreamK"+moduleName = "Data.StreamK" o_1_space_generation :: Int -> Benchmark o_1_space_generation streamLen =
+ benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs view
@@ -0,0 +1,455 @@+{-# OPTIONS_GHC -Wno-deprecations #-}++-- |+-- 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 $ concat [o_1_space]
benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs view
@@ -1,5 +1,5 @@ -- |--- Module : Streamly.Benchmark.Data.Stream.StreamK+-- Module : Streamly.Benchmark.Data.StreamK -- Copyright : (c) 2018 Composewell Technologies -- -- License : BSD3@@ -33,12 +33,11 @@ import qualified Prelude as P -- import qualified Data.List as List -import qualified Streamly.Internal.Data.Stream.StreamK.Type as S-import qualified Streamly.Internal.Data.Stream.StreamK as S-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.StreamK as S+import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Fold as Fold -import Gauge (bgroup, Benchmark, defaultMain)+import Test.Tasty.Bench (bgroup, Benchmark, defaultMain) import Streamly.Benchmark.Common
benchmark/Streamly/Benchmark/Data/Stream/Transform.hs view
@@ -43,22 +43,22 @@ import qualified Streamly.Internal.Data.Stream.IsStream as Stream import Streamly.Internal.Data.Time.Units #else-import Streamly.Internal.Data.Stream.StreamD (Stream)-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import Streamly.Internal.Data.Stream (Stream)+import qualified Streamly.Internal.Data.Stream as Stream #ifndef USE_STREAMLY_CORE-import qualified Streamly.Internal.Data.Stream.Time as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream #endif #ifdef USE_STREAMK import Control.DeepSeq (NFData(..)) import Data.Functor.Identity (Identity(..)) import qualified Prelude import qualified Streamly.Internal.Data.Fold as Fold-import Streamly.Internal.Data.Stream.StreamK (StreamK)-import qualified Streamly.Internal.Data.Stream.StreamK as StreamK+import Streamly.Internal.Data.StreamK (StreamK)+import qualified Streamly.Internal.Data.StreamK as StreamK #endif #endif -import Gauge+import Test.Tasty.Bench import Stream.Common hiding (scanl') import Streamly.Benchmark.Common import Prelude hiding (sequence, mapM)
benchmark/Streamly/Benchmark/Data/Unfold.hs view
@@ -31,17 +31,18 @@ import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Unfold as UF-import qualified Streamly.Internal.Data.Unfold.Exception as UF-import qualified Streamly.Internal.Data.Stream.StreamD as S-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K+import qualified Streamly.Internal.Data.Unfold.Prelude 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 Gauge hiding (env)+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 @@ -776,7 +777,11 @@ 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 @@ -792,7 +797,11 @@ 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
benchmark/Streamly/Benchmark/FileSystem/Handle.hs view
@@ -22,7 +22,7 @@ import qualified Handle.ReadWrite as RW import qualified Handle.Read as RO -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Prelude hiding (last, length) import Streamly.Benchmark.Common
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs view
@@ -33,23 +33,23 @@ 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.Array.Type as AT+import qualified Streamly.Internal.Data.Array as AT import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Stream.StreamD as IP+import qualified Streamly.Internal.Data.Stream as IP import qualified Streamly.Internal.FileSystem.Handle as IFH import qualified Streamly.Internal.Unicode.Stream as IUS import qualified Streamly.Data.Stream.Prelude as S import qualified Streamly.Unicode.Stream as SS -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Prelude hiding (last, length) import Streamly.Benchmark.Common.Handle #ifdef INSPECTION-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), FoldMany)+import Streamly.Internal.Data.Stream (Step(..), FoldMany) -import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.MutArray as MA+import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Unfold as IUF import Test.Inspection
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs view
@@ -34,16 +34,16 @@ import qualified Streamly.Data.Array as A import qualified Streamly.Data.Stream.Prelude as S -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common.Handle #ifdef INSPECTION-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))+import Streamly.Internal.Data.Stream (Step(..)) -import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Tuple.Strict as Strict-import qualified Streamly.Internal.Data.Array.Mut.Stream as MAS-import qualified Streamly.Internal.Data.Array.Type as AT+import qualified Streamly.Internal.Data.MutArray.Stream as MAS+import qualified Streamly.Internal.Data.Array as AT import Test.Inspection #endif
benchmark/Streamly/Benchmark/Prelude/Adaptive.hs view
@@ -10,7 +10,7 @@ import Control.Concurrent (threadDelay) import Control.Monad (when) import Control.Monad.IO.Class (liftIO)-import Gauge+import Test.Tasty.Bench import Streamly.Prelude as S import System.Random (randomRIO)
benchmark/Streamly/Benchmark/Prelude/Ahead.hs view
@@ -15,7 +15,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench moduleName :: String moduleName = "Prelude.Ahead"
benchmark/Streamly/Benchmark/Prelude/Async.hs view
@@ -16,7 +16,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench moduleName :: String moduleName = "Prelude.Async"
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs view
@@ -15,7 +15,7 @@ , fromWAsync, parallel, fromParallel ) -import Gauge+import Test.Tasty.Bench import qualified Streamly.Prelude as S -------------------------------------------------------------------------------
benchmark/Streamly/Benchmark/Prelude/Merge.hs view
@@ -30,13 +30,13 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif moduleName :: String
benchmark/Streamly/Benchmark/Prelude/Parallel.hs view
@@ -22,7 +22,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench moduleName :: String moduleName = "Prelude.Parallel"
benchmark/Streamly/Benchmark/Prelude/Rate.hs view
@@ -14,7 +14,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench moduleName :: String moduleName = "Prelude.Rate"
benchmark/Streamly/Benchmark/Prelude/WAsync.hs view
@@ -15,7 +15,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench moduleName :: String moduleName = "Prelude.WAsync"
benchmark/Streamly/Benchmark/Prelude/WSerial.hs view
@@ -29,13 +29,13 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif moduleName :: String
benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs view
@@ -15,7 +15,7 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude -import Gauge+import Test.Tasty.Bench moduleName :: String moduleName = "Prelude.ZipAsync"
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs view
@@ -29,13 +29,13 @@ import Streamly.Benchmark.Common import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM) -import Gauge+import Test.Tasty.Bench #ifdef INSPECTION import GHC.Types (SPEC(..)) import Test.Inspection -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D #endif moduleName :: String
benchmark/Streamly/Benchmark/Unicode/Char.hs view
@@ -16,7 +16,7 @@ import Streamly.Internal.Data.Array (Array) import System.FilePath (dropExtensions, takeFileName) import System.FilePath.Posix ((</>))-import Gauge.Main (Benchmark, bench, bgroup, defaultMain, env, nfIO)+import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, env, nfIO) import Streamly.Internal.Unicode.Char ( NormalizationMode(NFC, NFD, NFKC, NFKD) , normalize@@ -24,7 +24,7 @@ import Streamly.Benchmark.Common (o_1_space_prefix) import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Stream.StreamD as IsStream+import qualified Streamly.Internal.Data.Stream as IsStream import qualified System.Directory as Dir --------------------------------------------------------------------------------
+ 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
@@ -11,6 +11,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} +#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif+ #ifdef __HADDOCK_VERSION__ #undef INSPECTION #endif@@ -27,22 +32,22 @@ import qualified Streamly.Data.Array as Array import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.FileSystem.Handle as Handle import qualified Streamly.Internal.Unicode.Array as UnicodeArr import qualified Streamly.Internal.Unicode.Stream as Unicode -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common import Streamly.Benchmark.Common.Handle #ifdef INSPECTION-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))-import qualified Streamly.Internal.Data.Fold.Type as Fold+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Internal.Data.Stream (Step(..))+import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Tuple.Strict as Strict-import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.Array as Array import Test.Inspection #endif@@ -280,7 +285,8 @@ _copyStreamUtf8'Fold inh outh = Stream.fold (Handle.write outh) $ Unicode.encodeUtf8- $ Stream.foldMany Unicode.writeCharUtf8'+ $ Stream.catRights+ $ Stream.parseMany Unicode.writeCharUtf8' $ Stream.unfold Handle.reader inh {-# NOINLINE _copyStreamUtf8Parser #-}@@ -317,6 +323,7 @@ main :: IO () main = do+#ifndef FUSION_CHECK env <- mkHandleBenchEnv defaultMain (allBenchmarks env) @@ -329,3 +336,13 @@ , o_1_space_decode_encode_read env ] ]+#else+ -- Enable FUSION_CHECK macro at the beginning of the file+ -- Enable one benchmark below, and run the benchmark+ -- Check the .dump-simpl output+ env <- mkHandleBenchEnv+ let mkHandles (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh+ (Handles inh outh) <- getHandles env mkHandles+ copyStreamLatin1' inh outh+ return ()+#endif
benchmark/Streamly/Benchmark/Unicode/Utf8.hs view
@@ -13,7 +13,7 @@ import Data.Char (chr) import Streamly.Internal.Unicode.Utf8 (Utf8) -import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common import qualified Streamly.Internal.Unicode.Utf8 as Utf8
benchmark/bench-runner/Main.hs view
@@ -16,9 +16,11 @@ benchName = drop 4 benchName0 general- | "o-1-sp" `isInfixOf` benchName = "-K36K -M16M"+ -- 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"- | "o-n-st" `isInfixOf` benchName = "-K1M -M16M"+ -- 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 = "" @@ -27,6 +29,17 @@ | 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"@@ -57,12 +70,18 @@ -- GHC 9.4.4 requires 4M | "Data.Stream.StreamDK/o-n-space.traversable." `isPrefixOf` benchName = "-K4M"+ -- GHC-9.6 requires 64M, earlier it was 32M+ | "Data.Stream.StreamDK/o-n-heap.buffered.readsPrec pure streams" == benchName =+ "-M64M"+ -- GHC-9.6 requires 64M, earlier it was 32M+ | "Data.Stream.StreamDK/o-n-heap.buffered.showPrec Haskell lists" == benchName =+ "-M64M" ----------------------------------------------------------------------- - | "Data.Stream.StreamD/o-n-space.elimination.toList" == benchName =+ | "Data.StreamD/o-n-space.elimination.toList" == benchName = "-K2M"- | "Data.Stream.StreamK/o-n-space.elimination.toList" == benchName =+ | "Data.StreamK/o-n-space.elimination.toList" == benchName = "-K2M" -----------------------------------------------------------------------@@ -74,6 +93,13 @@ | "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 = "-M1024M" | "Data.Stream.ConcurrentEager/o-1-space."@@ -86,10 +112,12 @@ | "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 = "-M32M"+ && "/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 = "-M32M"+ `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@@ -98,7 +126,7 @@ `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.Parser.ParserK/o-1-space"+ | "Data.ParserK/o-1-space" `isPrefixOf` benchName = "-K4M -M256M" -----------------------------------------------------------------------
benchmark/lib/Streamly/Benchmark/Common.hs view
@@ -54,9 +54,9 @@ import System.Random (randomRIO) import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamD as S+import qualified Streamly.Internal.Data.Stream as S -import Gauge+import Test.Tasty.Bench ------------------------------------------------------------------------------- -- Benchmark Prefixes
benchmark/lib/Streamly/Benchmark/Common/Handle.hs view
@@ -30,6 +30,8 @@ , isSpace , isSp , mkHandleBenchEnv+ , Handles(..)+ , getHandles ) where @@ -46,7 +48,7 @@ import Data.IORef import Prelude hiding (last, length)-import Gauge hiding (env)+import Test.Tasty.Bench hiding (env) scratchDir :: String
benchmark/lib/Streamly/Benchmark/Prelude.hs view
@@ -82,7 +82,7 @@ import qualified Streamly.Internal.Data.Pipe as Pipe import qualified Streamly.Internal.Data.Stream.Serial as Serial -import Gauge+import Test.Tasty.Bench import Streamly.Internal.Data.Time.Units -- Common polymorphic stream APIs used across multiple stream modules
benchmark/streamly-benchmarks.cabal view
@@ -54,11 +54,6 @@ manual: True default: True -flag use-gauge- description: Use gauge instead of tasty-bench for benchmarking- manual: True- default: False- flag use-streamly-core description: Benchmark only core package manual: True@@ -145,6 +140,10 @@ -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 @@ -152,15 +151,17 @@ ghc-options: -Wmissed-specialisations -Wall-missed-specialisations - if flag(dev) || flag(debug)- ghc-options: -fno-ignore-asserts- common optimization-options if flag(opt) ghc-options: -O2 -fdicts-strict -fspec-constr-recursive=16 -fmax-worker-args=16++ -- For this to be effective it must come after the -O2 option+ if flag(dev) || flag(debug)+ ghc-options: -fno-ignore-asserts+ if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6) ghc-options: -fplugin Fusion.Plugin else@@ -174,43 +175,34 @@ -- 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.18- , deepseq >= 1.4.1 && < 1.5- , mtl >= 2.2 && < 2.3+ base >= 4.9 && < 4.20+ , deepseq >= 1.4.1 && < 1.6+ , mtl >= 2.2 && < 2.3.2 -- other libraries+ , exceptions >= 0.8 && < 0.11 , random >= 1.0 && < 2.0 , transformers >= 0.4 && < 0.7- , containers >= 0.5 && < 0.7+ , containers >= 0.5 && < 0.8 , hashable >= 1.3 && < 1.5 , unordered-containers >= 0.2 && < 0.3 , process >= 1.4 && < 1.7 , directory >= 1.2.2 && < 1.4 , filepath >= 1.4.1 && < 1.5- , ghc-prim >= 0.4 && < 0.10+ , ghc-prim >= 0.4 && < 0.12+ , tasty-bench >= 0.3 && < 0.4+ , tasty >= 1.4.1 && < 1.6+ , streamly-core - if flag(use-streamly-core)- build-depends: streamly-core- else+ if !flag(use-streamly-core) build-depends: streamly- , streamly-core - if flag(use-gauge)- build-depends: gauge >= 0.2.4 && < 0.3- else- build-depends: tasty-bench >= 0.3 && < 0.4- , tasty >= 1.4.1 && < 1.5- mixins: tasty-bench- (Test.Tasty.Bench as Gauge- , Test.Tasty.Bench as Gauge.Main- )- if flag(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.20- , inspection-testing >= 0.4 && < 0.5+ build-depends: template-haskell >= 2.14 && < 2.22+ , inspection-testing >= 0.4 && < 0.6 -- Array uses a Storable constraint in dev build making several inspection -- tests fail if flag(dev) && flag(inspection)@@ -356,7 +348,35 @@ else buildable: True +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.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.Unfold import: bench-options type: exitcode-stdio-1.0@@ -401,12 +421,13 @@ if flag(dev) ghc-options: +RTS -M3000M -RTS else- ghc-options: +RTS -M1000M -RTS+ ghc-options: +RTS -M2000M -RTS -benchmark Data.Parser.ParserK+benchmark Data.ParserK import: bench-options type: exitcode-stdio-1.0- hs-source-dirs: Streamly/Benchmark/Data/Parser+ hs-source-dirs: Streamly/Benchmark/Data+ cpp-options: -DBENCH_SINGULAR main-is: ParserK.hs if impl(ghcjs) buildable: False@@ -414,27 +435,35 @@ buildable: True build-depends: exceptions >= 0.8 && < 0.11 --- Note: to use this we have to set DISABLE_FUSION in ParserD.hs so that--- the rewrite rules are disabled. We can also use the "no-fusion" build--- flag but we need to keep in mind that it disables fusion for streams--- as well.-benchmark Data.Parser.FromParserK+benchmark Data.ParserK.Chunked import: bench-options type: exitcode-stdio-1.0- hs-source-dirs: Streamly/Benchmark/Data/Parser- cpp-options: -DFROM_PARSERK+ hs-source-dirs: Streamly/Benchmark/Data+ cpp-options: -DBENCH_CHUNKED main-is: ParserK.hs- if flag(use-streamly-core) || impl(ghcjs)+ 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+ ------------------------------------------------------------------------------- -- Raw Streams ------------------------------------------------------------------------------- -benchmark Data.Stream.StreamD+benchmark Data.StreamD import: bench-options type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Data/Stream@@ -442,7 +471,7 @@ if impl(ghcjs) buildable: False -benchmark Data.Stream.StreamK+benchmark Data.StreamK import: bench-options type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Data/Stream@@ -458,11 +487,11 @@ if !flag(dev) || impl(ghcjs) buildable: False -benchmark Data.Stream.StreamK.Alt+benchmark Data.StreamK.Alt import: bench-options type: exitcode-stdio-1.0 hs-source-dirs: Streamly/Benchmark/Data/Stream- main-is: StreamDK.hs+ main-is: StreamKAlt.hs if !flag(dev) || impl(ghcjs) buildable: False @@ -651,10 +680,10 @@ if flag(limit-build-mem) ghc-options: +RTS -M1500M -RTS -benchmark Data.Array.Mut+benchmark Data.MutArray import: bench-options type: exitcode-stdio-1.0- main-is: Streamly/Benchmark/Data/Array/Mut.hs+ main-is: Streamly/Benchmark/Data/MutArray.hs if flag(limit-build-mem) ghc-options: +RTS -M1500M -RTS if flag(use-streamly-core)@@ -741,3 +770,9 @@ buildable: False else buildable: True++benchmark Unicode.Parser+ import: bench-options+ type: exitcode-stdio-1.0+ hs-source-dirs: Streamly/Benchmark/Unicode+ main-is: Parser.hs
configure view
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.71 for streamly 0.9.0.+# Generated by GNU Autoconf 2.71 for streamly 0.10.0. # # Report bugs to <streamly@composewell.com>. #@@ -610,8 +610,8 @@ # Identity of this package. PACKAGE_NAME='streamly' PACKAGE_TARNAME='streamly'-PACKAGE_VERSION='0.9.0'-PACKAGE_STRING='streamly 0.9.0'+PACKAGE_VERSION='0.10.0'+PACKAGE_STRING='streamly 0.10.0' PACKAGE_BUGREPORT='streamly@composewell.com' PACKAGE_URL='https://streamly.composewell.com' @@ -1224,7 +1224,7 @@ # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF-\`configure' configures streamly 0.9.0 to adapt to many kinds of systems.+\`configure' configures streamly 0.10.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1286,7 +1286,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in- short | recursive ) echo "Configuration of streamly 0.9.0:";;+ short | recursive ) echo "Configuration of streamly 0.10.0:";; esac cat <<\_ACEOF @@ -1372,7 +1372,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF-streamly configure 0.9.0+streamly configure 0.10.0 generated by GNU Autoconf 2.71 Copyright (C) 2021 Free Software Foundation, Inc.@@ -1500,7 +1500,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by streamly $as_me 0.9.0, which was+It was created by streamly $as_me 0.10.0, which was generated by GNU Autoconf 2.71. Invocation command line was $ $0$ac_configure_args_raw@@ -3800,7 +3800,7 @@ # 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.9.0, which was+This file was extended by streamly $as_me 0.10.0, which was generated by GNU Autoconf 2.71. Invocation command line was CONFIG_FILES = $CONFIG_FILES@@ -3856,7 +3856,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-streamly config.status 0.9.0+streamly config.status 0.10.0 configured by $0, generated by GNU Autoconf 2.71, with options \\"\$ac_cs_config\\"
configure.ac view
@@ -3,7 +3,7 @@ # See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on # the macros used in this file. -AC_INIT([streamly], [0.9.0], [streamly@composewell.com], [streamly], [https://streamly.composewell.com])+AC_INIT([streamly], [0.10.0], [streamly@composewell.com], [streamly], [https://streamly.composewell.com]) # To suppress "WARNING: unrecognized options: --with-compiler" AC_ARG_WITH([compiler], [GHC])
docs/Developer/MAINTAINING.md view
@@ -158,14 +158,11 @@ * Run packcheck on the uploaded package. To get the latest uploaded version from hackage, run `cabal unpack <package-name>`. You might have to run `cabal update`.- * Create a git tag corresponding to the release where X.Y.Z is the new- package version (`git tag vX.Y.Z && git push -f origin vX.Y.Z`).+ * 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- * Optionally upload `package-X.Y.Z-sdist.tar.gz` to github release page- * `gh release create vX.Y.Z --title "vX.Y.Z"`- * `gh release upload vX.Y.Z package-X.Y.Z-sdist.tar.gz`- * Update release contributors on github release page- (`git shortlog -s prev_tag..new_tag | sed $'s/^[0-9 \t]*/* /' | sort -f`) * Update and if needed release streaming-benchmarks package * Check https://matrix.hackage.haskell.org/package/streamly * Check haddocks on Hackage, upload if not built
docs/Developer/module-organization.md view
@@ -225,7 +225,7 @@ Mutable arrays are a generalization of immutable arrays: -* `Streamly.Data.Array.Mut`+* `Streamly.Data.MutArray` * `Streamly.Data.Array.Storable.Mut` * `Streamly.Data.Array.Storable.Pinned.Mut` * ...
docs/Developer/optimization-guidelines.md view
@@ -244,7 +244,7 @@ The combinators in `Streamly.Prelude` are defined in terms of combinators in `Streamly.Internal.Data.Stream.StreamD` (Direct style streams) or-`Streamly.Internal.Data.Stream.StreamK` (CPS style streams). We convert the+`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
+ 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/HowTo/Compiling.md view
@@ -4,8 +4,9 @@ ### Compiler (GHC) Versions -Do not use ghc 9.0.x and 9.2.1. For best performance use-`fusion-plugin` (see below) when compiling.+Do not use ghc 9.0.x and 9.2.1. GHC 9.6.x may have a small memory+leak issue in some concurrent stream cases, see below for more details.+For best performance use `fusion-plugin` (see below) when compiling. ### Memory requirements @@ -63,7 +64,8 @@ * `-fdicts-strict` is needed to avoid [a GHC issue](https://gitlab.haskell.org/ghc/ghc/issues/17745) leading to-memory leak in some cases.+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@@ -108,25 +110,36 @@ error: ld: framework not found Cocoa ``` -### Native build+#### 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+#### Nix build Please note that `cabal2nix` may not always be able to generate a complete nix expression on `macOS`. See [this issue](https://github.com/NixOS/cabal2nix/issues/470). -You may need to add ``nixpkgs.darwin.apple_sdk.frameworks.Cocoa`` to-your ``buildInputs`` or ``executableFrameworkDepends``. Something like-this:+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: ```-executableFrameworkDepends =- if builtins.currentSystem == "x86_64-darwin"- then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]- else [];+ 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/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.8.3.txt view
@@ -0,0 +1,261 @@+# API diff as generated by cabal-diff with minor edits.+# ~~~ means deprecated module+# ~~ means deprecated symbol++#----------------------------+# Changes from 0.8.0 to 0.8.1+#----------------------------++@@@ Streamly.FileSystem.Handle+++ getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)+++ putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()++#----------------------------+# Changes from 0.7.3 to 0.8.0+#----------------------------++# Deprecated, merged into Streamly.Prelude+~~~ Streamly+# Fixity changes+++ infixr 6 `ahead`+++ infixr 6 `async`+++ infixr 6 `parallel`+++ infixr 6 `serial`+++ infixr 6 `wAsync`+++ infixr 6 `wSerial`++# Added+@@@ Streamly.Console.Stdio++# Deprecated, renamed+~~~ Streamly.Memory.Array+@@@ Streamly.Data.Array.Foreign++# Moved from Streamly.Memory.Array+++ data Array a+++ fromList :: Storable a => [a] -> Array a+++ fromListN :: Storable a => Int -> [a] -> Array a+++ length :: forall a. Storable a => Array a -> Int+++ read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a+++ toList :: Storable a => Array a -> [a]+++ write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)+++ writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)++# Added+++ asBytes :: Array a -> Array Word8+++ cast :: forall a b. Storable b => Array a -> Maybe (Array b)+++ getIndex :: Storable a => Array a -> Int -> Maybe a+++ readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a+++ writeLastN :: (Storable a, MonadIO m) => Int -> Fold m a (Array a)++@@@ Streamly.Data.Fold+# Signature changed+ - product :: (Monad m, Num a) => Fold m a a+ + product :: (Monad m, Num a, Eq a) => Fold m a a++# Removed (Moved to the Streamly.Data.Fold.Tee module)+-- instance (Monad m, Floating b) => Floating (Fold m a b)+-- instance (Monad m, GHC.Num.Num b) => GHC.Num.Num (Fold m a b)+-- instance (Monad m, GHC.Real.Fractional b) => GHC.Real.Fractional (Fold m a b)+-- instance (Semigroup b, Monad m) => Semigroup (Fold m a b)+-- instance (Semigroup b, Monoid b, Monad m) => Monoid (Fold m a b)+-- instance Applicative m => Applicative (Fold m a)++# Renamed+~~ mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c+++ rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c++# Deprecated+~~ sequence :: Monad m => Fold m a (m b) -> Fold m a b++# Added+++ catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b+++ chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c+++ concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c+++ filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r+++ filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r+++ foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b+++ foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b+++ foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b+++ lmap :: (a -> b) -> Fold m b r -> Fold m a r+++ lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r+++ many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+++ mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r+++ rollingHash :: (Monad m, Enum a) => Fold m a Int64+++ rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64+++ sconcat :: (Monad m, Semigroup a) => a -> Fold m a a+++ serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+++ take :: Monad m => Int -> Fold m a b -> Fold m a b+++ takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+++ takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+++ teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+++ toListRev :: Monad m => Fold m a [a]++# Added+@@@ Streamly.Data.Fold.Tee++@@@ Streamly.Data.Unfold+# Added+++ crossWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+++ drop :: 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.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,164 @@+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.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,658 @@+# Changelog++<!-- See rendered changelog at https://streamly.composewell.com -->++## 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.3.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.8.3.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.8.3.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
+ docs/User/Project/Github.link view
@@ -0,0 +1,1 @@+https://github.com/composewell/streamly
+ docs/User/Project/README.md view
@@ -0,0 +1,140 @@+# [Streamly][]: Idiomatic Haskell with C-Like Performance++[](https://gitter.im/composewell/streamly)+[](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 [Streamly Getting Started+Guide](/docs/User/Tutorials/getting-started.md) and [Quick+Overview](/docs/User/Tutorials/quick-overview.md) 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/ProjectRelated/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/
+ docs/User/Project/Roadmap.link view
@@ -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,384 @@+# Upgrading to streamly 0.9.0++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 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)+```++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/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt
@@ -1,175 +0,0 @@-----------------------------------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/ProjectRelated/ApiChangelogs/0.8.3.txt
@@ -1,261 +0,0 @@-# API diff as generated by cabal-diff with minor edits.-# ~~~ means deprecated module-# ~~ means deprecated symbol--#-----------------------------# Changes from 0.8.0 to 0.8.1-#------------------------------@@@ Streamly.FileSystem.Handle-++ getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)-++ putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()--#-----------------------------# Changes from 0.7.3 to 0.8.0-#------------------------------# Deprecated, merged into Streamly.Prelude-~~~ Streamly-# Fixity changes-++ infixr 6 `ahead`-++ infixr 6 `async`-++ infixr 6 `parallel`-++ infixr 6 `serial`-++ infixr 6 `wAsync`-++ infixr 6 `wSerial`--# Added-@@@ Streamly.Console.Stdio--# Deprecated, renamed-~~~ Streamly.Memory.Array-@@@ Streamly.Data.Array.Foreign--# Moved from Streamly.Memory.Array-++ data Array a-++ fromList :: Storable a => [a] -> Array a-++ fromListN :: Storable a => Int -> [a] -> Array a-++ length :: forall a. Storable a => Array a -> Int-++ read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-++ toList :: Storable a => Array a -> [a]-++ write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)-++ writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)--# Added-++ asBytes :: Array a -> Array Word8-++ cast :: forall a b. Storable b => Array a -> Maybe (Array b)-++ getIndex :: Storable a => Array a -> Int -> Maybe a-++ readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-++ writeLastN :: (Storable a, MonadIO m) => Int -> Fold m a (Array a)--@@@ Streamly.Data.Fold-# Signature changed- - product :: (Monad m, Num a) => Fold m a a- + product :: (Monad m, Num a, Eq a) => Fold m a a--# Removed (Moved to the Streamly.Data.Fold.Tee module)--- instance (Monad m, Floating b) => Floating (Fold m a b)--- instance (Monad m, GHC.Num.Num b) => GHC.Num.Num (Fold m a b)--- instance (Monad m, GHC.Real.Fractional b) => GHC.Real.Fractional (Fold m a b)--- instance (Semigroup b, Monad m) => Semigroup (Fold m a b)--- instance (Semigroup b, Monoid b, Monad m) => Monoid (Fold m a b)--- instance Applicative m => Applicative (Fold m a)--# Renamed-~~ mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-++ rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c--# Deprecated-~~ sequence :: Monad m => Fold m a (m b) -> Fold m a b--# Added-++ catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b-++ chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c-++ concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c-++ filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r-++ filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r-++ foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b-++ foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b-++ foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b-++ lmap :: (a -> b) -> Fold m b r -> Fold m a r-++ lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r-++ many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-++ mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r-++ rollingHash :: (Monad m, Enum a) => Fold m a Int64-++ rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64-++ sconcat :: (Monad m, Semigroup a) => a -> Fold m a a-++ serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-++ take :: Monad m => Int -> Fold m a b -> Fold m a b-++ takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-++ takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-++ teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-++ toListRev :: Monad m => Fold m a [a]--# Added-@@@ Streamly.Data.Fold.Tee--@@@ Streamly.Data.Unfold-# Added-++ crossWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d-++ drop :: 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/ProjectRelated/CONTRIBUTORS.md
@@ -1,156 +0,0 @@-This is a list of code contributors to this library. For issue contributors-please see https://github.com/composewell/streamly/issues.--Use `git shortlog -sn tag1...tag2` on the git repository to get a list of-contributors between two repository tags.--## 0.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/ProjectRelated/Changelog.md
@@ -1,636 +0,0 @@-# Changelog--<!-- See rendered changelog at https://streamly.composewell.com -->--## 0.9.0 (Mar 2023)--Also see the following:--* [streamly-0.9.0 Upgrade Guide](/docs/User/ProjectRelated/Upgrading.md) or- https://hackage.haskell.org/package/streamly-0.9.0/docs/docs/User/ProjectRelated/Upgrading.md-* [streamly-0.9.0 API Changelog](/docs/User/ProjectRelated/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](/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 [upgrade guide](/docs/User/ProjectRelated/Upgrading.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.3.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/ProjectRelated/ApiChangelogs/0.8.3.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/ProjectRelated/ApiChangelogs/0.8.3.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/ProjectRelated/Credits.md
@@ -1,43 +0,0 @@-# Credits and Contributions--This library builds upon many good ideas from the existing body of Haskell-work. We would like to thank all the Haskellers whose work might have-influenced this library. It is not possible to quantify that contribution and-give proper credits for it. Below, we have listed the copyright attributions-and contributions to this library. We do due diligence in giving credit where-its due, if something got missed please do point out by [raising an issue on-github](https://github.com/composewell/streamly/issues) or [sending an email to-the maintainers](mailto:streamly@composewell.com).--## Attributions--See LICENSE for parts of other works included in this package.--## Contributions--See CONTRIBUTORS.md for a release wise list of contributors to this library.--## References--Some (among many others) of the Haskell packages that we looked at and might-have taken some ideas or inspiration from include:--* http://hackage.haskell.org/package/base--* https://hackage.haskell.org/package/logict-* https://hackage.haskell.org/package/list-transformer-* http://hackage.haskell.org/package/transient--* http://hackage.haskell.org/package/streaming-* http://hackage.haskell.org/package/machines-* https://hackage.haskell.org/package/simple-conduit-* http://hackage.haskell.org/package/pipes-* http://hackage.haskell.org/package/conduit--* http://hackage.haskell.org/package/vector-* http://hackage.haskell.org/package/bytestring-* http://hackage.haskell.org/package/text--* http://hackage.haskell.org/package/split-* https://hackage.haskell.org/package/foldl-* https://github.com/effectfully/prefolds
− docs/User/ProjectRelated/Github.link
@@ -1,1 +0,0 @@-https://github.com/composewell/streamly
− docs/User/ProjectRelated/README.md
@@ -1,134 +0,0 @@-# [Streamly][]: Idiomatic Haskell with C-Like Performance--[](https://gitter.im/composewell/streamly)-[](https://hackage.haskell.org/package/streamly)--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 [Streamly Setup and Usage-Guide](/docs/User/Tutorials/setup-and-usage.md) and [Quick-Overview](/docs/User/Tutorials/quick-overview.md) 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/ProjectRelated/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/
− docs/User/ProjectRelated/Roadmap.link
@@ -1,1 +0,0 @@-https://github.com/composewell/streamly/issues/1046
− docs/User/ProjectRelated/Upgrading.md
@@ -1,279 +0,0 @@-# Upgrading to streamly 0.9.0--Also see:--* [0.9.0 API Changelog](/docs/User/ProjectRelated/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.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-```--## 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.--`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.Stream.StreamK.tail->>> init = Streamly.Internal.Data.Stream.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 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)-```--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/before-you-begin.md view
@@ -9,10 +9,29 @@ lazy evaluation. The [Haskell wikibook](https://en.wikibooks.org/wiki/Haskell) may be a good place to start and get familiar with Haskell. +## Installing Haskell+ If you wish to follow along and run the examples in this tutorial, you will-need to have [Streamly][] installed. Please see the [Setup and-Usage](/docs/User/Tutorials/setup-and-usage.md) guide for instructions-on how to install and use [Streamly][].+need to have Haskell tool chain installed.++You can choose one of the following sections.++### Haskell Toolchain++To get started, you will need a fairly recent version (last 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+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][streamly-packages].++## 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).
+ docs/User/Tutorials/getting-started.md view
@@ -0,0 +1,225 @@+<!--+(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 `ghci` REPL, a simple+program or 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™ 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.++## 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.++## Next Steps++If you got this far successfully, congratulations! For an overview+of the `streamly` package, please read the [Streamly Quick+Overview](/docs/User/Tutorials/quick-overview.md).++<!-- 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/quick-overview.md view
@@ -44,8 +44,6 @@ `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.-* An `Unfold IO a b` is a representation of a function that converts a seed- value of type `a` into a stream of values of type `b` in the IO Monad. ## The Examples @@ -219,7 +217,7 @@ countArray :: Array Word8 -> IO Counts countArray arr =- Stream.unfold Array.reader arr -- Stream IO Word8+ Array.read arr -- Stream IO Word8 & Unicode.decodeLatin1 -- Stream IO Char & Stream.fold (Fold.foldl' count (Counts 0 0 0 True)) -- IO Counts ```@@ -335,9 +333,9 @@ -- connection is closed. lookupWords :: Socket -> IO () lookupWords sk =- Stream.unfold Socket.reader sk -- Stream IO Word8+ Socket.read sk -- Stream IO Word8 & Unicode.decodeLatin1 -- Stream IO Char- & Stream.parseMany word -- Stream IO String+ & 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@@ -346,7 +344,6 @@ where - word = Parser.wordBy isSpace Fold.toList cfg = Stream.ordered True serve :: Socket -> IO ()@@ -357,9 +354,9 @@ -- "nc" as a client to try it out. main :: IO () main =- Stream.unfold TCP.acceptorOnPort 8091 -- Stream IO Socket- & Stream.parMapM id serve -- Stream IO ()- & Stream.fold Fold.drain -- IO ()+ TCP.accept 8091 -- Stream IO Socket+ & Stream.parMapM id serve -- Stream IO ()+ & Stream.fold Fold.drain -- IO () ``` ### Merging Incoming Streams@@ -379,7 +376,6 @@ import Streamly.Data.Stream (Stream) import System.IO (IOMode(AppendMode), Handle, withFile) -import qualified Streamly.Data.Unfold as Unfold import qualified Streamly.Network.Socket as Socket import qualified Streamly.FileSystem.Handle as Handle @@ -388,9 +384,9 @@ -- buffering for safety. readLines :: Socket -> Stream IO (Array Char) readLines sk =- Stream.unfold Socket.reader sk -- Stream IO Word8- & Unicode.decodeLatin1 -- Stream IO Char- & Stream.foldMany line -- Stream IO (Array Char)+ Socket.read sk -- Stream IO Word8+ & Unicode.decodeLatin1 -- Stream IO Char+ & Stream.foldMany line -- Stream IO (Array Char) where @@ -405,7 +401,7 @@ -- streams at line boundaries and writes the merged stream to a file. server :: Handle -> IO () server file =- Stream.unfold TCP.acceptorOnPort 8090 -- Stream IO Socket+ TCP.accept 8090 -- Stream IO Socket & Stream.parConcatMap (Stream.eager True) recv -- Stream IO (Array Char) & Stream.unfoldMany Array.reader -- Stream IO Char & Unicode.encodeLatin1 -- Stream IO Word8@@ -478,6 +474,7 @@ If you would like to view more examples, please visit the [Streamly Examples][streamly-examples] web page. +<!-- ### Further Reading * [Streaming Benchmarks][streaming-benchmarks]@@ -485,6 +482,7 @@ * 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.
− docs/User/Tutorials/setup-and-usage.md
@@ -1,226 +0,0 @@-<!---(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 install Haskell and the `streamly` package,-and then use Streamly in a simple program.--<!-- 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™ 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.--## Installing Haskell--You can choose one of the following options.--### Installing the Haskell Toolchain--To get started, you will need a fairly recent version (last 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-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][streamly-packages].--## 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 --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.--This invocation also creates a skeletal `app/Main.hs` file which we-will now use to write our streamly based program.--### 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-...-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.--## Next Steps--If you got this far successfully, congratulations! For an overview-of the `streamly` package, please read the [Streamly Quick-Overview](/docs/User/Tutorials/quick-overview.md).--<!-- 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/streamly-docs.cabal view
@@ -6,7 +6,7 @@ -- * Documentation can be released independent of the library -- * We do not want too many doc modules in the main library name: streamly-docs-version: 0.9.0+version: 0.10.0 synopsis: Documentation for Streamly description: Documentation for Streamly build-type: Simple@@ -16,6 +16,7 @@ ------------------------------------------------------------------------------- extra-doc-files:+ *.md User/*.md User/Tutorials/*.md User/Tutorials/*.link@@ -23,10 +24,10 @@ User/HowTo/*.link User/Explanatory/*.md User/Explanatory/streaming-pradigms.rst- User/ProjectRelated/*.md- User/ProjectRelated/*.link- User/ProjectRelated/ApiChangelogs/0.8.3.txt- User/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt+ User/Project/*.md+ User/Project/*.link+ User/Project/ApiChangelogs/0.8.3.txt+ User/Project/ApiChangelogs/0.8.3-0.9.0.txt Developer/*.png Developer/*.md Developer/*.link@@ -42,7 +43,7 @@ User.Tutorials.ReactiveProgramming build-depends:- base >= 4.9 && < 4.18- , transformers >= 0.4 && < 0.6+ base >= 4.9 && < 4.20+ , transformers >= 0.4 && < 0.7 , streamly , streamly-core
− src/Streamly.hs
@@ -1,624 +0,0 @@-{-# OPTIONS_GHC -Wno-deprecations #-}---- |--- Module : Streamly--- Copyright : (c) 2017 Composewell Technologies------ License : BSD3--- Maintainer : streamly@composewell.com--- Stability : experimental--- Portability : GHC------ Streamly is a general purpose programming framework using cocnurrent data--- flow programming paradigm. It can be considered as a generalization of--- Haskell lists to monadic streaming with concurrent composition capability.--- The serial stream type in streamly @SerialT m a@ is like the list type @[a]@--- parameterized by the monad @m@. For example, @SerialT IO a@ is a moral--- equivalent of @[a]@ in the IO monad. Streams are constructed very much like--- lists, except that they use 'nil' and 'cons' instead of '[]' and ':'.------ @--- > import "Streamly"--- > import "Streamly.Prelude" (cons, consM)--- > import qualified "Streamly.Prelude" as S--- >--- > S.toList $ 1 \`cons` 2 \`cons` 3 \`cons` nil--- [1,2,3]--- @------ Unlike lists, streams can be constructed from monadic effects:------ @--- > S.'toList' $ 'getLine' \`consM` 'getLine' \`consM` S.'nil'--- hello--- world--- ["hello","world"]--- @------ Streams are processed just like lists, with list like combinators, except--- that they are monadic and work in a streaming fashion. Here is a simple--- console echo program example:------ @--- > S.drain $ S.repeatM getLine & S.mapM putStrLn--- @------ @SerialT Identity a@ is a moral equivalent of pure lists. Streamly utilizes--- fusion for high performance, therefore, we can represent and process strings--- as streams of 'Char', encode and decode the streams to/from UTF8 and--- serialize them to @Array Word8@ obviating the need for special purpose--- libraries like @bytestring@ and @text@.------ For more details--- please see the "Streamly.Tutorial" module and the examples directory in this--- package.--{-# LANGUAGE NoMonomorphismRestriction #-}--#include "inline.hs"--module Streamly {-# DEPRECATED "Please use \"Streamly.Prelude\" instead." #-}- (- -- -- * Concepts Overview- -- -- ** Streams- -- -- $streams-- -- -- ** Folds- -- -- $folds-- -- -- ** Arrays- -- -- $arrays-- -- * Module Overview- -- $streamtypes-- -- * Type Synonyms- MonadAsync-- -- * Stream transformers- -- | A stream represents a sequence of pure or effectful actions. The- -- `cons` and `consM` operations and the corresponding operators '.:' and- -- '|:' can be used to join pure values or effectful actions in a sequence.- -- The effects in the stream can be executed in many different ways- -- depending on the type of stream. In other words, the behavior of 'consM'- -- depends on the type of the stream.- --- -- There are three high level categories of streams, /spatially ordered/- -- streams, /speculative/ streams and /time ordered/ streams. Spatially- -- ordered streams, 'SerialT' and 'WSerialT', execute the effects in serial- -- order i.e. one at a time and present the outputs of those effects to the- -- consumer in the same order. Speculative streams, 'AheadT', may execute- -- many effects concurrently but present the outputs to the consumer in the- -- specified spatial order. Time ordered streams, 'AsyncT', 'WAsyncT' and- -- 'ParallelT', may execute many effects concurrently and present the- -- outputs of those effects to the consumer in time order i.e. as soon as- -- the output is generated.- --- -- We described above how the effects in a sequence are executed for- -- different types of streams. The behvavior of the 'Semigroup' and 'Monad'- -- instances follow the behavior of 'consM'. Stream generation operations- -- like 'repeatM' also execute the effects differently for different- -- streams, providing a concurrent generation capability when used with- -- stream types that execute effects concurrently. Similarly, effectful- -- transformation operations like 'mapM' also execute the transforming- -- effects differently for different types of streams.-- -- ** Serial Streams- -- $serial- , SerialT- , WSerialT-- -- ** Speculative Streams- -- $ahead- , AheadT-- -- ** Asynchronous Streams- -- $async- , AsyncT- , WAsyncT- , ParallelT-- -- ** Zipping Streams- -- $zipping- , ZipSerialM- , ZipAsyncM-- -- * Parallel Function Application- -- $application- , (IP.|$)- , (IP.|&)- , (IP.|$.)- , (IP.|&.)- , mkAsync-- -- * Merging Streams- -- $sum- , serial- , wSerial- , ahead- , async- , wAsync- , parallel-- -- * Concurrency Control- -- $concurrency- , maxThreads- , maxBuffer-- -- * Rate Limiting- , Rate (..)- , rate- , avgRate- , minRate- , maxRate- , constRate-- -- * Stream Type Adapters- -- $adapters- , IsStream ()-- , serially- , wSerially- , asyncly- , aheadly- , wAsyncly- , parallely- , zipSerially- , zipAsyncly- , adapt-- -- * IO Streams- , Serial- , WSerial- , Ahead- , Async- , WAsync- , Parallel- , ZipSerial- , ZipAsync-- -- ** Folding Containers of Streams- -- | These are variants of standard 'Foldable' fold functions that use a- -- polymorphic stream sum operation (e.g. 'async' or 'wSerial') to fold a- -- finite container of streams. Note that these are just special cases of- -- the more general 'concatMapWith' operation.- --- , foldWith- , foldMapWith- , forEachWith-- -- * Re-exports- , Semigroup (..)- -- * Deprecated- , runStream- )-where--import Data.Semigroup (Semigroup(..))-import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.SVar (Rate(..))-import Streamly.Internal.Data.Stream.Ahead-import Streamly.Internal.Data.Stream.Async-import Streamly.Internal.Data.Stream.IsStream.Combinators-import Streamly.Internal.Data.Stream.IsStream.Expand-import Streamly.Internal.Data.Stream.IsStream.Type--import qualified Streamly.Prelude as P-import qualified Streamly.Internal.Data.Stream.IsStream as IP-import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform---- XXX provide good succinct examples of pipelining, merging, splitting etc.--- below.------ $streams------ A program is expressed as a network of streams and folds. A stream is a--- source or generator of data elements and a fold is a consumer of data elements that--- reduces multiple input elements to a single value.------ In the following example, a 'Word8' stream is generated by using--- 'Streamly.FileSystem.Handle.read' on a file handle, then the--- 'Streamly.Prelude.splitBySuffix' transformation splits the stream on--- newlines (ascii value 10); it uses the 'Streamly.Data.Fold.drain' fold to reduce--- the resulting lines to unit values (@()@), 'Streamly.Prelude.length' fold--- then counts the unit elements in the resulting stream which gives us the--- number of lines in the file:------ > S.length $ S.splitOnSuffix FL.drain 10 $ FH.read fh------ The following example folds the lines to arrays of 'Word8' using the--- 'Streamly.Data.Array.Foreign.writeF' fold and then wraps the lines in square--- brackets before writing them to standard output using--- 'Streamly.FileSystem.Handle.write':------ > wrapLine ln = S.fromList "[" <> A.read ln <> S.fromList "]\n"--- > readLines = S.splitOnSuffix A.writeF 10--- > FH.write stdout $ S.concatMap wrapLine $ readLines fh1------ One stream can be appended after another:------ > FH.write stdout $ S.concatMap wrapLine $ readLines fh1 <> readLines fh2------ The following example reads two files concurrently, merges the lines from--- the two streams and writes the resulting stream to another file:------ > FH.write stdout $ S.concatMap wrapLine $ readLines fh1 `parallel` readLines fh2------ There are many ways to generate, merge, zip, transform and fold data--- streams. Many transformations can be chained in a stream pipeline. See--- "Streamly.Prelude" module for combinators to manipulate streams.---- $folds------ The way stream types in this module like 'SerialT' represent data sources,--- the same way the 'Fold' type from "Streamly.Data.Fold" represents data sinks or--- reducers of streams. Reducers can be combined to consume a stream source in--- many ways. The simplest is to reduce a stream source using a fold e.g.:------ > S.fold FL.length $ S.enumerateTo 100------ Folds are consumers of streams and can be used to split a stream into--- multiple independent flows. Grouping transforms a stream by applying a fold--- on segments of a stream, distributing applies multiple folds in parallel on--- the same stream and combines them, partitioning sends different elements of--- a stream to different folds, unzipping divides the elements of a stream into--- parts and sends them through different folds. Parsers are nothing but a--- particular type of folds. Transformations can be applied contravariantly on--- the input of a fold.------ @------ |---transform----Fold m a b--------|--- ---stream m a-->transform-->| |---f b c ...--- |---transform----Fold m a c--------|--- | |--- ...--- @------- $arrays------ Streamly arrays (See "Streamly.Data.Array.Foreign") complement streams to provide an--- efficient computing paradigm. Streams are suitable for immutable--- transformations of /potentially infinite/ data using /sequential access/ and--- pipelined transformations whereas arrays are suitable for in-place--- transformations of /necessarily finite/ data using /random access/. Streams--- are synonymous with /sequential pipelined processing/ whereas arrays are--- synonymous with /efficient buffering and random access/.------ In general, a data processing pipeline reads data from some IO device, does--- some processing on it and finally writes the output to another IO device.--- Streams provide the overall framework of sequential processing pipeline in--- which arrays are used as buffering elements in the middle. In addition to--- buffering in the middle, arrays can also be used at the boundaries of the--- pipeline to efficiently interface with external storage systems like memory,--- files and network. If streams are the pipes in a water pipeline network--- then arrays are like the storage tanks in the middle. On the input side,--- think of arrays as buckets to fetch water to feed the pipeline and on the--- output side buckets to remove the processed water.------ 'ByteString' data type from the 'bytestring' package and the 'Text' data--- type from the 'text' package are special cases of arrays. 'ByteString' is--- like @Array Word8@ and 'Text' is like @utf16@ encoded @Array Word8@.--- Streamly arrays can be transformed as efficiently as @bytestring@ or @text@--- by using stream operations on them.---- Streams and arrays are equally important in computing. They are computing--- duals of each other.---- $streamtypes--- The basic stream type is 'Serial', it represents a sequence of IO actions,--- and is a 'Monad'. The type 'SerialT' is a monad transformer that can--- represent a sequence of actions in an arbitrary monad. The type 'Serial' is--- in fact a synonym for @SerialT IO@. There are a few more types similar to--- 'SerialT', all of them represent a stream and differ only in the--- 'Semigroup', 'Applicative' and 'Monad' compositions of the stream. 'Serial'--- and 'WSerial' types compose serially whereas 'Async' and 'WAsync'--- types compose concurrently. All these types can be freely inter-converted--- using type combinators without any cost. You can freely switch to any type--- of composition at any point in the program. When no type annotation or--- explicit stream type combinators are used, the default stream type is--- inferred as 'Serial'.------ This module exports stream types, instances and combinators for:------ * converting between different stream types--- * appending and concurrently merging streams--- * Concurrency control--- * Concurrent function application--- * Stream rate control------ This module is designed to be imported unqualified:------ @--- import Streamly--- @------ See the "Streamly.Prelude" module for APIs for construction,--- generation, elimination and transformation of streams.----------------------------------------------------------------------------------- Eliminating a stream----------------------------------------------------------------------------------- | Same as "Streamly.Prelude.runStream".----{-# DEPRECATED runStream "Please use Streamly.Prelude.drain instead." #-}-runStream :: Monad m => SerialT m a -> m ()-runStream = P.drain--{---- | Same as "Streamly.Prelude.foldWith".----{-# DEPRECATED foldWith "Please use Streamly.Prelude.foldWith instead." #-}-{-# INLINABLE foldWith #-}-foldWith :: (IsStream t, Foldable f)- => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-foldWith = P.foldWith---- | Same as "Streamly.Prelude.foldMapWith".----{-# DEPRECATED foldMapWith "Please use Streamly.Prelude.foldMapWith instead." #-}-{-# INLINABLE foldMapWith #-}-foldMapWith :: (IsStream t, Foldable f)- => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-foldMapWith = P.foldMapWith---- | Same as "Streamly.Prelude.forEachWith".----{-# DEPRECATED forEachWith "Please use Streamly.Prelude.forEachWith instead." #-}-{-# INLINABLE forEachWith #-}-forEachWith :: (IsStream t, Foldable f)- => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-forEachWith = P.forEachWith--}---- XXX Deprecate it in 0.8.0------ | Make a stream asynchronous, triggers the computation and returns a stream--- in the underlying monad representing the output generated by the original--- computation. The returned action is exhaustible and must be drained once. If--- not drained fully we may have a thread blocked forever and once exhausted it--- will always return 'empty'.------ @since 0.2.0-{-# INLINABLE mkAsync #-}-mkAsync :: (IsStream t, MonadAsync m) => t m a -> m (t m a)-mkAsync = return . Transform.mkAsync----------------------------------------------------------------------------------- Documentation----------------------------------------------------------------------------------- $serial------ When a stream consumer demands an element from a serial stream constructed--- as @a \`consM` b \`consM` ... nil@, the action @a@ at the head of the stream--- sequence is executed and the result is supplied to the consumer. When the--- next element is demanded, the action @b@ is executed and its result is--- supplied. Thus, the effects are performed and results are consumed strictly--- in a serial order. Serial streams can be considered as /spatially ordered/--- streams as the order of execution and consumption is the same as the spatial--- order in which the actions are composed by the programmer.------ Serial streams enforce the side effects as well as the results of the--- actions to be in the same order in which the actions are added to the--- stream. Therefore, the semigroup operation for serial streams is not--- commutative:------ @--- a <> b is not the same as b <> a--- @------ There are two serial stream types 'SerialT' and 'WSerialT'. The stream--- evaluation of both the variants works in the same way as described above,--- they differ only in the 'Semigroup' and 'Monad' implementaitons.---- $ahead------ When a stream consumer demands an element from a speculative stream--- constructed as @a \`consM` b \`consM` ... nil@, the action @a@ at the head--- of the stream is executed and the output of the action is supplied to the--- consumer. However, in addition to the action at the head multiple actions--- following it may also be executed concurrently and the results buffered.--- When the next element is demanded it may be served from the buffer and we--- may execute the next action in the sequence to keep the buffer adequately--- filled. Thus, the actions are executed concurrently but results consumed in--- serial order just like serial streams. `consM` can be used to fold an--- infinite lazy container of effects, as the number of concurrent executions--- is limited.------ Similar to 'consM', the monadic stream generation (e.g. replicateM) and--- transformation operations (e.g. mapM) on speculative streams can execute--- multiple effects concurrently in a speculative manner.------ How many effects can be executed concurrently and how many results can be--- buffered are controlled by 'maxThreads' and 'maxBuffer' combinators--- respectively. The actual number of concurrent threads is adjusted according--- to the rate at which the consumer is consuming the stream. It may even--- execute actions serially in a single thread if that is enough to match the--- consumer's speed.------ Speculative streams enforce ordering of the results of actions in the stream--- but the side effects are only partially ordered. Therefore, the semigroup--- operation for speculative streams is not commutative from the pure outputs--- perspective but commutative from side effects perspective.---- $async------ /Scheduling and execution:/ In an asynchronous stream @a \`consM` b \`consM`--- c ...@, the actions @a@, @b@, and @c@ are executed concurrently with the--- consumer of the stream. The actions are /scheduled/ for execution in the--- same order as they are specified in the stream. Multiple scheduled actions--- may be /executed/ concurrently in parallel threads of execution. The--- actions may be executed out of order and they may complete at arbitrary--- times. Therefore, the /effects/ of the actions may be observed out of--- order.------ /Buffering:/ The /results/ from multiple threads of execution are queued in--- a buffer as soon as they become available. The consumer of the stream is--- served from this buffer. Therefore, the consumer may observe the results to--- be out of order. In other words, an asynchronous stream is an unordered--- stream i.e. order does not matter.------ /Concurrency control:/ Threads are suspended if the `maxBuffer` limit is--- reached, and resumed when the consumer makes space in the buffer. The--- maximum number of concurrent threads depends on `maxThreads`. Number of--- threads is increased or decreased based on the speed of the consumer.------ /Generation operations:/ Concurrent stream generation operations e.g.--- 'Streamly.Prelude.replicateM' when used in async style schedule and execute--- the stream generating actions in the manner described above. The generation--- actions run concurrently, effects and results of the actions as observed by--- the consumer of the stream may be out of order.------ /Transformation operations:/ Concurrent stream transformation operations--- e.g. 'Streamly.Prelude.mapM', when used in async style, schedule and--- execute transformation actions in the manner described above. Transformation--- actions run concurrently, effects and results of the actions may be--- observed by the consumer out of order.------ /Variants:/ There are two asynchronous stream types 'AsyncT' and 'WAsyncT'.--- They are identical with respect to single stream evaluation behavior. Their--- behaviors differ in how they combine multiple streams using 'Semigroup' or--- 'Monad' composition. Since the order of elements does not matter in--- asynchronous streams the 'Semigroup' operation is effectively commutative.---- $zipping------ 'ZipSerialM' and 'ZipAsyncM', provide 'Applicative' instances for zipping the--- corresponding elements of two streams together. Note that these types are--- not monads.---- $application------ Stream processing functions can be composed in a chain using function--- application with or without the '$' operator, or with reverse function--- application operator '&'. Streamly provides concurrent versions of these--- operators applying stream processing functions such that each stage of the--- stream can run in parallel. The operators start with a @|@; we can read '|$'--- as "@parallel dollar@" to remember that @|@ comes before '$'.------ Imports for the code snippets below:------ @--- import Streamly--- import qualified Streamly.Prelude as S--- import Control.Concurrent--- @---- $sum--- The 'Semigroup' operation '<>' of each stream type combines two streams in a--- type specific manner. This section provides polymorphic versions of '<>'--- which can be used to combine two streams in a predetermined way irrespective--- of the type.---- XXX An alternative design choice would be to let a control parameter affect--- the nearest SVar only and then it gets cleared. The benefit of the current--- choice is that it is simply just like global configuration, just like state--- behaves, so should be easy to comprehend. But it has the downside of leaking--- to undesired actions, that is we can forget to reset it.------ $concurrency------ These combinators can be used at any point in a stream composition to set--- parameters to control the concurrency of the /argument stream/. A control--- parameter set at any point remains effective for any concurrent combinators--- used in the argument stream until it is reset by using the combinator again.--- These control parameters have no effect on non-concurrent combinators in the--- stream, or on non-concurrent streams.------ /Pitfall:/ Remember that 'maxBuffer' in the following example applies to--- 'mapM' and any other combinators that may follow it, and it does not apply--- to the combinators before it:------ @--- ...--- $ maxBuffer 10--- $ S.mapM ...--- ...--- @------ If we use '&' instead of '$' the situation will reverse, in the following--- example, 'maxBuffer' does not apply to 'mapM', it applies to combinators--- that come before it, because those are the arguments to 'maxBuffer':------ @--- ...--- & maxBuffer 10--- & S.mapM ...--- ...--- @---- $adapters------ You may want to use different stream composition styles at different points--- in your program. Stream types can be freely converted or adapted from one--- type to another. The 'IsStream' type class facilitates type conversion of--- one stream type to another. It is not used directly, instead the type--- combinators provided below are used for conversions.------ To adapt from one monomorphic type (e.g. 'AsyncT') to another monomorphic--- type (e.g. 'SerialT') use the 'adapt' combinator. To give a polymorphic code--- a specific interpretation or to adapt a specific type to a polymorphic type--- use the type specific combinators e.g. 'fromAsync' or 'fromWSerial'. You--- cannot adapt polymorphic code to polymorphic code, as the compiler would not know--- which specific type you are converting from or to. If you see a an--- @ambiguous type variable@ error then most likely you are using 'adapt'--- unnecessarily on polymorphic code.---- | Same as 'Streamly.Prelude.concatFoldableWith'------ @since 0.1.0-{-# DEPRECATED foldWith "Please use 'Streamly.Prelude.concatFoldableWith' instead." #-}-{-# INLINEABLE foldWith #-}-foldWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-foldWith = P.concatFoldableWith---- | Same as 'Streamly.Prelude.concatMapFoldableWith'------ @since 0.1.0-{-# DEPRECATED foldMapWith "Please use 'Streamly.Prelude.concatMapFoldableWith' instead." #-}-{-# INLINEABLE foldMapWith #-}-foldMapWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-foldMapWith = P.concatMapFoldableWith---- | Same as 'Streamly.Prelude.concatForFoldableWith'------ @since 0.1.0-{-# DEPRECATED forEachWith "Please use 'Streamly.Prelude.concatForFoldableWith' instead." #-}-{-# INLINEABLE forEachWith #-}-forEachWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-forEachWith = P.concatForFoldableWith--{-# DEPRECATED serially "Please use 'Streamly.Prelude.fromSerial' instead." #-}-serially :: IsStream t => SerialT m a -> t m a-serially = fromSerial--{-# DEPRECATED wSerially "Please use 'Streamly.Prelude.fromWSerial' instead." #-}-wSerially :: IsStream t => WSerialT m a -> t m a-wSerially = fromWSerial--{-# DEPRECATED asyncly "Please use 'Streamly.Prelude.fromAsync' instead." #-}-asyncly :: IsStream t => AsyncT m a -> t m a-asyncly = fromAsync--{-# DEPRECATED aheadly "Please use 'Streamly.Prelude.fromAhead' instead." #-}-aheadly :: IsStream t => AheadT m a -> t m a-aheadly = fromAhead--{-# DEPRECATED wAsyncly "Please use 'Streamly.Prelude.fromWAsync' instead." #-}-wAsyncly :: IsStream t => WAsyncT m a -> t m a-wAsyncly = fromWAsync--{-# DEPRECATED parallely "Please use 'Streamly.Prelude.fromParallel' instead." #-}-parallely :: IsStream t => ParallelT m a -> t m a-parallely = fromParallel--{-# DEPRECATED zipSerially "Please use 'Streamly.Prelude.fromZipSerial' instead." #-}-zipSerially :: IsStream t => ZipSerialM m a -> t m a-zipSerially = fromZipSerial--{-# DEPRECATED zipAsyncly "Please use 'Streamly.Prelude.fromZipAsync' instead." #-}-zipAsyncly :: IsStream t => ZipAsyncM m a -> t m a-zipAsyncly = fromZipAsync
+ src/Streamly/Data/Fold/Prelude.hs view
@@ -0,0 +1,65 @@+-- |+-- 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+ (+ -- * "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+ , parEval++ -- * Container Related+ , toHashMapIO+ )+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.Concurrent+import Streamly.Internal.Data.IsMap.HashMap ()++-- | 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.+--+-- >>> import Data.HashMap.Strict (HashMap, fromList)+-- >>> import qualified Streamly.Data.Fold.Prelude as Fold+-- >>> import qualified Streamly.Data.Stream as Stream+--+-- 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)+-- >>> Stream.fold classify input :: IO (HashMap String [Double])+-- fromList [("k2",[2.0,2.2]),("k1",[1.0,1.1])]+--+-- /Pre-release/+--+{-# INLINE toHashMapIO #-}+toHashMapIO :: (MonadIO m, Hashable k, Ord k) =>+ (a -> k) -> Fold m a b -> Fold m a (HashMap k b)+toHashMapIO = toContainerIO
src/Streamly/Data/Fold/Tee.hs view
@@ -13,4 +13,4 @@ ) where -import Streamly.Internal.Data.Fold.Tee+import Streamly.Internal.Data.Fold
− src/Streamly/Data/Stream/Concurrent.hs
@@ -1,191 +0,0 @@--- |--- Module : Streamly.Data.Stream.Concurrent--- Copyright : (c) 2022 Composewell Technologies--- License : BSD-3-Clause--- Maintainer : streamly@composewell.com--- Stability : released--- Portability : GHC------ This module provides concurrent streaming abstractions.------ == Programming Tips------ The names in this module do not conflict with other stream modules,--- therefore, you can import it in the same namespace:------ >>> import qualified Streamly.Data.Stream.Concurrent as Stream--module Streamly.Data.Stream.Concurrent- (- -- * Concurrency- -- $concurrency- MonadAsync-- -- ** Configuration- , Config-- -- *** Limits- , maxThreads- , maxBuffer-- -- *** Rate Control- , Rate(..)- , rate- , avgRate- , minRate- , maxRate- , constRate-- -- *** Stop behavior- , StopWhen (..)- , stopWhen-- -- *** Scheduling behavior- , eager- , ordered- , interleaved-- -- *** Diagnostics- , inspect-- -- ** Combinators- -- | Stream combinators using a concurrent channel.-- -- *** Evaluate- -- | Evaluates a serial stream asynchronously using a concurency channel.-- , parEval-- -- *** Generate- -- | Uses a concurrency channel to evaluate multiple actions concurrently.- , parRepeatM- , parReplicateM- , fromCallback-- -- *** Map- -- | Uses a concurrency channel to evaluate multiple mapped actions- -- concurrently.-- , parMapM- , parSequence-- -- *** Combine two- -- | Use a channel for each pair.- , parZipWithM- , parZipWith- , parMergeByM- , parMergeBy-- -- *** List of streams- -- | Shares a single channel across many streams.-- , parList- -- , zipWithM- -- , zipWith-- -- *** Stream of streams- -- **** Apply-- , parApply-- -- **** Concat- -- | Shares a single channel across many streams.-- , parConcat- , parConcatMap-- -- **** ConcatIterate- , parConcatIterate-- -- *** Observation- , tapCount- )-where--import Streamly.Internal.Data.Stream.Concurrent-import Prelude hiding (mapM, sequence, concat, concatMap, zipWith)---- $concurrency------ == 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.------ == Concurrency Primitives------ There are only a few fundamental abstractions for concurrency, 'parEval',--- 'parConcatMap', and 'parConcatIterate', all concurrency combinators can be--- expressed in terms of these.------ 'parEval', evaluates a single stream asynchronously, a worker thread runs--- the stream and buffers the results, and the consumer of the stream runs in--- another thread consuming it from the buffer, thus decoupling the production--- and consumption of the stream. This can be used to run different stages of a--- pipeline concurrently.------ 'parConcatMap' is used 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.------ == Concurrency 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 behavior------ 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.------ == Concurrent 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 'parEval'.--- Combinators like 'zipWithM', 'mergeByM' can also use 'parEval' on the input--- streams to evaluate them concurrently before combining.------ Combinators like 'repeatM', 'replicateM', 'fromListM', 'sequence', 'mapM' in--- which all actions are independent of each other can be made concurrent using--- the 'parConcatMap' operation.------ A concurrent 'repeatM' repeats an action using multiple concurrent--- executions of the action. Similarly, a concurrent 'mapM' performs the mapped--- action in independent threads.------ Some common concurrent combinators are provided in this module.
− src/Streamly/Data/Stream/Exception.hs
@@ -1,24 +0,0 @@--- |--- Module : Streamly.Data.Stream.Exception--- Copyright : (c) 2022 Composewell Technologies--- License : BSD-3-Clause--- Maintainer : streamly@composewell.com--- Stability : released--- Portability : GHC------ This module is designed such that it does not conflict with--- "Streamly.Data.Stream" module.------ >>> import qualified Streamly.Data.Stream.Exception as Stream----module Streamly.Data.Stream.Exception- (- -- * Lifted Exceptions- after- , bracket- -- , bracket3- , finally- )-where--import Streamly.Internal.Data.Stream.Exception.Lifted
src/Streamly/Data/Stream/MkType.hs view
@@ -7,7 +7,8 @@ -- Portability : GHC -- -- Template Haskell macros to create custom newtype wrappers for the 'Stream'--- type, deriving all the usual instances.+-- 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: --@@ -23,31 +24,61 @@ -- >>> import Streamly.Data.Stream.MkType -- >>> import qualified Streamly.Data.Stream.Prelude as Stream ----- Example, create an applicative type with zipping apply:+-- For 'Streamly.Prelude.AsyncT' monad type with a concurrent cross product+-- bind: -- -- >>> :{--- zipApply = Stream.zipWith ($)--- $(mkZipType "ZipStream" "zipApply" False)+-- bind = flip (Stream.parConcatMap id)+-- $(mkCrossType "AsyncT" "bind" True) -- :} ----- Example, create an applicative type with concurrent zipping apply:+-- For 'Streamly.Prelude.WAsyncT' monad type with a concurrent interleaved+-- bind: -- -- >>> :{--- parApply = Stream.parApply id--- $(mkZipType "ParZipStream" "parApply" True)+-- bind = flip (Stream.parConcatMap (Stream.interleaved True))+-- $(mkCrossType "WAsyncT" "bind" True) -- :} ----- Example, create a monad type with an eager concurrent cross product bind:+-- For 'Streamly.Prelude.AheadT' monad type with a concurrent ordered+-- cross product bind: -- -- >>> :{+-- bind = flip (Stream.parConcatMap (Stream.ordered True))+-- $(mkCrossType "AheadT" "bind" True)+-- :}+--+-- For 'Streamly.Prelude.ParallelT' monad type with an eager concurrent cross+-- product bind:+--+-- >>> :{ -- parBind = flip (Stream.parConcatMap (Stream.eager True))--- $(mkCrossType "ParEagerStream" "parBind" True)+-- $(mkCrossType "ParallelT" "parBind" True) -- :} --+-- For 'Streamly.Prelude.ZipSerialM' serial zipping applicative type:+--+-- >>> :{+-- zipApply = Stream.zipWith ($)+-- $(mkZipType "ZipSerialM" "zipApply" False)+-- :}+--+-- For 'Streamly.Prelude.ZipAsync' concurrent zipping applicative type:+--+-- >>> :{+-- parApply = Stream.parApply id+-- $(mkZipType "ZipAsync" "parApply" True)+-- :}+-- -- Instead of using these macros directly you could use 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.+-- 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 -- module Streamly.Data.Stream.MkType (
src/Streamly/Data/Stream/Prelude.hs view
@@ -6,25 +6,217 @@ -- Stability : experimental -- Portability : GHC ----- This module re-exports the "Streamly.Data.Stream" module from the--- "streamly-core" package and additionally provides concurrency, time and--- lifted exception operations as well in a single module.------ Also see the following modules for more pre-release operations:------ * "Streamly.Internal.Data.Stream.Concurrent"--- * "Streamly.Internal.Data.Stream.Time"--- * "Streamly.Internal.Data.Stream.Exception.Lifted"+-- 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- ( module Streamly.Data.Stream- , module Streamly.Data.Stream.Concurrent- , module Streamly.Data.Stream.Time- , module Streamly.Data.Stream.Exception+ (+ -- * "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++ -- *** Diagnostics+ , inspect++ -- ** Combinators+ -- | Stream combinators using a concurrent channel.++ -- *** Evaluate+ -- | Evaluates a serial stream asynchronously using a concurency channel.++ , parEval++ -- *** Generate+ -- | Uses a concurrency channel to evaluate multiple actions concurrently.+ , parRepeatM+ , parReplicateM+ , fromCallback++ -- *** Map+ -- | Uses a concurrency channel to evaluate multiple mapped actions+ -- concurrently.++ , parMapM+ , parSequence++ -- *** Combine two+ -- | Use a channel for each pair.+ , parZipWithM+ , parZipWith+ , parMergeByM+ , parMergeBy++ -- *** List of streams+ -- | Shares a single channel across many streams.++ , parList+ -- , zipWithM+ -- , zipWith++ -- *** Stream of streams+ -- **** Apply++ , parApply++ -- **** 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 ) where import Streamly.Data.Stream-import Streamly.Data.Stream.Concurrent-import Streamly.Data.Stream.Exception-import Streamly.Data.Stream.Time+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, 'parEval',+-- 'parConcatMap', and 'parConcatIterate', all concurrency combinators can be+-- expressed in terms of these.+--+-- 'parEval', evaluates a single stream asynchronously, a worker thread runs+-- the stream and buffers the results, and the consumer of the stream runs in+-- another thread consuming it from the buffer, thus decoupling the production+-- and consumption of the stream. This can be used to run different stages of a+-- pipeline concurrently.+--+-- 'parConcatMap' is used 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 'parEval'.+-- Combinators like 'zipWithM', 'mergeByM' can also use 'parEval' on the input+-- streams to evaluate them concurrently before combining.+--+-- Combinators like 'repeatM', 'replicateM', 'fromListM', 'sequence', 'mapM' in+-- which all actions are independent of each other can be made concurrent using+-- the 'parConcatMap' operation.+--+-- A concurrent 'repeatM' repeats an action using multiple concurrent+-- executions of the action. Similarly, a concurrent 'mapM' performs the mapped+-- action in independent threads.+--+-- Some common concurrent combinators are provided in this module.
− src/Streamly/Data/Stream/Time.hs
@@ -1,37 +0,0 @@--- |--- Module : Streamly.Data.Stream.Time--- Copyright : (c) 2022 Composewell Technologies--- License : BSD-3-Clause--- Maintainer : streamly@composewell.com--- Stability : released--- Portability : GHC------ This module provides time related streaming abstractions.------ The names in this module do not conflict with other stream modules,--- therefore, you can import it in the same namespace:------ >>> import qualified Streamly.Data.Stream.Time as Stream----module Streamly.Data.Stream.Time- (- -- * Time- -- ** Timers- interject-- -- ** Trimming- , takeInterval- , dropInterval-- -- ** Chunking- , intervalsOf-- -- ** Sampling- , sampleIntervalEnd- , sampleIntervalStart- , sampleBurstEnd- , sampleBurstStart- )-where--import Streamly.Internal.Data.Stream.Time
− src/Streamly/Data/Unicode/Stream.hs
@@ -1,99 +0,0 @@--- |--- Module : Streamly.Data.Unicode.Stream--- Copyright : (c) 2018 Composewell Technologies------ License : BSD3--- Maintainer : streamly@composewell.com--- Stability : experimental--- Portability : GHC------ = Processing Unicode Strings------ A 'Char' stream is the canonical representation to process Unicode strings.--- It can be processed efficiently using regular stream processing operations.--- A byte stream of Unicode text read from an IO device or from an--- 'Streamly.Data.Array.Foreign.Array' in memory can be decoded into a 'Char' stream--- using the decoding routines in this module. A 'String' (@[Char]@) can be--- converted into a 'Char' stream using 'Streamly.Prelude.fromList'. An @Array--- Char@ can be 'Streamly.Prelude.unfold'ed into a stream using the array--- 'Streamly.Data.Array.Foreign.read' unfold.------ = Storing Unicode Strings------ A stream of 'Char' can be encoded into a byte stream using the encoding--- routines in this module and then written to IO devices or to arrays in--- memory.------ If you have to store a 'Char' stream in memory you can convert it into a--- 'String' using 'Streamly.Prelude.toList' or using the--- 'Streamly.Data.Fold.toList' fold. The 'String' type can be more efficient--- than pinned arrays for short and short lived strings.------ For longer or long lived streams you can 'Streamly.Prelude.fold' the 'Char'--- stream as @Array Char@ using the array 'Streamly.Data.Array.Foreign.write' fold.--- The 'Array' type provides a more compact representation and pinned memory--- reducing GC overhead. If space efficiency is a concern you can use--- 'encodeUtf8'' on the 'Char' stream before writing it to an 'Array' providing--- an even more compact representation.------ = String Literals------ @Stream Identity Char@ and @Array Char@ are instances of 'IsString' and--- 'IsList', therefore, 'OverloadedStrings' and 'OverloadedLists' extensions--- can be used for convenience when specifying unicode strings literals using--- these types.------ = Pitfalls------ * Case conversion: Some unicode characters translate to more than one code--- point on case conversion. The 'toUpper' and 'toLower' functions in @base@--- package do not handle such characters. Therefore, operations like @map--- toUpper@ on a character stream or character array may not always perform--- correct conversion.--- * String comparison: In some cases, visually identical strings may have--- different unicode representations, therefore, a character stream or--- character array cannot be directly compared. A normalized comparison may be--- needed to check string equivalence correctly.------ = Experimental APIs------ Some experimental APIs to conveniently process text using the--- @Array Char@ represenation directly can be found in--- "Streamly.Internal.Memory.Unicode.Array".---- XXX an unpinned array representation can be useful to store short and short--- lived strings in memory.----module Streamly.Data.Unicode.Stream- {-# DEPRECATED "Please use Streamly.Unicode.Stream module from the streamly-core package." #-}- (- -- * Construction (Decoding)- decodeLatin1- , decodeUtf8-- -- * Elimination (Encoding)- , encodeLatin1- , encodeUtf8- {-- -- * Operations on character strings- , strip -- (dropAround isSpace)- , stripEnd- , stripStart- -}- -- Not exposing these yet as we have consider these with respect to Unicode- -- segmentation routines which are yet to be implemented.- -- -- * Transformation- -- , lines- -- , words- -- , unlines- -- , unwords-- -- * Deprecations- , decodeUtf8Lax- , encodeLatin1Lax- , encodeUtf8Lax- )-where--import Streamly.Internal.Unicode.Stream-import Prelude hiding (lines, words, unlines, unwords)
src/Streamly/Internal/Control/ForkLifted.hs view
@@ -9,12 +9,13 @@ module Streamly.Internal.Control.ForkLifted ( doFork+ , doForkWith , fork , forkManaged ) where -import Control.Concurrent (ThreadId, forkIO)+import Control.Concurrent (ThreadId, forkIO, forkOS) import Control.Exception (SomeException(..), catch, mask) import Data.Functor (void) import Streamly.Internal.Control.Concurrent (MonadRunInIO, RunInIO(..), withRunInIO, withRunInIONoRestore)@@ -32,11 +33,23 @@ -> RunInIO m -> (SomeException -> IO ()) -> m ThreadId-doFork action (RunInIO mrun) exHandler =+doFork = doForkWith False++-- | Similar to 'doFork', but has a \"bound\" boolean parameter for specifying+-- whether 'forkOS' should be used instead of 'rawForkIO'.+{-# INLINE doForkWith #-}+doForkWith :: MonadRunInIO m+ => Bool+ -> m ()+ -> RunInIO m+ -> (SomeException -> IO ())+ -> m ThreadId+doForkWith bound action (RunInIO mrun) exHandler = withRunInIO $ \run -> mask $ \restore -> do- tid <- rawForkIO $ catch (restore $ void $ mrun action)- exHandler+ tid <- (if bound then forkOS else rawForkIO) $+ catch (restore $ void $ mrun action)+ exHandler run (return tid) -- | 'fork' lifted to any monad with 'MonadBaseControl IO m' capability.
− src/Streamly/Internal/Data/Array/ArrayMacros.h
@@ -1,40 +0,0 @@----------------------------------------------------------------------------------- Macros to access array pointers------------------------------------------------------------------------------------ The Storable instance of () has size 0. We ensure that the size is non-zero--- to avoid a zero sized element and issues due to that.--- See https://mail.haskell.org/pipermail/libraries/2022-January/thread.html------ XXX Check the core to see if max can be statically eliminated. llvm can--- eliminate the comparison, but not sure if GHC NCG can.-#define SIZE_OF(a) max 1 (sizeOf (Proxy :: Proxy a))-#define STORABLE_SIZE_OF(a) max 1 (sizeOf (undefined :: a))---- Move the pointer to ith element of specified type. Type is specified as the--- type variable in the signature of the function where this macro is used.-#define PTR_NEXT(ptr,a) ptr `plusPtr` STORABLE_SIZE_OF(a)-#define PTR_PREV(ptr,a) ptr `plusPtr` negate (STORABLE_SIZE_OF(a))--#define PTR_INDEX(ptr,i,a) ptr `plusPtr` (STORABLE_SIZE_OF(a) * i)-#define PTR_RINDEX(ptr,i,a) ptr `plusPtr` negate (STORABLE_SIZE_OF(a) * (i + 1))---- XXX If we know that the array is guaranteed to have size multiples of the--- element size then we can use a simpler check saying "ptr < end". Since we--- always allocate in multiples of elem we can use the simpler check and assert--- the rigorous check.-#define PTR_VALID(ptr,end,a) ptr `plusPtr` STORABLE_SIZE_OF(a) <= end-#define PTR_INVALID(ptr,end,a) ptr `plusPtr` STORABLE_SIZE_OF(a) > end------------------------------------------------------------------------------------ Macros to access array indices----------------------------------------------------------------------------------#define INDEX_NEXT(i,a) i + SIZE_OF(a)-#define INDEX_PREV(i,a) i - SIZE_OF(a)--#define INDEX_OF(base,i,a) base + (SIZE_OF(a) * i)-#define RINDEX_OF(base,i,a) base - (SIZE_OF(a) * (i + 1))--#define INDEX_VALID(i,end,a) i + SIZE_OF(a) <= end-#define INDEX_INVALID(i,end,a) i + SIZE_OF(a) > end
+ src/Streamly/Internal/Data/Channel.hs view
@@ -0,0 +1,19 @@+-- |+-- Module : Streamly.Internal.Data.Channel+-- Copyright : (c) 2017 Composewell Technologies+-- License : BSD-3-Clause+-- Maintainer : streamly@composewell.com+-- Stability : experimental+-- Portability : GHC++module Streamly.Internal.Data.Channel+ (+ module Streamly.Internal.Data.Channel.Dispatcher+ , module Streamly.Internal.Data.Channel.Types+ , 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,294 @@+-- |+-- 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)+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+ cnt = max 1 $ minThreadDelay `div` latency+ 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)++-- 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 ::+ Bool+ -> SVarStats+ -> YieldRateInfo+ -> Bool+ -> IO (Count, AbsTime, NanoSecond64)+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+ (svarCnt, svarGainLossCnt, svarLat) <- case rateInfo 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 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 "")+ ]++-------------------------------------------------------------------------------+-- 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 $ modifyIORef 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 $ modifyIORef 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,817 @@+-- |+-- 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 (..)+ , newRateInfo++ -- * Output queue+ , readOutputQRaw+ , readOutputQBasic+ , ringDoorBell++ -- * Yield Limit+ , decrementYieldLimit+ , incrementYieldLimit++ -- * Configuration+ , Rate (..)+ , StopWhen (..)+ , Config++ -- ** Default config+ , magicMaxBuffer+ , defaultConfig++ -- ** Set config+ , maxThreads+ , maxBuffer+ , maxYields+ , inspect+ , eager+ , stopWhen+ , ordered+ , interleaved+ , boundThreads++ , rate+ , avgRate+ , minRate+ , maxRate+ , constRate++ -- ** Get config+ , getMaxThreads+ , getMaxBuffer+ , getStreamRate+ , getStreamLatency+ , setStreamLatency+ , getYieldLimit+ , getInspectMode+ , getEagerDispatch+ , getStopWhen+ , getOrdered+ , getInterleaved+ , getBound++ -- * Cleanup+ , cleanupSVar++ -- * Diagnostics+ , dumpCreator+ , dumpOutputQ+ , dumpDoorBell+ , dumpNeedDoorBell+ , dumpRunningThreads+ , dumpWorkerCount++ , withDiagMVar+ , printSVar+ )+where++import Control.Concurrent (ThreadId, throwTo, 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 Data.Set (Set)+import Streamly.Internal.Data.Atomics+ (atomicModifyIORefCAS, atomicModifyIORefCAS_, storeLoadBarrier)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units (AbsTime, NanoSecond64(..))+import System.IO (hPutStrLn, stderr)++import qualified Data.Set as Set++------------------------------------------------------------------------------+-- 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+ {+ -- | 0 means unlimited+ workerYieldMax :: Count+ -- | total number of yields by the worker till now+ , workerYieldCount :: IORef Count+ -- | yieldCount at start, timestamp+ , workerLatencyStart :: IORef (Count, AbsTime)+ }++data LatencyRange = LatencyRange+ { minLatency :: NanoSecond64+ , maxLatency :: NanoSecond64+ } deriving Show++-- | Rate control.+data YieldRateInfo = YieldRateInfo+ { svarLatencyTarget :: NanoSecond64+ , svarLatencyRange :: LatencyRange+ , svarRateBuffer :: Int++ -- | [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+ -- read by the worker threads+ , svarGainedLostYields :: IORef Count++ -- | Actual latency/througput as seen from the consumer side, we count the+ -- yields and the time it took to generates those yields. This is used to+ -- increase or decrease the number of workers needed to achieve the desired+ -- rate. The idle time of workers is adjusted in this, so that we only+ -- account for the rate when the consumer actually demands data.+ -- XXX interval latency is enough, we can move this under diagnostics build+ -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+ -- read by the worker threads+ , svarAllTimeLatency :: IORef (Count, AbsTime)++ -- XXX Worker latency specified by the user to be used before the first+ -- actual measurement arrives. Not yet implemented+ , workerBootstrapLatency :: Maybe NanoSecond64++ -- | After how many yields the worker should update the latency information.+ -- If the latency is high, this count is kept lower and vice-versa. XXX If+ -- the latency suddenly becomes too high this count may remain too high for+ -- long time, in such cases the consumer can change it.+ -- 0 means no latency computation+ -- XXX this is derivable from workerMeasuredLatency, can be removed.+ -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+ -- read by the worker threads+ , workerPollingInterval :: IORef Count++ -- | This is in progress latency stats maintained by the workers which we+ -- empty into workerCollectedLatency stats at certain intervals - whenever+ -- we process the stream elements yielded in this period. The first count+ -- is all yields, the second count is only those yields for which the+ -- latency was measured to be non-zero (note that if the timer resolution+ -- is low the measured latency may be zero e.g. on JS platform).+ -- [LOCKING] Locked access. Modified by the consumer thread as well as+ -- worker threads. Workers modify it periodically based on+ -- workerPollingInterval and not on every yield to reduce the locking+ -- overhead.+ -- (allYieldCount, yieldCount, timeTaken)+ , workerPendingLatency :: IORef (Count, Count, NanoSecond64)++ -- | This is the second level stat which is an accmulation from+ -- workerPendingLatency stats. We keep accumulating latencies in this+ -- bucket until we have stats for a sufficient period and then we reset it+ -- to start collecting for the next period and retain the computed average+ -- latency for the last period in workerMeasuredLatency.+ -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+ -- read by the worker threads+ -- (allYieldCount, yieldCount, timeTaken)+ , workerCollectedLatency :: IORef (Count, Count, NanoSecond64)++ -- | Latency as measured by workers, aggregated for the last period.+ -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+ -- read by the worker threads+ , workerMeasuredLatency :: IORef NanoSecond64+ }++data SVarStats = SVarStats {+ totalDispatches :: IORef Int+ , maxWorkers :: IORef Int+ , maxOutQSize :: IORef Int+ , maxHeapSize :: IORef Int+ , maxWorkQSize :: IORef Int+ , avgWorkerLatency :: IORef (Count, NanoSecond64)+ , minWorkerLatency :: IORef NanoSecond64+ , maxWorkerLatency :: IORef NanoSecond64+ , svarStopTime :: IORef (Maybe AbsTime)+}++-------------------------------------------------------------------------------+-- 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 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.+--+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+ }++-- | 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.++-- 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+ }++-------------------------------------------------------------------------------+-- 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. 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+ }++-------------------------------------------------------------------------------+-- Smart get/set routines for State+-------------------------------------------------------------------------------++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.+--+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++-- TODO: Make it consistently take effect everywhere.++-- | 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++-------------------------------------------------------------------------------+-- 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+ }++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+ }++-------------------------------------------------------------------------------+-- 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)++-------------------------------------------------------------------------------+-- 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+-------------------------------------------------------------------------------++{-# INLINE readOutputQBasic #-}+readOutputQBasic :: IORef ([ChildEvent a], Int) -> IO ([ChildEvent a], Int)+readOutputQBasic q = atomicModifyIORefCAS q $ \x -> (([],0), x)++{-# INLINE readOutputQRaw #-}+readOutputQRaw ::+ IORef ([ChildEvent a], Int) -> Maybe SVarStats -> IO ([ChildEvent a], Int)+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)++{-# INLINE ringDoorBell #-}+ringDoorBell :: IORef Bool -> MVar () -> 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++-------------------------------------------------------------------------------+-- Cleanup+-------------------------------------------------------------------------------++-- | Never called from a worker thread.+cleanupSVar :: IORef (Set ThreadId) -> IO ()+cleanupSVar workerSet = do+ workers <- readIORef workerSet+ -- self <- myThreadId+ Prelude.mapM_ (`throwTo` ThreadAbort)+ -- (Prelude.filter (/= self) $ Set.toList workers)+ (Set.toList workers)
+ src/Streamly/Internal/Data/Channel/Worker.hs view
@@ -0,0 +1,375 @@+-- |+-- 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+ (+ Work (..)+ , estimateWorkers+ , isBeyondMaxRate+ , workerRateControl++ -- * Send Events+ , sendWithDoorBell+ , sendYield+ , sendStop+ , handleChildException -- XXX rename to 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+-------------------------------------------------------------------------------++{-# 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++-------------------------------------------------------------------------------+-- 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++-- | 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 :: Limit -> IORef Int -> YieldRateInfo -> IO Bool+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.+{-# NOINLINE checkRatePeriodic #-}+checkRatePeriodic ::+ Limit+ -> IORef Int+ -> YieldRateInfo+ -> WorkerInfo+ -> Count+ -> IO Bool+checkRatePeriodic workerLimit workerCount rateInfo workerInfo ycnt = do+ 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++-- | CAUTION! this also updates the yield count and therefore should be called+-- only when we are actually yielding an element.+{-# NOINLINE workerRateControl #-}+workerRateControl :: Limit -> IORef Int -> YieldRateInfo -> WorkerInfo -> IO Bool+workerRateControl workerLimit workerCount rateInfo workerInfo = do+ cnt <- updateYieldCount workerInfo+ beyondMaxRate <- checkRatePeriodic 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.++-- | Returns whether the worker should continue (True) or stop (False).+{-# INLINE sendYield #-}+sendYield ::+ Limit+ -> Limit+ -> IORef Int+ -> Maybe WorkerInfo+ -> Maybe YieldRateInfo+ -> IORef ([ChildEvent a], Int)+ -> MVar ()+ -> ChildEvent a+ -> IO Bool+sendYield bufferLimit workerLimit workerCount workerInfo rateInfo q bell msg =+ do+ oldlen <- sendWithDoorBell q bell 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 ->+ workerRateControl 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++{-# INLINABLE sendStop #-}+sendStop ::+ IORef Int+ -> Maybe WorkerInfo+ -> Maybe YieldRateInfo+ -> IORef ([ChildEvent a], Int)+ -> MVar ()+ -> IO ()+sendStop workerCount workerInfo rateInfo q bell = do+ atomicModifyIORefCAS_ workerCount $ \n -> n - 1+ case (workerInfo, rateInfo) of+ (Just winfo, Just rinfo) ->+ workerStopUpdate winfo rinfo+ _ ->+ return ()+ myThreadId >>= \tid ->+ void $ sendWithDoorBell q bell (ChildStop tid Nothing)++{-# NOINLINE handleChildException #-}+handleChildException ::+ IORef ([ChildEvent a], Int) -> MVar () -> SomeException -> IO ()+handleChildException q bell e = do+ tid <- myThreadId+ void $ sendWithDoorBell q bell (ChildStop tid (Just e))
src/Streamly/Internal/Data/Fold/Async.hs view
@@ -22,7 +22,7 @@ import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(..)) import Streamly.Data.Fold (many)-import Streamly.Internal.Data.Fold.Type (Fold(..), Step (..))+import Streamly.Internal.Data.Fold (Fold(..), Step (..)) import Streamly.Internal.Control.Concurrent (MonadAsync, withRunInIO) import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..)) @@ -63,7 +63,8 @@ -- {-# INLINE takeInterval #-} takeInterval :: MonadAsync m => Double -> Fold m a b -> Fold m a b-takeInterval n (Fold step initial done) = Fold step' initial' done'+takeInterval n (Fold step initial done final) =+ Fold step' initial' done' final' where @@ -90,7 +91,7 @@ then do res <- step s a case res of- Partial sres -> Done <$> done sres+ Partial sres -> Done <$> final sres Done bres -> return $ Done bres else do res <- step s a@@ -99,6 +100,8 @@ 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)
src/Streamly/Internal/Data/Fold/Concurrent.hs view
@@ -6,64 +6,52 @@ -- Stability : experimental -- Portability : GHC ----- Eval a fold asynchronously in a separate thread.+-- Using 'parEval' 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. ----- Use multiple worker folds to fold a stream and collect the results using--- another fold, combine using a monoid. The results can be collected--- out-of-order or in-order.+-- Avoid scanning a stream using a concurrent fold. When scanning a stream+-- using a concurrent fold we need to keep in mind that the result of the scan+-- may be delayed because of the asynchronous execution. The results may not be+-- same as in the case of a synchronous fold. --+-- Stages in a fold pipeline can be made concurrent using 'parEval'.+--+-- The 'demux' combinator can be made concurrent by using 'parEval' 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 'parEval' 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.++-- TODO:+--+-- Before a fold returns "done" it has to drain the child folds. For example,+-- consider a "take" operation on a `parEval` fold, the take would return as+-- soon as it has taken required number of elements irrespective of whether the+-- child fold has yet finished or not.+--+-- parLmapM on a fold.+--+-- 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 at a time. This is+-- like parConcatMap in streams. We also need to have a lconcatMap to expand+-- the chunks in the input to streams before folding. This will require an+-- input Skip constructor. In fact, parLmapM would be implemented in terms of+-- this like 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 (- -- * Imports- -- $setup-- -- * Configuration- Config- , maxBuffer- , inspect-- -- * Combinators- -- | Stream combinators using Async channel-- , eval- , parEval+ module Streamly.Internal.Data.Fold.Concurrent.Channel ) where -import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Fold (Fold)- import Streamly.Internal.Data.Fold.Concurrent.Channel---- $setup------ Imports for example snippets in this module.------ >>> :m--- >>> :set -XFlexibleContexts--- >>> 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.Internal.Data.Fold.Concurrent as Fold--- >>> 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--- :}---- | Evaluate a stream asynchronously using a channel and serve the consumer--- from the evaluation buffer.------ >>> eval = Fold.parEval id----{-# INLINE eval #-}-eval :: MonadAsync m => Fold m a b -> Fold m a b-eval = parEval id
src/Streamly/Internal/Data/Fold/Concurrent/Channel.hs view
@@ -8,12 +8,11 @@ module Streamly.Internal.Data.Fold.Concurrent.Channel (- -- * Channel- Channel+ module Streamly.Internal.Data.Fold.Concurrent.Channel.Type -- * Configuration- , Config , maxBuffer+ , boundThreads , inspect -- * Fold operations@@ -27,11 +26,11 @@ import Data.IORef (writeIORef) import Streamly.Internal.Control.Concurrent (MonadAsync) import Streamly.Internal.Data.Fold (Fold(..), Step (..))-import Streamly.Internal.Data.Stream.Channel.Worker (sendWithDoorBell)+import Streamly.Internal.Data.Channel.Worker (sendWithDoorBell) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import Streamly.Internal.Data.Fold.Concurrent.Channel.Type-import Streamly.Internal.Data.Stream.Channel.Types+import Streamly.Internal.Data.Channel.Types ------------------------------------------------------------------------------- -- Evaluating a Fold@@ -39,13 +38,15 @@ -- XXX Cleanup the fold if the stream is interrupted. Add a GC hook. --- | Evaluate the fold asynchronously in a worker thread separate from the--- driver thread.+-- | Evaluate a fold asynchronously using a concurrent channel. The driver just+-- queues the input stream values to the fold channel buffer and returns. The+-- fold evaluates the queued values asynchronously. On finalization, 'parEval'+-- waits for the asynchronous fold to complete before it returns. -- {-# INLINABLE parEval #-} parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b parEval modifier f =- Fold step initial extract+ Fold step initial extract final where @@ -60,13 +61,33 @@ -- -- 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 parEvalScan 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 chan = do+ -- XXX We can use a separate type for non-scanning folds that will+ -- introduce a lot of complexity. Are there combinators that rely on the+ -- "extract" function even in non-scanning use cases?+ -- Instead of making such folds partial we can also make them return a+ -- Maybe type.+ 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 $ sendWithDoorBell (outputQueue chan)@@ -82,7 +103,7 @@ "parEval: waiting to drain" $ takeMVar (outputDoorBellFromConsumer chan) -- XXX remove recursion- extract chan+ final chan Just b -> do when (svarInspectMode chan) $ liftIO $ do t <- getTime Monotonic
src/Streamly/Internal/Data/Fold/Concurrent/Channel/Type.hs view
@@ -28,15 +28,15 @@ import Data.List (intersperse) import Streamly.Internal.Control.Concurrent (MonadAsync, MonadRunInIO, askRunInIO)-import Streamly.Internal.Control.ForkLifted (doFork)+import Streamly.Internal.Control.ForkLifted (doForkWith) import Streamly.Internal.Data.Fold (Fold(..))-import Streamly.Internal.Data.Stream.Channel.Dispatcher (dumpSVarStats)-import Streamly.Internal.Data.Stream.Channel.Worker (sendWithDoorBell)+import Streamly.Internal.Data.Channel.Dispatcher (dumpSVarStats)+import Streamly.Internal.Data.Channel.Worker (sendWithDoorBell) import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as D -import Streamly.Internal.Data.Stream.Channel.Types+import Streamly.Internal.Data.Channel.Types data Channel m a b = Channel {@@ -236,9 +236,10 @@ newChannel :: (MonadRunInIO m) => (Config -> Config) -> Fold m a b -> m (Channel m a b) newChannel modifier f = do- sv <- liftIO $ mkNewChannel (modifier defaultConfig)+ let config = modifier defaultConfig+ sv <- liftIO $ mkNewChannel config mrun <- askRunInIO- void $ doFork (work sv) mrun (sendExceptionToDriver sv)+ void $ doForkWith (getBound config) (work sv) mrun (sendExceptionToDriver sv) return sv where
+ src/Streamly/Internal/Data/Fold/Prelude.hs view
@@ -0,0 +1,19 @@+-- |+-- 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+ (+ module Streamly.Internal.Data.Fold.Async+ , module Streamly.Internal.Data.Fold.Concurrent+ , module Streamly.Internal.Data.Fold.SVar+ )+where++import Streamly.Internal.Data.Fold.Async+import Streamly.Internal.Data.Fold.Concurrent+import Streamly.Internal.Data.Fold.SVar
src/Streamly/Internal/Data/Fold/SVar.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Streamly.Internal.Data.Fold.SVar -- Copyright : (c) 2017 Composewell Technologies@@ -18,9 +19,9 @@ import Control.Monad (void) import Control.Monad.IO.Class (MonadIO(liftIO))-import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Fold (Fold(..)) -import qualified Streamly.Internal.Data.Fold.Type as FL (Step(Done, Partial))+import qualified Streamly.Internal.Data.Fold as FL (Step(Done, Partial)) import Streamly.Internal.Data.SVar @@ -33,7 +34,7 @@ -- {-# INLINE write #-} write :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()-write svar winfo = Fold step initial extract+write svar winfo = Fold step initial return final where @@ -47,14 +48,14 @@ void $ send svar (ChildYield x) return $ FL.Partial () - extract () = liftIO $ sendStop svar winfo+ final () = liftIO $ sendStop svar winfo -- | Like write, but applies a yield limit. -- {-# INLINE writeLimited #-} writeLimited :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()-writeLimited svar winfo = Fold step initial extract+writeLimited svar winfo = Fold step initial (const (return ())) final where @@ -74,5 +75,5 @@ return $ FL.Done () step False _ = return $ FL.Done () - extract True = liftIO $ sendStop svar winfo- extract False = return ()+ final True = liftIO $ sendStop svar winfo+ final False = return ()
src/Streamly/Internal/Data/IsMap/HashMap.hs view
@@ -20,7 +20,11 @@ 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@@ -30,3 +34,4 @@ mapDelete = HashMap.delete mapUnion = HashMap.union mapNull = HashMap.null+ mapTraverseWithKey = HashMap.traverseWithKey
src/Streamly/Internal/Data/SVar.hs view
@@ -8,6 +8,7 @@ -- -- module Streamly.Internal.Data.SVar+ {-# DEPRECATED "SVar is replaced by Channel." #-} ( module Streamly.Internal.Data.SVar.Type , module Streamly.Internal.Data.SVar.Worker
src/Streamly/Internal/Data/SmallArray.hs view
@@ -51,10 +51,10 @@ import Streamly.Data.Fold (Fold) import Streamly.Data.Stream (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Unfold (Unfold(..)) -import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.Fold as FL (Fold (..), Step (Done, Partial)) import Streamly.Internal.Data.SmallArray.Type@@ -106,7 +106,7 @@ -- 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+writeN len = FL.Fold step initial extract extract where
src/Streamly/Internal/Data/Stream/Ahead.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- | -- Module : Streamly.Internal.Data.Stream.Ahead@@ -33,13 +34,17 @@ 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)@@ -49,12 +54,12 @@ import Streamly.Internal.Control.Concurrent (MonadRunInIO, MonadAsync, askRunInIO, restoreM)-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream) -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (foldStreamShared, cons, mkStream, foldStream, fromEffect , nil, concatMapWith, fromPure, bindWith)-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as D (mapM, fromStreamK, toStreamK) import qualified Streamly.Internal.Data.Stream.Serial as Stream (toStreamK) @@ -692,9 +697,11 @@ -- @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.@@ -760,5 +767,10 @@ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------++#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m, MonadAsync m) => MonadBase b (AheadT m) where+ liftBase = liftBaseDefault+#endif MONAD_COMMON_INSTANCES(AheadT, MONADPARALLEL)
src/Streamly/Internal/Data/Stream/Async.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-} #include "inline.hs" @@ -40,14 +41,18 @@ 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)@@ -59,13 +64,13 @@ (MonadRunInIO, MonadAsync, askRunInIO, restoreM) import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS, atomicModifyIORefCAS_)-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream) import Streamly.Internal.Data.Stream.SVar.Generate (fromSVar, fromSVarD) -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (foldStreamShared, mkStream, foldStream, fromEffect , nil, concatMapWith, fromPure, bindWith)-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as D (Stream(..), Step(..), mapM, toStreamK, fromStreamK) import qualified Streamly.Internal.Data.Stream.Serial as Stream (toStreamK) @@ -744,9 +749,11 @@ -- @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.@@ -818,6 +825,11 @@ -- Other instances ------------------------------------------------------------------------------ +#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m, MonadAsync m) => MonadBase b (AsyncT m) where+ liftBase = liftBaseDefault+#endif+ MONAD_COMMON_INSTANCES(AsyncT, MONADPARALLEL) ------------------------------------------------------------------------------@@ -970,9 +982,11 @@ -- 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.@@ -1041,5 +1055,10 @@ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------++#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m, MonadAsync m) => MonadBase b (WAsyncT m) where+ liftBase = liftBaseDefault+#endif MONAD_COMMON_INSTANCES(WAsyncT, MONADPARALLEL)
− src/Streamly/Internal/Data/Stream/Channel/Dispatcher.hs
@@ -1,294 +0,0 @@--- |--- 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- (- -- * 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)-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.Stream.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- cnt = max 1 $ minThreadDelay `div` latency- 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)---- 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 ::- Bool- -> SVarStats- -> YieldRateInfo- -> Bool- -> IO (Count, AbsTime, NanoSecond64)-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- (svarCnt, svarGainLossCnt, svarLat) <- case rateInfo 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 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 "")- ]------------------------------------------------------------------------------------ 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 $ modifyIORef 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 $ modifyIORef 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/Stream/Channel/Types.hs
@@ -1,827 +0,0 @@--- |--- Module : Streamly.Internal.Data.Stream.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.Stream.Channel.Types- (- -- * Types- Count (..)- , Limit (..)- , ThreadAbort (..)- , ChildEvent (..)-- -- * Stats- , SVarStats (..)- , newSVarStats-- -- * Rate Control- , WorkerInfo (..)- , LatencyRange (..)- , YieldRateInfo (..)- , newRateInfo-- -- * Output queue- , readOutputQRaw- , readOutputQBasic- , ringDoorBell-- -- * Yield Limit- , decrementYieldLimit- , incrementYieldLimit-- -- * Configuration- , Rate (..)- , StopWhen (..)- , Config-- -- ** Default config- , magicMaxBuffer- , defaultConfig-- -- ** Set config- , maxThreads- , maxBuffer- , maxYields- , inspect- , eager- , stopWhen- , ordered- , interleaved-- , rate- , avgRate- , minRate- , maxRate- , constRate-- -- ** Get config- , getMaxThreads- , getMaxBuffer- , getStreamRate- , getStreamLatency- , setStreamLatency- , getYieldLimit- , getInspectMode- , getEagerDispatch- , getStopWhen- , getOrdered- , getInterleaved-- -- * Cleanup- , cleanupSVar-- -- * Diagnostics- , dumpCreator- , dumpOutputQ- , dumpDoorBell- , dumpNeedDoorBell- , dumpRunningThreads- , dumpWorkerCount-- , withDiagMVar- , printSVar-- , concatMapDivK- )-where--import Control.Concurrent (ThreadId, throwTo, 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 Data.Set (Set)-import Streamly.Internal.Data.Atomics- (atomicModifyIORefCAS, atomicModifyIORefCAS_, storeLoadBarrier)-import Streamly.Internal.Data.SVar.Type (adaptState)-import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)-import Streamly.Internal.Data.Time.Units (AbsTime, NanoSecond64(..))-import System.IO (hPutStrLn, stderr)--import qualified Data.Set as Set-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K----------------------------------------------------------------------------------- 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- {- -- | 0 means unlimited- workerYieldMax :: Count- -- | total number of yields by the worker till now- , workerYieldCount :: IORef Count- -- | yieldCount at start, timestamp- , workerLatencyStart :: IORef (Count, AbsTime)- }--data LatencyRange = LatencyRange- { minLatency :: NanoSecond64- , maxLatency :: NanoSecond64- } deriving Show---- | Rate control.-data YieldRateInfo = YieldRateInfo- { svarLatencyTarget :: NanoSecond64- , svarLatencyRange :: LatencyRange- , svarRateBuffer :: Int-- -- | [LOCKING] Unlocked access. Modified by the consumer thread and unsafely- -- read by the worker threads- , svarGainedLostYields :: IORef Count-- -- | Actual latency/througput as seen from the consumer side, we count the- -- yields and the time it took to generates those yields. This is used to- -- increase or decrease the number of workers needed to achieve the desired- -- rate. The idle time of workers is adjusted in this, so that we only- -- account for the rate when the consumer actually demands data.- -- XXX interval latency is enough, we can move this under diagnostics build- -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely- -- read by the worker threads- , svarAllTimeLatency :: IORef (Count, AbsTime)-- -- XXX Worker latency specified by the user to be used before the first- -- actual measurement arrives. Not yet implemented- , workerBootstrapLatency :: Maybe NanoSecond64-- -- | After how many yields the worker should update the latency information.- -- If the latency is high, this count is kept lower and vice-versa. XXX If- -- the latency suddenly becomes too high this count may remain too high for- -- long time, in such cases the consumer can change it.- -- 0 means no latency computation- -- XXX this is derivable from workerMeasuredLatency, can be removed.- -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely- -- read by the worker threads- , workerPollingInterval :: IORef Count-- -- | This is in progress latency stats maintained by the workers which we- -- empty into workerCollectedLatency stats at certain intervals - whenever- -- we process the stream elements yielded in this period. The first count- -- is all yields, the second count is only those yields for which the- -- latency was measured to be non-zero (note that if the timer resolution- -- is low the measured latency may be zero e.g. on JS platform).- -- [LOCKING] Locked access. Modified by the consumer thread as well as- -- worker threads. Workers modify it periodically based on- -- workerPollingInterval and not on every yield to reduce the locking- -- overhead.- -- (allYieldCount, yieldCount, timeTaken)- , workerPendingLatency :: IORef (Count, Count, NanoSecond64)-- -- | This is the second level stat which is an accmulation from- -- workerPendingLatency stats. We keep accumulating latencies in this- -- bucket until we have stats for a sufficient period and then we reset it- -- to start collecting for the next period and retain the computed average- -- latency for the last period in workerMeasuredLatency.- -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely- -- read by the worker threads- -- (allYieldCount, yieldCount, timeTaken)- , workerCollectedLatency :: IORef (Count, Count, NanoSecond64)-- -- | Latency as measured by workers, aggregated for the last period.- -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely- -- read by the worker threads- , workerMeasuredLatency :: IORef NanoSecond64- }--data SVarStats = SVarStats {- totalDispatches :: IORef Int- , maxWorkers :: IORef Int- , maxOutQSize :: IORef Int- , maxHeapSize :: IORef Int- , maxWorkQSize :: IORef Int- , avgWorkerLatency :: IORef (Count, NanoSecond64)- , minWorkerLatency :: IORef NanoSecond64- , maxWorkerLatency :: IORef NanoSecond64- , svarStopTime :: IORef (Maybe AbsTime)-}------------------------------------------------------------------------------------ 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 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.----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- }---- | 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.---- 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- }------------------------------------------------------------------------------------ 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. 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- }------------------------------------------------------------------------------------ Smart get/set routines for State----------------------------------------------------------------------------------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.----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. With 'eager' on workers are dispatched aggresively as--- long as there is more work to do irrespective of whether there is output--- pending to be processed. 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------------------------------------------------------------------------------------ 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- }--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- }------------------------------------------------------------------------------------ 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)------------------------------------------------------------------------------------ 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----------------------------------------------------------------------------------{-# INLINE readOutputQBasic #-}-readOutputQBasic :: IORef ([ChildEvent a], Int) -> IO ([ChildEvent a], Int)-readOutputQBasic q = atomicModifyIORefCAS q $ \x -> (([],0), x)--{-# INLINE readOutputQRaw #-}-readOutputQRaw ::- IORef ([ChildEvent a], Int) -> Maybe SVarStats -> IO ([ChildEvent a], Int)-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)--{-# INLINE ringDoorBell #-}-ringDoorBell :: IORef Bool -> MVar () -> 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------------------------------------------------------------------------------------ Cleanup------------------------------------------------------------------------------------ | Never called from a worker thread.-cleanupSVar :: IORef (Set ThreadId) -> IO ()-cleanupSVar workerSet = do- workers <- readIORef workerSet- -- self <- myThreadId- Prelude.mapM_ (`throwTo` ThreadAbort)- -- (Prelude.filter (/= self) $ Set.toList workers)- (Set.toList workers)------------------------------------------------------------------------------------ Evaluator------------------------------------------------------------------------------------ | @concatMapDivK useTail useHead stream@, divides the stream in head and--- tail, maps a stream generator on the head and maps an action on the tail of--- a stream. Returns the stream generated by the head.------ Used for concurrent evaluation of streams using a Channel.-{-# INLINE concatMapDivK #-}-concatMapDivK :: Monad m =>- (K.StreamK m a -> m ())- -> (a -> K.StreamK m b)- -> K.StreamK m a- -> K.StreamK m b-concatMapDivK useTail useHead stream =- K.mkStream $ \st yld sng stp -> do- let foldShared = K.foldStreamShared st yld sng stp- single a = foldShared $ useHead a- yieldk a r = useTail r >> single a- in K.foldStreamShared (adaptState st) yieldk single stp stream
− src/Streamly/Internal/Data/Stream/Channel/Worker.hs
@@ -1,375 +0,0 @@--- |--- Module : Streamly.Internal.Data.Stream.Concurrent.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.Stream.Channel.Worker- (- Work (..)- , estimateWorkers- , isBeyondMaxRate- , workerRateControl-- -- * Send Events- , sendWithDoorBell- , sendYield- , sendStop- , handleChildException -- XXX rename to 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.Stream.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----------------------------------------------------------------------------------{-# 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------------------------------------------------------------------------------------ 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---- | 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 :: Limit -> IORef Int -> YieldRateInfo -> IO Bool-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.-{-# NOINLINE checkRatePeriodic #-}-checkRatePeriodic ::- Limit- -> IORef Int- -> YieldRateInfo- -> WorkerInfo- -> Count- -> IO Bool-checkRatePeriodic workerLimit workerCount rateInfo workerInfo ycnt = do- 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---- | CAUTION! this also updates the yield count and therefore should be called--- only when we are actually yielding an element.-{-# NOINLINE workerRateControl #-}-workerRateControl :: Limit -> IORef Int -> YieldRateInfo -> WorkerInfo -> IO Bool-workerRateControl workerLimit workerCount rateInfo workerInfo = do- cnt <- updateYieldCount workerInfo- beyondMaxRate <- checkRatePeriodic 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.---- | Returns whether the worker should continue (True) or stop (False).-{-# INLINE sendYield #-}-sendYield ::- Limit- -> Limit- -> IORef Int- -> Maybe WorkerInfo- -> Maybe YieldRateInfo- -> IORef ([ChildEvent a], Int)- -> MVar ()- -> ChildEvent a- -> IO Bool-sendYield bufferLimit workerLimit workerCount workerInfo rateInfo q bell msg =- do- oldlen <- sendWithDoorBell q bell 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 ->- workerRateControl 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--{-# INLINABLE sendStop #-}-sendStop ::- IORef Int- -> Maybe WorkerInfo- -> Maybe YieldRateInfo- -> IORef ([ChildEvent a], Int)- -> MVar ()- -> IO ()-sendStop workerCount workerInfo rateInfo q bell = do- atomicModifyIORefCAS_ workerCount $ \n -> n - 1- case (workerInfo, rateInfo) of- (Just winfo, Just rinfo) ->- workerStopUpdate winfo rinfo- _ ->- return ()- myThreadId >>= \tid ->- void $ sendWithDoorBell q bell (ChildStop tid Nothing)--{-# NOINLINE handleChildException #-}-handleChildException ::- IORef ([ChildEvent a], Int) -> MVar () -> SomeException -> IO ()-handleChildException q bell e = do- tid <- myThreadId- void $ sendWithDoorBell q bell (ChildStop tid (Just e))
+ 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
@@ -21,26 +21,10 @@ -- * Imports -- $setup - -- * Types- MonadAsync+ module Streamly.Internal.Data.Stream.Concurrent.Channel - -- * Configuration- , Config- , maxThreads- , maxBuffer- , eager- , StopWhen (..)- , stopWhen- , ordered- , interleaved- -- maxYields- , Rate(..)- , rate- , avgRate- , minRate- , maxRate- , constRate- , inspect+ -- * Types+ , MonadAsync -- * Combinators -- | Stream combinators using a concurrent channel@@ -92,7 +76,7 @@ -- ** Reactive , fromCallback- , tapCountD+ , parTapCount , tapCount ) where@@ -104,20 +88,16 @@ import Control.Monad.IO.Class (MonadIO(liftIO)) import Streamly.Internal.Control.Concurrent (MonadAsync, askRunInIO) import Streamly.Internal.Control.ForkLifted (forkManaged)-import Streamly.Internal.Data.Stream.Channel.Dispatcher (modifyThread)-import Streamly.Internal.Data.Stream.Channel.Types- ( ChildEvent(..)- , concatMapDivK- )-import Streamly.Internal.Data.Stream.Channel.Worker (sendWithDoorBell)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Stream.StreamD (Step(..))+import Streamly.Internal.Data.Channel.Dispatcher (modifyThread)+import Streamly.Internal.Data.Channel.Types (ChildEvent(..))+import Streamly.Internal.Data.Channel.Worker (sendWithDoorBell)+import Streamly.Internal.Data.Stream (Stream, Step(..))+import Streamly.Internal.Data.SVar.Type (adaptState) -import qualified Streamly.Internal.Data.IORef.Unboxed as Unboxed-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.MutArray 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.Stream.Concurrent.Channel@@ -132,6 +112,7 @@ -- >>> 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 hiding (append2) -- >>> import qualified Streamly.Internal.Data.Stream.Concurrent as Stream -- >>> import Prelude hiding (concatMap, concat, zipWith)@@ -176,6 +157,10 @@ -- multiple streams won't apply here e.g. maxThreads, eager, interleaved, -- ordered, stopWhen options won't have any effect. --+-- Useful idioms:+--+-- >>> parUnfoldrM step = Stream.parEval id . Stream.unfoldrM step+-- >>> parIterateM step = Stream.parEval id . Stream.iterateM step {-# INLINE parEval #-} parEval :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a parEval modifier input = withChannel modifier input (const id)@@ -273,6 +258,28 @@ modifier (Stream.toStreamK stream1) (Stream.toStreamK stream2) -------------------------------------------------------------------------------+-- Evaluator+-------------------------------------------------------------------------------++-- | @concatMapDivK useTail useHead stream@, divides the stream in head and+-- tail, maps a stream generator on the head and maps an action on the tail of+-- a stream. Returns the stream generated by the head.+--+-- Used for concurrent evaluation of streams using a Channel.+{-# INLINE concatMapDivK #-}+concatMapDivK :: Monad m =>+ (K.StreamK m a -> m ())+ -> (a -> K.StreamK m b)+ -> K.StreamK m a+ -> K.StreamK m b+concatMapDivK useTail useHead stream =+ K.mkStream $ \st yld sng stp -> do+ let foldShared = K.foldStreamShared st yld sng stp+ single a = foldShared $ useHead a+ yieldk a r = useTail r >> single a+ in K.foldStreamShared (adaptState st) yieldk single stp stream++------------------------------------------------------------------------------- -- concat streams ------------------------------------------------------------------------------- @@ -523,9 +530,9 @@ -- -- >>> parMapM modifier f = Stream.parConcatMap modifier (Stream.fromEffect . f) ----- Example, the following example finishes in 1 second as all actions run in--- parallel. Even though results are available out of order they are ordered--- due to the config option::+-- 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]@@ -539,9 +546,15 @@ (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@@ -675,11 +688,17 @@ ------------------------------------------------------------------------------- -- 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.+-- 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. ----- | 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.+-- The callback queues a value to a concurrent channel associated with the+-- stream. The stream can be evaluated safely in any thread. -- -- /Pre-release/ --@@ -690,10 +709,13 @@ -- 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.+ -- 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@@ -702,10 +724,23 @@ -- XXX Use fromChannelD? return (callback, fromChannel chan) --- | Supplies a stream generating callback to a callback setter function. Each--- invocation of the callback results in a value being generated in the--- resulting stream.+-- XXX Rename this to parSetCallback. Also take the Channel config as argument.+-- What config can be set by user here? --+-- 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.++-- | @fromCallback f@ creates an entangled pair of a callback and a stream i.e.+-- whenever the callback is called a value appears in the stream. The function+-- @f@ is invoked with the callback as argument, and the stream is returned.+-- @f@ would store the callback for calling it later for generating values in+-- the stream.+--+-- 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 fromCallback #-}@@ -715,14 +750,30 @@ setCallback callback return stream -{-# INLINE_NORMAL tapCountD #-}-tapCountD+-- | @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-tapCountD predicate fld (D.Stream step state) = D.Stream step' Nothing+parTapCount predicate fld (D.Stream step state) = D.Stream step' Nothing where {-# INLINE_LATE step' #-}@@ -733,7 +784,7 @@ countVar <- liftIO $ Unboxed.newIORef (0 :: Int) tid <- forkManaged $ void $ fld- $ Unboxed.toStreamD countVar+ $ Unboxed.pollIntIORef countVar return $ Skip (Just (countVar, tid, state)) step' gst (Just (countVar, tid, st)) = do@@ -748,22 +799,8 @@ liftIO $ killThread tid return Stop --- | @tapCount predicate fold stream@ taps the count of those elements in the--- stream that pass the @predicate@. The resulting count stream is sent to--- another thread which folds it using @fold@.------ 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.tapCount (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/---+{-# DEPRECATED tapCount "Please use parTapCount instead." #-}+-- | Same as 'parTapCount'. Deprecated. {-# INLINE tapCount #-} tapCount :: (MonadAsync m)@@ -771,4 +808,88 @@ -> (Stream m Int -> m b) -> Stream m a -> Stream m a-tapCount = tapCountD+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 parEval 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/Concurrent/Channel.hs view
@@ -8,15 +8,18 @@ module Streamly.Internal.Data.Stream.Concurrent.Channel (+ module Streamly.Internal.Data.Stream.Concurrent.Channel.Type+ , module Streamly.Internal.Data.Stream.Concurrent.Channel.Operations+ , module Streamly.Internal.Data.Stream.Concurrent.Channel.Append+ , module Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave+ , module Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher+ , module Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer+ -- * Channel- Channel (..)+ , Channel (..) , newChannel , withChannel , withChannelK- , fromChannel- , toChannel- , toChannelK- , stopChannel -- quiesceChannel -- wait for running tasks but do not schedule any more. -- * Configuration@@ -51,18 +54,18 @@ where import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.Concurrent.Channel.Operations- (fromChannel, fromChannelK, toChannel, toChannelK)+import Streamly.Internal.Data.Stream (Stream) -import qualified Streamly.Internal.Data.Stream.Concurrent.Channel.Append- as Append-import qualified Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave- as Interleave-import qualified Streamly.Internal.Data.Stream.StreamK as K+import qualified Streamly.Internal.Data.StreamK as K +import Streamly.Internal.Data.Channel.Types+ import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Stream.Channel.Types+import Streamly.Internal.Data.Stream.Concurrent.Channel.Operations+import Streamly.Internal.Data.Stream.Concurrent.Channel.Append+import Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave+import Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer -- | Create a new concurrent stream evaluation channel. The monad -- state used to run the stream actions is captured from the call site of@@ -73,8 +76,8 @@ newChannel modifier = let cfg = modifier defaultConfig in if getInterleaved cfg- then Interleave.newChannel modifier- else Append.newChannel modifier+ then newInterleaveChannel modifier+ else newAppendChannel modifier -- | Allocate a channel and evaluate the stream using the channel and the -- supplied evaluator function. The evaluator is run in a worker thread.
src/Streamly/Internal/Data/Stream/Concurrent/Channel/Append.hs view
@@ -7,7 +7,7 @@ -- Portability : GHC -- -- The functions in this module are separated from the combinators using--- these because of a GHC issue. We need to have newChannel specialized but+-- 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@@ -15,7 +15,7 @@ module Streamly.Internal.Data.Stream.Concurrent.Channel.Append (- newChannel+ newAppendChannel ) where @@ -32,17 +32,17 @@ (MonadRunInIO, RunInIO(..), askRunInIO, restoreM) import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS, atomicModifyIORefCAS_)-import Streamly.Internal.Data.Stream.Channel.Dispatcher (modifyThread)+import Streamly.Internal.Data.Channel.Dispatcher (modifyThread) import qualified Data.Heap as H import qualified Data.Set as Set-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K import Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer import Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Stream.Channel.Types-import Streamly.Internal.Data.Stream.Channel.Worker+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Channel.Worker ------------------------------------------------------------------------------ -- Concurrent streams with first-come-first serve results@@ -1037,10 +1037,10 @@ -- | 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--- newChannel.-{-# INLINABLE newChannel #-}-{-# SPECIALIZE newChannel :: (Config -> Config) -> IO (Channel IO a) #-}-newChannel :: MonadRunInIO m => (Config -> Config) -> m (Channel m a)-newChannel modifier = do+-- newAppendChannel.+{-# 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/Concurrent/Channel/Consumer.hs view
@@ -25,8 +25,8 @@ import Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Stream.Channel.Dispatcher-import Streamly.Internal.Data.Stream.Channel.Types+import Streamly.Internal.Data.Channel.Dispatcher+import Streamly.Internal.Data.Channel.Types ------------------------------------------------------------------------------- -- Reading from the workers' output queue/buffer
src/Streamly/Internal/Data/Stream/Concurrent/Channel/Dispatcher.hs view
@@ -34,9 +34,9 @@ (MicroSecond64(..), diffAbsTime64, fromRelTime64, toRelTime64) import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Stream.Channel.Dispatcher-import Streamly.Internal.Data.Stream.Channel.Types-import Streamly.Internal.Data.Stream.Channel.Worker+import Streamly.Internal.Data.Channel.Dispatcher+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Channel.Worker ------------------------------------------------------------------------------- -- Dispatching workers
src/Streamly/Internal/Data/Stream/Concurrent/Channel/Interleave.hs view
@@ -8,7 +8,7 @@ module Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave (- newChannel+ newInterleaveChannel ) where @@ -21,14 +21,14 @@ import Data.IORef (newIORef, readIORef) import Streamly.Internal.Control.Concurrent (MonadRunInIO, MonadAsync, RunInIO(..), askRunInIO, restoreM)-import Streamly.Internal.Data.Stream.Channel.Dispatcher (delThread)+import Streamly.Internal.Data.Channel.Dispatcher (delThread) import qualified Data.Set as Set-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K import Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Stream.Channel.Types+import Streamly.Internal.Data.Channel.Types ------------------------------------------------------------------------------ -- Creating a channel@@ -87,6 +87,8 @@ yieldk a r = do res <- liftIO $ yield sv winfo 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 @@ -240,11 +242,11 @@ -- -- | 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--- newChannel.-{-# INLINABLE newChannel #-}-{-# SPECIALIZE newChannel :: (Config -> Config) -> IO (Channel IO a) #-}-newChannel :: MonadAsync m =>+-- newInterleaveChannel.+{-# INLINABLE newInterleaveChannel #-}+{-# SPECIALIZE newInterleaveChannel :: (Config -> Config) -> IO (Channel IO a) #-}+newInterleaveChannel :: MonadAsync m => (Config -> Config) -> m (Channel m a)-newChannel modifier = do+newInterleaveChannel modifier = do mrun <- askRunInIO liftIO $ getFifoSVar mrun (modifier defaultConfig)
src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hs view
@@ -34,17 +34,17 @@ import Data.Maybe (isNothing) import Streamly.Internal.Control.Concurrent (MonadAsync, MonadRunInIO, askRunInIO)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)+import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import System.Mem (performMajorGC) -import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K import Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Stream.Channel.Types hiding (inspect)+import Streamly.Internal.Data.Channel.Types hiding (inspect) import Prelude hiding (map, concat, concatMap)
src/Streamly/Internal/Data/Stream/Concurrent/Channel/Type.hs view
@@ -25,12 +25,12 @@ import Data.Set (Set) import Streamly.Internal.Control.Concurrent (RunInIO) import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS_)-import Streamly.Internal.Data.Stream.Channel.Dispatcher (dumpSVarStats)-import Streamly.Internal.Data.Stream.Channel.Worker+import Streamly.Internal.Data.Channel.Dispatcher (dumpSVarStats)+import Streamly.Internal.Data.Channel.Worker (sendYield, sendStop, sendWithDoorBell)-import Streamly.Internal.Data.Stream.StreamK.Type (StreamK)+import Streamly.Internal.Data.StreamK (StreamK) -import Streamly.Internal.Data.Stream.Channel.Types+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
− src/Streamly/Internal/Data/Stream/Exception/Lifted.hs
@@ -1,331 +0,0 @@--- |--- Module : Streamly.Internal.Data.Stream.Exception.Lifted--- Copyright : (c) 2019 Composewell Technologies--- License : BSD-3-Clause--- Maintainer : streamly@composewell.com--- Stability : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.Exception.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.StreamD.Type (Stream)-import Streamly.Internal.Data.IOFinalizer.Lifted- (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)-import Streamly.Internal.Data.Stream.StreamD (Step(..))--import qualified Control.Monad.Catch as MC-import qualified Data.Map.Strict as Map-import qualified Streamly.Internal.Data.Stream.StreamD as D---- $setup--- >>> :m--- >>> import qualified Streamly.Internal.Data.Stream.Exception.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 >> return (D.nilM (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.------ /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 @m b@ with async exceptions disabled but keeping--- blocking operations interruptible (see 'Control.Exception.mask'). Use the--- output @b@ as input to @b -> Stream m a@ to generate an output stream.------ @b@ is usually a resource under the 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/----{-# 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/Instances.hs view
@@ -15,14 +15,11 @@ {-# INLINE (<$) #-}; \ (<$) = fmap . const }; \ \-instance (MonadBase b m, Monad m CONSTRAINT) => MonadBase b (STREAM m) where {\- liftBase = liftBaseDefault }; \- \ instance (MonadIO m CONSTRAINT) => MonadIO (STREAM m) where { \- liftIO = lift . liftIO }; \+ liftIO x = STREAM $ K.fromEffect $ liftIO x }; \ \ instance (MonadThrow m CONSTRAINT) => MonadThrow (STREAM m) where { \- throwM = lift . throwM }; \+ throwM x = STREAM $ K.fromEffect $ throwM x }; \ \ {- \ instance (MonadError e m CONSTRAINT) => MonadError e (STREAM m) where { \@@ -32,16 +29,16 @@ -} \ \ instance (MonadReader r m CONSTRAINT) => MonadReader r (STREAM m) where { \- ask = lift ask; \+ ask = STREAM $ K.fromEffect ask; \ local f (STREAM m) = STREAM $ withLocal f m }; \ \ instance (MonadState s m CONSTRAINT) => MonadState s (STREAM m) where { \ {-# INLINE get #-}; \- get = lift get; \+ get = STREAM $ K.fromEffect get; \ {-# INLINE put #-}; \- put x = lift (put x); \+ put x = STREAM $ K.fromEffect $ put x; \ {-# INLINE state #-}; \- state k = lift (state k) }+ state k = STREAM $ K.fromEffect $ state k } ------------------------------------------------------------------------------ -- Lists
src/Streamly/Internal/Data/Stream/IsStream.hs view
@@ -5,7 +5,7 @@ -- Copyright : (c) 2017 Composewell Technologies -- License : BSD-3-Clause -- Maintainer : streamly@composewell.com--- Stability : pre-release+-- Stability : experimental -- Portability : GHC -- -- This is an internal module which is a superset of the corresponding released@@ -22,6 +22,9 @@ , 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 )@@ -38,8 +41,11 @@ 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.StreamD as D+import qualified Streamly.Internal.Data.Stream as D {-# INLINE fromStream #-} fromStream :: (IsStream t, Monad m) => D.Stream m a -> t m a
src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs view
@@ -31,7 +31,7 @@ import Streamly.Internal.Data.Stream.IsStream.Type (IsStream, mkStream, foldStreamShared) import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream) import Streamly.Internal.Data.SVar
src/Streamly/Internal/Data/Stream/IsStream/Common.hs view
@@ -71,23 +71,23 @@ import Control.Monad.IO.Class (MonadIO(..)) import Foreign.Storable (Storable) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Array.Type (Array)-import Streamly.Internal.Data.Fold.Type (Fold (..))+import Streamly.Internal.Data.Array (Array)+import Streamly.Internal.Data.Fold (Fold (..)) import Streamly.Internal.Data.Stream.IsStream.Combinators (maxYields) import Streamly.Internal.Data.Stream.IsStream.Type (IsStream(..), fromStreamD, toStreamD) import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64) import Streamly.Internal.System.IO (defaultChunkSize)-import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Data.MutByteArray (Unbox) -import qualified Streamly.Internal.Data.Array.Type as A+import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.Stream.Async as Async import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream import qualified Streamly.Internal.Data.Stream.Parallel as Par-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (fromPure, fromEffect, repeatMWith, reverse)-import qualified Streamly.Internal.Data.Stream.StreamD as D+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
src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs view
@@ -164,27 +164,27 @@ import Streamly.Internal.Data.Stream.IsStream.Type (IsStream, fromStreamD, toStreamD) import Streamly.Internal.Data.Stream.Serial (SerialT)-import Streamly.Internal.Data.Unboxed (Unbox)+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.ParserD as PRD+import qualified Streamly.Internal.Data.Parser as PRD -- import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream 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.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (uncons, foldlS, tail, init) import qualified System.IO as IO import Prelude hiding- ( drop, take, takeWhile, foldr , foldl, mapM_, sequence, all, any, sum- , product, elem, notElem, maximum, minimum, head, last, tail, length- , null , reverse, init, and, or, lookup, foldr1, (!!) , splitAt, break+ ( Foldable(..), drop, take, takeWhile, mapM_, sequence, all, any+ , notElem, head, last, tail+ , reverse, init, and, or, lookup, (!!), splitAt, break , mconcat) -- $setup
src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs view
@@ -65,7 +65,7 @@ import Streamly.Internal.Data.Stream.IsStream.Type (IsStream(..), fromStreamD) import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D ( enumerateFromNum , enumerateFromThenNum , enumerateFromThenToIntegral
src/Streamly/Internal/Data/Stream/IsStream/Exception.hs view
@@ -32,7 +32,7 @@ import Streamly.Internal.Data.Stream.IsStream.Type (IsStream(..), fromStreamD, toStreamD) -import qualified Streamly.Internal.Data.Stream.StreamD.Exception as D+import qualified Streamly.Internal.Data.Stream as D ( before , afterUnsafe , onException@@ -42,7 +42,7 @@ , handle ) -import qualified Streamly.Internal.Data.Stream.Exception.Lifted as D+import qualified Streamly.Internal.Data.Stream.Lifted as D ( afterD , bracket3D , retryD@@ -225,7 +225,7 @@ => (e -> t m a -> t m a) -> t m a -> t m a ghandle handler = fromStreamD- . D.ghandle (\e xs -> toStreamD $ handler e (fromStreamD xs))+ . D.ghandle (\e xs -> return $ toStreamD $ handler e (fromStreamD xs)) . toStreamD -- | When evaluating a stream if an exception occurs, stream evaluation aborts@@ -238,7 +238,7 @@ handle :: (IsStream t, MonadCatch m, Exception e) => (e -> t m a) -> t m a -> t m a handle handler xs =- fromStreamD $ D.handle (toStreamD . handler) $ toStreamD xs+ fromStreamD $ D.handle (return . toStreamD . handler) $ toStreamD xs -- | @retry@ takes 3 arguments
src/Streamly/Internal/Data/Stream/IsStream/Expand.hs view
@@ -178,14 +178,13 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D (append, interleave, interleaveFstSuffix, interleaveFst, interleaveMin , roundRobin, mergeByM, unfoldMany, unfoldInterleave, intersperse , unfoldRoundRobin, interpose, interposeSuffix, gintercalate , gintercalateSuffix, intersperseMSuffix)-import qualified Streamly.Internal.Data.Stream.StreamK as K (mergeBy, mergeByM)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K- (interleave, append, mergeMapWith)+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)
src/Streamly/Internal/Data/Stream/IsStream/Generate.hs view
@@ -92,7 +92,7 @@ import Control.Monad.IO.Class (MonadIO(..)) import Data.Void (Void) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Unfold.Type (Unfold)+import Streamly.Internal.Data.Unfold (Unfold) import Streamly.Internal.Data.SVar (Rate (..)) import Streamly.Internal.Data.Stream.IsStream.Enumeration (Enumerable(..), enumerate, enumerateTo)@@ -103,18 +103,18 @@ (IsStream (..), fromSerial, consM, fromStreamD) import Streamly.Internal.Data.Stream.Serial (SerialT, WSerialT) import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64)-import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Data.MutByteArray (Unbox) -import qualified Streamly.Internal.Data.IORef.Unboxed as Unboxed- (toStreamD, IORef)+import qualified Streamly.Internal.Data.MutArray as Unboxed+ (pollIntIORef, IORef) import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Stream.StreamD as D+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.Stream.StreamK.Type as K+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)@@ -637,4 +637,4 @@ -- {-# INLINE fromPrimIORef #-} fromPrimIORef :: (IsStream t, MonadIO m, Unbox a) => Unboxed.IORef a -> t m a-fromPrimIORef = fromStreamD . Unboxed.toStreamD+fromPrimIORef = fromStreamD . Unboxed.pollIntIORef
src/Streamly/Internal/Data/Stream/IsStream/Lift.hs view
@@ -34,7 +34,7 @@ (IsStream(..), fromStreamD, toStreamD) import Streamly.Internal.Data.Stream.Serial (SerialT) -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D (morphInner, liftInner, runReaderT, evalStateT, runStateT) ------------------------------------------------------------------------------
src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs view
@@ -160,11 +160,11 @@ import Data.Proxy (Proxy(..)) import Foreign.Storable (Storable) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Fold.Type (Fold (..))+import Streamly.Internal.Data.Fold (Fold (..)) import Streamly.Internal.Data.IsMap (IsMap(..)) import Streamly.Internal.Data.Refold.Type (Refold (..)) import Streamly.Internal.Data.Parser (Parser (..), ParseError)-import Streamly.Internal.Data.Array.Type (Array)+import Streamly.Internal.Data.Array (Array) import Streamly.Internal.Data.Stream.IsStream.Common ( fold , interjectSuffix@@ -180,18 +180,18 @@ import Streamly.Internal.Data.Time.Units ( AbsTime, MilliSecond64(..), addToAbsTime, toRelTime , toAbsTime)-import Streamly.Internal.Data.Unboxed (Unbox)+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.Type as A+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.ParserD as PRD (Parser(..))+import qualified Streamly.Internal.Data.Parser as PRD (Parser(..)) import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D ( foldMany , groupsOf , refoldMany@@ -1321,10 +1321,10 @@ -> 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) input =+ (Fold step initial extract final) input = Expand.unfoldMany (Unfold.lmap (toStreamK . sessionOutputStream) Unfold.fromStreamK)- $ scanlMAfter' sstep (return szero) (flush extract)+ $ scanlMAfter' sstep (return szero) (flush final) $ interjectSuffix tick (return Nothing) $ map Just input
src/Streamly/Internal/Data/Stream/IsStream/Top.hs view
@@ -72,8 +72,7 @@ -- 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 (one, last)-import qualified Streamly.Internal.Data.Fold.Type as Fold+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@@ -83,9 +82,9 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Reduce as Stream import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Stream import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream-import qualified Streamly.Internal.Data.Stream.StreamD as StreamD+import qualified Streamly.Internal.Data.Stream as StreamD -import Prelude hiding (filter, zipWith, concatMap, concat)+import Prelude hiding (Foldable(..), filter, zipWith, concatMap, concat) -- $setup -- >>> :m
src/Streamly/Internal/Data/Stream/IsStream/Transform.hs view
@@ -220,8 +220,8 @@ import Data.Either (isLeft, isRight, fromLeft, fromRight) import Data.Kind (Type) import Data.Maybe (isJust, fromJust)-import Streamly.Internal.Data.Fold.Type (Fold (..))-import Streamly.Internal.Data.Pipe.Type (Pipe (..))+import Streamly.Internal.Data.Fold (Fold (..))+import Streamly.Internal.Data.Pipe (Pipe (..)) import Streamly.Internal.Data.Stream.IsStream.Combinators ( inspectMode, maxBuffer, maxThreads, rate, avgRate, minRate , maxRate, constRate)@@ -256,7 +256,7 @@ import qualified Streamly.Internal.Data.Stream.Concurrent as Concur import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream as D (transform, foldrT, tap, tapOffsetEvery, mapM, scan , scanMany, postscan, scanlx', scanlM', scanl', postscanl', prescanl' , prescanlM', scanl1M', scanl1', filter, filterM, uniq, deleteBy, takeWhileM@@ -264,7 +264,7 @@ , intersperseM_, intersperseMSuffix, intersperseMSuffix_ , intersperseMSuffixWith, indexed, indexedR, rollingMap, rollingMapM , rollingMap2, mapMaybe, mapMaybeM)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (foldrS, foldrSShared, mapMWith) import qualified Prelude @@ -583,7 +583,7 @@ -> t m a pollCounts predicate f xs = fromStreamD- $ Concur.tapCountD predicate (f . fromStreamD)+ $ Concur.parTapCount predicate (f . fromStreamD) $ toStreamD xs -- | Apply a monadic function to each element flowing through the stream and
src/Streamly/Internal/Data/Stream/IsStream/Type.hs view
@@ -103,7 +103,7 @@ where import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Fold.Type (Fold (..))+import Streamly.Internal.Data.Fold (Fold (..)) import Streamly.Internal.Data.Stream.Serial (SerialT, Serial, WSerialT(..), WSerial) import Streamly.Internal.Data.Stream.Async@@ -119,21 +119,22 @@ import qualified Streamly.Internal.Data.Stream.Async as Async import qualified Streamly.Internal.Data.Stream.Parallel as Parallel import qualified Streamly.Internal.Data.Stream.Serial as Serial-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as D (Stream(..), toStreamK, fromStreamK , drain, eqBy, cmpBy, fromList, toList, foldrMx, foldlMx' , foldlx', foldl', fold)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (StreamK(..), cons, fromEffect , nil, fromPure, bindWith, drain , fromFoldable, nilM, repeat)-import qualified Streamly.Internal.Data.Stream.StreamK as StreamK+import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK, toStreamK) import qualified Streamly.Internal.Data.Stream.Zip as Zip import qualified Streamly.Internal.Data.Stream.ZipAsync as ZipAsync -import Prelude hiding (foldr, repeat)+import Prelude hiding (Foldable(..), repeat)+import Data.Foldable (Foldable) #include "inline.hs"
+ 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.Exception.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/Parallel.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- | -- Module : Streamly.Internal.Data.Stream.Parallel@@ -48,26 +49,30 @@ 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) 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.StreamD.Type (Step(..))+import Streamly.Internal.Data.Stream (Step(..)) import qualified Data.Set as Set-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (StreamK, foldStreamShared, mkStream, foldStream, fromEffect , nil, concatMapWith, fromPure, bindWith)-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+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@@ -431,9 +436,11 @@ -- @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.@@ -502,6 +509,11 @@ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------++#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m, MonadAsync m) => MonadBase b (ParallelT m) where+ liftBase = liftBaseDefault+#endif MONAD_COMMON_INSTANCES(ParallelT, MONADPARALLEL)
+ src/Streamly/Internal/Data/Stream/Prelude.hs view
@@ -0,0 +1,19 @@+-- |+-- 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+ (+ module Streamly.Internal.Data.Stream.Concurrent+ , module Streamly.Internal.Data.Stream.Time+ , module Streamly.Internal.Data.Stream.Lifted+ )+where++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,18 @@+-- |+-- 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
@@ -36,13 +36,13 @@ import Streamly.Internal.Control.ForkLifted (doFork) import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS_) import Streamly.Internal.Data.Fold.SVar (write, writeLimited)-import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Fold (Fold(..)) import Streamly.Internal.Data.Stream.Serial (SerialT) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) -import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as D (Stream(..), Step(..), fold)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (Stream, mkStream, foldStream, foldStreamShared, nilM) import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK, toStreamK)
src/Streamly/Internal/Data/Stream/SVar/Generate.hs view
@@ -43,9 +43,9 @@ import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import System.Mem (performMajorGC) -import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as D (Stream(..), Step(..))-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK as K (Stream, foldStreamShared, mkStream, foldStream) import qualified Streamly.Internal.Data.Stream.Serial as Stream (fromStreamK) @@ -162,6 +162,7 @@ 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@@ -177,6 +178,7 @@ , ''Typeable , ''Functor ]+#endif #endif -- | Generate a stream from an SVar. An unevaluated stream can be pushed to an
src/Streamly/Internal/Data/Stream/Serial.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- | -- Module : Streamly.Internal.Data.Stream.Serial@@ -47,9 +48,13 @@ ) 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(..))@@ -65,13 +70,11 @@ , readListPrecDefault) import Streamly.Internal.BaseCompat ((#.)) import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream) import qualified Streamly.Internal.Data.Stream.Common as P-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as D-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K import Prelude hiding (map, mapM, repeat, filter) @@ -406,6 +409,11 @@ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------++#if !(MIN_VERSION_transformers(0,6,0))+instance (MonadBase b m, Monad m) => MonadBase b (SerialT m) where+ liftBase = liftBaseDefault+#endif MONAD_COMMON_INSTANCES(WSerialT,) LIST_INSTANCES(WSerialT)
src/Streamly/Internal/Data/Stream/Time.hs view
@@ -25,7 +25,7 @@ -- * Chunking , intervalsOf- , chunksOfTimeout+ , groupsOfTimeout -- * Sampling , sampleIntervalEnd@@ -60,9 +60,9 @@ import Data.Maybe (isNothing) import Data.Proxy (Proxy(..)) import Streamly.Data.Fold (Fold)-import Streamly.Internal.Data.Fold.Type (Fold (..))+import Streamly.Internal.Data.Fold (Fold (..)) import Streamly.Internal.Data.IsMap (IsMap(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)+import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Time.Units ( AbsTime , MilliSecond64(..)@@ -78,7 +78,7 @@ 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.StreamD as Stream+import qualified Streamly.Internal.Data.Stream as Stream ( scanlMAfter' , timeIndexed , timestamped@@ -239,13 +239,13 @@ -- is 100 ms. -- -- >>> s = Stream.delayPost 0.3 $ Stream.fromList [1..1000]--- >>> f = Stream.fold (Fold.drainMapM print) $ Stream.chunksOfTimeout 5 1 Fold.toList s+-- >>> f = Stream.fold (Fold.drainMapM print) $ Stream.groupsOfTimeout 5 1 Fold.toList s -- -- /Pre-release/-{-# INLINE chunksOfTimeout #-}-chunksOfTimeout :: MonadAsync m+{-# INLINE groupsOfTimeout #-}+groupsOfTimeout :: MonadAsync m => Int -> Double -> Fold m a b -> Stream m a -> Stream m b-chunksOfTimeout n timeout f =+groupsOfTimeout n timeout f = fmap snd . classifySessionsBy 0.1 False (const (return False)) timeout (Fold.take n f)@@ -536,9 +536,9 @@ -- data) -> Stream m (Key f, b) -- ^ session key, fold result classifySessionsByGeneric _ tick reset ejectPred tmout- (Fold step initial extract) input =+ (Fold step initial extract final) input = Stream.unfoldMany (Unfold.lmap sessionOutputStream Unfold.fromStream)- $ Stream.scanlMAfter' sstep (return szero) (flush extract)+ $ Stream.scanlMAfter' sstep (return szero) (flush final) $ interject (return Nothing) tick $ fmap Just input
src/Streamly/Internal/Data/Stream/Zip.hs view
@@ -13,8 +13,11 @@ -- To run examples in this module: -- -- >>> import qualified Streamly.Prelude as Stream+-- >>> import qualified Streamly.Internal.Data.Stream as D+-- >>> import qualified Streamly.Data.Fold as Fold -- module Streamly.Internal.Data.Stream.Zip+ {-# DEPRECATED "Use \"Streamly.Data.Stream.MkType\" instead." #-} ( ZipSerialM (..) , ZipSerial@@ -22,12 +25,16 @@ , zipWithK , zipWithMK + , ZipConcurrent (..)+ -- * Deprecated , ZipStream ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Control.DeepSeq (NFData(..)) #if MIN_VERSION_deepseq(1,4,3) import Control.DeepSeq (NFData1(..))@@ -46,11 +53,12 @@ import Streamly.Internal.BaseCompat ((#.)) import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe) import Streamly.Internal.Data.Stream.Serial (SerialT(..))-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream)+import Streamly.Internal.Data.Stream.Concurrent (MonadAsync, parZipWith) import qualified Streamly.Internal.Data.Stream.Common as P-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamD as D+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)@@ -59,6 +67,8 @@ -- $setup -- >>> import qualified Streamly.Prelude as Stream+-- >>> import qualified Streamly.Internal.Data.Stream as D+-- >>> import qualified Streamly.Data.Fold as Fold -- >>> import Control.Concurrent (threadDelay) -- >>> :{ -- delay n = do@@ -133,3 +143,27 @@ FOLDABLE_INSTANCE(ZipSerialM) TRAVERSABLE_INSTANCE(ZipSerialM)++-------------------------------------------------------------------------------+-- ZipConcurrent+-------------------------------------------------------------------------------++newtype ZipConcurrent m a = ZipConcurrent {getZipConcurrent :: D.Stream m a}+ deriving (Functor)++-- | An IO stream whose applicative instance zips streams concurrently. Note+-- that it uses the default concurrency options.+--+-- >>> s = ZipConcurrent $ D.fromList [1, 2, 3]+-- >>> x = (,,) <$> s <*> s <*> s+-- >>> D.fold Fold.toList (getZipConcurrent x)+-- [(1,1,1),(2,2,2),(3,3,3)]+--+-- @since 0.9.0++instance MonadAsync m => Applicative (ZipConcurrent m) where+ pure = ZipConcurrent . D.repeat++ {-# INLINE (<*>) #-}+ ZipConcurrent m1 <*> ZipConcurrent m2 =+ ZipConcurrent $ parZipWith id id m1 m2
− src/Streamly/Internal/Data/Stream/Zip/Concurrent.hs
@@ -1,50 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}--- |--- Module : Streamly.Internal.Data.Stream.Concurrent--- 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.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Data.Fold as Fold----module Streamly.Internal.Data.Stream.Zip.Concurrent- (- ZipConcurrent (..)- )-where--import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.Concurrent (MonadAsync, parZipWith)--import qualified Streamly.Internal.Data.Stream.StreamD as Stream (repeat)-import Prelude hiding (map, repeat, zipWith)---- $setup--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Data.Fold as Fold-----newtype ZipConcurrent m a = ZipConcurrent {getZipConcurrent :: Stream m a}- deriving (Functor)---- | An IO stream whose applicative instance zips streams concurrently. Note--- that it uses the default concurrency options.------ >>> s = ZipConcurrent $ Stream.fromList [1, 2, 3]--- >>> x = (,,) <$> s <*> s <*> s--- >>> Stream.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 . Stream.repeat-- {-# INLINE (<*>) #-}- ZipConcurrent m1 <*> ZipConcurrent m2 =- ZipConcurrent $ parZipWith id id m1 m2
src/Streamly/Internal/Data/Stream/ZipAsync.hs view
@@ -13,7 +13,8 @@ -- -- >>> import qualified Streamly.Prelude as Stream ---module Streamly.Internal.Data.Stream.ZipAsync {-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream.Zip.Concurrent\" instead." #-}+module Streamly.Internal.Data.Stream.ZipAsync+ {-# DEPRECATED "Use \"Streamly.Data.Stream.MkType\" instead." #-} ( ZipAsyncM(..) , ZipAsync , consMZipAsync@@ -23,11 +24,11 @@ where import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Stream.StreamK.Type (Stream)+import Streamly.Internal.Data.StreamK (Stream) -import qualified Streamly.Internal.Data.Stream.StreamK as K+import qualified Streamly.Internal.Data.StreamK as K (mkStream, foldStream, zipWithM, consM)-import qualified Streamly.Internal.Data.Stream.StreamD as D (fromStreamK)+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
src/Streamly/Internal/Data/Unfold/Exception.hs view
@@ -25,11 +25,9 @@ (MonadRunInIO, MonadAsync, withRunInIO) import Streamly.Internal.Data.IOFinalizer.Lifted (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))- import qualified Control.Monad.Catch as MC -import Streamly.Internal.Data.Unfold.Type+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
+ src/Streamly/Internal/Data/Unfold/Prelude.hs view
@@ -0,0 +1,17 @@+-- |+-- 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+ , module Streamly.Internal.Data.Unfold.SVar+ )+where++import Streamly.Internal.Data.Unfold.Exception+import Streamly.Internal.Data.Unfold.SVar
src/Streamly/Internal/Data/Unfold/SVar.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Streamly.Internal.Data.Unfold.SVar -- Copyright : (c) 2019 Composewell Technologies@@ -21,10 +22,10 @@ import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef) import Data.Maybe (isNothing) import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))+import Streamly.Internal.Data.Stream (Step(..)) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import Streamly.Internal.Data.SVar (printSVar, cleanupSVar, sendStopToProducer)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Unfold (Unfold(..)) import System.Mem (performMajorGC) import qualified Control.Monad.Catch as MC
src/Streamly/Internal/FileSystem/Event.hs view
@@ -47,8 +47,8 @@ import Data.List.NonEmpty (NonEmpty) import Data.Word (Word8)-import Streamly.Internal.Data.Array (Array)-import Streamly.Internal.Data.Stream.StreamD (Stream)+import Streamly.Data.Array (Array)+import Streamly.Data.Stream (Stream) #if defined(CABAL_OS_DARWIN) import Streamly.Internal.FileSystem.Event.Darwin (Event)
src/Streamly/Internal/FileSystem/Event/Darwin.hs view
@@ -175,7 +175,7 @@ import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Cont (contListMap) import Streamly.Internal.Data.Parser (Parser)-import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Array (Array(..)) import System.IO (Handle, hClose) import qualified Data.List.NonEmpty as NonEmpty@@ -493,9 +493,9 @@ readOneEvent = do arr <- PR.takeEQ 24 (A.writeN 24) let arr1 = A.castUnsafe arr :: Array Word64- eid = A.unsafeIndex 0 arr1- eflags = A.unsafeIndex 1 arr1- pathLen = fromIntegral $ A.unsafeIndex 2 arr1+ eid = A.getIndexUnsafe 0 arr1+ eflags = A.getIndexUnsafe 1 arr1+ pathLen = fromIntegral $ A.getIndexUnsafe 2 arr1 path <- PR.takeEQ pathLen (A.writeN pathLen) return $ Event { eventId = eid
src/Streamly/Internal/FileSystem/Event/Linux.hs view
@@ -171,23 +171,29 @@ import GHC.IO.Device (IODeviceType(Stream)) import GHC.IO.FD (fdFD, mkFD) import GHC.IO.Handle.FD (mkHandleFromFD)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Parser (Parser)-import Streamly.Internal.Data.Array.Type (Array(..), byteLength)+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 qualified Data.IntMap.Lazy as Map import qualified Data.List.NonEmpty as NonEmpty-import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Data.Fold as FL+import qualified Streamly.Data.Array as A (fromList, writeN, 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.Data.Array as A+ ( fromStream, asCStringUnsafe, asPtrUnsafe+ , getSliceUnsafe, read+ )+import qualified Streamly.Internal.FileSystem.Dir as Dir (readDirs) import qualified Streamly.Internal.Data.Parser as PR (takeEQ, fromEffect, fromFold)-import qualified Streamly.Internal.Data.Stream.StreamD as S-import qualified Streamly.Internal.FileSystem.Dir as Dir-import qualified Streamly.Internal.FileSystem.Handle as FH-import qualified Streamly.Internal.Unicode.Stream as U ------------------------------------------------------------------------------- -- Subscription to events
src/Streamly/Internal/FileSystem/Event/Windows.hs view
@@ -98,8 +98,6 @@ import Foreign.Marshal.Alloc (alloca, allocaBytes) import Foreign.Storable (peekByteOff) import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)-import Streamly.Internal.Data.Stream (Stream)-import Streamly.Internal.Data.Stream.Concurrent (eager) import System.Win32.File ( FileNotificationFlag , LPOVERLAPPED@@ -118,14 +116,19 @@ , oPEN_EXISTING ) import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)++import Streamly.Data.Array (Array)+import Streamly.Data.Stream (Stream)+import Streamly.Data.Stream.Prelude (eager)+ import qualified Data.List.NonEmpty as NonEmpty+import qualified Streamly.Data.Array as A (fromList) import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream as S-import qualified Streamly.Internal.Data.Stream.Concurrent as S (parConcatMap)-import qualified Streamly.Internal.Unicode.Stream as U-import qualified Streamly.Internal.Unicode.Utf8 as UTF8-import qualified Streamly.Internal.Data.Array as A-import Streamly.Internal.Data.Array (Array)+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.
src/Streamly/Internal/FileSystem/FD.hs view
@@ -120,7 +120,6 @@ import Data.Word (Word8) -- import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Ptr (castPtr)-import Streamly.Internal.Data.Unboxed (Unbox) -- import System.IO (Handle, hGetBufSome, hPutBuf) import System.IO (IOMode) import Prelude hiding (read)@@ -128,10 +127,12 @@ import qualified GHC.IO.FD as FD import qualified GHC.IO.Device as RawIO -import Streamly.Internal.Data.Array.Type- (Array(..), byteLength, unsafeFreeze, asPtrUnsafe)+import Streamly.Data.Array (Array, Unbox)+import Streamly.Data.Stream (Stream)++import Streamly.Internal.Data.Array (byteLength, unsafeFreeze, asPtrUnsafe) import Streamly.Internal.System.IO (defaultChunkSize)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)+ #if !defined(mingw32_HOST_OS) {- import Streamly.Internal.Data.Stream.IsStream.Type (toStreamD)@@ -145,13 +146,13 @@ import qualified Streamly.Data.Array as A import qualified Streamly.Data.Fold as FL-import qualified Streamly.Internal.Data.Array.Mut as MArray- (MutArray(..), newPinnedBytes, asPtrUnsafe)-import qualified Streamly.Internal.Data.Stream.Chunked as AS-import qualified Streamly.Internal.Data.Stream.StreamD as S-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.MutArray as MArray+ (MutArray(..), asPtrUnsafe, 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.Stream.StreamK.Type as K (mkStream)+import qualified Streamly.Internal.Data.StreamK as K (mkStream) -------------------------------------------------------------------------------@@ -217,7 +218,7 @@ {-# INLINABLE readArrayUpto #-} readArrayUpto :: Int -> Handle -> IO (Array Word8) readArrayUpto size (Handle fd) = do- arr <- MArray.newPinnedBytes size+ arr <- MArray.pinnedNewBytes size -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8)) MArray.asPtrUnsafe arr $ \p -> do -- n <- hGetBufSome h p size
src/Streamly/Internal/Network/Inet/TCP.hs view
@@ -11,20 +11,25 @@ module Streamly.Internal.Network.Inet.TCP (+ -- * Setup+ -- | To execute the code examples provided in this module in ghci, please+ -- run the following commands first.+ --+ -- $setup+ -- * TCP Servers -- ** Streams- acceptOnAddr+ accept+ , acceptLocal+ , acceptOnAddr , acceptOnAddrWith- , acceptOnPort- -- , acceptOnPortWith- , acceptOnPortLocal -- ** Unfolds+ , acceptor+ , acceptorLocal+ , acceptorWith , acceptorOnAddr , acceptorOnAddrWith- , acceptorOnPort- , acceptorOnPortWith- , acceptorOnPortLocal -- * TCP clients -- | IP Address based operations.@@ -89,6 +94,10 @@ , datagrams , datagramsOn -}++ -- * Deprecated+ , acceptorOnPort+ , acceptorOnPortLocal ) where @@ -106,13 +115,14 @@ import Streamly.Internal.Control.Concurrent (MonadAsync) import Streamly.Internal.Control.ForkLifted (fork)-import Streamly.Internal.Data.Array.Type (Array(..), writeNUnsafe)-import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Data.Array (Array)+import Streamly.Internal.Data.Array (pinnedWriteNUnsafe)+import Streamly.Internal.Data.Fold ( Fold(..) ) import Streamly.Data.Stream (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.Network.Socket (SockSpec(..), accept, acceptor)+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@@ -120,14 +130,21 @@ 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.Type as A-import qualified Streamly.Internal.Data.Unfold as UF (first, bracketIO)-import qualified Streamly.Internal.Data.Fold.Type as FL (Step(..), reduce)-import qualified Streamly.Internal.Data.Stream.StreamD as S-import qualified Streamly.Internal.Data.Stream.Exception.Lifted as S+import qualified Streamly.Internal.Data.Array as A (pinnedChunksOf)+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) -------------------------------------------------------------------------------@@ -137,7 +154,7 @@ :: MonadIO m => [(SocketOption, Int)] -> Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket-acceptorOnAddrWith opts = UF.lmap f acceptor+acceptorOnAddrWith opts = UF.lmap f ISK.acceptor where f (addr, port) = (maxListenQueue@@ -160,36 +177,50 @@ => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket acceptorOnAddr = acceptorOnAddrWith [] -{-# INLINE acceptorOnPortWith #-}-acceptorOnPortWith :: MonadIO m+{-# INLINE acceptorWith #-}+acceptorWith :: MonadIO m => [(SocketOption, Int)] -> Unfold m PortNumber Socket-acceptorOnPortWith opts = UF.first (0,0,0,0) (acceptorOnAddrWith opts)+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. ----- > acceptorOnPort = UF.first acceptorOnAddr (0,0,0,0)+-- >>> 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 = UF.first (0,0,0,0) acceptorOnAddr+acceptorOnPort = acceptor --- | Like 'acceptorOnAddr' 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.+-- | 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. ----- > acceptorOnPortLocal = UF.first acceptorOnAddr (127,0,0,1)+-- >>> 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 = UF.first (127,0,0,1) acceptorOnAddr+acceptorOnPortLocal = acceptorLocal ------------------------------------------------------------------------------- -- Accept (streams) ------------------------------------------------------------------------------- +-- | Like 'acceptOnAddr' but with the ability to specify a list of socket+-- options.+--+-- /Pre-release/ {-# INLINE acceptOnAddrWith #-} acceptOnAddrWith :: MonadIO m@@ -198,7 +229,7 @@ -> PortNumber -> Stream m Socket acceptOnAddrWith opts addr port =- accept maxListenQueue SockSpec+ ISK.accept maxListenQueue SockSpec { sockFamily = AF_INET , sockType = Stream , sockProto = defaultProtocol@@ -206,9 +237,10 @@ } (SockAddrInet port (tupleToHostAddress addr)) --- | Like 'accept' but binds on the specified IPv4 address of the machine--- and listens for TCP connections on the specified port.+-- | Like 'accept' but binds on the specified IPv4 address. --+-- >>> acceptOnAddr = TCP.acceptOnAddrWith []+-- -- /Pre-release/ {-# INLINE acceptOnAddr #-} acceptOnAddr@@ -218,27 +250,27 @@ -> Stream m Socket acceptOnAddr = acceptOnAddrWith [] --- | Like 'accept' but binds on the IPv4 address @0.0.0.0@ i.e. on all--- IPv4 addresses/interfaces of the machine and listens for TCP connections on--- the specified port.+-- | Start a TCP stream server that binds on the IPV4 address @0.0.0.0@ and+-- listens for TCP connections from remote hosts on the specified server port.+-- The server generates a stream of connected sockets. ----- > acceptOnPort = acceptOnAddr (0,0,0,0)+-- >>> accept = TCP.acceptOnAddr (0,0,0,0) -- -- /Pre-release/-{-# INLINE acceptOnPort #-}-acceptOnPort :: MonadIO m => PortNumber -> Stream m Socket-acceptOnPort = acceptOnAddr (0,0,0,0)+{-# 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. ----- > acceptOnPortLocal = acceptOnAddr (127,0,0,1)+-- >>> acceptLocal = TCP.acceptOnAddr (127,0,0,1) -- -- /Pre-release/-{-# INLINE acceptOnPortLocal #-}-acceptOnPortLocal :: MonadIO m => PortNumber -> Stream m Socket-acceptOnPortLocal = acceptOnAddr (127,0,0,1)+{-# INLINE acceptLocal #-}+acceptLocal :: MonadIO m => PortNumber -> Stream m Socket+acceptLocal = acceptOnAddr (127,0,0,1) ------------------------------------------------------------------------------- -- TCP Clients@@ -355,7 +387,7 @@ => (Word8, Word8, Word8, Word8) -> PortNumber -> Fold m (Array Word8) ()-writeChunks addr port = Fold step initial extract+writeChunks addr port = Fold step initial extract final where initial = do skt <- liftIO (connect addr port)@@ -365,12 +397,15 @@ step (Tuple' fld skt) x = do r <- FL.addOne x fld `MC.onException` liftIO (Net.close skt) return $ FL.Partial (Tuple' r skt)- extract (Tuple' (Fold _ initial1 extract1) skt) = do++ extract _ = return ()++ final (Tuple' (Fold _ initial1 _ final1) skt) = do liftIO $ Net.close skt res <- initial1 case res of- FL.Partial fs -> extract1 fs- FL.Done fb -> return fb+ FL.Partial fs -> final1 fs+ FL.Done () -> return () -- | Like 'write' but provides control over the write buffer. Output will -- be written to the IO device as soon as we collect the specified number of@@ -385,7 +420,8 @@ -> PortNumber -> Stream m Word8 -> m ()-putBytesWithBufferOf n addr port m = putChunks addr port $ A.chunksOf n m+putBytesWithBufferOf n addr port m =+ putChunks addr port $ A.pinnedChunksOf 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@@ -399,7 +435,7 @@ -> PortNumber -> Fold m Word8 () writeWithBufferOf n addr port =- FL.groupsOf n (writeNUnsafe n) (writeChunks addr port)+ FL.groupsOf n (pinnedWriteNUnsafe n) (writeChunks addr port) -- | Write a stream to the supplied IPv4 host address and port number. --
src/Streamly/Internal/Network/Socket.hs view
@@ -11,7 +11,7 @@ -- module Streamly.Internal.Network.Socket (- SockSpec (..)+ SockSpec (..) -- * Use a socket , forSocketM , withSocket@@ -72,7 +72,7 @@ import Data.Maybe (isNothing, fromJust) import Data.Word (Word8) import Foreign.Ptr (plusPtr, Ptr, castPtr)-import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Data.MutByteArray (Unbox) import Network.Socket (Socket, SocketOption(..), Family(..), SockAddr(..), ProtocolNumber, withSocketsDo, SocketType(..), socket, bind,@@ -86,26 +86,25 @@ import qualified Network.Socket as Net -import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Stream.Chunked (lpackArraysChunksOf)-import Streamly.Internal.Data.Fold (Fold)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Array (Array(..))+import Streamly.Internal.Data.Array.Stream (lpackArraysChunksOf)+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 (reader, length, writeN)+import qualified Streamly.Data.Array as A import qualified Streamly.Data.Fold as FL-import qualified Streamly.Internal.Data.Array.Type as A- (unsafeFreeze, asPtrUnsafe, byteLength, writeNUnsafe, chunksOf)-import qualified Streamly.Internal.Data.Array.Mut as MArray- (MutArray(..), newPinnedBytes, asPtrUnsafe)-import qualified Streamly.Internal.Data.Stream.StreamD as S-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D- (Stream(..), Step(..))+import qualified Streamly.Data.Stream as S import qualified Streamly.Data.Unfold as UF-import qualified Streamly.Internal.Data.Unfold as UF (first, map)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (mkStream)+import qualified Streamly.Internal.Data.Array as A+ ( unsafeFreeze, asPtrUnsafe, byteLength, pinnedChunksOf,+ pinnedWriteN, pinnedWriteNUnsafe )+import qualified Streamly.Internal.Data.MutArray as MArray+ (MutArray(..), asPtrUnsafe, pinnedNewBytes)+import qualified Streamly.Internal.Data.Stream as S (fromStreamK, Stream(..), Step(..))+import qualified Streamly.Internal.Data.StreamK as K (mkStream) -- $setup -- >>> :m@@ -140,6 +139,9 @@ -- XXX Protocol specific socket options should be separated from socket level -- options. --+-- NOTE: the socket config is specified as a record and not by composing+-- functions because all the fields are mandatory except the sockOpts field.+ -- | Specify the socket protocol details. data SockSpec = SockSpec {@@ -173,7 +175,7 @@ step listener = do r <- liftIO (Net.accept listener `onException` Net.close listener)- return $ D.Yield r listener+ return $ S.Yield r listener -- | Unfold a three tuple @(listenQLen, spec, addr)@ into a stream of connected -- protocol sockets corresponding to incoming connections. @listenQLen@ is the@@ -183,7 +185,7 @@ -- {-# INLINE acceptor #-} acceptor :: MonadIO m => Unfold m (Int, SockSpec, SockAddr) Socket-acceptor = UF.map fst listenTuples+acceptor = fmap fst listenTuples {-# INLINE connectCommon #-} connectCommon :: SockSpec -> Maybe SockAddr -> SockAddr -> IO Socket@@ -258,7 +260,7 @@ -> h -> IO (Array Word8) readArrayUptoWith f size h = do- arr <- MArray.newPinnedBytes size+ arr <- MArray.pinnedNewBytes size -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8)) MArray.asPtrUnsafe arr $ \p -> do n <- f h p size@@ -344,15 +346,15 @@ {-# INLINE_NORMAL readChunksWith #-} readChunksWith :: MonadIO m => Int -> Socket -> Stream m (Array Word8) -- readChunksWith = _readChunksUptoWith readChunk-readChunksWith size h = D.Stream step ()+readChunksWith size h = S.Stream step () where {-# INLINE_LATE step #-} step _ _ = do arr <- liftIO $ getChunk size h return $ case A.length arr of- 0 -> D.Stop- _ -> D.Yield arr ()+ 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@.@@ -378,8 +380,8 @@ arr <- liftIO $ getChunk size h return $ case A.length arr of- 0 -> D.Stop- _ -> D.Yield arr (size, h)+ 0 -> S.Stop+ _ -> S.Yield arr (size, h) -- | Same as 'chunkReaderWith' --@@ -495,14 +497,14 @@ -- {-# INLINE putBytesWith #-} putBytesWith :: MonadIO m => Int -> Socket -> Stream m Word8 -> m ()-putBytesWith n h m = putChunks h $ A.chunksOf n m+putBytesWith n h m = putChunks h $ A.pinnedChunksOf 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.writeNUnsafe n) (writeChunks h)+writeWith n h = FL.groupsOf n (A.pinnedWriteNUnsafe n) (writeChunks h) -- | Same as 'writeWith' --@@ -520,7 +522,7 @@ writeMaybesWith :: (MonadIO m ) => Int -> Socket -> Fold m (Maybe Word8) () writeMaybesWith n h =- let writeNJusts = FL.lmap fromJust $ A.writeN n+ let writeNJusts = FL.lmap fromJust $ A.pinnedWriteN n writeOnNothing = FL.takeEndBy_ isNothing writeNJusts in FL.many writeOnNothing (writeChunks h)
src/Streamly/Internal/System/IOVec.hs view
@@ -30,13 +30,13 @@ import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import Foreign.Ptr (castPtr)-import Streamly.Internal.Data.Array.Mut.Type (length)+import Streamly.Internal.Data.MutArray (length) import Streamly.Internal.Data.SVar.Type (adaptState)-import Streamly.Internal.Data.Array.Mut.Type (Array(..))+import Streamly.Internal.Data.MutArray (Array(..)) -import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Array.Mut.Type as MArray-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutArray.Type as MArray+import qualified Streamly.Internal.Data.Stream as D -} #endif @@ -69,11 +69,11 @@ step' gst (GatherInitial st) = do when (n <= 0) $ -- XXX we can pass the module string from the higher level API- error $ "Streamly.Internal.Data.Array.Mut.Type.groupIOVecsOf: the size of "+ error $ "Streamly.Internal.Data.MutArray.Type.groupIOVecsOf: the size of " ++ "groups [" ++ show n ++ "] must be a natural number" when (maxIOVLen <= 0) $ -- XXX we can pass the module string from the higher level API- error $ "Streamly.Internal.Data.Array.Mut.Type.groupIOVecsOf: the number of "+ error $ "Streamly.Internal.Data.MutArray.Type.groupIOVecsOf: the number of " ++ "IOVec entries [" ++ show n ++ "] must be a natural number" r <- step (adaptState gst) st case r of
src/Streamly/Internal/Unicode/Char.hs view
@@ -7,6 +7,10 @@ -- 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. --@@ -35,9 +39,7 @@ import Data.Char (isAsciiUpper, isAsciiLower, chr, ord) import Unicode.Char (DecomposeMode(..))-import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))--import qualified Streamly.Internal.Data.Stream.StreamD as Stream (Stream)+import Streamly.Internal.Data.Stream (Stream(..), Step (..)) import qualified Unicode.Char as Char @@ -321,6 +323,6 @@ normalize :: Monad m => NormalizationMode- -> Stream.Stream m Char- -> Stream.Stream m Char+ -> Stream m Char+ -> Stream m Char normalize = normalizeD
− src/Streamly/Memory/Array.hs
@@ -1,74 +0,0 @@-#include "inline.hs"---- |--- Module : Streamly.Memory.Array--- Copyright : (c) 2019 Composewell Technologies------ License : BSD3--- Maintainer : streamly@composewell.com--- Stability : experimental--- Portability : GHC------ This module provides immutable arrays in pinned memory (non GC memory)--- suitable for long lived data storage, random access and for interfacing with--- the operating system.------ Arrays in this module are chunks of pinned memory that hold a sequence of--- 'Storable' values of a given type, they cannot store non-serializable data--- like functions. Once created an array cannot be modified. Pinned memory--- allows efficient buffering of long lived data without adding any impact to--- GC. One array is just one pointer visible to GC and it does not have to be--- copied across generations. Moreover, pinned memory allows communication--- with foreign consumers and producers (e.g. file or network IO) without--- copying the data.------ = Programmer Notes------ To apply a transformation to an array use 'read' to unfold the array into a--- stream, apply a transformation on the stream and then use 'write' to fold it--- back to an array.------ This module is designed to be imported qualified:------ > import qualified Streamly.Array as A------ For experimental APIs see "Streamly.Internal.Data.Array".--module Streamly.Memory.Array- {-# DEPRECATED "Use Streamly.Data.Array.Foreign instead" #-}- (- A.Array-- -- * Arrays- -- ** Construction- -- | When performance matters, the fastest way to generate an array is- -- 'writeN'. 'IsList' and 'IsString' instances can be- -- used to conveniently construct arrays from literal values.- -- 'OverloadedLists' extension or 'fromList' can be used to construct an- -- array from a list literal. Similarly, 'OverloadedStrings' extension or- -- 'fromList' can be used to construct an array from a string literal.-- -- Pure List APIs- , A.fromListN- , A.fromList-- -- Monadic APIs- , A.writeN -- drop new- , A.write -- full buffer- -- , writeLastN -- drop old (ring buffer)-- -- ** Elimination- -- 'GHC.Exts.toList' from "GHC.Exts" can be used to convert an array to a- -- list.-- , A.toList- , A.read-- -- ** Random Access- , A.length- -- , (!!)- -- , A.readIndex- )-where--import Streamly.Internal.Data.Array as A
src/Streamly/Network/Inet/TCP.hs view
@@ -7,7 +7,7 @@ -- Stability : released -- Portability : GHC ----- Combinators to build Inet/TCP clients and servers.+-- Combinators to build Inet\/IPv4/TCP clients and servers. -- -- >>> import qualified Streamly.Network.Inet.TCP as TCP --@@ -15,10 +15,16 @@ module Streamly.Network.Inet.TCP ( -- * Accept Connections+ -- ** Streams+ accept+ , acceptLocal+ , acceptOnAddr+ , acceptOnAddrWith+ -- ** Unfolds- acceptorOnAddr- , acceptorOnPort- , acceptorOnPortLocal+ , acceptor+ , acceptorLocal+ , acceptorOnAddr -- * Connect to Servers , connect@@ -48,34 +54,11 @@ , datagrams , datagramsOn -}+ -- * Deprecated- , acceptOnAddr- , acceptOnPort- , acceptOnPortLocal+ , acceptorOnPort+ , acceptorOnPortLocal ) where -import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Network.Socket (Socket, PortNumber)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))- import Streamly.Internal.Network.Inet.TCP- hiding (acceptOnAddr, acceptOnPort, acceptOnPortLocal)--{-# DEPRECATED acceptOnAddr "Please use 'acceptorOnAddr' instead" #-}-{-# INLINE acceptOnAddr #-}-acceptOnAddr- :: MonadIO m- => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Socket-acceptOnAddr = acceptorOnAddr--{-# DEPRECATED acceptOnPort "Please use 'acceptorOnPort' instead" #-}-{-# INLINE acceptOnPort #-}-acceptOnPort :: MonadIO m => Unfold m PortNumber Socket-acceptOnPort = acceptorOnPort--{-# DEPRECATED acceptOnPortLocal "Please use 'acceptorOnPortLocal' instead" #-}-{-# INLINE acceptOnPortLocal #-}-acceptOnPortLocal :: MonadIO m => Unfold m PortNumber Socket-acceptOnPortLocal = acceptorOnPortLocal
src/Streamly/Network/Socket.hs view
@@ -50,11 +50,11 @@ -- in server spec addr -- where -- server spec addr =--- Stream.unfold Socket.acceptor (maxListenQueue, spec, addr)+-- Socket.accept maxListenQueue spec addr -- & Stream.parMapM (Stream.eager True) (Socket.forSocketM echo) -- & Stream.fold Fold.drain -- echo sk =--- Stream.unfold Socket.chunkReader sk -- Stream IO (Array Word8)+-- Socket.readChunks sk -- Stream IO (Array Word8) -- & Stream.fold (Socket.writeChunks sk) -- IO () -- :} --@@ -95,12 +95,19 @@ SockSpec(..) -- * Accept Connections+ , accept , acceptor -- * Reads -- ** Singleton , getChunk + -- ** Streams+ , read+ , readWith+ , readChunks+ , readChunksWith+ -- ** Unfolds , reader , readerWith@@ -121,33 +128,23 @@ , forSocketM -- * Deprecated- , accept , readChunk , writeChunk- , read , readWithBufferOf- , readChunks , readChunksWithBufferOf , writeWithBufferOf , writeChunksWithBufferOf ) where -import Control.Monad.IO.Class (MonadIO(..)) import Data.Word (Word8)-import Network.Socket (Socket, SockAddr)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Unboxed (Unbox)+import Network.Socket (Socket)+import Streamly.Data.Array (Array)+import Streamly.Data.MutByteArray (Unbox) -import Streamly.Internal.Network.Socket hiding (accept, read, readChunks)+import Streamly.Internal.Network.Socket import Prelude hiding (read) -{-# DEPRECATED accept "Please use 'acceptor' instead" #-}-{-# INLINE accept #-}-accept :: MonadIO m => Unfold m (Int, SockSpec, SockAddr) Socket-accept = acceptor- {-# DEPRECATED readChunk "Please use 'getChunk' instead" #-} {-# INLINABLE readChunk #-} readChunk :: Int -> Socket -> IO (Array Word8)@@ -157,13 +154,3 @@ {-# INLINABLE writeChunk #-} writeChunk :: Unbox a => Socket -> Array a -> IO () writeChunk = putChunk--{-# DEPRECATED read "Please use 'reader' instead" #-}-{-# INLINE read #-}-read :: MonadIO m => Unfold m Socket Word8-read = reader--{-# DEPRECATED readChunks "Please use 'chunkReader' instead" #-}-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m Socket (Array Word8)-readChunks = chunkReader
src/Streamly/Prelude.hs view
@@ -943,10 +943,10 @@ import Streamly.Internal.Control.Concurrent (MonadAsync) import Prelude- hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,- foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem,- notElem, maximum, minimum, head, last, tail, length, null,- reverse, iterate, init, and, or, lookup, foldr1, (!!),+ hiding (Foldable(..), filter, drop, dropWhile, take, takeWhile, zipWith,+ map, mapM, mapM_, sequence, all, any,+ notElem, head, last, tail,+ reverse, iterate, init, and, or, lookup, (!!), scanl, scanl1, repeat, replicate, concatMap, span) import Streamly.Internal.Data.Stream.IsStream
streamly.cabal view
@@ -1,8 +1,11 @@ cabal-version: 2.2 name: streamly-version: 0.9.0+version: 0.10.0 synopsis: Streaming, dataflow programming and 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 comprises two packages, the <https://hackage.haskell.org/package/streamly-core streamly-core> package provides functionality that depends only on boot libraries, and@@ -15,10 +18,10 @@ high-performance, concurrent, scalable applications in Haskell. Stream fusion optimizations in streamly enable exceptional modularity with high performance comparable to C. Streamly complements the Haskell- <https://hackage.haskell.org/package/base base> package, supplying the- missing functionality to quickly build general-purpose applications+ <https://hackage.haskell.org/package/base base> package, supplying+ additional functionality to quickly build general-purpose applications in Haskell. For high-level functionality built over streamly like- streaming system processes, shell programming, GNU coreutils,+ streaming OS processes, shell programming, GNU coreutils, statistics, and compression libraries please see the <https://streamly.composewell.com/ecosystem.html streamly ecosystem packages>. .@@ -28,6 +31,7 @@ * API close to standard Haskell lists (<https://github.com/composewell/streamly-examples Examples>) * Declarative concurrency with automatic scaling * Filesystem, fsnotify, network, and Unicode support included+ * Fast binary serialization (with optional JSON like features) * More functionality is provided via many (<https://streamly.composewell.com/ecosystem.html ecosystem packages>) . Unified and powerful abstractions:@@ -36,6 +40,7 @@ * Unifies @Data.List@, @list-t@, and @logict@ with streaming * Unifies concurrency with standard streaming abstractions * Unifies reactive, time-domain programming with streaming+ * Unifies binary serialization and unboxed arrays * Interworks with other streaming libraries homepage: https://streamly.composewell.com@@ -46,8 +51,10 @@ , GHC==8.8.4 , GHC==8.10.7 , GHC==9.0.2- , GHC==9.2.7- , GHC==9.4.4+ , GHC==9.2.8+ , GHC==9.4.7+ , GHC==9.6.3+ , GHC==9.8.1 author: Composewell Technologies maintainer: streamly@composewell.com copyright: 2017 Composewell Technologies@@ -63,16 +70,16 @@ benchmark/bench-runner/Main.hs benchmark/bench-runner/bench-runner.cabal benchmark/Streamly/Benchmark/Data/*.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/Ring/Unboxed.hs- benchmark/Streamly/Benchmark/Data/Array/Mut.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/Parser/*.hs benchmark/Streamly/Benchmark/Data/Stream/*.hs benchmark/Streamly/Benchmark/FileSystem/*.hs benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs@@ -94,7 +101,6 @@ -- This is duplicated src/Streamly/Internal/Data/Stream/Instances.hs- src/Streamly/Internal/Data/Array/ArrayMacros.h src/Streamly/Internal/FileSystem/Event/Darwin.h src/assert.hs@@ -105,10 +111,11 @@ test/Streamly/Test/Data/Array/Common.hs test/Streamly/Test/Data/Array/Generic.hs test/Streamly/Test/Data/Array.hs- test/Streamly/Test/Data/Array/Mut.hs+ test/Streamly/Test/Data/MutArray.hs test/Streamly/Test/Data/Ring/Unboxed.hs test/Streamly/Test/Data/Array/Stream.hs- test/Streamly/Test/Data/Parser/ParserD.hs+ test/Streamly/Test/Data/Parser.hs+ test/Streamly/Test/Data/ParserK.hs test/Streamly/Test/Data/Stream/Concurrent.hs test/Streamly/Test/FileSystem/Event.hs test/Streamly/Test/FileSystem/Event/Common.hs@@ -130,6 +137,9 @@ 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@@ -143,6 +153,7 @@ CHANGELOG.md README.md benchmark/README.md+ docs/*.md docs/Developer/Benchmarks.md docs/Developer/*.png docs/Developer/*.md@@ -160,10 +171,12 @@ docs/User/HowTo/*.svg docs/User/Explanatory/*.md docs/User/Explanatory/streaming-pradigms.rst- docs/User/ProjectRelated/*.md- docs/User/ProjectRelated/*.link- docs/User/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt- docs/User/ProjectRelated/ApiChangelogs/0.8.3.txt+ docs/User/Project/*.md+ docs/User/Project/Upgrading-0.8-to-0.9.md+ docs/User/Project/*.link+ docs/User/Project/ApiChangelogs/0.8.3.txt+ docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt+ docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txt test/README.md docs/Developer/Tests.md @@ -259,6 +272,10 @@ -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 @@ -318,6 +335,7 @@ -- For this to be effective it must come after the -O2 option if flag(dev) || flag(debug) || !flag(opt) ghc-options: -fno-ignore-asserts+ cpp-options: -DDEBUG common threading-options ghc-options: -threaded@@ -345,16 +363,15 @@ include-dirs: src , src/Streamly/Internal/Data/Stream- , src/Streamly/Internal/Data/Array 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@@ -362,27 +379,10 @@ , Streamly.Internal.Control.ForkLifted , Streamly.Internal.Data.Atomics , Streamly.Internal.Data.IOFinalizer.Lifted- , Streamly.Internal.Data.Stream.Channel.Types- , Streamly.Internal.Data.Stream.Channel.Dispatcher- , Streamly.Internal.Data.Stream.Channel.Worker - , Streamly.Internal.Data.Unfold.Exception- , Streamly.Internal.Data.Fold.Concurrent.Channel.Type- , Streamly.Internal.Data.Fold.Concurrent.Channel- , Streamly.Internal.Data.Fold.Concurrent- , Streamly.Data.Fold.Tee-- , Streamly.Internal.Data.Stream.Concurrent.Channel.Type- , Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher- , Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer- , Streamly.Internal.Data.Stream.Concurrent.Channel.Append- , Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave- , Streamly.Internal.Data.Stream.Concurrent.Channel.Operations- , Streamly.Internal.Data.Stream.Concurrent.Channel- , Streamly.Internal.Data.Stream.Concurrent- , Streamly.Internal.Data.Stream.Zip.Concurrent- , Streamly.Internal.Data.Stream.Time- , Streamly.Internal.Data.Stream.Exception.Lifted+ , Streamly.Internal.Data.Stream.Prelude+ , Streamly.Internal.Data.Unfold.Prelude+ , Streamly.Internal.Data.Fold.Prelude -- streamly-unicode (depends on unicode-data) , Streamly.Internal.Unicode.Utf8@@ -395,29 +395,20 @@ -- Exposed modules , Streamly.Data.Stream.MkType , Streamly.Data.Stream.Prelude+ , Streamly.Data.Fold.Prelude -- Network/IO , Streamly.Network.Socket , Streamly.Network.Inet.TCP -- Deprecated- , Streamly- , Streamly.Data.Unicode.Stream- , Streamly.Memory.Array , Streamly.Data.Array.Foreign+ , Streamly.Data.Fold.Tee , Streamly.Prelude -- Deprecated Internal modules- , Streamly.Internal.Data.SVar.Worker- , Streamly.Internal.Data.SVar.Dispatch- , Streamly.Internal.Data.SVar.Pull , Streamly.Internal.Data.SVar-- , Streamly.Internal.Data.Unfold.SVar- , Streamly.Internal.Data.Fold.SVar- , Streamly.Internal.Data.Fold.Async- , Streamly.Internal.Data.Stream.SVar.Generate- , Streamly.Internal.Data.Stream.SVar.Eliminate+ , Streamly.Internal.Data.Stream.SVar , Streamly.Internal.Data.Stream.Serial , Streamly.Internal.Data.Stream.Zip@@ -426,22 +417,10 @@ , Streamly.Internal.Data.Stream.Ahead , Streamly.Internal.Data.Stream.ZipAsync - , Streamly.Internal.Data.Stream.IsStream.Type- , Streamly.Internal.Data.Stream.IsStream.Combinators- , Streamly.Internal.Data.Stream.IsStream.Common- , Streamly.Internal.Data.Stream.IsStream.Enumeration- , Streamly.Internal.Data.Stream.IsStream.Generate- , Streamly.Internal.Data.Stream.IsStream.Eliminate- , Streamly.Internal.Data.Stream.IsStream.Transform- , Streamly.Internal.Data.Stream.IsStream.Expand- , Streamly.Internal.Data.Stream.IsStream.Reduce- , Streamly.Internal.Data.Stream.IsStream.Exception- , Streamly.Internal.Data.Stream.IsStream.Lift- , Streamly.Internal.Data.Stream.IsStream.Top , Streamly.Internal.Data.Stream.IsStream if !impl(ghcjs) && flag(dev)- exposed-modules:+ other-modules: Streamly.Internal.System.IOVec.Type , Streamly.Internal.System.IOVec , Streamly.Internal.FileSystem.FDIO@@ -450,7 +429,7 @@ if flag(dev) exposed-modules: Streamly.Data.SmallArray , Streamly.Internal.Data.SmallArray- , Streamly.Internal.Data.SmallArray.Type+ other-modules: Streamly.Internal.Data.SmallArray.Type if os(windows) exposed-modules: Streamly.Internal.FileSystem.Event.Windows@@ -467,10 +446,53 @@ exposed-modules: Streamly.Internal.FileSystem.Event other-modules:- Streamly.Data.Stream.Exception- , Streamly.Data.Stream.Concurrent- , Streamly.Data.Stream.Time+ Streamly.Internal.Data.Channel.Types+ , Streamly.Internal.Data.Channel.Dispatcher+ , Streamly.Internal.Data.Channel.Worker + , Streamly.Internal.Data.Stream.Concurrent.Channel.Type+ , Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher+ , Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer+ , Streamly.Internal.Data.Stream.Concurrent.Channel.Append+ , Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave+ , Streamly.Internal.Data.Stream.Concurrent.Channel.Operations+ , Streamly.Internal.Data.Stream.Concurrent.Channel+ , Streamly.Internal.Data.Stream.Concurrent+ , Streamly.Internal.Data.Stream.Time+ , Streamly.Internal.Data.Stream.Lifted++ , Streamly.Internal.Data.Fold.Async+ , Streamly.Internal.Data.Fold.Concurrent.Channel.Type+ , Streamly.Internal.Data.Fold.Concurrent.Channel+ , Streamly.Internal.Data.Fold.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@@ -478,22 +500,19 @@ -- packages depending on the "ghc" package (packages -- depending on doctest is a common example) can -- depend on streamly.- base >= 4.12 && < 4.19- , containers >= 0.6.0 && < 0.7- , deepseq >= 1.4.4 && < 1.5+ base >= 4.12 && < 4.20+ , containers >= 0.6.0 && < 0.8+ , 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.20+ , template-haskell >= 2.14 && < 2.22 -- The core streamly package- , streamly-core == 0.1.0+ , streamly-core == 0.2.0 , hashable >= 1.3 && < 1.5 , unordered-containers >= 0.2 && < 0.3-- -- XXX to be removed- , transformers-base >= 0.4 && < 0.5 , heaps >= 0.3 && < 0.5 -- concurrency@@ -504,6 +523,9 @@ -- Network , network >= 2.6 && < 3.2++ if impl(ghc < 9.6)+ build-depends: transformers-base >= 0.4 && < 0.5 if flag(use-unliftio) build-depends: unliftio-core >= 0.2 && < 0.3
targets/Targets.hs view
@@ -10,13 +10,13 @@ targets :: [(String, [String])] targets = [ -- Base streams- ("Data.Stream.StreamD",+ ("Data.Stream", [ "base_stream_grp" , "base_stream_cmp" , "noTest" ] )- , ("Data.Stream.StreamK",+ , ("Data.StreamK", [ "base_stream_grp" , "base_stream_cmp" , "noTest"@@ -166,7 +166,7 @@ , "pinned_array_cmp" ] )- , ("Data.Array.Mut",+ , ("Data.MutArray", [ "array_grp" , "array_cmp" ]@@ -176,7 +176,7 @@ , ("Data.Ring.Unboxed", []) -- Parsers- , ("Data.Parser.ParserK",+ , ("Data.ParserK", [ "base_parser_grp" , "base_parser_cmp" , "infinite_grp"@@ -187,7 +187,13 @@ , ("Data.Fold.Window", [ "parser_grp", "infinite_grp" ]) , ("Data.Parser", [ "parser_grp", "infinite_grp" ]) - , ("Data.Unbox", ["noBench"])+ , ("Data.Unbox", ["noTest"])+ , ("Data.Unbox.TH", ["noBench"])+ , ("Data.Unbox.Derive.Generic", ["noBench"])+ , ("Data.Unbox.Derive.TH", [])+ , ("Data.Serialize", [])+ , ("Data.Serialize.Derive.TH", ["noBench"])+ , ("Data.Serialize.ENABLE_constructorTagAsString", ["noBench"]) , ("Data.Unfold", ["infinite_grp"]) , ("FileSystem.Handle", []) , ("Unicode.Stream", [])
test/Streamly/Test/Data/Array.hs view
@@ -14,13 +14,12 @@ import Data.Word(Word8) import Foreign.Storable (peek) import GHC.Ptr (plusPtr)-import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)-import Streamly.Internal.Data.Array.Mut.Type (MutArray)+import Streamly.Internal.Data.MutByteArray (Unbox, sizeOf)+import Streamly.Internal.Data.MutArray (MutArray) import Test.QuickCheck (chooseInt, listOf) import qualified Streamly.Internal.Data.Array as A-import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Array.Mut.Type as MA+import qualified Streamly.Internal.Data.MutArray as MA #include "Streamly/Test/Data/Array/CommonImports.hs" @@ -150,7 +149,7 @@ else MA.bubble (flip compare) arr return arr )- (MA.newPinned $ length ls)+ (MA.pinnedNew $ length ls) testBubbleAsc :: Property testBubbleAsc = testBubbleWith True@@ -160,7 +159,7 @@ testByteLengthWithMA :: forall a. Unbox a => a -> IO () testByteLengthWithMA _ = do- arrA <- MA.newPinned 100 :: IO (MutArray a)+ arrA <- MA.pinnedNew 100 :: IO (MutArray a) let arrW8 = MA.castUnsafe arrA :: MutArray Word8 MA.byteLength arrA `shouldBe` MA.length arrW8 @@ -181,7 +180,7 @@ testUnsafeIndxedFromList :: [Char] -> IO () testUnsafeIndxedFromList inp = let arr = A.fromList inp- in fmap (`A.unsafeIndex` arr) [0 .. (length inp - 1)] `shouldBe` inp+ in fmap (`A.getIndexUnsafe` arr) [0 .. (length inp - 1)] `shouldBe` inp testAsPtrUnsafeMA :: IO () testAsPtrUnsafeMA = do@@ -268,7 +267,7 @@ describe "toList . fromList" $ do it "testFromToList abc" (testFromToList "abc") it "testFromToList \\22407" (testFromToList "\22407")- describe "unsafeIndex . fromList" $ do+ describe "getIndexUnsafe . fromList" $ do it "testUnsafeIndxedFromList abc" (testUnsafeIndxedFromList "abc") it "testUnsafeIndxedFromList \\22407" (testUnsafeIndxedFromList "\22407")
− test/Streamly/Test/Data/Array/Mut.hs
@@ -1,152 +0,0 @@-module Streamly.Test.Data.Array.Mut (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.Unboxed (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.RTS.Flags (IoSubSystem(..))-#endif--import qualified Streamly.Internal.Data.Array.Mut as MArray-import qualified Streamly.Internal.Data.Stream as Stream-import qualified Test.Hspec as Hspec--maxTestCount :: Int-maxTestCount = 100--moduleName :: String-moduleName = "Data.Array.Mut"--testAppend :: Property-testAppend =- forAll (listOf (chooseInt (-50, 100))) $ \ls0 ->- monadicIO $ action ls0-- where-- action ls = do- x <- Stream.fold- (MArray.writeAppend (MArray.newPinned 0))- (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/Array/Stream.hs view
@@ -10,7 +10,7 @@ import Test.QuickCheck.Monadic (assert, monadicIO, run) import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Stream.Chunked as ArrayStream+import qualified Streamly.Internal.Data.Array.Stream as ArrayStream import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.Stream as Stream
test/Streamly/Test/Data/Fold.hs view
@@ -23,9 +23,8 @@ import qualified Data.Map import qualified Prelude-import qualified Streamly.Internal.Data.Array.Mut as MArray+import qualified Streamly.Internal.Data.MutArray as MArray import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Fold.Container as Fold import qualified Streamly.Internal.Data.Stream as Stream import Prelude hiding
test/Streamly/Test/Data/Fold/Window.hs view
@@ -1,8 +1,7 @@ module Streamly.Test.Data.Fold.Window (main) where -import Streamly.Internal.Data.Fold.Window import Test.Hspec (hspec, describe, it, runIO)-import qualified Streamly.Internal.Data.Ring.Unboxed as Ring+import qualified Streamly.Internal.Data.Ring as Ring import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Fold as Fold @@ -29,8 +28,8 @@ it ("should not deviate more than " ++ show deviationLimit) $ c1 >= -1 * deviationLimit && c1 <= deviationLimit - describe "Sum" $ testFunc sum- describe "mean" $ testFunc mean+ describe "Sum" $ testFunc Fold.windowSum+ describe "mean" $ testFunc Fold.windowMean describe "Correctness" $ do let winSize = 3@@ -53,16 +52,16 @@ it (show tc) $ a == expec describe "minimum" $ do- testFunc2 testCase1 (Just (-2.5)) minimum+ testFunc2 testCase1 (Just (-2.5)) Fold.windowMinimum describe "maximum" $ do- testFunc2 testCase1 (Just 7.0) maximum+ testFunc2 testCase1 (Just 7.0) Fold.windowMaximum describe "range" $ do- testFunc2 testCase1 (Just (-2.5, 7.0)) range+ testFunc2 testCase1 (Just (-2.5, 7.0)) Fold.windowRange describe "sum" $ do let scanInf = [1, 2, 3, 4, 5, 12] :: [Double] scanWin = [1, 2, 3, 3, 3, 9] :: [Double]- testFunc testCase2 sum scanInf scanWin+ testFunc testCase2 Fold.windowSum scanInf scanWin describe "mean" $ do let scanInf = [1, 1, 1, 1, 1, 2] :: [Double] scanWin = [1, 1, 1, 1, 1, 3] :: [Double]- testFunc testCase2 mean scanInf scanWin+ testFunc testCase2 Fold.windowMean scanInf scanWin
+ test/Streamly/Test/Data/MutArray.hs view
@@ -0,0 +1,152 @@+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.RTS.Flags (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+ x <- Stream.fold+ (MArray.writeAppend (MArray.pinnedNew 0))+ (Stream.fromList (ls::[Int]))+ lst <- MArray.toList x+ assert (ls == lst)++#define TEST_IE(_type) it "_type" $ testIE ([] :: [_type])++-- XXX This should be in test/Data.Unbox+-- C-ish foreign types are platfor specific. The platform needs to be taken into+-- consideration when making instances.+testUnboxInstanceExistance :: Hspec.SpecWith ()+testUnboxInstanceExistance = do+ describe "Unbox instances" $ do+ -- TEST_IE(CBool)+ -- TEST_IE(CChar)+ -- TEST_IE(CClock)+ -- TEST_IE(CDouble)+ -- TEST_IE(CFloat)+ -- TEST_IE(CInt)+ -- TEST_IE(CIntMax)+ -- TEST_IE(CIntPtr)+ -- TEST_IE(CLLong)+ -- TEST_IE(CLong)+ -- TEST_IE(CPtrdiff)+ -- TEST_IE(CSChar)+ -- TEST_IE(CSUSeconds)+ -- TEST_IE(CShort)+ -- TEST_IE(CSigAtomic)+ -- TEST_IE(CSize)+ -- TEST_IE(CTime)+ -- TEST_IE(CUChar)+ -- TEST_IE(CUInt)+ -- TEST_IE(CUIntMax)+ -- TEST_IE(CUIntPtr)+ -- TEST_IE(CULLong)+ -- TEST_IE(CULong)+ -- TEST_IE(CUSeconds)+ -- TEST_IE(CUShort)+ -- TEST_IE(CWchar)+ TEST_IE(IntPtr)+ TEST_IE(WordPtr)+ TEST_IE(Fingerprint)+ TEST_IE(Int16)+ TEST_IE(Int32)+ TEST_IE(Int64)+ TEST_IE(Int8)+#if MIN_VERSION_base(4,15,0)+ TEST_IE(IoSubSystem)+#endif+ TEST_IE(Word16)+ TEST_IE(Word32)+ TEST_IE(Word64)+ TEST_IE(Word8)+ -- TEST_IE(CBlkCnt)+ -- TEST_IE(CBlkSize)+ -- TEST_IE(CCc)+ -- TEST_IE(CClockId)+ -- TEST_IE(CDev)+ -- TEST_IE(CFsBlkCnt)+ -- TEST_IE(CFsFilCnt)+ -- TEST_IE(CGid)+ -- TEST_IE(CId)+ -- TEST_IE(CIno)+ -- TEST_IE(CKey)+ -- TEST_IE(CMode)+ -- TEST_IE(CNfds)+ -- TEST_IE(CNlink)+ -- TEST_IE(COff)+ -- TEST_IE(CPid)+ -- TEST_IE(CRLim)+ -- TEST_IE(CSocklen)+ -- TEST_IE(CSpeed)+ -- TEST_IE(CSsize)+ -- TEST_IE(CTcflag)+ -- TEST_IE(CTimer)+ -- TEST_IE(CUid)+ -- TEST_IE(Fd)+ TEST_IE(())+ TEST_IE(Bool)+ TEST_IE(Char)+ TEST_IE(Double)+ TEST_IE(Float)+ TEST_IE(Int)+ TEST_IE(Word)+ TEST_IE(Complex Int)+ TEST_IE(Identity Int)+#if MIN_VERSION_base(4,14,0)+ TEST_IE(Down Int)+#endif+ TEST_IE(FunPtr Int)+ TEST_IE(Ptr Int)+ TEST_IE(Ratio Int)+ TEST_IE(StablePtr Int)+ TEST_IE(Const Int Int)+ where++ testIE :: Unbox a => [a] -> IO ()+ testIE lst = void $ MArray.fromList lst++main :: IO ()+main =+ hspec $+ Hspec.parallel $+ modifyMaxSuccess (const maxTestCount) $ do+ describe moduleName $ do+ describe "Stream Append" $ do+ prop "testAppend" testAppend+ testUnboxInstanceExistance
test/Streamly/Test/Data/Parser.hs view
@@ -1,5 +1,10 @@+-- 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 Data.Foldable (for_) import Data.Word (Word8, Word32, Word64)@@ -8,7 +13,7 @@ import Test.Hspec.QuickCheck import Test.QuickCheck (arbitrary, forAll, elements, Property, property, listOf,- vectorOf, Gen)+ vectorOf, Gen, (.&&.)) import Test.QuickCheck.Monadic (monadicIO, assert, run) import Prelude hiding (sequence)@@ -16,17 +21,19 @@ import qualified Control.Monad.Fail as Fail import qualified Data.List as List import qualified Prelude+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.Stream as S+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Test.Hspec as H #if MIN_VERSION_QuickCheck(2,14,0) import Test.QuickCheck (chooseAny) import Control.Monad.Identity (Identity(runIdentity, Identity))-import Streamly.Internal.Data.Parser.ParserD (ParseError(..))+import Streamly.Internal.Data.Parser (ParseError(..)) #else @@ -191,8 +198,8 @@ $ Prelude.take lpl ls Left _ -> property False -takeBetween :: Property-takeBetween =+_takeBetween :: Property+_takeBetween = forAll (chooseInt (min_value, max_value)) $ \m -> forAll (chooseInt (min_value, max_value)) $ \n -> forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->@@ -213,6 +220,13 @@ Left _ -> property ((m >= 0 && n >= 0 && m > n) || inputLen < m) +take :: Property+take =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parse (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of+ Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)+ Left _ -> property False takeEQPass :: Property takeEQPass =@@ -263,7 +277,6 @@ else property False Left _ -> property (n > list_length) - nLessThanEqual0 :: ( Int -> FL.Fold Identity Int [Int]@@ -286,21 +299,23 @@ prop "takeGE n FL.toList xs = xs" $ nLessThanEqual0 P.takeGE (\_ -> id) --- lookAheadPass :: Property--- lookAheadPass =--- forAll (chooseInt (min_value + 1, max_value)) $ \n ->--- let--- takeWithoutConsume = P.lookAhead $ P.take n FL.toList--- parseTwice = do--- parsed_list_1 <- takeWithoutConsume--- parsed_list_2 <- takeWithoutConsume--- return (parsed_list_1, parsed_list_2)--- in--- forAll (chooseInt (n, max_value)) $ \list_length ->--- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->--- case S.parse parseTwice (S.fromList ls) of--- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)--- Left _ -> property $ False+-- XXX lookAhead can't deal with EOF which in this case means when+-- n==list_length, this test will fail. So excluding that case for now.+lookAheadPass :: Property+lookAheadPass =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ let+ takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList+ parseTwice = do+ parsed_list_1 <- takeWithoutConsume+ parsed_list_2 <- takeWithoutConsume+ return (parsed_list_1, parsed_list_2)+ in+ forAll (chooseInt (n+1, max_value)) $ \list_length ->+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parse parseTwice (S.fromList ls) of+ Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)+ Left _ -> property $ False -- lookAheadFail :: Property -- lookAheadFail =@@ -318,22 +333,22 @@ -- Right _ -> False -- Left _ -> True --- lookAhead :: Property--- lookAhead =--- forAll (chooseInt (min_value, max_value)) $ \n ->--- let--- takeWithoutConsume = P.lookAhead $ P.take n FL.toList--- parseTwice = do--- parsed_list_1 <- takeWithoutConsume--- parsed_list_2 <- takeWithoutConsume--- return (parsed_list_1, parsed_list_2)--- in--- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->--- case S.parse parseTwice (S.fromList ls) of--- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)--- Left _ -> property ((list_length < n) || (list_length == n && n == 0))--- where--- list_length = Prelude.length ls+lookAhead :: Property+lookAhead =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ let+ takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList+ parseTwice = do+ parsed_list_1 <- takeWithoutConsume+ parsed_list_2 <- takeWithoutConsume+ return (parsed_list_1, parsed_list_2)+ in+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parse parseTwice (S.fromList ls) of+ Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)+ Left _ -> property ((list_length < n) || (list_length == n && n == 0))+ where+ list_length = Prelude.length ls takeEndBy_ :: Property takeEndBy_ =@@ -347,6 +362,16 @@ prsr = P.many (P.satisfy (const True)) FL.toList tkwhl ls = Prelude.takeWhile (not . predicate) ls +takeEndByOrMax_ :: Property+takeEndByOrMax_ =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (listOf (chooseInt (0, 1))) $ \ls ->+ case runIdentity $ S.parse (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of+ Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))+ Left _ -> property False+ where+ predicate = (== 1)+ takeStartBy :: Property takeStartBy = forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->@@ -464,6 +489,25 @@ | null lst = [] | otherwise = head $ List.groupBy cmp lst +groupByRolling :: Property+groupByRolling =+ forAll (listOf (chooseInt (0, 1)))+ $ \ls ->+ case runIdentity $ S.parse parser (S.fromList ls) of+ Right parsed -> checkListEqual parsed (groupByLF Nothing ls)+ Left _ -> property False++ where++ cmp = (==)+ parser = P.groupBy cmp FL.toList+ groupByLF _ [] = []+ groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs+ groupByLF (Just y) (x:xs) =+ if cmp y x+ then x : groupByLF (Just x) xs+ else []+ wordBy :: Property wordBy = forAll (listOf (elements [' ', 's']))@@ -530,42 +574,41 @@ , ["The qui[ck] brown", "fox"]) ] ---- splitWithPass :: Property--- splitWithPass =--- forAll (listOf (chooseInt (0, 1))) $ \ls ->--- case S.parse (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of--- Right (result_first, result_second) -> case ls of--- 0 : 1 : _ -> (result_first == 0) && (result_second == 1)--- _ -> False--- Left _ -> case ls of--- 0 : 1 : _ -> False--- _ -> True+splitWith :: Property+splitWith =+ forAll (listOf (chooseInt (0, 1))) $ \ls ->+ case runIdentity $ S.parse (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of+ Right (result_first, result_second) -> case ls of+ 0 : 1 : _ -> (result_first == 0) && (result_second == 1)+ _ -> False+ Left _ -> case ls of+ 0 : 1 : _ -> False+ _ -> True --- splitWithFailLeft :: Property--- splitWithFailLeft =--- property (case S.parse (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of--- Right _ -> False--- Left _ -> True)+splitWithFailLeft :: Property+splitWithFailLeft =+ property (case runIdentity $ S.parse (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True) --- splitWithFailRight :: Property--- splitWithFailRight =--- property (case S.parse (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of--- Right _ -> False--- Left _ -> True)+splitWithFailRight :: Property+splitWithFailRight =+ property (case runIdentity $ S.parse (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True) --- splitWithFailBoth :: Property--- splitWithFailBoth =--- property (case S.parse (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of--- Right _ -> False--- Left _ -> True)+splitWithFailBoth :: Property+splitWithFailBoth =+ property (case runIdentity $ S.parse (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True) -- teeWithPass :: Property -- teeWithPass =--- forAll (chooseInt (0, 10000)) $ \n ->+-- forAll (chooseInt (min_value, max_value)) $ \n -> -- forAll (listOf (chooseInt (0, 1))) $ \ls -> -- let--- prsr = P.take n FL.toList+-- prsr = P.fromFold $ FL.take n FL.toList -- in -- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of -- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2@@ -610,50 +653,86 @@ -- shortestPass = -- forAll (listOf (chooseInt(min_value, max_value))) $ \ls -> -- let--- prsr_1 = P.takeWhile (<= (mid_value `Prelude.div` 2)) FL.toList+-- half_mid_value = mid_value `Prelude.div` 2+-- prsr_1 = P.takeWhile (<= half_mid_value) FL.toList -- prsr_2 = P.takeWhile (<= mid_value) FL.toList -- prsr_shortest = P.shortest prsr_1 prsr_2 -- in -- case S.parse prsr_shortest (S.fromList ls) of--- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)+-- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls) -- Left _ -> property False --- shortestFailLeft :: Property--- shortestFailLeft =+-- shortestPassLeft :: Property+-- shortestPassLeft = -- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of -- Right r -> r == 1 -- Left _ -> False)---- shortestFailRight :: Property--- shortestFailRight =+--+-- shortestPassRight :: Property+-- shortestPassRight = -- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of -- Right r -> r == 1 -- Left _ -> False) -- shortestFailBoth :: Property -- shortestFailBoth =--- property (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of+-- property+-- (case S.parse+-- (P.shortest (P.die "die") (P.die "die"))+-- (S.fromList [1 :: Int]) of+-- Right _ -> False+-- Left _ -> True)+--+-- longestPass :: Property+-- longestPass =+-- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->+-- let+-- half_mid_value = mid_value `Prelude.div` 2+-- prsr_1 = P.takeWhile (<= half_mid_value) FL.toList+-- prsr_2 = P.takeWhile (<= mid_value) FL.toList+-- prsr_longest = P.longest prsr_1 prsr_2+-- in+-- case S.parse prsr_longest (S.fromList ls) of+-- Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls+-- Left _ -> False+--+-- longestPassLeft :: Property+-- longestPassLeft =+-- property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of+-- Right r -> r == 1+-- Left _ -> False)+--+-- longestPassRight :: Property+-- longestPassRight =+-- property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of+-- Right r -> r == 1+-- Left _ -> False)+--+-- longestFailBoth :: Property+-- longestFailBoth =+-- property+-- (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of -- Right _ -> False -- Left _ -> True) many :: Property many = forAll (listOf (chooseInt (0, 1))) $ \ls ->- let fldstp conL currL = return $ FL.Partial $ conL ++ currL- concatFold = FL.Fold fldstp (return (FL.Partial [])) return+ 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 $ S.parse prsr (S.fromList ls) of- Right res_list -> checkListEqual res_list- $ Prelude.filter (== 0) ls+ flip P.many concatFold+ $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList+ in case runIdentity $ S.parse prsr (S.fromList ls) of+ Right res_list ->+ checkListEqual res_list (Prelude.filter (== 0) ls) Left _ -> property False --- many_empty :: Property--- many_empty =--- property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of--- Right res_list -> checkListEqual res_list ([] :: [Int])--- Left _ -> property False)+many_empty :: Property+many_empty =+ property (case runIdentity $ S.parse (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of+ Right res_list -> checkListEqual res_list ([] :: [Int])+ Left _ -> property False) some :: Property some =@@ -661,19 +740,19 @@ let ls = 0 : genLs fldstp conL currL = return $ FL.Partial $ conL ++ currL- concatFold = FL.Fold fldstp (return (FL.Partial [])) return+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return return prsr =- flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList- in- case runIdentity $ S.parse prsr (S.fromList ls) of+ flip P.some concatFold+ $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList+ in case runIdentity $ S.parse prsr (S.fromList ls) of Right res_list -> res_list == Prelude.filter (== 0) ls Left _ -> False --- someFail :: Property--- someFail =--- property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of--- Right _ -> False--- Left _ -> True)+someFail :: Property+someFail =+ property (case runIdentity $ S.parse (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True) ------------------------------------------------------------------------------- -- Instances@@ -687,12 +766,10 @@ (,) <$> P.fromFold (FL.take (length list1) FL.toList) <*> P.fromFold (FL.take (length list2) FL.toList)- in monadicIO $ do- s <- S.parse parser (S.fromList $ list1 ++ list2)- return $- case s of- Right (olist1, olist2) -> olist1 == list1 && olist2 == list2- Left _ -> False+ in+ case runIdentity $ S.parse parser (S.fromList $ list1 ++ list2) of+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2+ Left _ -> False sequence :: Property sequence =@@ -708,6 +785,28 @@ Right ls -> ls == ins Left _ -> False +altEOF1 :: Property+altEOF1 =+ monadicIO $ do+ s1 <- S.parse+ (P.satisfy (> 0) <|> return 66)+ (S.fromList ([]::[Int]))+ return $+ case s1 of+ Right x -> x == 66+ Left _ -> False++altEOF2 :: Property+altEOF2 =+ monadicIO $ do+ s1 <- S.parse+ ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))+ (S.fromList ([51]::[Int]))+ return $+ case s1 of+ Right x -> x == [51]+ Left _ -> False+ monad :: Property monad = forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->@@ -740,6 +839,49 @@ $ 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 $ S.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.unfoldMany 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 -------------------------------------------------------------------------------@@ -774,9 +916,9 @@ readOneEvent = do arr <- P.takeEQ 24 (A.writeN 24) let arr1 = A.castUnsafe arr :: A.Array Word64- eid = A.unsafeIndex 0 arr1- eflags = A.unsafeIndex 1 arr1- pathLen = fromIntegral $ A.unsafeIndex 2 arr1+ eid = A.getIndexUnsafe 0 arr1+ eflags = A.getIndexUnsafe 1 arr1+ pathLen = fromIntegral $ A.getIndexUnsafe 2 arr1 -- XXX handle if pathLen is 0 path <- P.takeEQ pathLen (A.writeN pathLen) return $ Event@@ -1145,11 +1287,15 @@ describe "Instances" $ do prop "applicative" applicative+ prop "Alternative: end of input 1" altEOF1+ prop "Alternative: end of input 2" altEOF2 prop "monad" monad prop "sequence" sequence describe "Stream parsing" $ do prop "parseMany" parseMany prop "parseMany2Events" parseMany2Events+ prop "parseUnfold" parseUnfold+ prop "parserSequence" parserSequence describe "test for accumulator" $ do prop "P.fromFold FL.sum = FL.sum" fromFold@@ -1172,18 +1318,19 @@ describe "test for sequence parser" $ do prop "P.takeBetween = Prelude.take when len >= m and len <= n" takeBetweenPass- prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"- ++ "otherwise fail") Main.takeBetween-+ -- XXX This test fails+ -- XXX cabal run test:Data.Parser -- --match "/Data.Parser/test for sequence parser/P.takeBetween = Prelude.take when len >= m and len <= n and failotherwise fail/" --seed 1563586298+ -- prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"+ -- ++ "otherwise fail") Main._takeBetween+ prop "P.take = Prelude.take" Main.take prop "P.takeEQ = Prelude.take when len >= n" takeEQPass prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ prop "P.takeGE n ls = ls when len >= n" takeGEPass prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE- -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass+ prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass -- prop "Fail when stream length exceeded" lookAheadFail- -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead- prop "P.takeEndBy_ test" Main.takeEndBy_+ prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)" ++ " tail") takeStartBy prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile@@ -1192,13 +1339,14 @@ prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP prop ("P.takeP = Prelude.take") takeP prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy+ prop "groupByRolling" groupByRolling prop "many (P.wordBy ' ') = words'" wordBy parseManyWordQuotedBy -- prop "choice" choice- -- prop "" splitWithPass- -- prop "" splitWithFailLeft- -- prop "" splitWithFailRight- -- prop "" splitWithFailBoth+ prop "parse 0, then 1, else fail" splitWith+ prop "fail due to die as left parser" splitWithFailLeft+ prop "fail due to die as right parser" splitWithFailRight+ prop "fail due to die as both parsers" splitWithFailBoth -- prop "" teeWithPass -- prop "" teeWithFailLeft -- prop "" teeWithFailRight@@ -1210,13 +1358,14 @@ -- prop "" shortestFailBoth prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList =" ++ "Prelude.filter (== 0)") many- -- prop "[] due to parser being die" many_empty+ prop "[] due to parser being die" many_empty prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList =" ++ "Prelude.filter (== 0)") some- -- prop "fail due to parser being die" someFail+ prop "fail due to parser being die" someFail prop "P.many == S.parseMany" manyEqParseMany prop "takeEndBy_" takeEndBy_+ prop "takeEndByOrMax_" takeEndByOrMax_ prop "takeEndBy1" takeEndBy1 prop "takeEndBy2" takeEndBy2 prop "takeEndByEsc" takeEndByEsc
− test/Streamly/Test/Data/Parser/ParserD.hs
@@ -1,837 +0,0 @@-module Main (main) where--import Control.Applicative ((<|>))-import Control.Exception (SomeException(..), try)-import Data.Word (Word8, Word32, Word64)-import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)-import Test.Hspec (Spec, hspec, describe)-import Test.Hspec.QuickCheck-import Test.QuickCheck- (arbitrary, forAll, elements, Property,- property, listOf, vectorOf, (.&&.), Gen)-import Test.QuickCheck.Monadic (monadicIO, assert, run)--import qualified Data.List as List-import qualified Prelude-import qualified Streamly.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.ParserD as P-import qualified Streamly.Internal.Data.Producer.Source as Source-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream as S-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Test.Hspec as H--import Prelude hiding (sequence)--#if MIN_VERSION_QuickCheck(2,14,0)--import Test.QuickCheck (chooseAny)-import Control.Monad.Identity (runIdentity, Identity (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--maxTestCount :: Int-maxTestCount = 100--min_value :: Int-min_value = 0--mid_value :: Int-mid_value = 5000--max_value :: Int-max_value = 10000--max_length :: Int-max_length = 1000--toList :: Monad m => S.Stream m a -> m [a]-toList = S.fold FL.toList---- Accumulator Tests--fromFold :: Property-fromFold =- forAll (listOf $ chooseInt (min_value, max_value))- $ \ls ->- case (==) <$> runIdentity (S.parseD (P.fromFold FL.sum) (S.fromList ls))- <*> (S.fold FL.sum (S.fromList ls)) of- Right is_equal -> is_equal- Left _ -> False--fromPure :: Property-fromPure =- forAll (chooseInt (min_value, max_value)) $ \x ->- case runIdentity $ S.parseD (P.fromPure x) (S.fromList [1 :: Int]) of- Right r -> r == x- Left _ -> False--fromEffect :: Property-fromEffect =- forAll (chooseInt (min_value, max_value)) $ \x ->- case runIdentity $ S.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of- Right r -> r == x- Left _ -> False--die :: Property-die =- property $- case runIdentity (S.parseD (P.die "die test") (S.fromList [0 :: Int])) of- Right _ -> False- Left _ -> True--dieM :: Property-dieM =- property $- case runIdentity (S.parseD (P.dieM (Identity "die test")) (S.fromList [0 :: Int])) of- Right _ -> False- Left _ -> True---- Element Parser Tests--peekPass :: Property-peekPass =- forAll (chooseInt (1, max_length)) $ \list_length ->- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD P.peek (S.fromList ls) of- Right head_value -> case ls of- head_ls : _ -> head_value == head_ls- _ -> False- Left _ -> False--peekFail :: Property-peekFail =- property (case runIdentity $ S.parseD P.peek (S.fromList []) of- Right _ -> False- Left _ -> True)--eofPass :: Property-eofPass =- property (case S.parseD P.eof (S.fromList []) of- Right _ -> True- Left _ -> False)--eofFail :: Property-eofFail =- forAll (chooseInt (1, max_length)) $ \list_length ->- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD P.eof (S.fromList ls) of- Right _ -> False- Left _ -> True--satisfyPass :: Property-satisfyPass =- forAll (chooseInt (mid_value, max_value)) $ \first_element ->- forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->- let- ls = first_element : ls_tail- predicate = (>= mid_value)- in- case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of- Right r -> r == first_element- Left _ -> False--satisfy :: Property-satisfy =- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of- Right r -> case ls of- [] -> False- (x : _) -> predicate x && (r == x)- Left _ -> case ls of- [] -> True- (x : _) -> not $ predicate x- where- predicate = (>= mid_value)---- Sequence Parsers Tests-takeBetweenPass :: Property-takeBetweenPass =- forAll (chooseInt (min_value, max_value)) $ \m ->- forAll (chooseInt (m, max_value)) $ \n ->- forAll (chooseInt (m, max_value)) $ \list_length ->- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of- Right parsed_list ->- let lpl = Prelude.length parsed_list- in checkListEqual parsed_list (Prelude.take lpl ls)- Left _ -> property False---takeBetween :: Property-takeBetween =- forAll (chooseInt (min_value, max_value)) $ \m ->- forAll (chooseInt (min_value, max_value)) $ \n ->- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->- let- list_length = Prelude.length ls- in monadicIO $ do- let p = P.takeBetween m n FL.toList- r <- run $ try $ S.parseD p (S.fromList ls)- return $ case r of- Right x -> case x of- Right parsed_list ->- if m <= list_length && n >= m- then- let len = Prelude.length parsed_list- in checkListEqual- parsed_list (Prelude.take len ls)- else property False- Left _ ->- property (m > n || list_length < m)- Left (_ :: SomeException) ->- property (m > n || list_length < m)--take :: Property-take =- forAll (chooseInt (min_value, max_value)) $ \n ->- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of- Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)- Left _ -> property False--takeEQPass :: Property-takeEQPass =- forAll (chooseInt (min_value, max_value)) $ \n ->- forAll (chooseInt (n, max_value)) $ \list_length ->- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of- Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)- Left _ -> property False--takeEQ :: Property-takeEQ =- forAll (chooseInt (min_value, max_value)) $ \n ->- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->- let- list_length = Prelude.length ls- in- case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of- Right parsed_list ->- if (n <= list_length) then- checkListEqual parsed_list (Prelude.take n ls)- else- property False- Left _ -> property (n > list_length)--takeGEPass :: Property-takeGEPass =- forAll (chooseInt (min_value, max_value)) $ \n ->- forAll (chooseInt (n, max_value)) $ \list_length ->- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of- Right parsed_list -> checkListEqual parsed_list ls- Left _ -> property False--takeGE :: Property-takeGE =- forAll (chooseInt (min_value, max_value)) $ \n ->- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->- let- list_length = Prelude.length ls- in- case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of- Right parsed_list ->- if (n <= list_length) then- checkListEqual parsed_list ls- else- property False- Left _ -> property (n > list_length)--nLessThanEqual0 ::- ( Int- -> FL.Fold Identity Int [Int]- -> P.Parser Int Identity [Int]- )- -> (Int -> [Int] -> [Int])- -> Property-nLessThanEqual0 tk ltk =- forAll (elements [0, (-1)]) $ \n ->- forAll (listOf arbitrary) $ \ls ->- case runIdentity $ S.parseD (tk n FL.toList) (S.fromList ls) of- Right parsed_list -> checkListEqual parsed_list (ltk n ls)- Left _ -> property False--takeProperties :: Spec-takeProperties =- describe "take combinators when n <= 0/" $ do- prop "takeEQ n FL.toList = []" $- nLessThanEqual0 P.takeEQ (\_ -> const [])- prop "takeGE n FL.toList xs = xs" $- nLessThanEqual0 P.takeGE (\_ -> id)----- XXX lookAhead can't deal with EOF which in this case means when--- n==list_length, this test will fail. So excluding that case for now.-lookAheadPass :: Property-lookAheadPass =- forAll (chooseInt (min_value, max_value)) $ \n ->- let- takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList- parseTwice = do- parsed_list_1 <- takeWithoutConsume- parsed_list_2 <- takeWithoutConsume- return (parsed_list_1, parsed_list_2)- in- forAll (chooseInt (n+1, max_value)) $ \list_length ->- forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD parseTwice (S.fromList ls) of- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)- Left _ -> property $ False--lookAhead :: Property-lookAhead =- forAll (chooseInt (min_value, max_value)) $ \n ->- let- takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList- parseTwice = do- parsed_list_1 <- takeWithoutConsume- parsed_list_2 <- takeWithoutConsume- return (parsed_list_1, parsed_list_2)- in- forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->- case runIdentity $ S.parseD parseTwice (S.fromList ls) of- Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)- Left _ -> property ((list_length < n) || (list_length == n && n == 0))- where- list_length = Prelude.length ls--takeWhile :: Property-takeWhile =- forAll (listOf (chooseInt (0, 1))) $ \ ls ->- case runIdentity $ S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of- Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls)- Left _ -> property False- where- predicate = (== 0)--takeWhile1 :: Property-takeWhile1 =- forAll (listOf (chooseInt (0, 1))) $ \ ls ->- case runIdentity $ S.parseD (P.takeWhile1 predicate FL.toList) (S.fromList ls) of- Right parsed_list -> case ls of- [] -> property False- (x : _) ->- if predicate x then- checkListEqual parsed_list (Prelude.takeWhile predicate ls)- else- property False- Left _ -> case ls of- [] -> property True- (x : _) -> property (not $ predicate x)- where- predicate = (== 0)--groupBy :: Property-groupBy =- forAll (listOf (chooseInt (0, 1)))- $ \ls ->- case runIdentity $ S.parseD parser (S.fromList ls) of- Right parsed -> checkListEqual parsed (groupByLF ls)- Left _ -> property False-- where-- cmp = (==)- parser = P.groupBy cmp FL.toList- groupByLF lst- | null lst = []- | otherwise = head $ List.groupBy cmp lst--groupByRolling :: Property-groupByRolling =- forAll (listOf (chooseInt (0, 1)))- $ \ls ->- case runIdentity $ S.parseD parser (S.fromList ls) of- Right parsed -> checkListEqual parsed (groupByLF Nothing ls)- Left _ -> property False-- where-- cmp = (==)- parser = P.groupBy cmp FL.toList- groupByLF _ [] = []- groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs- groupByLF (Just y) (x:xs) =- if cmp y x- then x : groupByLF (Just x) xs- else []--takeEndByOrMax :: Property-takeEndByOrMax =- forAll (chooseInt (min_value, max_value)) $ \n ->- forAll (listOf (chooseInt (0, 1))) $ \ls ->- case runIdentity $ S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of- Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))- Left _ -> property False- where- predicate = (== 1)--wordBy :: Property-wordBy =- forAll (listOf (elements [' ', 's']))- $ \ls ->- case runIdentity $ S.parseD parser (S.fromList ls) of- Right parsed -> checkListEqual parsed (words' ls)- Left _ -> property False-- where-- predicate = (== ' ')- parser = P.many (P.wordBy predicate FL.toList) FL.toList- words' lst =- let wrds = words lst- in if wrds == [] && length lst > 0 then [""] else wrds---splitWith :: Property-splitWith =- forAll (listOf (chooseInt (0, 1))) $ \ls ->- case runIdentity $ S.parseD (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of- Right (result_first, result_second) -> case ls of- 0 : 1 : _ -> (result_first == 0) && (result_second == 1)- _ -> False- Left _ -> case ls of- 0 : 1 : _ -> False- _ -> True--splitWithFailLeft :: Property-splitWithFailLeft =- property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)--splitWithFailRight :: Property-splitWithFailRight =- property (case runIdentity $ S.parseD (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)--splitWithFailBoth :: Property-splitWithFailBoth =- property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)--{--teeWithPass :: Property-teeWithPass =- forAll (chooseInt (min_value, max_value)) $ \n ->- forAll (listOf (chooseInt (0, 1))) $ \ls ->- let- prsr = P.fromFold $ FL.take n FL.toList- in- case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2- Left _ -> property False--teeWithFailLeft :: Property-teeWithFailLeft =- property (case S.parseD (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)--teeWithFailRight :: Property-teeWithFailRight =- property (case S.parseD (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)--teeWithFailBoth :: Property-teeWithFailBoth =- property (case S.parseD (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)--shortestPass :: Property-shortestPass =- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->- let- half_mid_value = mid_value `Prelude.div` 2- prsr_1 = P.takeWhile (<= half_mid_value) FL.toList- prsr_2 = P.takeWhile (<= mid_value) FL.toList- prsr_shortest = P.shortest prsr_1 prsr_2- in- case S.parseD prsr_shortest (S.fromList ls) of- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)- Left _ -> property False--shortestPassLeft :: Property-shortestPassLeft =- property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of- Right r -> r == 1- Left _ -> False)--shortestPassRight :: Property-shortestPassRight =- property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of- Right r -> r == 1- Left _ -> False)--shortestFailBoth :: Property-shortestFailBoth =- property- (case S.parseD- (P.shortest (P.die "die") (P.die "die"))- (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)--longestPass :: Property-longestPass =- forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->- let- half_mid_value = mid_value `Prelude.div` 2- prsr_1 = P.takeWhile (<= half_mid_value) FL.toList- prsr_2 = P.takeWhile (<= mid_value) FL.toList- prsr_longest = P.longest prsr_1 prsr_2- in- case S.parseD prsr_longest (S.fromList ls) of- Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls- Left _ -> False--longestPassLeft :: Property-longestPassLeft =- property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of- Right r -> r == 1- Left _ -> False)--longestPassRight :: Property-longestPassRight =- property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of- Right r -> r == 1- Left _ -> False)--longestFailBoth :: Property-longestFailBoth =- property- (case S.parseD (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)--}--many :: Property-many =- forAll (listOf (chooseInt (0, 1)))- $ \ls ->- let fldstp conL currL = return $ FL.Partial (conL ++ currL)- concatFold =- FL.Fold fldstp (return (FL.Partial [])) return- prsr =- flip P.many concatFold- $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList- in case runIdentity $ S.parseD prsr (S.fromList ls) of- Right res_list ->- checkListEqual res_list (Prelude.filter (== 0) ls)- Left _ -> property False--many_empty :: Property-many_empty =- property (case runIdentity $ S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of- Right res_list -> checkListEqual res_list ([] :: [Int])- Left _ -> property False)--some :: Property-some =- forAll (listOf (chooseInt (0, 1)))- $ \ls ->- let fldstp conL currL = return $ FL.Partial $ conL ++ currL- concatFold = FL.Fold fldstp (return (FL.Partial [])) return- prsr =- flip P.some concatFold- $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList- in case runIdentity $ S.parseD prsr (S.fromList ls) of- Right res_list -> res_list == Prelude.filter (== 0) ls- Left _ -> False--someFail :: Property-someFail =- property (case runIdentity $ S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of- Right _ -> False- Left _ -> True)------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------applicative :: Property-applicative =- forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->- forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->- monadicIO $ do- let parser =- (,)- <$> P.fromFold (FL.take (length list1) FL.toList)- <*> P.fromFold (FL.take (length list2) FL.toList)-- return $- case runIdentity $ S.parseD parser (S.fromList $ list1 ++ list2) of- Right (olist1, olist2) -> olist1 == list1 && olist2 == list2- Left _ -> False--sequence :: Property-sequence =- forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->- monadicIO $ do- let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins- outs <- S.parseD- (Prelude.sequence parsers)- (S.fromList $ concat ins)- return $- case outs of- Right x -> x == ins- Left _ -> False--altEOF1 :: Property-altEOF1 =- monadicIO $ do- s1 <- S.parseD- (P.satisfy (> 0) <|> return 66)- (S.fromList ([]::[Int]))- return $- case s1 of- Right x -> x == 66- Left _ -> False--altEOF2 :: Property-altEOF2 =- monadicIO $ do- s1 <- S.parseD- ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))- (S.fromList ([51]::[Int]))- return $- case s1 of- Right x -> x == [51]- Left _ -> False--monad :: Property-monad =- forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->- forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->- monadicIO $ do- let parser = do- olist1 <- P.fromFold (FL.take (length list1) FL.toList)- olist2 <- P.fromFold (FL.take (length list2) FL.toList)- return (olist1, olist2)- s1 <- S.parseD parser (S.fromList $ list1 ++ list2)- return $- case s1 of- Right (olist1, olist2) -> olist1 == list1 && olist2 == list2- Left _ -> False------------------------------------------------------------------------------------ Stream parsing----------------------------------------------------------------------------------parseMany :: Property-parseMany =- forAll (chooseInt (1,100)) $ \len ->- forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->- monadicIO $ do- outs <-- (toList $ S.catRights $ S.parseManyD- (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)- )- return $ 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 <- toList $ S.chunksOf clen (S.fromList ls)- let src = Source.source (Just (Producer.OuterLoop arrays))- let parser = P.fromFold (FL.take tlen FL.toList)- let readSrc =- Source.producer- $ Producer.concat Producer.fromList A.producer- let streamParser =- Producer.simplify (Source.parseManyD parser readSrc)- xs <- run- $ toList- $ S.unfoldMany 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 = D.fromList- $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins- let sequencedParser = P.sequence parsers FL.sum- outs <-- S.parseD 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.writeN 24)- let arr1 = A.castUnsafe arr :: A.Array Word64- eid = A.unsafeIndex 0 arr1- eflags = A.unsafeIndex 1 arr1- pathLen = fromIntegral $ A.unsafeIndex 2 arr1- path <- P.takeEQ pathLen (A.writeN pathLen)- return $ Event- { eventId = eid- , eventFlags = fromIntegral eflags- , eventAbsPath = path- }--parseMany2Events :: Property-parseMany2Events =- monadicIO $ do- xs <-- ( run- $ toList- $ S.catRights- $ S.parseManyD readOneEvent- $ S.fromList (concat (replicate 2 event))- )- assert (length xs == 2)- -- XXX assuming little endian machine- let ev = Event- { eventId = 152170080- , eventFlags = 66560- , eventAbsPath = A.fromList evPath- }- in listEquals (==) xs (replicate 2 ev)------------------------------------------------------------------------------------ Main----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Parser.ParserD"--main :: IO ()-main =- hspec $- H.parallel $- modifyMaxSuccess (const maxTestCount) $ do- describe moduleName $ do-- describe "Instances" $ do- prop "applicative" applicative- prop "Alternative: end of input 1" altEOF1- prop "Alternative: end of input 2" altEOF2- prop "monad" monad- prop "sequence" sequence-- describe "Stream parsing" $ do- prop "parseMany" parseMany- prop "parseMany2Events" parseMany2Events- prop "parseUnfold" parseUnfold- prop "parserSequence" parserSequence-- describe "test for accumulator" $ do- prop "P.fromFold FL.sum = FL.sum" fromFold- prop "fromPure value provided" fromPure- prop "fromPure monadic value provided" fromEffect- prop "always fail" die- prop "always fail but monadic" dieM-- describe "test for element parser" $ do- prop "peek = head with list length > 0" peekPass- prop "peek fail on []" peekFail- prop "eof pass on []" eofPass- prop "eof fail on non-empty list" eofFail- prop "first element exists and >= mid_value" satisfyPass- prop "check first element exists and satisfies predicate" satisfy-- describe "test for sequence parser" $ do- prop "P.takeBetween m n = Prelude.take when len >= m and len <= n"- takeBetweenPass- prop ("P.takeBetween m n = Prelude.take when len >= m and len <= n and"- ++ " fail otherwise") takeBetween- prop "P.take = Prelude.take" Main.take- prop "P.takeEQ = Prelude.take when len >= n" takeEQPass- prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ- prop "P.takeGE n ls = ls when len >= n" takeGEPass- prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead- prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile- prop "P.takeWhile1 = Prelude.takeWhile if taken something, else check why failed" takeWhile1- prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy- prop "groupByRolling" groupByRolling- prop "P.takeEndByOrMax = Prelude.take n (Prelude.takeWhile (not . predicate)" takeEndByOrMax- prop "many (P.wordBy ' ') = words'" wordBy- prop "parse 0, then 1, else fail" splitWith- prop "fail due to die as left parser" splitWithFailLeft- prop "fail due to die as right parser" splitWithFailRight- prop "fail due to die as both parsers" splitWithFailBoth- {-- prop "parsed two lists should be equal" teeWithPass- prop "fail due to die as left parser" teeWithFailLeft- prop "fail due to die as right parser" teeWithFailRight- prop "fail due to die as both parsers" teeWithFailBoth- prop "P.takeWhile (<= half_mid_value) = Prelude.takeWhile half_mid_value" shortestPass- prop "pass even if die is left parser" shortestPassLeft- prop "pass even if die is right parser" shortestPassRight- prop "fail due to die as both parsers" shortestFailBoth- prop "P.takeWhile (<= mid_value) = Prelude.takeWhile (<= mid_value)" longestPass- prop "pass even if die is left parser" longestPassLeft- prop "pass even if die is right parser" longestPassRight- prop "fail due to die as both parsers" longestFailBoth- -}- prop "P.many concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" many- prop "[] due to parser being die" many_empty- prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some- prop "fail due to parser being die" someFail- takeProperties
+ test/Streamly/Test/Data/ParserK.hs view
@@ -0,0 +1,841 @@+-- 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 (SomeException(..), try)+import Data.Word (Word8, Word32, Word64)+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)+import Test.Hspec (Spec, hspec, describe)+import Test.Hspec.QuickCheck+import Test.QuickCheck+ (arbitrary, forAll, elements, Property,+ property, listOf, vectorOf, (.&&.), Gen)+import Test.QuickCheck.Monadic (monadicIO, assert, run)++import qualified Data.List as List+import qualified Prelude+import qualified Streamly.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.Producer as Producer+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Test.Hspec as H++import Prelude hiding (sequence)++#if MIN_VERSION_QuickCheck(2,14,0)++import Test.QuickCheck (chooseAny)+import Control.Monad.Identity (runIdentity, Identity (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++maxTestCount :: Int+maxTestCount = 100++min_value :: Int+min_value = 0++mid_value :: Int+mid_value = 5000++max_value :: Int+max_value = 10000++max_length :: Int+max_length = 1000++toList :: Monad m => S.Stream m a -> m [a]+toList = S.fold FL.toList++-- Accumulator Tests++fromFold :: Property+fromFold =+ forAll (listOf $ chooseInt (min_value, max_value))+ $ \ls ->+ case (==) <$> runIdentity (S.parseD (P.fromFold FL.sum) (S.fromList ls))+ <*> (S.fold FL.sum (S.fromList ls)) of+ Right is_equal -> is_equal+ Left _ -> False++fromPure :: Property+fromPure =+ forAll (chooseInt (min_value, max_value)) $ \x ->+ case runIdentity $ S.parseD (P.fromPure x) (S.fromList [1 :: Int]) of+ Right r -> r == x+ Left _ -> False++fromEffect :: Property+fromEffect =+ forAll (chooseInt (min_value, max_value)) $ \x ->+ case runIdentity $ S.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of+ Right r -> r == x+ Left _ -> False++die :: Property+die =+ property $+ case runIdentity (S.parseD (P.die "die test") (S.fromList [0 :: Int])) of+ Right _ -> False+ Left _ -> True++dieM :: Property+dieM =+ property $+ case runIdentity (S.parseD (P.dieM (Identity "die test")) (S.fromList [0 :: Int])) of+ Right _ -> False+ Left _ -> True++-- Element Parser Tests++peekPass :: Property+peekPass =+ forAll (chooseInt (1, max_length)) $ \list_length ->+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD P.peek (S.fromList ls) of+ Right head_value -> case ls of+ head_ls : _ -> head_value == head_ls+ _ -> False+ Left _ -> False++peekFail :: Property+peekFail =+ property (case runIdentity $ S.parseD P.peek (S.fromList []) of+ Right _ -> False+ Left _ -> True)++eofPass :: Property+eofPass =+ property (case S.parseD P.eof (S.fromList []) of+ Right _ -> True+ Left _ -> False)++eofFail :: Property+eofFail =+ forAll (chooseInt (1, max_length)) $ \list_length ->+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD P.eof (S.fromList ls) of+ Right _ -> False+ Left _ -> True++satisfyPass :: Property+satisfyPass =+ forAll (chooseInt (mid_value, max_value)) $ \first_element ->+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->+ let+ ls = first_element : ls_tail+ predicate = (>= mid_value)+ in+ case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of+ Right r -> r == first_element+ Left _ -> False++satisfy :: Property+satisfy =+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of+ Right r -> case ls of+ [] -> False+ (x : _) -> predicate x && (r == x)+ Left _ -> case ls of+ [] -> True+ (x : _) -> not $ predicate x+ where+ predicate = (>= mid_value)++-- Sequence Parsers Tests+takeBetweenPass :: Property+takeBetweenPass =+ forAll (chooseInt (min_value, max_value)) $ \m ->+ forAll (chooseInt (m, max_value)) $ \n ->+ forAll (chooseInt (m, max_value)) $ \list_length ->+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of+ Right parsed_list ->+ let lpl = Prelude.length parsed_list+ in checkListEqual parsed_list (Prelude.take lpl ls)+ Left _ -> property False+++takeBetween :: Property+takeBetween =+ forAll (chooseInt (min_value, max_value)) $ \m ->+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+ let+ list_length = Prelude.length ls+ in monadicIO $ do+ let p = P.takeBetween m n FL.toList+ r <- run $ try $ S.parseD p (S.fromList ls)+ return $ case r of+ Right x -> case x of+ Right parsed_list ->+ if m <= list_length && n >= m+ then+ let len = Prelude.length parsed_list+ in checkListEqual+ parsed_list (Prelude.take len ls)+ else property False+ Left _ ->+ property (m > n || list_length < m)+ Left (_ :: SomeException) ->+ property (m > n || list_length < m)++take :: Property+take =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of+ Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)+ Left _ -> property False++takeEQPass :: Property+takeEQPass =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (chooseInt (n, max_value)) $ \list_length ->+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of+ Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)+ Left _ -> property False++takeEQ :: Property+takeEQ =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+ let+ list_length = Prelude.length ls+ in+ case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of+ Right parsed_list ->+ if (n <= list_length) then+ checkListEqual parsed_list (Prelude.take n ls)+ else+ property False+ Left _ -> property (n > list_length)++takeGEPass :: Property+takeGEPass =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (chooseInt (n, max_value)) $ \list_length ->+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of+ Right parsed_list -> checkListEqual parsed_list ls+ Left _ -> property False++takeGE :: Property+takeGE =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+ let+ list_length = Prelude.length ls+ in+ case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of+ Right parsed_list ->+ if (n <= list_length) then+ checkListEqual parsed_list ls+ else+ property False+ Left _ -> property (n > list_length)++nLessThanEqual0 ::+ ( Int+ -> FL.Fold Identity Int [Int]+ -> P.Parser Int Identity [Int]+ )+ -> (Int -> [Int] -> [Int])+ -> Property+nLessThanEqual0 tk ltk =+ forAll (elements [0, (-1)]) $ \n ->+ forAll (listOf arbitrary) $ \ls ->+ case runIdentity $ S.parseD (tk n FL.toList) (S.fromList ls) of+ Right parsed_list -> checkListEqual parsed_list (ltk n ls)+ Left _ -> property False++takeProperties :: Spec+takeProperties =+ describe "take combinators when n <= 0/" $ do+ prop "takeEQ n FL.toList = []" $+ nLessThanEqual0 P.takeEQ (\_ -> const [])+ prop "takeGE n FL.toList xs = xs" $+ nLessThanEqual0 P.takeGE (\_ -> id)+++-- XXX lookAhead can't deal with EOF which in this case means when+-- n==list_length, this test will fail. So excluding that case for now.+lookAheadPass :: Property+lookAheadPass =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ let+ takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList+ parseTwice = do+ parsed_list_1 <- takeWithoutConsume+ parsed_list_2 <- takeWithoutConsume+ return (parsed_list_1, parsed_list_2)+ in+ forAll (chooseInt (n+1, max_value)) $ \list_length ->+ forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD parseTwice (S.fromList ls) of+ Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)+ Left _ -> property $ False++lookAhead :: Property+lookAhead =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ let+ takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList+ parseTwice = do+ parsed_list_1 <- takeWithoutConsume+ parsed_list_2 <- takeWithoutConsume+ return (parsed_list_1, parsed_list_2)+ in+ forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+ case runIdentity $ S.parseD parseTwice (S.fromList ls) of+ Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)+ Left _ -> property ((list_length < n) || (list_length == n && n == 0))+ where+ list_length = Prelude.length ls++takeWhile :: Property+takeWhile =+ forAll (listOf (chooseInt (0, 1))) $ \ ls ->+ case runIdentity $ S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of+ Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls)+ Left _ -> property False+ where+ predicate = (== 0)++takeWhile1 :: Property+takeWhile1 =+ forAll (listOf (chooseInt (0, 1))) $ \ ls ->+ case runIdentity $ S.parseD (P.takeWhile1 predicate FL.toList) (S.fromList ls) of+ Right parsed_list -> case ls of+ [] -> property False+ (x : _) ->+ if predicate x then+ checkListEqual parsed_list (Prelude.takeWhile predicate ls)+ else+ property False+ Left _ -> case ls of+ [] -> property True+ (x : _) -> property (not $ predicate x)+ where+ predicate = (== 0)++groupBy :: Property+groupBy =+ forAll (listOf (chooseInt (0, 1)))+ $ \ls ->+ case runIdentity $ S.parseD parser (S.fromList ls) of+ Right parsed -> checkListEqual parsed (groupByLF ls)+ Left _ -> property False++ where++ cmp = (==)+ parser = P.groupBy cmp FL.toList+ groupByLF lst+ | null lst = []+ | otherwise = head $ List.groupBy cmp lst++groupByRolling :: Property+groupByRolling =+ forAll (listOf (chooseInt (0, 1)))+ $ \ls ->+ case runIdentity $ S.parseD parser (S.fromList ls) of+ Right parsed -> checkListEqual parsed (groupByLF Nothing ls)+ Left _ -> property False++ where++ cmp = (==)+ parser = P.groupBy cmp FL.toList+ groupByLF _ [] = []+ groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs+ groupByLF (Just y) (x:xs) =+ if cmp y x+ then x : groupByLF (Just x) xs+ else []++takeEndByOrMax :: Property+takeEndByOrMax =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (listOf (chooseInt (0, 1))) $ \ls ->+ case runIdentity $ S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of+ Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))+ Left _ -> property False+ where+ predicate = (== 1)++wordBy :: Property+wordBy =+ forAll (listOf (elements [' ', 's']))+ $ \ls ->+ case runIdentity $ S.parseD parser (S.fromList ls) of+ Right parsed -> checkListEqual parsed (words' ls)+ Left _ -> property False++ where++ predicate = (== ' ')+ parser = P.many (P.wordBy predicate FL.toList) FL.toList+ words' lst =+ let wrds = words lst+ in if wrds == [] && length lst > 0 then [""] else wrds+++splitWith :: Property+splitWith =+ forAll (listOf (chooseInt (0, 1))) $ \ls ->+ case runIdentity $ S.parseD (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of+ Right (result_first, result_second) -> case ls of+ 0 : 1 : _ -> (result_first == 0) && (result_second == 1)+ _ -> False+ Left _ -> case ls of+ 0 : 1 : _ -> False+ _ -> True++splitWithFailLeft :: Property+splitWithFailLeft =+ property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)++splitWithFailRight :: Property+splitWithFailRight =+ property (case runIdentity $ S.parseD (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)++splitWithFailBoth :: Property+splitWithFailBoth =+ property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)++{-+teeWithPass :: Property+teeWithPass =+ forAll (chooseInt (min_value, max_value)) $ \n ->+ forAll (listOf (chooseInt (0, 1))) $ \ls ->+ let+ prsr = P.fromFold $ FL.take n FL.toList+ in+ case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of+ Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2+ Left _ -> property False++teeWithFailLeft :: Property+teeWithFailLeft =+ property (case S.parseD (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)++teeWithFailRight :: Property+teeWithFailRight =+ property (case S.parseD (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)++teeWithFailBoth :: Property+teeWithFailBoth =+ property (case S.parseD (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)++shortestPass :: Property+shortestPass =+ forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->+ let+ half_mid_value = mid_value `Prelude.div` 2+ prsr_1 = P.takeWhile (<= half_mid_value) FL.toList+ prsr_2 = P.takeWhile (<= mid_value) FL.toList+ prsr_shortest = P.shortest prsr_1 prsr_2+ in+ case S.parseD prsr_shortest (S.fromList ls) of+ Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)+ Left _ -> property False++shortestPassLeft :: Property+shortestPassLeft =+ property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of+ Right r -> r == 1+ Left _ -> False)++shortestPassRight :: Property+shortestPassRight =+ property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of+ Right r -> r == 1+ Left _ -> False)++shortestFailBoth :: Property+shortestFailBoth =+ property+ (case S.parseD+ (P.shortest (P.die "die") (P.die "die"))+ (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)++longestPass :: Property+longestPass =+ forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->+ let+ half_mid_value = mid_value `Prelude.div` 2+ prsr_1 = P.takeWhile (<= half_mid_value) FL.toList+ prsr_2 = P.takeWhile (<= mid_value) FL.toList+ prsr_longest = P.longest prsr_1 prsr_2+ in+ case S.parseD prsr_longest (S.fromList ls) of+ Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls+ Left _ -> False++longestPassLeft :: Property+longestPassLeft =+ property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of+ Right r -> r == 1+ Left _ -> False)++longestPassRight :: Property+longestPassRight =+ property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of+ Right r -> r == 1+ Left _ -> False)++longestFailBoth :: Property+longestFailBoth =+ property+ (case S.parseD (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)+-}++many :: Property+many =+ forAll (listOf (chooseInt (0, 1)))+ $ \ls ->+ let fldstp conL currL = return $ FL.Partial (conL ++ currL)+ concatFold =+ FL.Fold fldstp (return (FL.Partial [])) return return+ prsr =+ flip P.many concatFold+ $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList+ in case runIdentity $ S.parseD prsr (S.fromList ls) of+ Right res_list ->+ checkListEqual res_list (Prelude.filter (== 0) ls)+ Left _ -> property False++many_empty :: Property+many_empty =+ property (case runIdentity $ S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of+ Right res_list -> checkListEqual res_list ([] :: [Int])+ Left _ -> property False)++some :: Property+some =+ forAll (listOf (chooseInt (0, 1)))+ $ \ls ->+ let fldstp conL currL = return $ FL.Partial $ conL ++ currL+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return return+ prsr =+ flip P.some concatFold+ $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList+ in case runIdentity $ S.parseD prsr (S.fromList ls) of+ Right res_list -> res_list == Prelude.filter (== 0) ls+ Left _ -> False++someFail :: Property+someFail =+ property (case runIdentity $ S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of+ Right _ -> False+ Left _ -> True)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++applicative :: Property+applicative =+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->+ monadicIO $ do+ let parser =+ (,)+ <$> P.fromFold (FL.take (length list1) FL.toList)+ <*> P.fromFold (FL.take (length list2) FL.toList)++ return $+ case runIdentity $ S.parseD parser (S.fromList $ list1 ++ list2) of+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2+ Left _ -> False++sequence :: Property+sequence =+ forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->+ monadicIO $ do+ let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins+ outs <- S.parseD+ (Prelude.sequence parsers)+ (S.fromList $ concat ins)+ return $+ case outs of+ Right x -> x == ins+ Left _ -> False++altEOF1 :: Property+altEOF1 =+ monadicIO $ do+ s1 <- S.parseD+ (P.satisfy (> 0) <|> return 66)+ (S.fromList ([]::[Int]))+ return $+ case s1 of+ Right x -> x == 66+ Left _ -> False++altEOF2 :: Property+altEOF2 =+ monadicIO $ do+ s1 <- S.parseD+ ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))+ (S.fromList ([51]::[Int]))+ return $+ case s1 of+ Right x -> x == [51]+ Left _ -> False++monad :: Property+monad =+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->+ monadicIO $ do+ let parser = do+ olist1 <- P.fromFold (FL.take (length list1) FL.toList)+ olist2 <- P.fromFold (FL.take (length list2) FL.toList)+ return (olist1, olist2)+ s1 <- S.parseD parser (S.fromList $ list1 ++ list2)+ return $+ case s1 of+ Right (olist1, olist2) -> olist1 == list1 && olist2 == list2+ Left _ -> False++-------------------------------------------------------------------------------+-- Stream parsing+-------------------------------------------------------------------------------++parseMany :: Property+parseMany =+ forAll (chooseInt (1,100)) $ \len ->+ forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->+ monadicIO $ do+ outs <-+ (toList $ S.catRights $ S.parseManyD+ (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)+ )+ return $ 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 <- toList $ S.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+ $ toList+ $ S.unfoldMany 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 = D.fromList+ $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins+ let sequencedParser = P.sequence parsers FL.sum+ outs <-+ S.parseD 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.writeN 24)+ let arr1 = A.castUnsafe arr :: A.Array Word64+ eid = A.getIndexUnsafe 0 arr1+ eflags = A.getIndexUnsafe 1 arr1+ pathLen = fromIntegral $ A.getIndexUnsafe 2 arr1+ path <- P.takeEQ pathLen (A.writeN pathLen)+ return $ Event+ { eventId = eid+ , eventFlags = fromIntegral eflags+ , eventAbsPath = path+ }++parseMany2Events :: Property+parseMany2Events =+ monadicIO $ do+ xs <-+ ( run+ $ toList+ $ S.catRights+ $ S.parseManyD readOneEvent+ $ S.fromList (concat (replicate 2 event))+ )+ assert (length xs == 2)+ -- XXX assuming little endian machine+ let ev = Event+ { eventId = 152170080+ , eventFlags = 66560+ , eventAbsPath = A.fromList evPath+ }+ in listEquals (==) xs (replicate 2 ev)++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.ParserK"++main :: IO ()+main =+ hspec $+ H.parallel $+ modifyMaxSuccess (const maxTestCount) $ do+ describe moduleName $ do++ describe "Instances" $ do+ prop "applicative" applicative+ prop "Alternative: end of input 1" altEOF1+ prop "Alternative: end of input 2" altEOF2+ prop "monad" monad+ prop "sequence" sequence++ describe "Stream parsing" $ do+ prop "parseMany" parseMany+ prop "parseMany2Events" parseMany2Events+ prop "parseUnfold" parseUnfold+ prop "parserSequence" parserSequence++ describe "test for accumulator" $ do+ prop "P.fromFold FL.sum = FL.sum" fromFold+ prop "fromPure value provided" fromPure+ prop "fromPure monadic value provided" fromEffect+ prop "always fail" die+ prop "always fail but monadic" dieM++ describe "test for element parser" $ do+ prop "peek = head with list length > 0" peekPass+ prop "peek fail on []" peekFail+ prop "eof pass on []" eofPass+ prop "eof fail on non-empty list" eofFail+ prop "first element exists and >= mid_value" satisfyPass+ prop "check first element exists and satisfies predicate" satisfy++ describe "test for sequence parser" $ do+ prop "P.takeBetween m n = Prelude.take when len >= m and len <= n"+ takeBetweenPass+ prop ("P.takeBetween m n = Prelude.take when len >= m and len <= n and"+ ++ " fail otherwise") takeBetween+ prop "P.take = Prelude.take" Main.take+ prop "P.takeEQ = Prelude.take when len >= n" takeEQPass+ prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ+ prop "P.takeGE n ls = ls when len >= n" takeGEPass+ prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE+ prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass+ prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead+ prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile+ prop "P.takeWhile1 = Prelude.takeWhile if taken something, else check why failed" takeWhile1+ prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy+ prop "groupByRolling" groupByRolling+ prop "P.takeEndByOrMax = Prelude.take n (Prelude.takeWhile (not . predicate)" takeEndByOrMax+ prop "many (P.wordBy ' ') = words'" wordBy+ prop "parse 0, then 1, else fail" splitWith+ prop "fail due to die as left parser" splitWithFailLeft+ prop "fail due to die as right parser" splitWithFailRight+ prop "fail due to die as both parsers" splitWithFailBoth+ {-+ prop "parsed two lists should be equal" teeWithPass+ prop "fail due to die as left parser" teeWithFailLeft+ prop "fail due to die as right parser" teeWithFailRight+ prop "fail due to die as both parsers" teeWithFailBoth+ prop "P.takeWhile (<= half_mid_value) = Prelude.takeWhile half_mid_value" shortestPass+ prop "pass even if die is left parser" shortestPassLeft+ prop "pass even if die is right parser" shortestPassRight+ prop "fail due to die as both parsers" shortestFailBoth+ prop "P.takeWhile (<= mid_value) = Prelude.takeWhile (<= mid_value)" longestPass+ prop "pass even if die is left parser" longestPassLeft+ prop "pass even if die is right parser" longestPassRight+ prop "fail due to die as both parsers" longestFailBoth+ -}+ prop "P.many concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" many+ prop "[] due to parser being die" many_empty+ prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some+ prop "fail due to parser being die" someFail+ takeProperties
test/Streamly/Test/Data/Ring/Unboxed.hs view
@@ -10,8 +10,8 @@ import Control.Monad (void) -import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Ring.Unboxed as Ring+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Ring as Ring import Prelude as P import qualified Data.Foldable as P
+ test/Streamly/Test/Data/Serialize.hs view
@@ -0,0 +1,275 @@+{-# 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 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.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)|])++instance Arbitrary a => Arbitrary (BinTree a) where+ arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]++--------------------------------------------------------------------------------+-- 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++ off1 <- Serialize.serializeAt serStartOff arr val+ 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` Array.deserialize slice+ clonedSlice <- Array.clone slice+ val `shouldBe` Array.deserialize clonedSlice++roundtrip+ :: forall a. (Eq a, Show a, Serialize.Serialize a)+ => a+ -> IO ()+roundtrip val = do++ val `shouldBe` Array.deserialize (Array.pinnedSerialize 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" $ \(x :: BinTree Int) -> roundtrip x++ 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/Stream.hs view
@@ -0,0 +1,33 @@+-- |+-- 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 qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream++import Test.Hspec.QuickCheck+import Test.Hspec as H++moduleName :: String+moduleName = "Data.Stream"++testgroupsOf :: Expectation+testgroupsOf =+ Stream.toList+ (Stream.groupsOf 2 Fold.sum (Stream.enumerateFromTo 1 10))+ `shouldReturn` [3::Int, 7, 11, 15, 19]++main :: IO ()+main =+ hspec $+ H.parallel $+ modifyMaxSuccess (const 1) $ do+ describe moduleName $ do+ describe "Repeated Fold" $ do+ prop "testgroupsOf" testgroupsOf
test/Streamly/Test/Data/Stream/Concurrent.hs view
@@ -23,9 +23,10 @@ import Test.QuickCheck.Monadic (monadicIO, run) import Test.Hspec as H -import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Fold as Fold ( toList ) import qualified Streamly.Data.Stream as Stream-import qualified Streamly.Internal.Data.Stream.Concurrent as Async+ ( replicate, fromEffect, fromPure, fromList, fold, take, nil )+import qualified Streamly.Internal.Data.Stream.Prelude as Async import Streamly.Test.Common (listEquals) @@ -39,10 +40,10 @@ sortEq :: Ord a => [a] -> [a] -> Bool sortEq a b = sort a == sort b -cmp :: Stream IO Int -> ([Int] -> [Int] -> Bool) -> [Int] -> Property-cmp s eq list =+cmp :: (Show a, Ord a) => ([a] -> [a] -> Bool) -> [a] -> Stream IO a -> Property+cmp eq list s = monadicIO $ do- stream <- run $ Stream.fold Fold.toList s+ stream <- run $ sort <$> Stream.fold Fold.toList s listEquals eq stream list prop1 :: Testable prop => String -> prop -> SpecWith ()@@ -226,94 +227,137 @@ $ describe moduleName $ do let transform = transformCombineFromList Stream.fromList sortEq - prop "eval" $+ prop "parEval" $ transform (fmap (+2)) (fmap (+1) . Async.parEval id . fmap (+1)) asyncSpec $ prop "parSequence" . sequenceReplicate- -- XXX Need to use asyncSpec in all tests- prop "mapM (+1)" $- transform (fmap (+1)) (Async.parMapM id (\x -> return (x + 1))) + 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- prop1 "append [] []"- $ cmp (Async.parList id [Stream.nil, Stream.nil]) sortEq []- prop1 "append [] [1]"- $ cmp (Async.parList id [Stream.nil, Stream.fromPure 1]) sortEq [1]- prop1 "append [1] []"- $ cmp (Async.parList id [Stream.fromPure 1, Stream.nil]) sortEq [1]- prop1 "append [0] [1]"- $ let stream = Async.parList id [Stream.fromPure 0, Stream.fromPure 1]- in cmp stream sortEq [0, 1]+ asyncSpec $+ let appWith cfg = Async.parList cfg [Stream.nil, Stream.nil]+ in prop1 "parList [] []" . cmp sortEq ([] :: [Int]) . appWith - prop1 "append [0] [] [1]"- $ let stream =- Async.parList id- [Stream.fromPure 0, Stream.nil, Stream.fromPure 1]- in cmp stream sortEq [0, 1]+ asyncSpec $+ let appWith cfg = Async.parList cfg [Stream.nil, Stream.fromPure 1]+ in prop1 "parList [] [1]" . cmp sortEq [1 :: Int] . appWith - let async = Async.parTwo id- prop1 "append2 left associated"- $ let stream =- Stream.fromPure 0- `async` Stream.fromPure 1- `async` Stream.fromPure 2- `async` Stream.fromPure 3- in cmp stream sortEq [0, 1, 2, 3]+ asyncSpec $+ let appWith cfg = Async.parList cfg [Stream.fromPure 1, Stream.nil]+ in prop1 "parList [1] []" . cmp sortEq [1 :: Int] . appWith - prop1 "append right associated"- $ let stream =- Stream.fromPure 0- `async` (Stream.fromPure 1- `async` (Stream.fromPure 2- `async` Stream.fromPure 3))- in cmp stream sortEq [0, 1, 2, 3]+ asyncSpec $+ let appWith cfg =+ Async.parList cfg [Stream.fromPure 0, Stream.fromPure 1]+ in prop1 "parList [0] [1]" . cmp sortEq [0, 1 :: Int] . appWith - prop1 "append balanced"- $ let leaf x y = Stream.fromPure x `async` Stream.fromPure y- leaf11 = leaf 0 1 `async` leaf 2 (3 :: Int)- leaf12 = leaf 4 5 `async` leaf 6 7- stream = leaf11 `async` leaf12- in cmp stream sortEq [0, 1, 2, 3, 4, 5, 6,7]+ 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 - prop1 "combineWith (maxThreads 1)"- $ let stream =- Async.parTwo (Async.maxThreads 1)- (Stream.fromList [1,2,3,4,5])+ 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 cmp stream (==) [1,2,3,4,5,6,7,8,9,10]+ in prop1 "parTwo" . cmp (==) [1,2,3,4,5,6,7,8,9,10] . appWith - prop1 "apply (async arg1)"- $ let s1 = Async.parApply id (Stream.fromPure (,)) (Stream.fromPure 1 `async` Stream.fromPure 2)- s2 = Async.parApply id s1 (Stream.fromPure 3) :: Stream IO (Int, Int)- xs = Stream.fold Fold.toList s2- in sort <$> xs `shouldReturn` [(1, 3), (2, 3)]+ asyncSpec $+ let par2 cfg =+ Async.parTwo+ cfg+ (Stream.fromPure 1)+ (Stream.fromPure 2)+ s1 cfg =+ Async.parApply+ cfg+ (Stream.fromPure (,))+ (par2 cfg)+ s2 cfg =+ Async.parApply+ cfg+ (s1 cfg)+ (Stream.fromPure 3) :: Stream IO (Int, Int)+ in prop1+ "parApply (async arg1)" . cmp (==) ( [(1, 3), (2, 3)]) . s2 - prop1 "apply (async arg2)"- $ let s1 = Stream.fromPure (1,)- s2 = Async.parApply id s1 (Stream.fromPure 2 `async` Stream.fromPure 3)- xs = Stream.fold Fold.toList s2 :: IO [(Int, Int)]- in sort <$> xs `shouldReturn` [(1, 2), (1, 3)]+ asyncSpec $+ let par2 cfg =+ Async.parTwo+ cfg+ (Stream.fromPure (2 :: Int))+ (Stream.fromPure 3)+ s1 = Stream.fromPure (1 :: Int,)+ s2 cfg = Async.parApply cfg s1 (par2 cfg)+ in prop1 "apply (async arg2)" . cmp (==) ([(1, 2), (1, 3)]) . s2 -- concat- prop1 "concat"- $ let stream =- Async.parConcat id+ asyncSpec $+ let stream cfg =+ Async.parConcat cfg $ fmap Stream.fromPure- $ Stream.fromList [1..100]- in cmp stream sortEq [1..100]+ $ Stream.fromList [1..100 :: Int]+ in prop1 "parConcat" . cmp sortEq [1..100] . stream - prop "concatMap" $- forAll (choose (0, 100)) $ \n ->- transform- (concatMap (const [1..n]))- (Async.parConcatMap id (const (Stream.fromList [1..n])))+ 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
test/Streamly/Test/Data/Unbox.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE StandaloneDeriving, DeriveAnyClass #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE TypeApplications #-}-{-# HLINT ignore "Use newtype instead of data" #-}-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# 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 #-}-{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-} -- | -- Module : Streamly.Test.Data.Unbox@@ -26,75 +26,137 @@ import Data.Proxy (Proxy(..)) import GHC.Generics (Generic, Rep(..)) import GHC.Real (Ratio(..))-import Streamly.Internal.Data.Unboxed- ( PeekRep(..)- , PokeRep(..)- , SizeOfRep(..)- , Unbox(..)- , genericPeekByteIndex- , genericPokeByteIndex- , genericSizeOf- , newUnpinnedBytes- , pokeByteIndex- ) +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 (Unbox, Show, Generic, Eq)+ deriving (Show, Generic, Eq)+DERIVE_UNBOX(Unit) data UnarySum = Sum1 | Sum2- deriving (Unbox, Show, Generic, Eq)+ deriving (Show, Generic, Eq)+DERIVE_UNBOX(UnarySum) data UnarySum2 = UnitSum1 Unit | UnitSum2 Unit- deriving (Generic, Unbox, Eq, Show)+ deriving (Generic, Eq, Show)+DERIVE_UNBOX(UnarySum2) data Unit1 = Unit1 Unit- deriving (Generic, Unbox, Eq, Show)+ deriving (Generic, Eq, Show)+DERIVE_UNBOX(Unit1) data Unit2 = Unit2 Unit Unit- deriving (Generic, Unbox, Eq, Show)+ deriving (Generic, Eq, Show)+DERIVE_UNBOX(Unit2) data Unit3 = Unit3 Int Unit Int- deriving (Generic, Unbox, Eq, Show)+ deriving (Generic, Eq, Show)+DERIVE_UNBOX(Unit3) data Unit4 = Unit4 Int Unit1 Int- deriving (Generic, Unbox, Eq, Show)+ deriving (Generic, Eq, Show)+DERIVE_UNBOX(Unit4) {-# ANN Single "HLint: ignore" #-} data Single = Single Int- deriving (Unbox, Show, Generic, Eq)+ deriving (Show, Generic, Eq)+DERIVE_UNBOX(Single) data Product2 = Product2 Int Char- deriving (Unbox, Show, Generic, Eq)+ deriving (Show, Generic, Eq)+DERIVE_UNBOX(Product2) data SumOfProducts = SOP0 | SOP1 Int | SOP2 Int Char | SOP3 Int Int Int- deriving (Unbox, Show, Generic, Eq)+ deriving (Show, Generic, Eq)+DERIVE_UNBOX(SumOfProducts) data NestedSOP = NSOP0 SumOfProducts | NSOP1 SumOfProducts- deriving (Unbox, Show, Generic, Eq)+ deriving (Show, Generic, Eq)+DERIVE_UNBOX(NestedSOP) -------------------------------------------------------------------------------- -- Standalone derivations@@ -103,23 +165,54 @@ -- Ratio does not have a Generic instance by default deriving instance Generic (Ratio Int) +#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, Unbox a)+ forall a. (Eq a, Show a, TYPE_CLASS a) => a -> IO () testSerialization val = do- arr <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))- pokeByteIndex 0 arr val- peekByteIndex 0 arr `shouldReturn` val+ let len =+#ifdef USE_SERIALIZE+ (variableSizeOf val)+#else+ (sizeOf (Proxy :: Proxy a))+#endif+ arr <- MBA.new len+ nextOff <- POKE(0, arr, val)+ (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)@@ -131,21 +224,35 @@ testGenericConsistency val = do -- Test the generic sizeOf- sizeOf (Proxy :: Proxy a) `shouldBe` genericSizeOf (Proxy :: Proxy a)+ 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 <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))+ arr <- MBA.new (sizeOf (Proxy :: Proxy a)) - pokeByteIndex 0 arr val+ nextOff <- POKE(0, arr, val) genericPeekByteIndex arr 0 `shouldReturn` val genericPokeByteIndex arr 0 val- peekByteIndex 0 arr `shouldReturn` 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 _ size = sizeOf (Proxy :: Proxy a) `shouldBe` size+checkSizeOf _ sz = sizeOf (Proxy :: Proxy a) `shouldBe` sz +#endif+ -------------------------------------------------------------------------------- -- CPP helpers --------------------------------------------------------------------------------@@ -175,6 +282,7 @@ 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)@@ -186,6 +294,7 @@ 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)@@ -213,7 +322,7 @@ -------------------------------------------------------------------------------- moduleName :: String-moduleName = "Data.Unboxed"+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
@@ -16,8 +16,8 @@ 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.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K+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
test/Streamly/Test/FileSystem/Event/Common.hs view
@@ -67,7 +67,7 @@ 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.Concurrent as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream import qualified Streamly.Unicode.Stream as Unicode #if defined(FILESYSTEM_EVENT_LINUX)
test/Streamly/Test/Prelude/Serial.hs view
@@ -1,5 +1,9 @@ {-# 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@@ -22,7 +26,7 @@ import Data.Word (Word8) import Data.Semigroup (Sum(..), getSum) import Foreign.Storable (Storable)-import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Internal.Data.MutByteArray (Unbox) import Test.Hspec.QuickCheck import Test.QuickCheck ( Gen@@ -49,7 +53,7 @@ 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.Stream.StreamK as K+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@@ -474,7 +478,7 @@ testTakeInterval = do r <- S.fold (FL.tee FL.head FL.last)- $ S.takeInterval (toRelTime64 takeDropTime)+ $ S.takeInterval (fromIntegral takeDropTime * 10**(-9)) $ S.repeatM (threadDelay 1000 >> getTime Monotonic) checkTakeDropTime r @@ -483,7 +487,7 @@ t0 <- getTime Monotonic mt1 <- S.fold FL.head- $ S.dropInterval (toRelTime64 takeDropTime)+ $ S.dropInterval (fromIntegral takeDropTime * 10**(-9)) $ S.repeatM (threadDelay 1000 >> getTime Monotonic) checkTakeDropTime (Just t0, mt1) #endif
test/Streamly/Test/Prelude/Top.hs view
@@ -14,7 +14,7 @@ ) import Test.QuickCheck.Monadic (monadicIO, assert, run) import qualified Streamly.Prelude as S-import qualified Streamly.Internal.Data.Stream.IsStream.Top as Top+import qualified Streamly.Internal.Data.Stream.IsStream as Top import Prelude hiding (maximum, minimum, elem, notElem, null, product, sum, head, last, take)
test/Streamly/Test/Serialize/Serializable.hs view
@@ -10,8 +10,8 @@ ) import Test.QuickCheck.Monadic (monadicIO) -import qualified Streamly.Internal.Serialize.FromBytes as Decoder-import qualified Streamly.Internal.Serialize.ToBytes as Encoder+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)
+ 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.Internal.Data.Stream as Stream (parseBreak)+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
@@ -20,8 +20,8 @@ import qualified Streamly.Data.Array as A import qualified Streamly.Data.Stream as Stream-import qualified Streamly.Internal.Data.Stream.Chunked as AS-import qualified Streamly.Internal.Data.Stream.StreamD 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
test/lib/Streamly/Test/Common.hs view
@@ -12,6 +12,7 @@ , listEquals , checkListEqual , chooseInt+ , chooseDouble ) where import Control.Monad (when)@@ -60,3 +61,6 @@ chooseInt :: (Int, Int) -> Gen Int chooseInt = choose++chooseDouble :: (Double, Double) -> Gen Double+chooseDouble = choose
test/lib/Streamly/Test/Prelude/Common.hs view
@@ -1,4 +1,8 @@ {-# 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@@ -85,7 +89,10 @@ , sortEq ) where -import Control.Applicative (ZipList(..), liftA2)+#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Applicative (ZipList(..)) import Control.Exception (Exception, try) import Control.Concurrent (threadDelay) import Control.Monad (replicateM)@@ -131,7 +138,7 @@ import qualified Streamly.Prelude as S import qualified Streamly.Data.Fold as FL import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.IsStream.Common as IS+import qualified Streamly.Internal.Data.Stream.IsStream as IS import qualified Streamly.Internal.Data.Unfold as UF import qualified Data.Map.Strict as Map
test/streamly-tests.cabal view
@@ -145,12 +145,12 @@ common test-dependencies build-depends: streamly-core- , base >= 4.9 && < 4.18- , containers >= 0.5 && < 0.7+ , base >= 4.9 && < 4.20+ , containers >= 0.5 && < 0.8 , exceptions >= 0.8 && < 0.11 , ghc- , hspec >= 2.0 && < 2.10- , mtl >= 2.2 && < 2.3+ , hspec >= 2.0 && < 2.12+ , mtl >= 2.2 && < 2.3.2 , random >= 1.0.0 && < 1.3 , transformers >= 0.4 && < 0.7 , QuickCheck >= 2.13 && < 2.15@@ -158,6 +158,8 @@ , filepath >= 1.4.1 && < 1.5 , temporary >= 1.3 && < 1.4 , network >= 3.1 && < 3.2+ , scientific >= 0.0 && < 0.4+ , template-haskell >= 2.12 && < 2.22 if !flag(use-streamly-core) build-depends: streamly@@ -214,13 +216,14 @@ -- Test suites in sorted order ------------------------------------------------------------------------------- -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+-- 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@@ -241,12 +244,18 @@ main-is: Streamly/Test/Data/Array.hs ghc-options: -main-is Streamly.Test.Data.Array.main -test-suite Data.Array.Mut+test-suite Data.Stream import: test-options type: exitcode-stdio-1.0- main-is: Streamly/Test/Data/Array/Mut.hs- ghc-options: -main-is Streamly.Test.Data.Array.Mut.main+ main-is: Streamly/Test/Data/Stream.hs+ ghc-options: -main-is Streamly.Test.Data.Stream.main +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.Ring.Unboxed import: test-options type: exitcode-stdio-1.0@@ -255,12 +264,57 @@ if flag(use-streamly-core) buildable: False -test-suite Data.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.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.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.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.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.Array.Stream import: test-options type: exitcode-stdio-1.0@@ -286,10 +340,10 @@ if flag(limit-build-mem) ghc-options: +RTS -M4000M -RTS -test-suite Data.Parser.ParserD+test-suite Data.ParserK import: test-options type: exitcode-stdio-1.0- main-is: Streamly/Test/Data/Parser/ParserD.hs+ main-is: Streamly/Test/Data/ParserK.hs if flag(limit-build-mem) ghc-options: +RTS -M1500M -RTS @@ -334,9 +388,7 @@ other-modules: Streamly.Test.FileSystem.Event.Common cpp-options: -DFILESYSTEM_EVENT_LINUX ghc-options: -main-is Streamly.Test.FileSystem.Event.Linux- if !os(linux)- buildable: False- if flag(use-streamly-core)+ if !os(linux) || !flag(dev) || flag(use-streamly-core) buildable: False test-suite FileSystem.Event.Windows@@ -360,28 +412,30 @@ buildable: False test-suite Network.Inet.TCP- import: test-options+ 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- -- XXX on Windows these test cases are hanging for ever- -- need to be investigated.- -- https://github.com/composewell/streamly/issues/2315- if os(windows)- buildable: False test-suite Network.Socket- import: test-options+ import: lib-options type: exitcode-stdio-1.0 main-is: Streamly/Test/Network/Socket.hs+ ghc-options: -rtsopts -fno-ignore-asserts+ include-dirs: .+ build-depends: streamly-tests+ -- Cannot killThread in listen/accept on Windows threaded runtime+ if !os(windows)+ ghc-options: -threaded -with-rtsopts=-N if flag(use-streamly-core) buildable: False- -- XXX on Windows these test cases are hanging for ever- -- need to be investigated.- -- https://github.com/composewell/streamly/issues/2315- if os(windows)- buildable: False test-suite Prelude import: test-options@@ -509,6 +563,14 @@ 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 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