streamly 0.5.2 → 0.6.0
raw patch · 45 files changed
+7987/−3471 lines, 45 filesdep ~deepseqdep ~path-iodep ~randomnew-component:exe:adaptivenew-component:exe:nano-bench
Dependency ranges changed: deepseq, path-io, random
Files
- Changelog.md +28/−0
- bench.sh +23/−9
- benchmark/Adaptive.hs +132/−0
- benchmark/BaseStreams.hs +182/−53
- benchmark/Chart.hs +195/−60
- benchmark/Linear.hs +220/−82
- benchmark/LinearAsync.hs +29/−16
- benchmark/LinearOps.hs +345/−82
- benchmark/NanoBenchmarks.hs +96/−0
- benchmark/Nested.hs +12/−6
- benchmark/NestedOps.hs +7/−0
- benchmark/StreamDOps.hs +184/−85
- benchmark/StreamKOps.hs +145/−67
- docs/streamly-vs-async.md +5/−0
- examples/AcidRain.hs +25/−13
- examples/ControlFlow.hs +28/−28
- examples/MergeSort.hs +11/−27
- src/Streamly.hs +18/−29
- src/Streamly/Enumeration.hs +550/−0
- src/Streamly/Internal.hs +1/−1
- src/Streamly/List.hs +188/−0
- src/Streamly/Prelude.hs +1847/−1037
- src/Streamly/SVar.hs +11/−3
- src/Streamly/Streams/Ahead.hs +60/−61
- src/Streamly/Streams/Async.hs +86/−63
- src/Streamly/Streams/Combinators.hs +216/−0
- src/Streamly/Streams/Instances.hs +78/−0
- src/Streamly/Streams/Parallel.hs +36/−29
- src/Streamly/Streams/Prelude.hs +128/−11
- src/Streamly/Streams/SVar.hs +11/−213
- src/Streamly/Streams/Serial.hs +49/−53
- src/Streamly/Streams/StreamD.hs +1457/−662
- src/Streamly/Streams/StreamD/Type.hs +100/−0
- src/Streamly/Streams/StreamK.hs +381/−439
- src/Streamly/Streams/StreamK/Type.hs +418/−0
- src/Streamly/Streams/Zip.hs +42/−19
- src/Streamly/Streams/inline.h +0/−3
- src/Streamly/Streams/inline.hs +27/−0
- src/Streamly/String.hs +28/−0
- src/Streamly/Tutorial.hs +86/−61
- stack-7.10.yaml +1/−0
- stack-8.0.yaml +1/−0
- stack.yaml +4/−2
- streamly.cabal +160/−43
- test/Prop.hs +336/−214
Changelog.md view
@@ -1,3 +1,31 @@+## 0.6.0++### 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 ### Bug Fixes
bench.sh view
@@ -2,23 +2,26 @@ print_help () { echo "Usage: $0 "- echo " [--compare] [--base commit] [--candidate commit]" echo " [--benchmarks <all|linear|linear-async|linear-rate|nested|base>]"+ echo " [--group-diff]" echo " [--graphs]"- echo " [--slow]" echo " [--no-measure]" echo " [--append] "+ echo " [--compare] [--base commit] [--candidate commit]"+ echo " [--slow]" echo " -- <gauge options>" echo echo "Multiple benchmarks can be specified as a space separate list" echo " e.g. --benchmarks \"linear nested\"" echo+ echo "--group-diff is used to compare groups within a single benchmark"+ echo " e.g. StreamD vs StreamK in base benchmark."+ echo echo "When using --compare, by default comparative chart of HEAD^ vs HEAD" echo "commit is generated, in the 'charts' directory." echo "Use --base and --candidate to select the commits to compare." echo echo "Any arguments after a '--' are passed directly to guage"- echo "You can omit '--' if the gauge args used do not start with a '-'." exit } @@ -159,14 +162,14 @@ echo "Checking out base commit [$BASE] for benchmarking" git checkout "$BASE" || die "Checkout of base commit [$BASE] failed" - $STACK build --bench --no-run-benchmarks || die "build failed"+ $STACK build $STACK_BUILD_FLAGS --bench --no-run-benchmarks || die "build failed" run_benches "$bench_list" echo "Checking out candidate commit [$CANDIDATE] for benchmarking" git checkout "$CANDIDATE" || \ die "Checkout of candidate [$CANDIDATE] commit failed" - $STACK build --bench --no-run-benchmarks || die "build failed"+ $STACK build $STACK_BUILD_FLAGS --bench --no-run-benchmarks || die "build failed" run_benches "$bench_list" # XXX reset back to the original commit }@@ -206,7 +209,9 @@ for i in $1 do echo "Generating reports for ${i}..."- $prog --benchmark $i+ $prog $(test "$GRAPH" = 1 && echo "--graphs") \+ $(test "$GROUP_DIFF" = 1 && echo "--group-diff") \+ --benchmark $i done } @@ -216,6 +221,7 @@ DEFAULT_BENCHMARKS="linear" ALL_BENCHMARKS="linear linear-async linear-rate nested base"+GROUP_DIFF=0 COMPARE=0 BASE=@@ -240,13 +246,16 @@ do case $1 in -h|--help|help) print_help ;;+ # options with arguments --slow) SPEED_OPTIONS="--min-duration 0"; shift ;;- --append) APPEND=1; shift ;; --benchmarks) shift; BENCHMARKS=$1; shift ;; --base) shift; BASE=$1; shift ;; --candidate) shift; CANDIDATE=$1; shift ;;+ # flags --compare) COMPARE=1; shift ;; --raw) RAW=1; shift ;;+ --append) APPEND=1; shift ;;+ --group-diff) GROUP_DIFF=1; shift ;; --graphs) GRAPH=1; shift ;; --no-measure) MEASURE=0; shift ;; --) shift; break ;;@@ -259,6 +268,11 @@ echo "Using stack command [$STACK]" set_benchmarks +if echo "$BENCHMARKS" | grep -q base+then+ STACK_BUILD_FLAGS="--flag streamly:dev"+fi+ #----------------------------------------------------------------------------- # Build stuff #-----------------------------------------------------------------------------@@ -273,7 +287,7 @@ if test "$MEASURE" = "1" then- $STACK build --bench --no-run-benchmarks || die "build failed"+ $STACK build $STACK_BUILD_FLAGS --bench --no-run-benchmarks || die "build failed" run_measurements "$BENCHMARKS" fi @@ -283,5 +297,5 @@ if test "$RAW" = "0" then- run_reports "$BENCHMARKS"+ run_reports "$BENCHMARKS" fi
+ benchmark/Adaptive.hs view
@@ -0,0 +1,132 @@+-- |+-- Module : Main+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com++import Control.Concurrent (threadDelay)+import Control.Monad (when)+import Control.Monad.IO.Class (liftIO)+import Gauge+import Streamly+import Streamly.Prelude as S+import System.Random (randomRIO)++-- Note that we should also compare the cpuTime especially when threaded+-- runtime is used with this benchmark because thread scheduling is not+-- predictable and can add non-deterministic delay to the total time measured.+--+-- Also, the worker dispatch depends on the worker dispatch latency which is+-- set to fixed 200 us. We need to keep that in mind when designing tests.++value :: Int+value = 1000++{-# INLINE source #-}+source :: IsStream t => (Int, Int) -> t IO Int+source range = S.replicateM value $ do+ r <- randomRIO range+ when (r /= 0) $ liftIO $ threadDelay r+ return r++{-# INLINE run #-}+run :: IsStream t => (Int, Int) -> (Int, Int) -> (t IO Int -> SerialT IO Int) -> IO ()+run srange crange t = runStream $ do+ n <- t $ source srange+ d <- liftIO (randomRIO crange)+ when (d /= 0) $ liftIO $ threadDelay d+ return n++low, medium, high :: Int+low = 10+medium = 20+high = 30++{-# INLINE noDelay #-}+noDelay :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+noDelay = run (0,0) (0,0)++{-# INLINE alwaysConstSlowSerial #-}+alwaysConstSlowSerial :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysConstSlowSerial = run (0,0) (medium,medium)++{-# INLINE alwaysConstSlow #-}+alwaysConstSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysConstSlow = run (low,low) (medium,medium)++{-# INLINE alwaysConstFast #-}+alwaysConstFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysConstFast = run (high,high) (medium,medium)++{-# INLINE alwaysVarSlow #-}+alwaysVarSlow :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysVarSlow = run (low,low) (low,high)++{-# INLINE alwaysVarFast #-}+alwaysVarFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+alwaysVarFast = run (high,high) (low,high)++-- XXX add variable producer tests as well++{-# INLINE runVarSometimesFast #-}+runVarSometimesFast :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+runVarSometimesFast = run (medium,medium) (low,high)++{-# INLINE randomVar #-}+randomVar :: IsStream t => (t IO Int -> SerialT IO Int) -> IO ()+randomVar = run (low,high) (low,high)++main :: IO ()+main =+ defaultMain+ [+ bgroup "serialConstantSlowConsumer"+ [ bench "serially" $ nfIO $ alwaysConstSlowSerial serially+ , bench "wSerially" $ nfIO $ alwaysConstSlowSerial wSerially+ ]+ , bgroup "default"+ [ bench "serially" $ nfIO $ noDelay serially+ , bench "wSerially" $ nfIO $ noDelay wSerially+ , bench "aheadly" $ nfIO $ noDelay aheadly+ , bench "asyncly" $ nfIO $ noDelay asyncly+ , bench "wAsyncly" $ nfIO $ noDelay wAsyncly+ , bench "parallely" $ nfIO $ noDelay parallely+ ]+ , bgroup "constantSlowConsumer"+ [ bench "aheadly" $ nfIO $ alwaysConstSlow aheadly+ , bench "asyncly" $ nfIO $ alwaysConstSlow asyncly+ , bench "wAsyncly" $ nfIO $ alwaysConstSlow wAsyncly+ , bench "parallely" $ nfIO $ alwaysConstSlow parallely+ ]+ , bgroup "constantFastConsumer"+ [ bench "aheadly" $ nfIO $ alwaysConstFast aheadly+ , bench "asyncly" $ nfIO $ alwaysConstFast asyncly+ , bench "wAsyncly" $ nfIO $ alwaysConstFast wAsyncly+ , bench "parallely" $ nfIO $ alwaysConstFast parallely+ ]+ , bgroup "variableSlowConsumer"+ [ bench "aheadly" $ nfIO $ alwaysVarSlow aheadly+ , bench "asyncly" $ nfIO $ alwaysVarSlow asyncly+ , bench "wAsyncly" $ nfIO $ alwaysVarSlow wAsyncly+ , bench "parallely" $ nfIO $ alwaysVarSlow parallely+ ]+ , bgroup "variableFastConsumer"+ [ bench "aheadly" $ nfIO $ alwaysVarFast aheadly+ , bench "asyncly" $ nfIO $ alwaysVarFast asyncly+ , bench "wAsyncly" $ nfIO $ alwaysVarFast wAsyncly+ , bench "parallely" $ nfIO $ alwaysVarFast parallely+ ]+ , bgroup "variableSometimesFastConsumer"+ [ bench "aheadly" $ nfIO $ runVarSometimesFast aheadly+ , bench "asyncly" $ nfIO $ runVarSometimesFast asyncly+ , bench "wAsyncly" $ nfIO $ runVarSometimesFast wAsyncly+ , bench "parallely" $ nfIO $ runVarSometimesFast parallely+ ]+ , bgroup "variableFullOverlap"+ [ bench "aheadly" $ nfIO $ randomVar aheadly+ , bench "asyncly" $ nfIO $ randomVar asyncly+ , bench "wAsyncly" $ nfIO $ randomVar wAsyncly+ , bench "parallely" $ nfIO $ randomVar parallely+ ]+ ]
benchmark/BaseStreams.hs view
@@ -19,12 +19,21 @@ -- completely optimized out by the compiler in some cases. {-# INLINE benchIO #-} benchIO :: String -> (a IO Int -> IO ()) -> (Int -> a IO Int) -> Benchmark-benchIO name run f = bench name $ nfIO $ randomRIO (1,1000) >>= run . f+benchIO name run f = bench name $ nfIO $ randomRIO (1,1) >>= run . f benchFold :: NFData b => String -> (t IO Int -> IO b) -> (Int -> t IO Int) -> Benchmark-benchFold name f src = bench name $ nfIO $ randomRIO (1,1000) >>= f . src+benchFold name f src = bench name $ nfIO $ randomRIO (1,1) >>= f . src +-- | Takes a source, and uses it with a default drain/fold method.+{-# INLINE benchD #-}+benchD :: String -> (Int -> D.Stream IO Int) -> Benchmark+benchD name f = bench name $ nfIO $ randomRIO (1,1) >>= D.toNull . f++{-# INLINE benchK #-}+benchK :: String -> (Int -> K.Stream IO Int) -> Benchmark+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= K.toNull . f+ {- _benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark _benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)@@ -37,46 +46,109 @@ [ bgroup "generation" [ benchIO "unfoldr" D.toNull D.sourceUnfoldr , benchIO "unfoldrM" D.toNull D.sourceUnfoldrM- , benchIO "fromEnum" D.toNull D.sourceFromEnum+ , benchIO "intFromTo" D.toNull D.sourceIntFromTo , benchIO "fromList" D.toNull D.sourceFromList -- , benchIO "fromFoldableM" D.sourceFromFoldableM ] , bgroup "elimination"- [ benchIO "toNull" D.toNull D.sourceUnfoldrM- , benchIO "uncons" D.uncons D.sourceUnfoldrM- , benchIO "nullHeadTail" D.nullHeadTail D.sourceUnfoldrM+ [ benchIO "toNull" D.toNull D.sourceUnfoldrM+ , benchIO "uncons" D.uncons D.sourceUnfoldrM+ , benchFold "tail" D.tail D.sourceUnfoldrM+ , benchIO "nullTail" D.nullTail D.sourceUnfoldrM+ , benchIO "headTail" D.headTail D.sourceUnfoldrM+ , benchFold "toList" K.toList K.sourceUnfoldrM+ , benchFold "fold" K.foldl K.sourceUnfoldrM+ , benchFold "last" K.last K.sourceUnfoldrM ] , bgroup "transformation"- [ benchIO "scanlM'" D.scan D.sourceUnfoldrM- , benchIO "map" D.map D.sourceUnfoldrM- , benchIO "mapM" D.mapM D.sourceUnfoldrM+ [ benchIO "scan" (D.scan 1) D.sourceUnfoldrM+ , benchIO "map" (D.map 1) D.sourceUnfoldrM+ , benchIO "fmap" (D.fmap 1) D.sourceUnfoldrM+ , benchIO "mapM" (D.mapM 1) D.sourceUnfoldrM+ , benchIO "mapMaybe" (D.mapMaybe 1) D.sourceUnfoldrM+ , benchIO "mapMaybeM" (D.mapMaybeM 1) D.sourceUnfoldrM ]+ , bgroup "transformationX4"+ [ benchIO "scan" (D.scan 4) D.sourceUnfoldrM+ , benchIO "map" (D.map 4) D.sourceUnfoldrM+ , benchIO "fmap" (D.fmap 4) D.sourceUnfoldrM+ , benchIO "mapM" (D.mapM 4) D.sourceUnfoldrM+ , benchIO "mapMaybe" (D.mapMaybe 4) D.sourceUnfoldrM+ , benchIO "mapMaybeM" (D.mapMaybeM 4) D.sourceUnfoldrM+ ] , bgroup "filtering"- [ benchIO "filter-even" D.filterEven D.sourceUnfoldrM- , benchIO "filter-all-out" D.filterAllOut D.sourceUnfoldrM- , benchIO "filter-all-in" D.filterAllIn D.sourceUnfoldrM- , benchIO "take-all" D.takeAll D.sourceUnfoldrM- , benchIO "takeWhile-true" D.takeWhileTrue D.sourceUnfoldrM- , benchIO "drop-all" D.dropAll D.sourceUnfoldrM- , benchIO "dropWhile-true" D.dropWhileTrue D.sourceUnfoldrM+ [ benchIO "filter-even" (D.filterEven 1) D.sourceUnfoldrM+ , benchIO "filter-all-out" (D.filterAllOut 1) D.sourceUnfoldrM+ , benchIO "filter-all-in" (D.filterAllIn 1) D.sourceUnfoldrM+ , benchIO "take-all" (D.takeAll 1) D.sourceUnfoldrM+ , benchIO "takeWhile-true" (D.takeWhileTrue 1) D.sourceUnfoldrM+ , benchIO "drop-one" (D.dropOne 1) D.sourceUnfoldrM+ , benchIO "drop-all" (D.dropAll 1) D.sourceUnfoldrM+ , benchIO "dropWhile-true" (D.dropWhileTrue 1) D.sourceUnfoldrM+ , benchIO "dropWhile-false" (D.dropWhileFalse 1) D.sourceUnfoldrM ]- , benchIO "zip" D.zip D.sourceUnfoldrM- , bgroup "compose"- [ benchIO "mapM" D.composeMapM D.sourceUnfoldrM-#if __GLASGOW_HASKELL__ != 802- , benchIO "map-with-all-in-filter" D.composeMapAllInFilter D.sourceUnfoldrM- , benchIO "all-in-filters" D.composeAllInFilters D.sourceUnfoldrM- , benchIO "all-out-filters" D.composeAllOutFilters D.sourceUnfoldrM-#endif+ , bgroup "filteringX4"+ [ benchIO "filter-even" (D.filterEven 4) D.sourceUnfoldrM+ , benchIO "filter-all-out" (D.filterAllOut 4) D.sourceUnfoldrM+ , benchIO "filter-all-in" (D.filterAllIn 4) D.sourceUnfoldrM+ , benchIO "take-all" (D.takeAll 4) D.sourceUnfoldrM+ , benchIO "takeWhile-true" (D.takeWhileTrue 4) D.sourceUnfoldrM+ , benchIO "drop-one" (D.dropOne 4) D.sourceUnfoldrM+ , benchIO "drop-all" (D.dropAll 4) D.sourceUnfoldrM+ , benchIO "dropWhile-true" (D.dropWhileTrue 4) D.sourceUnfoldrM+ , benchIO "dropWhile-false" (D.dropWhileFalse 4) D.sourceUnfoldrM ]- -- Scaling with same operation in sequence- , bgroup "compose-scaling"- [ benchIO "1" (D.composeScaling 1) D.sourceUnfoldrM- , benchIO "2" (D.composeScaling 2) D.sourceUnfoldrM- , benchIO "3" (D.composeScaling 3) D.sourceUnfoldrM- , benchIO "4" (D.composeScaling 4) D.sourceUnfoldrM+ , bgroup "zipping"+ [ benchFold "eqBy" D.eqBy D.sourceUnfoldrM+ , benchFold "cmpBy" D.cmpBy D.sourceUnfoldrM+ , benchIO "zip" D.zip D.sourceUnfoldrM ]+ , bgroup "mixed"+ [ benchIO "scan-map" (D.scanMap 1) D.sourceUnfoldrM+ , benchIO "drop-map" (D.dropMap 1) D.sourceUnfoldrM+ , benchIO "drop-scan" (D.dropScan 1) D.sourceUnfoldrM+ , benchIO "take-drop" (D.takeDrop 1) D.sourceUnfoldrM+ , benchIO "take-scan" (D.takeScan 1) D.sourceUnfoldrM+ , benchIO "take-map" (D.takeMap 1) D.sourceUnfoldrM+ , benchIO "filter-drop" (D.filterDrop 1) D.sourceUnfoldrM+ , benchIO "filter-take" (D.filterTake 1) D.sourceUnfoldrM+ , benchIO "filter-scan" (D.filterScan 1) D.sourceUnfoldrM+ , benchIO "filter-map" (D.filterMap 1) D.sourceUnfoldrM+ ]+ , bgroup "mixedX2"+ [ benchIO "scan-map" (D.scanMap 2) D.sourceUnfoldrM+ , benchIO "drop-map" (D.dropMap 2) D.sourceUnfoldrM+ , benchIO "drop-scan" (D.dropScan 2) D.sourceUnfoldrM+ , benchIO "take-drop" (D.takeDrop 2) D.sourceUnfoldrM+ , benchIO "take-scan" (D.takeScan 2) D.sourceUnfoldrM+ , benchIO "take-map" (D.takeMap 2) D.sourceUnfoldrM+ , benchIO "filter-drop" (D.filterDrop 2) D.sourceUnfoldrM+ , benchIO "filter-take" (D.filterTake 2) D.sourceUnfoldrM+ , benchIO "filter-scan" (D.filterScan 2) D.sourceUnfoldrM+ , benchIO "filter-map" (D.filterMap 2) D.sourceUnfoldrM+ ]+ , bgroup "mixedX4"+ [ benchIO "scan-map" (D.scanMap 4) D.sourceUnfoldrM+ , benchIO "drop-map" (D.dropMap 4) D.sourceUnfoldrM+ , benchIO "drop-scan" (D.dropScan 4) D.sourceUnfoldrM+ , benchIO "take-drop" (D.takeDrop 4) D.sourceUnfoldrM+ , benchIO "take-scan" (D.takeScan 4) D.sourceUnfoldrM+ , benchIO "take-map" (D.takeMap 4) D.sourceUnfoldrM+ , benchIO "filter-drop" (D.filterDrop 4) D.sourceUnfoldrM+ , benchIO "filter-take" (D.filterTake 4) D.sourceUnfoldrM+ , benchIO "filter-scan" (D.filterScan 4) D.sourceUnfoldrM+ , benchIO "filter-map" (D.filterMap 4) D.sourceUnfoldrM+ ]+ , bgroup "iterated"+ [ benchD "mapM" D.iterateMapM+ , benchD "scan(1/10)" D.iterateScan+ , benchD "filterEven" D.iterateFilterEven+ , benchD "takeAll" D.iterateTakeAll+ , benchD "dropOne" D.iterateDropOne+ , benchD "dropWhileFalse(1/10)" D.iterateDropWhileFalse+ , benchD "dropWhileTrue" D.iterateDropWhileTrue+ ] ] , bgroup "streamK" [ bgroup "generation"@@ -93,42 +165,99 @@ ] , bgroup "elimination" [ benchIO "toNull" K.toNull K.sourceUnfoldrM+ , benchIO "mapM_" K.mapM_ K.sourceUnfoldrM , benchIO "uncons" K.uncons K.sourceUnfoldrM , benchFold "init" K.init K.sourceUnfoldrM , benchFold "tail" K.tail K.sourceUnfoldrM- , benchIO "nullHeadTail" K.nullHeadTail K.sourceUnfoldrM+ , benchIO "nullTail" K.nullTail K.sourceUnfoldrM+ , benchIO "headTail" K.headTail K.sourceUnfoldrM , benchFold "toList" K.toList K.sourceUnfoldrM , benchFold "fold" K.foldl K.sourceUnfoldrM , benchFold "last" K.last K.sourceUnfoldrM ] , bgroup "transformation"- [ benchIO "scan" K.scan K.sourceUnfoldrM- , benchIO "map" K.map K.sourceUnfoldrM- , benchIO "mapM" K.mapM K.sourceUnfoldrM+ [ benchIO "scan" (K.scan 1) K.sourceUnfoldrM+ , benchIO "map" (K.map 1) K.sourceUnfoldrM+ , benchIO "fmap" (K.fmap 1) K.sourceUnfoldrM+ , benchIO "mapM" (K.mapM 1) K.sourceUnfoldrM -- , benchIO "concat" K.concat K.sourceUnfoldrM ]+ , bgroup "transformationX4"+ [ benchIO "scan" (K.scan 4) K.sourceUnfoldrM+ , benchIO "map" (K.map 4) K.sourceUnfoldrM+ , benchIO "fmap" (K.fmap 4) K.sourceUnfoldrM+ , benchIO "mapM" (K.mapM 4) K.sourceUnfoldrM+ -- , benchIO "concat" K.concat K.sourceUnfoldrM+ ] , bgroup "filtering"- [ benchIO "filter-even" K.filterEven K.sourceUnfoldrM- , benchIO "filter-all-out" K.filterAllOut K.sourceUnfoldrM- , benchIO "filter-all-in" K.filterAllIn K.sourceUnfoldrM- , benchIO "take-all" K.takeAll K.sourceUnfoldrM- , benchIO "takeWhile-true" K.takeWhileTrue K.sourceUnfoldrM- , benchIO "drop-all" K.dropAll K.sourceUnfoldrM- , benchIO "dropWhile-true" K.dropWhileTrue K.sourceUnfoldrM+ [ benchIO "filter-even" (K.filterEven 1) K.sourceUnfoldrM+ , benchIO "filter-all-out" (K.filterAllOut 1) K.sourceUnfoldrM+ , benchIO "filter-all-in" (K.filterAllIn 1) K.sourceUnfoldrM+ , benchIO "take-all" (K.takeAll 1) K.sourceUnfoldrM+ , benchIO "takeWhile-true" (K.takeWhileTrue 1) K.sourceUnfoldrM+ , benchIO "drop-one" (K.dropOne 1) K.sourceUnfoldrM+ , benchIO "drop-all" (K.dropAll 1) K.sourceUnfoldrM+ , benchIO "dropWhile-true" (K.dropWhileTrue 1) K.sourceUnfoldrM+ , benchIO "dropWhile-false" (K.dropWhileFalse 1) K.sourceUnfoldrM ]- , benchIO "zip" K.zip K.sourceUnfoldrM- , bgroup "compose"- [ benchIO "mapM" K.composeMapM K.sourceUnfoldrM- , benchIO "map-with-all-in-filter" K.composeMapAllInFilter K.sourceUnfoldrM- , benchIO "all-in-filters" K.composeAllInFilters K.sourceUnfoldrM- , benchIO "all-out-filters" K.composeAllOutFilters K.sourceUnfoldrM+ , bgroup "filteringX4"+ [ benchIO "filter-even" (K.filterEven 4) K.sourceUnfoldrM+ , benchIO "filter-all-out" (K.filterAllOut 4) K.sourceUnfoldrM+ , benchIO "filter-all-in" (K.filterAllIn 4) K.sourceUnfoldrM+ , benchIO "take-all" (K.takeAll 4) K.sourceUnfoldrM+ , benchIO "takeWhile-true" (K.takeWhileTrue 4) K.sourceUnfoldrM+ , benchIO "drop-one" (K.dropOne 4) K.sourceUnfoldrM+ , benchIO "drop-all" (K.dropAll 4) K.sourceUnfoldrM+ , benchIO "dropWhile-true" (K.dropWhileTrue 4) K.sourceUnfoldrM+ , benchIO "dropWhile-false" (K.dropWhileFalse 4) K.sourceUnfoldrM ]- -- Scaling with same operation in sequence- , bgroup "compose-scaling"- [ benchIO "1" (K.composeScaling 1) K.sourceUnfoldrM- , benchIO "2" (K.composeScaling 2) K.sourceUnfoldrM- , benchIO "3" (K.composeScaling 3) K.sourceUnfoldrM- , benchIO "4" (K.composeScaling 4) K.sourceUnfoldrM+ , bgroup "zipping"+ [ benchIO "zip" K.zip K.sourceUnfoldrM+ ]+ , bgroup "mixed"+ [ benchIO "scan-map" (K.scanMap 1) K.sourceUnfoldrM+ , benchIO "drop-map" (K.dropMap 1) K.sourceUnfoldrM+ , benchIO "drop-scan" (K.dropScan 1) K.sourceUnfoldrM+ , benchIO "take-drop" (K.takeDrop 1) K.sourceUnfoldrM+ , benchIO "take-scan" (K.takeScan 1) K.sourceUnfoldrM+ , benchIO "take-map" (K.takeMap 1) K.sourceUnfoldrM+ , benchIO "filter-drop" (K.filterDrop 1) K.sourceUnfoldrM+ , benchIO "filter-take" (K.filterTake 1) K.sourceUnfoldrM+ , benchIO "filter-scan" (K.filterScan 1) K.sourceUnfoldrM+ , benchIO "filter-map" (K.filterMap 1) K.sourceUnfoldrM+ ]+ , bgroup "mixedX2"+ [ benchIO "scan-map" (K.scanMap 2) K.sourceUnfoldrM+ , benchIO "drop-map" (K.dropMap 2) K.sourceUnfoldrM+ , benchIO "drop-scan" (K.dropScan 2) K.sourceUnfoldrM+ , benchIO "take-drop" (K.takeDrop 2) K.sourceUnfoldrM+ , benchIO "take-scan" (K.takeScan 2) K.sourceUnfoldrM+ , benchIO "take-map" (K.takeMap 2) K.sourceUnfoldrM+ , benchIO "filter-drop" (K.filterDrop 2) K.sourceUnfoldrM+ , benchIO "filter-take" (K.filterTake 2) K.sourceUnfoldrM+ , benchIO "filter-scan" (K.filterScan 2) K.sourceUnfoldrM+ , benchIO "filter-map" (K.filterMap 2) K.sourceUnfoldrM+ ]+ , bgroup "mixedX4"+ [ benchIO "scan-map" (K.scanMap 4) K.sourceUnfoldrM+ , benchIO "drop-map" (K.dropMap 4) K.sourceUnfoldrM+ , benchIO "drop-scan" (K.dropScan 4) K.sourceUnfoldrM+ , benchIO "take-drop" (K.takeDrop 4) K.sourceUnfoldrM+ , benchIO "take-scan" (K.takeScan 4) K.sourceUnfoldrM+ , benchIO "take-map" (K.takeMap 4) K.sourceUnfoldrM+ , benchIO "filter-drop" (K.filterDrop 4) K.sourceUnfoldrM+ , benchIO "filter-take" (K.filterTake 4) K.sourceUnfoldrM+ , benchIO "filter-scan" (K.filterScan 4) K.sourceUnfoldrM+ , benchIO "filter-map" (K.filterMap 4) K.sourceUnfoldrM+ ]+ , bgroup "iterated"+ [ benchK "mapM" K.iterateMapM+ , benchK "scan(1/10)" K.iterateScan+ , benchK "filterEven" K.iterateFilterEven+ , benchK "takeAll" K.iterateTakeAll+ , benchK "dropOne" K.iterateDropOne+ , benchK "dropWhileFalse(1/10)" K.iterateDropWhileFalse+ , benchK "dropWhileTrue" K.iterateDropWhileTrue ] ] ]
benchmark/Chart.hs view
@@ -7,8 +7,10 @@ import Control.Exception (handle, catch, SomeException, ErrorCall(..)) import Control.Monad.Trans.State import Control.Monad.Trans.Maybe+import Data.Function (on, (&)) import Data.List import Data.List.Split+import Data.Maybe (mapMaybe) import Data.Ord (comparing) import System.Environment (getArgs) import Control.Monad.IO.Class (liftIO)@@ -21,18 +23,24 @@ ------------------------------------------------------------------------------ data BenchType = Linear | LinearAsync | LinearRate | Nested | Base+ deriving Show data Options = Options { genGraphs :: Bool+ , groupDiff :: Bool , benchType :: BenchType- }+ } deriving Show -defaultOptions = Options False Linear+defaultOptions = Options False False Linear setGenGraphs val = do (args, opts) <- get put (args, opts { genGraphs = val }) +setGroupDiff val = do+ (args, opts) <- get+ put (args, opts { groupDiff = val })+ setBenchType val = do (args, opts) <- get put (args, opts { benchType = val })@@ -66,15 +74,25 @@ parseOptions = do args <- getArgs runMaybeT $ flip evalStateT (args, defaultOptions) $ do- x <- shift- case x of- Just "--graphs" -> setGenGraphs True- Just "--benchmark" -> parseBench- Just str -> do+ parseLoop+ fmap snd get++ where++ parseOpt opt =+ case opt of+ "--graphs" -> setGenGraphs True+ "--group-diff" -> setGroupDiff True+ "--benchmark" -> parseBench+ str -> do liftIO $ putStrLn $ "Unrecognized option " <> str mzero++ parseLoop = do+ next <- shift+ case next of+ Just opt -> parseOpt opt >> parseLoop Nothing -> return ()- fmap snd get ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) -> putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")@@ -84,97 +102,198 @@ ------------------------------------------------------------------------------ makeLinearGraphs :: Config -> String -> IO ()-makeLinearGraphs cfg inputFile = do- ignoringErr $ graph inputFile "operations" $ cfg- { title = Just "Streamly operations"- , classifyBenchmark = \b ->- if not ("serially/" `isPrefixOf` b)- || "/generation" `isInfixOf` b- || "/compose" `isInfixOf` b- || "/concat" `isSuffixOf` b- then Nothing- else Just ("Streamly", last $ splitOn "/" b)+makeLinearGraphs cfg@Config{..} inputFile = do+ ignoringErr $ graph inputFile "generation" $ cfg+ { title = (++) <$> title <*> Just " generation"+ , classifyBenchmark =+ fmap ("Streamly",) . stripPrefix "serially/generation/" } - ignoringErr $ graph inputFile "generation" $ cfg- { title = Just "Stream generation"+ ignoringErr $ graph inputFile "elimination" $ cfg+ { title = (++) <$> title <*> Just " Elimination"+ , classifyBenchmark =+ fmap ("Streamly",) . stripPrefix "serially/elimination/"+ }++ ignoringErr $ graph inputFile "transformation-zip" $ cfg+ { title = (++) <$> title <*> Just " Transformation & Zip" , classifyBenchmark = \b ->- if "serially/generation" `isPrefixOf` b+ if "serially/transformation/" `isPrefixOf` b+ || "serially/zipping" `isPrefixOf` b then Just ("Streamly", last $ splitOn "/" b) else Nothing } - ignoringErr $ graph inputFile "composition" $ cfg- { title = Just "Streamly composition performance"- , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose/"+ ignoringErr $ graph inputFile "filtering" $ cfg+ { title = (++) <$> title <*> Just " Filtering"+ , classifyBenchmark =+ fmap ("Streamly",) . stripPrefix "serially/filtering/" } - ignoringErr $ graph inputFile "composition-scaling"+ ignoringErr $ graph inputFile "transformationX4" $ cfg+ { title = (++) <$> title <*> Just " Transformation x 4"+ , classifyBenchmark =+ fmap ("Streamly",) . stripPrefix "serially/transformationX4/"+ }++ ignoringErr $ graph inputFile "filteringX4" $ cfg- { title = Just "Streamly composition scaling"- , classifyBenchmark = fmap ("Streamly",) . stripPrefix "serially/compose-"+ { title = (++) <$> title <*> Just " Filtering x 4"+ , classifyBenchmark =+ fmap ("Streamly",) . stripPrefix "serially/filteringX4/" } + ignoringErr $ graph inputFile "mixedX4"+ $ cfg+ { title = (++) <$> title <*> Just " Mixed x 4"+ , classifyBenchmark =+ fmap ("Streamly",) . stripPrefix "serially/mixedX4/"+ }++ ignoringErr $ graph inputFile "iterated"+ $ cfg+ { title = Just "iterate 10,000 times over 10 elems"+ , classifyBenchmark =+ fmap ("Streamly",) . stripPrefix "serially/iterated/"+ }+ ------------------------------------------------------------------------------ -- Nested composition charts ------------------------------------------------------------------------------ makeNestedGraphs :: Config -> String -> IO () makeNestedGraphs cfg inputFile =- ignoringErr $ graph inputFile "nested-serial-diff" $ cfg- { title = Just "Nested serial"- , classifyBenchmark = \b ->- let ls = splitOn "/" b- in case head ls of- "serially" -> Just (head ls, last ls)- _ -> Nothing+ ignoringErr $ graph inputFile "nested-all" $ cfg+ { presentation = Groups Absolute+ , classifyBenchmark = classifyNested+ , selectGroups = \gs ->+ groupBy ((==) `on` snd) gs+ & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)+ & concat } + where++ order = ["serially", "asyncly", "wAsyncly", "aheadly", "parallely"]++ classifyNested b+ | "serially/" `isPrefixOf` b =+ ("serially",) <$> stripPrefix "serially/" b+ | "asyncly/" `isPrefixOf` b =+ ("asyncly",) <$> stripPrefix "asyncly/" b+ | "wAsyncly/" `isPrefixOf` b =+ ("wAsyncly",) <$> stripPrefix "wAsyncly/" b+ | "aheadly/" `isPrefixOf` b =+ ("aheadly",) <$> stripPrefix "aheadly/" b+ | "parallely/" `isPrefixOf` b =+ ("parallely",) <$> stripPrefix "parallely/" b+ | otherwise = Nothing+ ------------------------------------------------------------------------------ -- Charts for parallel streams ------------------------------------------------------------------------------ makeLinearAsyncGraphs :: Config -> String -> IO ()-makeLinearAsyncGraphs cfg inputFile = do- putStrLn "Not implemented"- return ()+makeLinearAsyncGraphs cfg inputFile =+ ignoringErr $ graph inputFile "linear-async" cfg+ { presentation = Groups Absolute+ , classifyBenchmark = classifyAsync+ , selectGroups = \gs ->+ groupBy ((==) `on` snd) gs+ & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)+ & concat+ } + where++ order = ["asyncly", "wAsyncly", "aheadly", "parallely"]++ classifyAsync b+ | "asyncly/" `isPrefixOf` b =+ ("asyncly",) <$> stripPrefix "asyncly/" b+ | "wAsyncly/" `isPrefixOf` b =+ ("wAsyncly",) <$> stripPrefix "wAsyncly/" b+ | "aheadly/" `isPrefixOf` b =+ ("aheadly",) <$> stripPrefix "aheadly/" b+ | "parallely/" `isPrefixOf` b =+ ("parallely",) <$> stripPrefix "parallely/" b+ | otherwise = Nothing+ makeLinearRateGraphs :: Config -> String -> IO () makeLinearRateGraphs cfg inputFile = do putStrLn "Not implemented" return () --------------------------------------------------------------------------------- Charts for base streams+-- Reports/Charts for base streams ------------------------------------------------------------------------------ -makeBaseGraphs :: Config -> String -> IO ()-makeBaseGraphs cfg inputFile = do- putStrLn "Not implemented"- return ()+showStreamDVsK Options{..} cfg inp out =+ let cfg' = cfg { classifyBenchmark = classifyBase }+ in if genGraphs+ then ignoringErr $ graph inp "streamD-vs-streamK"+ cfg' { outputDir = Just out+ , presentation = Groups Absolute+ }+ else ignoringErr $ report inp Nothing cfg' + where++ classifyBase b+ | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b+ | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b+ | otherwise = Nothing++showStreamD Options{..} cfg inp out =+ let cfg' = cfg { classifyBenchmark = classifyStreamD }+ in if genGraphs+ then ignoringErr $ graph inp "streamD"+ cfg' {outputDir = Just out}+ else ignoringErr $ report inp Nothing cfg'++ where++ classifyStreamD b+ | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b+ | otherwise = Nothing++showStreamK Options{..} cfg inp out =+ let cfg' = cfg { classifyBenchmark = classifyStreamK }+ in if genGraphs+ then ignoringErr $ graph inp "streamK"+ cfg' {outputDir = Just out}+ else ignoringErr $ report inp Nothing cfg'++ where++ classifyStreamK b+ | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b+ | otherwise = Nothing+ ------------------------------------------------------------------------------ -- text reports ------------------------------------------------------------------------------ +selectBench :: (SortColumn -> Either String [(String, Double)]) -> [String]+selectBench f =+ reverse+ $ fmap fst+ $ either+ (const $ either error (sortOn snd) $ f $ ColumnIndex 0)+ (sortOn snd)+ $ f $ ColumnIndex 1+ benchShow Options{..} cfg func inp out = if genGraphs then func cfg {outputDir = Just out} inp- else- ignoringErr $ report inp Nothing $ cfg- { selectBenchmarks =- \f ->- reverse- $ fmap fst- $ either- (const $ either error id $ f $ ColumnIndex 0)- (sortOn snd)- $ f $ ColumnIndex 1- }+ else ignoringErr $ report inp Nothing cfg main :: IO () main = do- let cfg = defaultConfig { presentation = Groups PercentDiff }+ let cfg = defaultConfig+ { presentation = Groups PercentDiff+ , selectBenchmarks = selectBench+ } res <- parseOptions case res of@@ -183,18 +302,34 @@ return () Just opts@Options{..} -> case benchType of- Linear -> benchShow opts cfg makeLinearGraphs+ Linear -> benchShow opts cfg+ { title = Just "100,000 elems" }+ makeLinearGraphs "charts/linear/results.csv" "charts/linear"- LinearAsync -> benchShow opts cfg makeLinearAsyncGraphs+ LinearAsync -> benchShow opts cfg+ { title = Just "Async 10,000 elems" }+ makeLinearAsyncGraphs "charts/linear-async/results.csv" "charts/linear-async" LinearRate -> benchShow opts cfg makeLinearRateGraphs "charts/linear-rate/results.csv" "charts/linear-rate"- Nested -> benchShow opts cfg makeNestedGraphs+ Nested -> benchShow opts cfg+ { title = Just "Nested loops 100 x 100 elems" }+ makeNestedGraphs "charts/nested/results.csv" "charts/nested"- Base -> benchShow opts cfg makeBaseGraphs- "charts/base/results.csv"- "charts/base"+ Base -> do+ let cfg' = cfg { title = Just "100,000 elems" }+ if groupDiff+ then showStreamDVsK opts cfg'+ "charts/base/results.csv"+ "charts/base"+ else do+ showStreamD opts cfg'+ "charts/base/results.csv"+ "charts/base"+ showStreamK opts cfg'+ "charts/base/results.csv"+ "charts/base"
benchmark/Linear.hs view
@@ -6,121 +6,259 @@ -- Maintainer : harendra.kumar@gmail.com import Control.DeepSeq (NFData)--- import Data.Functor.Identity (Identity, runIdentity)+import Data.Functor.Identity (Identity, runIdentity) import System.Random (randomRIO)++import qualified GHC.Exts as GHC import qualified LinearOps as Ops import Streamly+import qualified Streamly.Prelude as S import Gauge -- We need a monadic bind here to make sure that the function f does not get -- completely optimized out by the compiler in some cases.---+ -- | Takes a fold method, and uses it with a default source.-{-# INLINE benchIO #-}-benchIO :: (IsStream t, NFData b) => String -> (t IO Int -> IO b) -> Benchmark-benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source+{-# INLINE benchIOSink #-}+benchIOSink+ :: (IsStream t, NFData b)+ => String -> (t IO Int -> IO b) -> Benchmark+benchIOSink name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source +-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but+-- we can't use it as it requires MonadAsync constraint.+{-# INLINE benchIdentitySink #-}+benchIdentitySink+ :: (IsStream t, NFData b)+ => String -> (t Identity Int -> Identity b) -> Benchmark+benchIdentitySink name f = bench name $ nf (f . Ops.sourceUnfoldr) 1+ -- | Takes a source, and uses it with a default drain/fold method.-{-# INLINE benchSrcIO #-}-benchSrcIO- :: (t IO Int -> SerialT IO Int)+{-# INLINE benchIOSrc #-}+benchIOSrc+ :: (t IO a -> SerialT IO a) -> String- -> (Int -> t IO Int)+ -> (Int -> t IO a) -> Benchmark-benchSrcIO t name f- = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f+benchIOSrc t name f =+ bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f -{--_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark-_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)--}+{-# INLINE benchPure #-}+benchPure :: NFData b => String -> (Int -> a) -> (a -> b) -> Benchmark+benchPure name src f = bench name $ nfIO $ randomRIO (1,1) >>= return . f . src +{-# INLINE benchPureSink #-}+benchPureSink :: NFData b => String -> (SerialT Identity Int -> b) -> Benchmark+benchPureSink name f = benchPure name Ops.sourceUnfoldr f++{-# INLINE benchPureSinkIO #-}+benchPureSinkIO+ :: NFData b+ => String -> (SerialT Identity Int -> IO b) -> Benchmark+benchPureSinkIO name f =+ bench name $ nfIO $ randomRIO (1, 1) >>= f . Ops.sourceUnfoldr++{-# INLINE benchPureSrc #-}+benchPureSrc :: String -> (Int -> SerialT Identity a) -> Benchmark+benchPureSrc name src = benchPure name src (runIdentity . runStream)+ main :: IO () main = defaultMain [ bgroup "serially"- [ bgroup "generation"+ [ bgroup "pure"+ [ benchPureSink "id" id+ , benchPureSink "eqBy" Ops.eqBy+ , benchPureSink "==" Ops.eqInstance+ , benchPureSink "/=" Ops.eqInstanceNotEq+ , benchPureSink "cmpBy" Ops.cmpBy+ , benchPureSink "<" Ops.ordInstance+ , benchPureSink "min" Ops.ordInstanceMin+ , benchPureSrc "IsList.fromList" Ops.sourceIsList+ , benchPureSink "IsList.toList" GHC.toList+ , benchPureSrc "IsString.fromString" Ops.sourceIsString+ , benchPure "readsPrec" (\n -> S.fromList [1..n :: Int])+ Ops.readInstance+ , benchPureSink "showsPrec" Ops.showInstance+ , benchPure "showsPrecList" (\n -> S.fromList [1..n :: Int])+ Ops.showInstanceList+ , benchPureSink "foldl'" Ops.pureFoldl'+ , benchPureSink "foldable/foldl'" Ops.foldableFoldl'+ , benchPureSink "foldable/sum" Ops.foldableSum+ , benchPureSinkIO "traversable/mapM" Ops.traversableMapM+ ]+ , bgroup "generation" [ -- Most basic, barely stream continuations running- benchSrcIO serially "unfoldr" Ops.sourceUnfoldr- , benchSrcIO serially "unfoldrM" Ops.sourceUnfoldrM- , benchSrcIO serially "fromList" Ops.sourceFromList- , benchSrcIO serially "fromListM" Ops.sourceFromListM+ benchIOSrc serially "unfoldr" Ops.sourceUnfoldr+ , benchIOSrc serially "unfoldrM" Ops.sourceUnfoldrM+ , benchIOSrc serially "intFromTo" Ops.sourceIntFromTo+ , benchIOSrc serially "intFromThenTo" Ops.sourceIntFromThenTo+ , benchIOSrc serially "integerFromStep" Ops.sourceIntegerFromStep+ , benchIOSrc serially "fracFromThenTo" Ops.sourceFracFromThenTo+ , benchIOSrc serially "fracFromTo" Ops.sourceFracFromTo+ , benchIOSrc serially "fromList" Ops.sourceFromList+ , benchIOSrc serially "fromListM" Ops.sourceFromListM -- These are essentially cons and consM- , benchSrcIO serially "fromFoldable" Ops.sourceFromFoldable- , benchSrcIO serially "fromFoldableM" Ops.sourceFromFoldableM+ , benchIOSrc serially "fromFoldable" Ops.sourceFromFoldable+ , benchIOSrc serially "fromFoldableM" Ops.sourceFromFoldableM -- These are essentially appends- , benchSrcIO serially "foldMapWith" Ops.sourceFoldMapWith- , benchSrcIO serially "foldMapWithM" Ops.sourceFoldMapWithM+ , benchIOSrc serially "foldMapWith" Ops.sourceFoldMapWith+ , benchIOSrc serially "foldMapWithM" Ops.sourceFoldMapWithM+ , benchIOSrc serially "foldMapM" Ops.sourceFoldMapM ] , bgroup "elimination"- [ benchIO "toNull" $ Ops.toNull serially- , benchIO "uncons" Ops.uncons- , benchIO "init" Ops.init- , benchIO "tail" Ops.tail- , benchIO "nullHeadTail" Ops.nullHeadTail- , benchIO "mapM_" Ops.mapM_- , benchIO "toList" Ops.toList- , benchIO "foldr" Ops.foldr- , benchIO "foldr1" Ops.foldr1- , benchIO "foldrM" Ops.foldrM- , benchIO "foldl'" Ops.foldl'- , benchIO "foldl1'" Ops.foldl1'+ [ benchIOSink "toNull" $ Ops.toNull serially+ , benchIOSink "uncons" Ops.uncons+ , benchIOSink "init" Ops.init+ , benchIOSink "tail" Ops.tail+ , benchIOSink "nullHeadTail" Ops.nullHeadTail+ , benchIOSink "mapM_" Ops.mapM_+ , benchIOSink "toList" Ops.toList - , benchIO "last" Ops.last- , benchIO "length" Ops.length- , benchIO "elem" Ops.elem- , benchIO "notElem" Ops.notElem- , benchIO "all" Ops.all- , benchIO "any" Ops.any- , benchIO "and" Ops.and- , benchIO "or" Ops.or- , benchIO "find" Ops.find- , benchIO "findIndex" Ops.findIndex- , benchIO "elemIndex" Ops.elemIndex- , benchIO "maximum" Ops.maximum- , benchIO "minimum" Ops.minimum- , benchIO "sum" Ops.sum- , benchIO "product" Ops.product+ , bgroup "reduce"+ [ bgroup "IO"+ [ benchIOSink "foldr" Ops.foldrReduce+ , benchIOSink "foldr1" Ops.foldr1Reduce+ , benchIOSink "foldl'" Ops.foldl'Reduce+ , benchIOSink "foldl1'" Ops.foldl1'Reduce+ , benchIOSink "foldlM'" Ops.foldlM'Reduce+ ]+ , bgroup "Identity"+ [ benchIdentitySink "foldr" Ops.foldrReduce+ , benchIdentitySink "foldr1" Ops.foldr1Reduce+ , benchIdentitySink "foldl'" Ops.foldl'Reduce+ , benchIdentitySink "foldl1'" Ops.foldl1'Reduce+ , benchIdentitySink "foldlM'" Ops.foldlM'Reduce+ ]+ ]++ , bgroup "build"+ [ bgroup "IO"+ [ benchIOSink "foldr" Ops.foldrBuild+ , benchIOSink "foldrM" Ops.foldrMBuild+ , benchIOSink "foldl'" Ops.foldl'Build+ , benchIOSink "foldlM'" Ops.foldlM'Build+ ]+ , bgroup "Identity"+ [ benchIdentitySink "foldr" Ops.foldrBuild+ , benchIdentitySink "foldrM" Ops.foldrMBuild+ , benchIdentitySink "foldl'" Ops.foldl'Build+ , benchIdentitySink "foldlM'" Ops.foldlM'Build+ ]+ ]++ , benchIOSink "last" Ops.last+ , benchIOSink "length" Ops.length+ , benchIOSink "elem" Ops.elem+ , benchIOSink "notElem" Ops.notElem+ , benchIOSink "all" Ops.all+ , benchIOSink "any" Ops.any+ , benchIOSink "and" Ops.and+ , benchIOSink "or" Ops.or+ , benchIOSink "find" Ops.find+ , benchIOSink "findIndex" Ops.findIndex+ , benchIOSink "elemIndex" Ops.elemIndex+ , benchIOSink "maximum" Ops.maximum+ , benchIOSink "maximumBy" Ops.maximumBy+ , benchIOSink "minimum" Ops.minimum+ , benchIOSink "minimumBy" Ops.minimumBy+ , benchIOSink "sum" Ops.sum+ , benchIOSink "product" Ops.product ] , bgroup "transformation"- [ benchIO "scan" Ops.scan- , benchIO "map" Ops.map- , benchIO "fmap" Ops.fmap- , benchIO "mapM" (Ops.mapM serially)- , benchIO "mapMaybe" Ops.mapMaybe- , benchIO "mapMaybeM" Ops.mapMaybeM+ [ benchIOSink "scan" (Ops.scan 1)+ , benchIOSink "scanl1'" (Ops.scanl1' 1)+ , benchIOSink "map" (Ops.map 1)+ , benchIOSink "fmap" (Ops.fmap 1)+ , benchIOSink "mapM" (Ops.mapM serially 1)+ , benchIOSink "mapMaybe" (Ops.mapMaybe 1)+ , benchIOSink "mapMaybeM" (Ops.mapMaybeM 1) , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n -> Ops.sequence serially (Ops.sourceUnfoldrMAction n)- , benchIO "findIndices" Ops.findIndices- , benchIO "elemIndices" Ops.elemIndices- -- , benchIO "concat" Ops.concat+ , benchIOSink "findIndices" (Ops.findIndices 1)+ , benchIOSink "elemIndices" (Ops.elemIndices 1) ]+ , bgroup "transformationX4"+ [ benchIOSink "scan" (Ops.scan 4)+ , benchIOSink "scanl1'" (Ops.scanl1' 4)+ , benchIOSink "map" (Ops.map 4)+ , benchIOSink "fmap" (Ops.fmap 4)+ , benchIOSink "mapM" (Ops.mapM serially 4)+ , benchIOSink "mapMaybe" (Ops.mapMaybe 4)+ , benchIOSink "mapMaybeM" (Ops.mapMaybeM 4)+ -- , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->+ -- Ops.sequence serially (Ops.sourceUnfoldrMAction n)+ , benchIOSink "findIndices" (Ops.findIndices 4)+ , benchIOSink "elemIndices" (Ops.elemIndices 4)+ ] , bgroup "filtering"- [ benchIO "filter-even" Ops.filterEven- , benchIO "filter-all-out" Ops.filterAllOut- , benchIO "filter-all-in" Ops.filterAllIn- , benchIO "take-all" Ops.takeAll- , benchIO "takeWhile-true" Ops.takeWhileTrue- , benchIO "takeWhileM-true" Ops.takeWhileMTrue- , benchIO "drop-all" Ops.dropAll- , benchIO "dropWhile-true" Ops.dropWhileTrue- , benchIO "dropWhileM-true" Ops.dropWhileMTrue+ [ benchIOSink "filter-even" (Ops.filterEven 1)+ , benchIOSink "filter-all-out" (Ops.filterAllOut 1)+ , benchIOSink "filter-all-in" (Ops.filterAllIn 1)+ , benchIOSink "take-all" (Ops.takeAll 1)+ , benchIOSink "takeWhile-true" (Ops.takeWhileTrue 1)+ --, benchIOSink "takeWhileM-true" (Ops.takeWhileMTrue 1)+ , benchIOSink "drop-one" (Ops.dropOne 1)+ , benchIOSink "drop-all" (Ops.dropAll 1)+ , benchIOSink "dropWhile-true" (Ops.dropWhileTrue 1)+ --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 1)+ , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 1)+ , benchIOSink "deleteBy" (Ops.deleteBy 1)+ , benchIOSink "insertBy" (Ops.insertBy 1) ]- , benchIO "zip" Ops.zip- , benchIO "zipM" Ops.zipM- , bgroup "compose"- [ benchIO "mapM" Ops.composeMapM- , benchIO "map-with-all-in-filter" Ops.composeMapAllInFilter- , benchIO "all-in-filters" Ops.composeAllInFilters- , benchIO "all-out-filters" Ops.composeAllOutFilters+ , bgroup "filteringX4"+ [ benchIOSink "filter-even" (Ops.filterEven 4)+ , benchIOSink "filter-all-out" (Ops.filterAllOut 4)+ , benchIOSink "filter-all-in" (Ops.filterAllIn 4)+ , benchIOSink "take-all" (Ops.takeAll 4)+ , benchIOSink "takeWhile-true" (Ops.takeWhileTrue 4)+ --, benchIOSink "takeWhileM-true" (Ops.takeWhileMTrue 4)+ , benchIOSink "drop-one" (Ops.dropOne 4)+ , benchIOSink "drop-all" (Ops.dropAll 4)+ , benchIOSink "dropWhile-true" (Ops.dropWhileTrue 4)+ --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 4)+ , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 4)+ , benchIOSink "deleteBy" (Ops.deleteBy 4)+ , benchIOSink "insertBy" (Ops.insertBy 4) ]- -- Scaling with same operation in sequence- , bgroup "compose-scaling"- [ benchIO "1" $ Ops.composeScaling 1- , benchIO "2" $ Ops.composeScaling 2- , benchIO "3" $ Ops.composeScaling 3- , benchIO "4" $ Ops.composeScaling 4+ , bgroup "multi-stream"+ [ benchIOSink "eqBy" Ops.eqBy+ , benchIOSink "cmpBy" Ops.cmpBy+ , benchIOSink "zip" Ops.zip+ , benchIOSink "zipM" Ops.zipM+ , benchIOSink "mergeBy" Ops.mergeBy+ , benchIOSink "isPrefixOf" Ops.isPrefixOf+ , benchIOSink "isSubsequenceOf" Ops.isSubsequenceOf+ , benchIOSink "stripPrefix" Ops.stripPrefix+ , benchIOSrc serially "concatMap" Ops.concatMap ]+ , bgroup "mixed"+ [ benchIOSink "sum-product-fold" Ops.sumProductFold+ , benchIOSink "sum-product-scan" Ops.sumProductScan ]+ , bgroup "mixedX4"+ [ benchIOSink "scan-map" (Ops.scanMap 4)+ , benchIOSink "drop-map" (Ops.dropMap 4)+ , benchIOSink "drop-scan" (Ops.dropScan 4)+ , benchIOSink "take-drop" (Ops.takeDrop 4)+ , benchIOSink "take-scan" (Ops.takeScan 4)+ , benchIOSink "take-map" (Ops.takeMap 4)+ , benchIOSink "filter-drop" (Ops.filterDrop 4)+ , benchIOSink "filter-take" (Ops.filterTake 4)+ , benchIOSink "filter-scan" (Ops.filterScan 4)+ , benchIOSink "filter-scanl1" (Ops.filterScanl1 4)+ , benchIOSink "filter-map" (Ops.filterMap 4) ]+ , bgroup "iterated"+ [ benchIOSrc serially "mapM" Ops.iterateMapM+ , benchIOSrc serially "scan(1/100)" Ops.iterateScan+ , benchIOSrc serially "scanl1(1/100)" Ops.iterateScanl1+ , benchIOSrc serially "filterEven" Ops.iterateFilterEven+ , benchIOSrc serially "takeAll" Ops.iterateTakeAll+ , benchIOSrc serially "dropOne" Ops.iterateDropOne+ , benchIOSrc serially "dropWhileFalse" Ops.iterateDropWhileFalse+ , benchIOSrc serially "dropWhileTrue" Ops.iterateDropWhileTrue+ ]+ ]+ ]
benchmark/LinearAsync.hs view
@@ -40,36 +40,45 @@ main = defaultMain [ bgroup "asyncly"- [ -- benchIO "unfoldr" $ Ops.toNull asyncly- benchSrcIO asyncly "unfoldrM" Ops.sourceUnfoldrM- -- , benchSrcIO asyncly "fromFoldable" Ops.sourceFromFoldable+ [ benchSrcIO asyncly "unfoldr" Ops.sourceUnfoldr+ , benchSrcIO asyncly "unfoldrM" Ops.sourceUnfoldrM+ , benchSrcIO asyncly "fromFoldable" Ops.sourceFromFoldable , benchSrcIO asyncly "fromFoldableM" Ops.sourceFromFoldableM- -- , benchSrcIO asyncly "foldMapWith" Ops.sourceFoldMapWith+ , benchSrcIO asyncly "foldMapWith" Ops.sourceFoldMapWith , benchSrcIO asyncly "foldMapWithM" Ops.sourceFoldMapWithM- , benchIO "mapM" $ Ops.mapM asyncly+ , benchSrcIO asyncly "foldMapM" Ops.sourceFoldMapM+ , benchIO "map" $ Ops.map' asyncly 1+ , benchIO "fmap" $ Ops.fmap' asyncly 1+ , benchIO "mapM" $ Ops.mapM asyncly 1 , benchSrcIO asyncly "unfoldrM maxThreads 1" (maxThreads 1 . Ops.sourceUnfoldrM) , benchSrcIO asyncly "unfoldrM maxBuffer 1 (1000 ops)" (maxBuffer 1 . Ops.sourceUnfoldrMN 1000) ] , bgroup "wAsyncly"- [ -- benchIO "unfoldr" $ Ops.toNull wAsyncly- benchSrcIO wAsyncly "unfoldrM" Ops.sourceUnfoldrM- -- , benchSrcIO wAsyncly "fromFoldable" Ops.sourceFromFoldable+ [ benchSrcIO wAsyncly "unfoldr" Ops.sourceUnfoldr+ , benchSrcIO wAsyncly "unfoldrM" Ops.sourceUnfoldrM+ , benchSrcIO wAsyncly "fromFoldable" Ops.sourceFromFoldable , benchSrcIO wAsyncly "fromFoldableM" Ops.sourceFromFoldableM- -- , benchSrcIO wAsyncly "foldMapWith" Ops.sourceFoldMapWith+ , benchSrcIO wAsyncly "foldMapWith" Ops.sourceFoldMapWith , benchSrcIO wAsyncly "foldMapWithM" Ops.sourceFoldMapWithM- , benchIO "mapM" $ Ops.mapM wAsyncly+ , benchSrcIO wAsyncly "foldMapM" Ops.sourceFoldMapM+ , benchIO "map" $ Ops.map' wAsyncly 1+ , benchIO "fmap" $ Ops.fmap' wAsyncly 1+ , benchIO "mapM" $ Ops.mapM wAsyncly 1 ] -- unfoldr and fromFoldable are always serial and thereofore the same for -- all stream types. , bgroup "aheadly"- [ -- benchIO "unfoldr" $ Ops.toNull aheadly- benchSrcIO aheadly "unfoldrM" Ops.sourceUnfoldrM+ [ benchSrcIO aheadly "unfoldr" Ops.sourceUnfoldr+ , benchSrcIO aheadly "unfoldrM" Ops.sourceUnfoldrM , benchSrcIO aheadly "fromFoldableM" Ops.sourceFromFoldableM -- , benchSrcIO aheadly "foldMapWith" Ops.sourceFoldMapWith , benchSrcIO aheadly "foldMapWithM" Ops.sourceFoldMapWithM- , benchIO "mapM" $ Ops.mapM aheadly+ , benchSrcIO aheadly "foldMapM" Ops.sourceFoldMapM+ , benchIO "map" $ Ops.map' aheadly 1+ , benchIO "fmap" $ Ops.fmap' aheadly 1+ , benchIO "mapM" $ Ops.mapM aheadly 1 , benchSrcIO aheadly "unfoldrM maxThreads 1" (maxThreads 1 . Ops.sourceUnfoldrM) , benchSrcIO aheadly "unfoldrM maxBuffer 1 (1000 ops)"@@ -78,15 +87,19 @@ ] -- XXX need to use smaller streams to finish in reasonable time , bgroup "parallely"- [ --benchIO "unfoldr" $ Ops.toNull parallely- benchSrcIO parallely "unfoldrM" Ops.sourceUnfoldrM+ [ benchSrcIO parallely "unfoldr" Ops.sourceUnfoldr+ , benchSrcIO parallely "unfoldrM" Ops.sourceUnfoldrM --, benchSrcIO parallely "fromFoldable" Ops.sourceFromFoldable , benchSrcIO parallely "fromFoldableM" Ops.sourceFromFoldableM -- , benchSrcIO parallely "foldMapWith" Ops.sourceFoldMapWith , benchSrcIO parallely "foldMapWithM" Ops.sourceFoldMapWithM- , benchIO "mapM" $ Ops.mapM parallely+ , benchSrcIO parallely "foldMapM" Ops.sourceFoldMapM+ , benchIO "map" $ Ops.map' parallely 1+ , benchIO "fmap" $ Ops.fmap' parallely 1+ , benchIO "mapM" $ Ops.mapM parallely 1 -- Zip has only one parallel flavor , benchIO "zip" Ops.zipAsync , benchIO "zipM" Ops.zipAsyncM+ , benchIO "zipAp" Ops.zipAsyncAp ] ]
benchmark/LinearOps.hs view
@@ -7,14 +7,25 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} module LinearOps where import Control.Monad (when)+import Data.Functor.Identity (Identity, runIdentity) import Data.Maybe (fromJust) import Prelude- (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (<=),- subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry)+ (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=), (==), (>=),+ subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry,+ maxBound, div, IO, compare, Double, fromIntegral, Integer, (<$>),+ (<*>), flip)+import qualified Prelude as P+import qualified Data.Foldable as F+import qualified GHC.Exts as GHC+import Control.DeepSeq (NFData)+import GHC.Generics (Generic) import qualified Streamly as S import qualified Streamly.Prelude as S@@ -39,9 +50,31 @@ {-# INLINE source #-} source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int-source n = S.serially $ sourceUnfoldrM n--- source n = S.serially $ sourceFromList n+source n = sourceUnfoldrM n +{-# INLINE sourceIntFromTo #-}+sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> t m Int+sourceIntFromTo n = S.enumerateFromTo n (n + value)++{-# INLINE sourceIntFromThenTo #-}+sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> t m Int+sourceIntFromThenTo n = S.enumerateFromThenTo n (n + 1) (n + value)++{-# INLINE sourceFracFromTo #-}+sourceFracFromTo :: (Monad m, S.IsStream t) => Int -> t m Double+sourceFracFromTo n =+ S.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))++{-# INLINE sourceFracFromThenTo #-}+sourceFracFromThenTo :: (Monad m, S.IsStream t) => Int -> t m Double+sourceFracFromThenTo n = S.enumerateFromThenTo (fromIntegral n)+ (fromIntegral n + 1.0001) (fromIntegral (n + value))++{-# INLINE sourceIntegerFromStep #-}+sourceIntegerFromStep :: (Monad m, S.IsStream t) => Int -> t m Integer+sourceIntegerFromStep n =+ S.take value $ S.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)+ {-# INLINE sourceFromList #-} sourceFromList :: (Monad m, S.IsStream t) => Int -> t m Int sourceFromList n = S.fromList [n..n+value]@@ -68,6 +101,11 @@ => Int -> t m Int sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value] +{-# INLINE sourceFoldMapM #-}+sourceFoldMapM :: (S.IsStream t, Monad m, P.Monoid (t m Int))+ => Int -> t m Int+sourceFoldMapM n = F.foldMap (S.yieldM . return) [n..n+value]+ {-# INLINE sourceUnfoldr #-} sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> t m Int sourceUnfoldr n = S.unfoldr step n@@ -105,6 +143,18 @@ else return (Just (return cnt, cnt + 1)) -------------------------------------------------------------------------------+-- Pure stream generation+-------------------------------------------------------------------------------++{-# INLINE sourceIsList #-}+sourceIsList :: Int -> S.SerialT Identity Int+sourceIsList n = GHC.fromList [n..n+value]++{-# INLINE sourceIsString #-}+sourceIsString :: Int -> S.SerialT Identity P.Char+sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')++------------------------------------------------------------------------------- -- Elimination ------------------------------------------------------------------------------- @@ -113,9 +163,7 @@ runStream = S.runStream {-# INLINE toList #-}-{-# INLINE foldr #-}-{-# INLINE foldrM #-}-toList, foldr, foldrM :: Monad m => Stream m Int -> m [Int]+toList :: Monad m => Stream m Int -> m [Int] {-# INLINE last #-} {-# INLINE maximum #-}@@ -123,16 +171,33 @@ {-# INLINE find #-} {-# INLINE findIndex #-} {-# INLINE elemIndex #-}-{-# INLINE foldl1' #-}-{-# INLINE foldr1 #-}-last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1 :: Monad m => Stream m Int -> m (Maybe Int)+{-# INLINE foldl1'Reduce #-}+{-# INLINE foldr1Reduce #-}+last, minimum, maximum, find, findIndex, elemIndex, foldl1'Reduce, foldr1Reduce+ :: Monad m => Stream m Int -> m (Maybe Int) -{-# INLINE foldl' #-}+{-# INLINE minimumBy #-}+{-# INLINE maximumBy #-}+minimumBy, maximumBy :: Monad m => Stream m Int -> m (Maybe Int)++{-# INLINE foldl'Reduce #-}+{-# INLINE foldlM'Reduce #-}+{-# INLINE foldrReduce #-} {-# INLINE length #-} {-# INLINE sum #-} {-# INLINE product #-}-foldl', length, sum, product :: Monad m => Stream m Int -> m Int+foldl'Reduce, foldlM'Reduce, foldrReduce, length, sum, product+ :: Monad m+ => Stream m Int -> m Int +{-# INLINE foldl'Build #-}+{-# INLINE foldlM'Build #-}+{-# INLINE foldrBuild #-}+{-# INLINE foldrMBuild #-}+foldrBuild, foldrMBuild, foldl'Build, foldlM'Build+ :: Monad m+ => Stream m Int -> m [Int]+ {-# INLINE all #-} {-# INLINE any #-} {-# INLINE and #-}@@ -142,7 +207,7 @@ elem, notElem, all, any, and, or :: Monad m => Stream m Int -> m Bool {-# INLINE toNull #-}-toNull :: Monad m => (t m Int -> S.SerialT m Int) -> t m Int -> m ()+toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m () toNull t = runStream . t {-# INLINE uncons #-}@@ -169,13 +234,23 @@ _ <- S.head s S.tail s >>= Prelude.mapM_ nullHeadTail +{-# INLINE mapM_ #-}+mapM_ :: Monad m => Stream m Int -> m () mapM_ = S.mapM_ (\_ -> return ())+ toList = S.toList-foldr = S.foldr (:) []-foldr1 = S.foldr1 (+)-foldrM = S.foldrM (\a xs -> return (a : xs)) []-foldl' = S.foldl' (+) 0-foldl1' = S.foldl1' (+)++foldl'Build = S.foldl' (flip (:)) []+foldrBuild = S.foldr (:) []+foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []+foldrMBuild = S.foldrM (\x xs -> return $ x : xs) []++foldrReduce = S.foldr (+) 0+foldr1Reduce = S.foldr1 (+)+foldl'Reduce = S.foldl' (+) 0+foldl1'Reduce = S.foldl1' (+)+foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0+ last = S.last elem = S.elem maxValue notElem = S.notElem maxValue@@ -191,6 +266,8 @@ minimum = S.minimum sum = S.sum product = S.product+minimumBy = S.minimumBy compare+maximumBy = S.maximumBy compare ------------------------------------------------------------------------------- -- Transformation@@ -200,8 +277,33 @@ 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++-- polymorphic stream version of composeN+{-# INLINE composeN' #-}+composeN'+ :: (S.IsStream t, Monad m)+ => Int -> (t m Int -> Stream m Int) -> t m Int -> m ()+composeN' n f =+ case n of+ 1 -> transform . f+ 2 -> transform . f . S.adapt . f+ 3 -> transform . f . S.adapt . f . S.adapt . f+ 4 -> transform . f . S.adapt . f . S.adapt . f . S.adapt . f+ _ -> undefined+ {-# INLINE scan #-}-{-# INLINE mapM_ #-}+{-# INLINE scanl1' #-} {-# INLINE map #-} {-# INLINE fmap #-} {-# INLINE mapMaybe #-}@@ -212,63 +314,117 @@ {-# INLINE takeAll #-} {-# INLINE takeWhileTrue #-} {-# INLINE takeWhileMTrue #-}+{-# INLINE dropOne #-} {-# INLINE dropAll #-} {-# INLINE dropWhileTrue #-} {-# INLINE dropWhileMTrue #-}+{-# INLINE dropWhileFalse #-} {-# INLINE findIndices #-} {-# INLINE elemIndices #-}-scan, mapM_, map, fmap, mapMaybe, filterEven, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropAll,- dropWhileTrue, dropWhileMTrue,- findIndices, elemIndices+{-# INLINE insertBy #-}+{-# INLINE deleteBy #-}+scan, scanl1', map, fmap, mapMaybe, filterEven, filterAllOut,+ filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,+ dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,+ findIndices, elemIndices, insertBy, deleteBy :: Monad m- => Stream m Int -> m ()+ => Int -> Stream m Int -> m () {-# INLINE mapMaybeM #-}-mapMaybeM :: S.MonadAsync m => Stream m Int -> m ()+mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m () {-# INLINE mapM #-}-mapM :: (S.IsStream t, S.MonadAsync m)- => (t m Int -> S.SerialT m Int) -> t m Int -> m ()+{-# INLINE map' #-}+{-# INLINE fmap' #-}+mapM, map' :: (S.IsStream t, S.MonadAsync m)+ => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m () +fmap' :: (S.IsStream t, S.MonadAsync m, P.Functor (t m))+ => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()+ {-# INLINE sequence #-} sequence :: (S.IsStream t, S.MonadAsync m) => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m () -scan = transform . S.scanl' (+) 0-fmap = transform . Prelude.fmap (+1)-map = transform . S.map (+1)-mapM t = transform . t . S.mapM return-mapMaybe = transform . S.mapMaybe- (\x -> if Prelude.odd x then Nothing else Just ())-mapMaybeM = transform . S.mapMaybeM- (\x -> if Prelude.odd x then return Nothing else return $ Just ())+scan n = composeN n $ S.scanl' (+) 0+scanl1' n = composeN n $ S.scanl1' (+)+fmap n = composeN n $ Prelude.fmap (+1)+fmap' t n = composeN' n $ t . Prelude.fmap (+1)+map n = composeN n $ S.map (+1)+map' t n = composeN' n $ t . S.map (+1)+mapM t n = composeN' n $ t . S.mapM return+mapMaybe n = composeN n $ S.mapMaybe+ (\x -> if Prelude.odd x then Nothing else Just x)+mapMaybeM n = composeN n $ S.mapMaybeM+ (\x -> if Prelude.odd x then return Nothing else return $ Just x) sequence t = transform . t . S.sequence-filterEven = transform . S.filter even-filterAllOut = transform . S.filter (> maxValue)-filterAllIn = transform . S.filter (<= maxValue)-takeOne = transform . S.take 1-takeAll = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-takeWhileMTrue = transform . S.takeWhileM (return . (<= maxValue))-dropAll = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)-dropWhileMTrue = transform . S.dropWhileM (return . (<= maxValue))-findIndices = transform . S.findIndices (== maxValue)-elemIndices = transform . S.elemIndices maxValue+filterEven n = composeN n $ S.filter even+filterAllOut n = composeN n $ S.filter (> maxValue)+filterAllIn n = composeN n $ S.filter (<= maxValue)+takeOne n = composeN n $ S.take 1+takeAll n = composeN n $ S.take maxValue+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)+takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))+dropOne n = composeN n $ S.drop 1+dropAll n = composeN n $ S.drop maxValue+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)+dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))+dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)+findIndices n = composeN n $ S.findIndices (== maxValue)+elemIndices n = composeN n $ S.elemIndices maxValue+insertBy n = composeN n $ S.insertBy compare maxValue+deleteBy n = composeN n $ S.deleteBy (>=) 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 iterateScanl1 #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,+ iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue+ :: S.MonadAsync m+ => Int -> Stream m Int++-- this is quadratic+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)+-- so is this+iterateScanl1 = iterateSource (S.scanl1' (+)) (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+iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue)) maxIters+iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters++------------------------------------------------------------------------------- -- Zipping and concat ------------------------------------------------------------------------------- {-# INLINE zip #-} {-# INLINE zipM #-}-{-# INLINE concat #-}-zip, zipM, concat :: Monad m => Stream m Int -> m ()--{-# INLINE zipAsync #-}-{-# INLINE zipAsyncM #-}-zipAsync, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()+{-# INLINE mergeBy #-}+zip, zipM, mergeBy :: Monad m => Stream m Int -> m () zip src = do r <- S.tail src@@ -278,47 +434,154 @@ r <- S.tail src let src1 = fromJust r transform (S.zipWithM (curry return) src src1)++mergeBy src = do+ r <- S.tail src+ let src1 = fromJust r+ transform (S.mergeBy P.compare src src1)++{-# INLINE isPrefixOf #-}+{-# INLINE isSubsequenceOf #-}+isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool++isPrefixOf src = S.isPrefixOf src src+isSubsequenceOf src = S.isSubsequenceOf src src++{-# INLINE stripPrefix #-}+stripPrefix :: Monad m => Stream m Int -> m ()+stripPrefix src = do+ _ <- S.stripPrefix src src+ return ()++{-# INLINE zipAsync #-}+{-# INLINE zipAsyncM #-}+{-# INLINE zipAsyncAp #-}+zipAsync, zipAsyncAp, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()+ zipAsync src = do r <- S.tail src let src1 = fromJust r transform (S.zipAsyncWith (,) src src1)+ zipAsyncM src = do r <- S.tail src let src1 = fromJust r transform (S.zipAsyncWithM (curry return) src src1)-concat _n = return () +zipAsyncAp src = do+ r <- S.tail src+ let src1 = fromJust r+ transform (S.zipAsyncly $ (,) <$> S.serially src+ <*> S.serially src1)++{-# INLINE eqBy #-}+eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool+eqBy src = S.eqBy (==) src src++{-# INLINE cmpBy #-}+cmpBy :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering+cmpBy src = S.cmpBy P.compare src src++concatStreamLen, maxNested :: Int+concatStreamLen = 1+maxNested = 100000++{-# INLINE concatMap #-}+concatMap :: S.MonadAsync m => Int -> Stream m Int+concatMap n = S.concatMap (\_ -> sourceUnfoldrMN maxNested n)+ (sourceUnfoldrMN concatStreamLen n)+ ---------------------------------------------------------------------------------- Composition+-- Mixed Composition ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f+{-# INLINE scanMap #-}+{-# INLINE dropMap #-}+{-# INLINE dropScan #-}+{-# INLINE takeDrop #-}+{-# INLINE takeScan #-}+{-# INLINE takeMap #-}+{-# INLINE filterDrop #-}+{-# INLINE filterTake #-}+{-# INLINE filterScan #-}+{-# INLINE filterScanl1 #-}+{-# INLINE filterMap #-}+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,+ filterTake, filterScan, filterScanl1, filterMap+ :: Monad m => Int -> Stream m Int -> m () -{-# INLINE composeMapM #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter- :: Monad m- => Stream m Int -> m ()-composeMapM :: S.MonadAsync m => Stream m Int -> m ()+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)+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue) -composeMapM = compose (S.mapM return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter =- compose (S.filter (<= maxValue) . Prelude.fmap (subtract 1))+data Pair a b = Pair !a !b deriving (Generic, NFData) -{-# INLINABLE composeScaling #-}-composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling m =- case m of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined- where f = S.filter (<= maxValue)+{-# INLINE sumProductFold #-}+sumProductFold :: Monad m => Stream m Int -> m (Int, Int)+sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)++{-# INLINE sumProductScan #-}+sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)+sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)+ . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)++-------------------------------------------------------------------------------+-- Pure stream operations+-------------------------------------------------------------------------------++{-# INLINE eqInstance #-}+eqInstance :: Stream Identity Int -> Bool+eqInstance src = src == src++{-# INLINE eqInstanceNotEq #-}+eqInstanceNotEq :: Stream Identity Int -> Bool+eqInstanceNotEq src = src P./= src++{-# INLINE ordInstance #-}+ordInstance :: Stream Identity Int -> Bool+ordInstance src = src P.< src++{-# INLINE ordInstanceMin #-}+ordInstanceMin :: Stream Identity Int -> Stream Identity Int+ordInstanceMin src = P.min src src++{-# INLINE showInstance #-}+showInstance :: Stream Identity Int -> P.String+showInstance src = P.show src++{-# INLINE showInstanceList #-}+showInstanceList :: Stream Identity Int -> P.String+showInstanceList src = P.show (GHC.toList src P.++ [2..value])++{-# INLINE readInstance #-}+readInstance :: Stream Identity Int -> Stream Identity Int+readInstance src =+ let r = P.reads ("fromList [1"+ P.++ P.concat (P.replicate value ",1") P.++ "]")+ in case r of+ [(x,"")] -> src S.<> x+ _ -> P.error "readInstance: no parse"++{-# INLINE pureFoldl' #-}+pureFoldl' :: Stream Identity Int -> Int+pureFoldl' = runIdentity . S.foldl' (+) 0++{-# INLINE foldableFoldl' #-}+foldableFoldl' :: Stream Identity Int -> Int+foldableFoldl' = F.foldl' (+) 0++{-# INLINE foldableSum #-}+foldableSum :: Stream Identity Int -> Int+foldableSum = P.sum++{-# INLINE traversableMapM #-}+traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)+traversableMapM = P.mapM return
+ benchmark/NanoBenchmarks.hs view
@@ -0,0 +1,96 @@+-------------------------------------------------------------------------------+-- Investigate specific benchmarks more closely in isolation, possibly looking+-- at GHC generated code for optimizing specific problematic cases.+-------------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+import Streamly.SVar (MonadAsync)+import qualified Streamly.Streams.StreamK as S+import Gauge+import System.Random++maxValue :: Int+maxValue = 100000++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: MonadAsync m => S.Stream m Int+sourceUnfoldrM = S.unfoldrM step 0+ where+ step cnt =+ if cnt > maxValue+ then return Nothing+ else return (Just (cnt, cnt + 1))++{-# INLINE sourceUnfoldrMN #-}+sourceUnfoldrMN :: MonadAsync m => Int -> S.Stream m Int+sourceUnfoldrMN n = S.unfoldrM step n+ where+ step cnt =+ if cnt > n+ then return Nothing+ else return (Just (cnt, cnt + 1))++{-# INLINE sourceUnfoldr #-}+sourceUnfoldr :: Monad m => Int -> S.Stream m Int+sourceUnfoldr n = S.unfoldr step n+ where+ step cnt =+ if cnt > n + maxValue+ then Nothing+ else Just (cnt, cnt + 1)++-------------------------------------------------------------------------------+-- take-drop composition+-------------------------------------------------------------------------------++takeAllDropOne :: Monad m => S.Stream m Int -> S.Stream m Int+takeAllDropOne = S.drop 1 . S.take maxValue++-- Requires -fspec-constr-recursive=5 for better fused code+-- The number depends on how many times we compose it++{-# INLINE takeDrop #-}+takeDrop :: Monad m => S.Stream m Int -> m ()+takeDrop = S.runStream .+ takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne++-------------------------------------------------------------------------------+-- dropWhileFalse composition+-------------------------------------------------------------------------------++dropWhileFalse :: Monad m => S.Stream m Int -> S.Stream m Int+dropWhileFalse = S.dropWhile (> maxValue)++-- Requires -fspec-constr-recursive=5 for better fused code+-- The number depends on how many times we compose it++{-# INLINE dropWhileFalseX4 #-}+dropWhileFalseX4 :: Monad m => S.Stream m Int -> m ()+dropWhileFalseX4 = S.runStream+ . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse++-------------------------------------------------------------------------------+-- iteration+-------------------------------------------------------------------------------++{-# INLINE iterateSource #-}+iterateSource+ :: MonadAsync m+ => (S.Stream m Int -> S.Stream m Int) -> Int -> Int -> S.Stream m Int+iterateSource g i n = f i (sourceUnfoldrMN n)+ where+ f (0 :: Int) m = g m+ f x m = g (f (x - 1) m)++-- Keep only the benchmark that is to be investiagted and comment out the rest.+-- We keep all of them enabled by default for testing the build.+main :: IO ()+main = do+ defaultMain [bench "unfoldr" $ nfIO $+ randomRIO (1,1) >>= \n -> S.runStream (sourceUnfoldr n)]+ defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]+ defaultMain [bench "dropWhileFalseX4" $+ nfIO $ dropWhileFalseX4 sourceUnfoldrM]+ defaultMain [bench "iterate-mapM" $+ nfIO $ S.runStream $ iterateSource (S.mapM return) 100000 10]
benchmark/Nested.hs view
@@ -23,7 +23,8 @@ -- TBD Study scaling with 10, 100, 1000 loop iterations defaultMain [ bgroup "serially"- [ benchIO "toNull" $ Ops.toNull serially+ [ benchIO "toNullAp" $ Ops.toNullAp serially+ , benchIO "toNull" $ Ops.toNull serially , benchIO "toList" $ Ops.toList serially -- , benchIO "toListSome" $ Ops.toListSome serially , benchIO "filterAllOut" $ Ops.filterAllOut serially@@ -33,7 +34,8 @@ ] , bgroup "wSerially"- [ benchIO "toNull" $ Ops.toNull wSerially+ [ benchIO "toNullAp" $ Ops.toNullAp wSerially+ , benchIO "toNull" $ Ops.toNull wSerially , benchIO "toList" $ Ops.toList wSerially -- , benchIO "toListSome" $ Ops.toListSome wSerially , benchIO "filterAllOut" $ Ops.filterAllOut wSerially@@ -43,7 +45,8 @@ ] , bgroup "aheadly"- [ benchIO "toNull" $ Ops.toNull aheadly+ [ benchIO "toNullAp" $ Ops.toNullAp aheadly+ , benchIO "toNull" $ Ops.toNull aheadly , benchIO "toList" $ Ops.toList aheadly -- , benchIO "toListSome" $ Ops.toListSome aheadly , benchIO "filterAllOut" $ Ops.filterAllOut aheadly@@ -53,7 +56,8 @@ ] , bgroup "asyncly"- [ benchIO "toNull" $ Ops.toNull asyncly+ [ benchIO "toNullAp" $ Ops.toNullAp asyncly+ , benchIO "toNull" $ Ops.toNull asyncly , benchIO "toList" $ Ops.toList asyncly -- , benchIO "toListSome" $ Ops.toListSome asyncly , benchIO "filterAllOut" $ Ops.filterAllOut asyncly@@ -63,7 +67,8 @@ ] , bgroup "wAsyncly"- [ benchIO "toNull" $ Ops.toNull wAsyncly+ [ benchIO "toNullAp" $ Ops.toNullAp wAsyncly+ , benchIO "toNull" $ Ops.toNull wAsyncly , benchIO "toList" $ Ops.toList wAsyncly -- , benchIO "toListSome" $ Ops.toListSome wAsyncly , benchIO "filterAllOut" $ Ops.filterAllOut wAsyncly@@ -73,7 +78,8 @@ ] , bgroup "parallely"- [ benchIO "toNull" $ Ops.toNull parallely+ [ benchIO "toNullAp" $ Ops.toNullAp parallely+ , benchIO "toNull" $ Ops.toNull parallely , benchIO "toList" $ Ops.toList parallely --, benchIO "toListSome" $ Ops.toListSome parallely , benchIO "filterAllOut" $ Ops.filterAllOut parallely
benchmark/NestedOps.hs view
@@ -62,6 +62,13 @@ -- Benchmark ops ------------------------------------------------------------------------------- +{-# INLINE toNullAp #-}+toNullAp+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))+ => (t m Int -> S.SerialT m Int) -> Int -> m ()+toNullAp t start = runStream . t $+ (+) <$> source start prodCount <*> source start prodCount+ {-# INLINE toNull #-} toNull :: (S.IsStream t, S.MonadAsync m, Monad (t m))
benchmark/StreamDOps.hs view
@@ -6,13 +6,17 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-} module StreamDOps where import Control.Monad (when)+import Data.Maybe (isJust) import Prelude- (Monad, Int, (+), ($), (.), return, (>), even, (<=),- subtract, undefined, Maybe(..), not, mapM_, (>>=))+ (Monad, Int, (+), ($), (.), return, (>), even, (<=), div,+ subtract, undefined, Maybe(..), not, mapM_, (>>=),+ maxBound, fmap, odd, (==))+import qualified Prelude as P import qualified Streamly.Streams.StreamD as S @@ -21,50 +25,6 @@ maxValue = value + 1000 ---------------------------------------------------------------------------------- Benchmark ops----------------------------------------------------------------------------------{-# INLINE uncons #-}-{-# INLINE nullHeadTail #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE zip #-}-{--{-# INLINE concat #-}--}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-uncons, nullHeadTail, map, scan, filterEven, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- -- concat,- composeAllInFilters, composeAllOutFilters, composeMapAllInFilter- :: Monad m- => Stream m Int -> m ()--{-# INLINE composeMapM #-}-composeMapM :: Monad m => Stream m Int -> m ()--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-{-# INLINE foldl #-}-foldl :: Monad m => Stream m Int -> m Int-{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)--{-# INLINE toNull #-}-{-# INLINE mapM #-}-toNull, mapM :: Monad m => Stream m Int -> m ()--------------------------------------------------------------------------------- -- Stream generation and elimination ------------------------------------------------------------------------------- @@ -79,6 +39,15 @@ then Nothing else Just (cnt, cnt + 1) +{-# INLINE sourceUnfoldrMN #-}+sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrMN m n = S.unfoldrM step n+ where+ step cnt =+ if cnt > n + m+ then return Nothing+ else return (Just (cnt, cnt + 1))+ {-# INLINE sourceUnfoldrM #-} sourceUnfoldrM :: Monad m => Int -> Stream m Int sourceUnfoldrM n = S.unfoldrM step n@@ -88,9 +57,9 @@ 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 sourceIntFromTo #-}+sourceIntFromTo :: Monad m => Int -> Stream m Int+sourceIntFromTo n = S.enumerateFromToIntegral n (n + value) {-# INLINE sourceFromList #-} sourceFromList :: Monad m => Int -> Stream m Int@@ -108,19 +77,45 @@ runStream :: Monad m => Stream m a -> m () runStream = S.runStream +{-# INLINE toNull #-}+toNull :: Monad m => Stream m Int -> m () toNull = runStream++{-# INLINE uncons #-}+{-# INLINE nullTail #-}+{-# INLINE headTail #-}+uncons, nullTail, headTail+ :: Monad m+ => Stream m Int -> m ()+ uncons s = do r <- S.uncons s case r of Nothing -> return () Just (_, t) -> uncons t-nullHeadTail s = do++{-# INLINE tail #-}+tail :: Monad m => Stream m a -> m ()+tail s = S.tail s >>= mapM_ tail++nullTail s = do r <- S.null s- when (not r) $ do- _ <- S.head s- S.tail s >>= mapM_ nullHeadTail+ when (not r) $ S.tail s >>= mapM_ nullTail++headTail s = do+ h <- S.head s+ when (isJust h) $ S.tail s >>= 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 -------------------------------------------------------------------------------@@ -131,45 +126,149 @@ transform :: Monad m => Stream m a -> m () transform = runStream -scan = transform . S.scanlM' (\a b -> return (a + b)) 0-map = transform . S.map (+1)-mapM = transform . S.mapM return-filterEven = transform . S.filter even-filterAllOut = transform . S.filter (> maxValue)-filterAllIn = transform . S.filter (<= maxValue)-takeOne = transform . S.take 1-takeAll = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)+{-# 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 mapM #-}+{-# INLINE mapMaybe #-}+{-# INLINE mapMaybeM #-}+{-# INLINE filterEven #-}+{-# INLINE filterAllOut #-}+{-# INLINE filterAllIn #-}+{-# INLINE takeOne #-}+{-# INLINE takeAll #-}+{-# INLINE takeWhileTrue #-}+{-# INLINE takeWhileMTrue #-}+{-# INLINE dropOne #-}+{-# INLINE dropAll #-}+{-# INLINE dropWhileTrue #-}+{-# INLINE dropWhileMTrue #-}+{-# INLINE dropWhileFalse #-}+scan, map, fmap, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,+ filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,+ dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse+ :: Monad m+ => Int -> Stream m Int -> m ()++scan n = composeN n $ S.scanl' (+) 0+fmap n = composeN n $ Prelude.fmap (+1)+map n = composeN n $ S.map (+1)+mapM n = composeN n $ S.mapM return+mapMaybe n = composeN n $ S.mapMaybe+ (\x -> if Prelude.odd x then Nothing else Just x)+mapMaybeM n = composeN n $ S.mapMaybeM+ (\x -> if Prelude.odd x then return Nothing else return $ Just x)+filterEven n = composeN n $ S.filter even+filterAllOut n = composeN n $ S.filter (> maxValue)+filterAllIn n = composeN n $ S.filter (<= maxValue)+takeOne n = composeN n $ S.take 1+takeAll n = composeN n $ S.take maxValue+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)+takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))+dropOne n = composeN n $ S.drop 1+dropAll n = composeN n $ S.drop maxValue+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)+dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))+dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)+ ---------------------------------------------------------------------------------- Zipping and concat+-- Iteration ------------------------------------------------------------------------------- -zip src = transform $ S.zipWith (,) src src--- concat _n = return ()+iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 10000 +{-# INLINE iterateSource #-}+iterateSource+ :: Monad m+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)+ where+ f (0 :: Int) m = g m+ f x m = g (f (x P.- 1) m)++{-# INLINE iterateMapM #-}+{-# INLINE iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,+ iterateDropWhileFalse, iterateDropWhileTrue+ :: Monad m+ => Int -> Stream m Int++-- this is quadratic+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)+iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))+ (maxIters `div` 10)++iterateMapM = iterateSource (S.mapM return) maxIters+iterateFilterEven = iterateSource (S.filter even) maxIters+iterateTakeAll = iterateSource (S.take maxValue) maxIters+iterateDropOne = iterateSource (S.drop 1) maxIters+iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters+ ---------------------------------------------------------------------------------- Composition+-- Zipping and concat ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f+{-# INLINE eqBy #-}+eqBy :: (Monad m, P.Eq a) => S.Stream m a -> m P.Bool+eqBy src = S.eqBy (==) src src -composeMapM = compose (S.mapM return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . S.map (subtract 1))+{-# INLINE cmpBy #-}+cmpBy :: (Monad m, P.Ord a) => S.Stream m a -> m P.Ordering+cmpBy src = S.cmpBy P.compare src src -{-# INLINABLE composeScaling #-}-composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling m =- case m of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined- where f = S.filter (<= maxValue)+{-# INLINE zip #-}+zip :: Monad m => Stream m Int -> m ()+zip src = transform $ S.zipWith (,) src src++{-+{-# INLINE concat #-}+concat _n = return ()+-}++-------------------------------------------------------------------------------+-- 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)
benchmark/StreamKOps.hs view
@@ -6,16 +6,20 @@ -- Maintainer : harendra.kumar@gmail.com {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-} module StreamKOps where import Control.Monad (when)+import Data.Maybe (isJust) import Prelude- (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),- subtract, undefined, Maybe(..), not, mapM_, (>>=))+ (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,+ subtract, undefined, Maybe(..), not, (>>=),+ maxBound)+import qualified Prelude as P import qualified Streamly.Streams.StreamK as S-import qualified Streamly.Streams.Prelude as S+import qualified Streamly.Streams.Prelude as SP import qualified Streamly.SVar as S value, maxValue :: Int@@ -28,32 +32,14 @@ {-# INLINE toNull #-} {-# INLINE uncons #-}-{-# INLINE nullHeadTail #-}-{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}+{-# INLINE nullTail #-}+{-# INLINE headTail #-} {-# INLINE zip #-} {-# INLINE concat #-}-{-# INLINE composeAllInFilters #-}-{-# INLINE composeAllOutFilters #-}-{-# INLINE composeMapAllInFilter #-}-toNull, uncons, nullHeadTail, scan, map, filterEven, filterAllOut,- filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,- concat, composeAllInFilters, composeAllOutFilters,- composeMapAllInFilter+toNull, uncons, nullTail, headTail, zip, concat :: Monad m => Stream m Int -> m () -{-# INLINE composeMapM #-}-composeMapM :: S.MonadAsync m => Stream m Int -> m ()- {-# INLINE toList #-} toList :: Monad m => Stream m Int -> m [Int] {-# INLINE foldl #-}@@ -61,9 +47,6 @@ {-# INLINE last #-} last :: Monad m => Stream m Int -> m (Maybe Int) -{-# INLINE mapM #-}-mapM :: S.MonadAsync m => Stream m Int -> m ()- ------------------------------------------------------------------------------- -- Stream generation and elimination -------------------------------------------------------------------------------@@ -88,6 +71,15 @@ then return Nothing else return (Just (cnt, cnt + 1)) +{-# INLINE sourceUnfoldrMN #-}+sourceUnfoldrMN :: S.MonadAsync 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@@ -106,11 +98,11 @@ {-# INLINE sourceFoldMapWith #-} sourceFoldMapWith :: Int -> Stream m Int-sourceFoldMapWith n = S.foldMapWith S.serial S.yield [n..n+value]+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value] {-# INLINE sourceFoldMapWithM #-} sourceFoldMapWithM :: Monad m => Int -> Stream m Int-sourceFoldMapWithM n = S.foldMapWith S.serial (S.yieldM . return) [n..n+value]+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value] {-# INLINE source #-} source :: S.MonadAsync m => Int -> Stream m Int@@ -124,6 +116,10 @@ runStream :: Monad m => Stream m a -> m () runStream = S.runStream +{-# INLINE mapM_ #-}+mapM_ :: Monad m => Stream m a -> m ()+mapM_ = S.mapM_ (\_ -> return ())+ toNull = runStream uncons s = do r <- S.uncons s@@ -135,20 +131,20 @@ init :: (Monad m, S.IsStream t) => t m a -> m () init s = do t <- S.init s- mapM_ S.runStream t+ P.mapM_ S.runStream t {-# INLINE tail #-} tail :: (Monad m, S.IsStream t) => t m a -> m ()-tail s = S.tail s >>= mapM_ tail+tail s = S.tail s >>= P.mapM_ tail --- | If the stream is not null get its head and tail and then do the same to--- the tail.-nullHeadTail s = do+nullTail s = do r <- S.null s- when (not r) $ do- _ <- S.head s- S.tail s >>= mapM_ nullHeadTail+ 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+ toList = S.toList foldl = S.foldl' (+) 0 last = S.last@@ -161,19 +157,96 @@ transform :: Monad m => Stream m a -> m () transform = runStream -scan = transform . S.scanl' (+) 0-map = transform . fmap (+1)-mapM = transform . S.mapM return-filterEven = transform . S.filter even-filterAllOut = transform . S.filter (> maxValue)-filterAllIn = transform . S.filter (<= maxValue)-takeOne = transform . S.take 1-takeAll = transform . S.take maxValue-takeWhileTrue = transform . S.takeWhile (<= maxValue)-dropAll = transform . S.drop maxValue-dropWhileTrue = transform . S.dropWhile (<= maxValue)+{-# 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 #-}+scan, map, fmap, filterEven, filterAllOut,+ filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,+ dropWhileTrue, dropWhileFalse+ :: Monad m+ => Int -> Stream m Int -> m ()++{-# INLINE mapM #-}+mapM :: 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+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)+ -------------------------------------------------------------------------------+-- 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 ------------------------------------------------------------------------------- @@ -181,25 +254,30 @@ concat _n = return () ---------------------------------------------------------------------------------- Composition+-- Mixed Composition ------------------------------------------------------------------------------- -{-# INLINE compose #-}-compose :: Monad m => (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-compose f = transform . f . f . f . f--composeMapM = compose (S.mapM return)-composeAllInFilters = compose (S.filter (<= maxValue))-composeAllOutFilters = compose (S.filter (> maxValue))-composeMapAllInFilter = compose (S.filter (<= maxValue) . fmap (subtract 1))+{-# 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 () -{-# INLINABLE composeScaling #-}-composeScaling :: Monad m => Int -> Stream m Int -> m ()-composeScaling m =- case m of- 1 -> transform . f- 2 -> transform . f . f- 3 -> transform . f . f . f- 4 -> transform . f . f . f . f- _ -> undefined- where f = S.filter (<= maxValue)+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)
docs/streamly-vs-async.md view
@@ -228,3 +228,8 @@ See the [haddock documentation on hackage](https://hackage.haskell.org/package/streamly) and [a comprehensive tutorial here](https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html).++## References++* https://hackage.haskell.org/package/async+* https://hackage.haskell.org/package/lifted-async
examples/AcidRain.hs view
@@ -5,11 +5,11 @@ import Streamly import Streamly.Prelude as S-import Control.Monad (when)+import Control.Monad (void, when) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.State (MonadState, get, modify, runStateT, put) -data Event = Harm Int | Heal Int deriving (Show)+data Event = Quit | Harm Int | Heal Int deriving (Show) userAction :: MonadAsync m => SerialT m Event userAction = S.repeatM $ liftIO askUser@@ -18,26 +18,38 @@ command <- getLine case command of "potion" -> return (Heal 10)- "quit" -> fail "quit"- _ -> putStrLn "What?" >> askUser+ "harm" -> return (Harm 10)+ "quit" -> return Quit+ _ -> putStrLn "Type potion or harm or quit" >> askUser acidRain :: MonadAsync m => SerialT m Event acidRain = asyncly $ constRate 1 $ S.repeatM $ liftIO $ return $ Harm 1 -game :: (MonadAsync m, MonadState Int m) => SerialT m ()-game = do+data Result = Check | Done++runEvents :: (MonadAsync m, MonadState Int m) => SerialT m Result+runEvents = do event <- userAction `parallel` acidRain case event of- Harm n -> modify $ \h -> h - n- Heal n -> modify $ \h -> h + n+ Harm n -> modify (\h -> h - n) >> return Check+ Heal n -> modify (\h -> h + n) >> return Check+ Quit -> return Done - h <- get- when (h <= 0) $ fail "You die!"- liftIO $ putStrLn $ "Health = " <> show h+data Status = Alive | GameOver deriving Eq +getStatus :: (MonadAsync m, MonadState Int m) => Result -> m Status+getStatus result =+ case result of+ Done -> liftIO $ putStrLn "You quit!" >> return GameOver+ Check -> do+ h <- get+ liftIO $ if (h <= 0)+ then putStrLn "You die!" >> return GameOver+ else putStrLn ("Health = " <> show h) >> return Alive+ main :: IO () main = do putStrLn "Your health is deteriorating due to acid rain,\ \ type \"potion\" or \"quit\""- _ <- runStateT (runStream game) 60- return ()+ let runGame = S.runWhile (== Alive) $ S.mapM getStatus runEvents+ void $ runStateT runGame 60
examples/ControlFlow.hs view
@@ -48,7 +48,7 @@ liftIO $ putStrLn "MaybeT below streamly: Enter one char per line: " i <- S.fromFoldable [1..2 :: Int]- liftIO $ putStrLn $ "iteration = " ++ show i+ liftIO $ putStrLn $ "iteration = " <> show i r1 <- liftIO getLine when (r1 /= "x") $ lift mzero@@ -78,13 +78,13 @@ liftIO $ putStrLn "MaybeT above streamly: Enter one char per line: " i <- lift $ S.fromFoldable [1..2 :: Int]- liftIO $ putStrLn $ "iteration = " ++ show i+ liftIO $ putStrLn $ "iteration = " <> show i r1 <- liftIO getLine- when (r1 /= "x") $ mzero+ when (r1 /= "x") mzero r2 <- liftIO getLine- when (r2 /= "y") $ mzero+ when (r2 /= "y") mzero mainMaybeAbove :: (IsStream t, MonadIO (t m)) => MaybeT (t m) () mainMaybeAbove = do@@ -111,13 +111,13 @@ liftIO $ putStrLn "ExceptT below streamly: Enter one char per line: " i <- S.fromFoldable [1..2 :: Int]- liftIO $ putStrLn $ "iteration = " ++ show i+ liftIO $ putStrLn $ "iteration = " <> show i r1 <- liftIO getLine- when (r1 /= "x") $ lift $ throwE $ "Expecting x got: " ++ r1+ when (r1 /= "x") $ lift $ throwE $ "Expecting x got: " <> r1 r2 <- liftIO getLine- when (r2 /= "y") $ lift $ throwE $ "Expecting y got: " ++ r2+ when (r2 /= "y") $ lift $ throwE $ "Expecting y got: " <> r2 mainEitherBelow :: IO () mainEitherBelow = do@@ -140,7 +140,7 @@ , MonadAsync m , MonadIO (t m) , MonadIO (t (ExceptT String m))- , Semigroup (t (ExceptT [Char] m) Integer)+ , Semigroup (t (ExceptT String m) Integer) ) => t (ExceptT String m) () getSequenceEitherAsyncBelow = do@@ -151,11 +151,11 @@ >> return 1) <> (lift (throwE "Second task") >> return 2) <> S.yield (3 :: Integer)- liftIO $ putStrLn $ "iteration = " ++ show i+ liftIO $ putStrLn $ "iteration = " <> show i mainEitherAsyncBelow :: IO () mainEitherAsyncBelow = do- r <- runExceptT (runStream $ asyncly $ getSequenceEitherAsyncBelow)+ r <- runExceptT (runStream $ asyncly getSequenceEitherAsyncBelow) case r of Right _ -> liftIO $ putStrLn "Bingo" Left s -> liftIO $ putStrLn s@@ -178,25 +178,25 @@ liftIO $ putStrLn "ExceptT above streamly: Enter one char per line: " i <- lift $ S.fromFoldable [1..2 :: Int]- liftIO $ putStrLn $ "iteration = " ++ show i+ liftIO $ putStrLn $ "iteration = " <> show i r1 <- liftIO getLine- when (r1 /= "x") $ throwE $ "Expecting x got: " ++ r1+ when (r1 /= "x") $ throwE $ "Expecting x got: " <> r1 r2 <- liftIO getLine- when (r2 /= "y") $ throwE $ "Expecting y got: " ++ r2+ when (r2 /= "y") $ throwE $ "Expecting y got: " <> r2 mainEitherAbove :: (IsStream t, Monad m, MonadIO (t m)) => ExceptT String (t m) ()-mainEitherAbove = do+mainEitherAbove = catchE (getSequenceEitherAbove >> liftIO (putStrLn "Bingo"))- (\e -> liftIO $ putStrLn e)+ (liftIO . putStrLn) ------------------------------------------------------------------------------- -- Using MonadThrow to throw exceptions in streamly ------------------------------------------------------------------------------- ---data Unexpected = Unexpected String deriving Show+newtype Unexpected = Unexpected String deriving Show instance Exception Unexpected @@ -209,18 +209,18 @@ liftIO $ putStrLn "MonadThrow in streamly: Enter one char per line: " i <- S.fromFoldable [1..2 :: Int]- liftIO $ putStrLn $ "iteration = " ++ show i+ liftIO $ putStrLn $ "iteration = " <> show i r1 <- liftIO getLine- when (r1 /= "x") $ throwM $ Unexpected $ "Expecting x got: " ++ r1+ when (r1 /= "x") $ throwM $ Unexpected $ "Expecting x got: " <> r1 r2 <- liftIO getLine- when (r2 /= "y") $ throwM $ Unexpected $ "Expecting y got: " ++ r2+ when (r2 /= "y") $ throwM $ Unexpected $ "Expecting y got: " <> r2 mainMonadThrow :: IO ()-mainMonadThrow = do+mainMonadThrow = catch (runStream getSequenceMonadThrow >> liftIO (putStrLn "Bingo"))- (\(e :: SomeException) -> liftIO $ putStrLn $ show e)+ (\(e :: SomeException) -> liftIO $ print e) ------------------------------------------------------------------------------- -- Using ContT below streamly@@ -238,19 +238,19 @@ liftIO $ putStrLn "ContT below streamly: Enter one char per line: " i <- S.fromFoldable [1..2 :: Int]- liftIO $ putStrLn $ "iteration = " ++ show i+ liftIO $ putStrLn $ "iteration = " <> show i r <- lift $ callCC $ \exit -> do r1 <- liftIO getLine _ <- if r1 /= "x"- then exit $ Left $ "Expecting x got: " ++ r1+ then exit $ Left $ "Expecting x got: " <> r1 else return $ Right () r2 <- liftIO getLine if r2 /= "y"- then exit $ Left $ "Expecting y got: " ++ r2+ then exit $ Left $ "Expecting y got: " <> r2 else return $ Right ()- liftIO $ putStrLn $ "done iteration = " ++ show i+ liftIO $ putStrLn $ "done iteration = " <> show i return r mainContBelow@@ -272,17 +272,17 @@ liftIO $ putStrLn "ContT above streamly: Enter one char per line: " i <- lift $ S.fromFoldable [1..2 :: Int]- liftIO $ putStrLn $ "iteration = " ++ show i+ liftIO $ putStrLn $ "iteration = " <> show i callCC $ \exit -> do r1 <- liftIO getLine _ <- if r1 /= "x"- then exit $ Left $ "Expecting x got: " ++ r1+ then exit $ Left $ "Expecting x got: " <> r1 else return $ Right () r2 <- liftIO getLine if r2 /= "y"- then exit $ Left $ "Expecting y got: " ++ r2+ then exit $ Left $ "Expecting y got: " <> r2 else return $ Right () mainContAbove :: (IsStream t, Monad m, MonadIO (t m)) => ContT r (t m) ()
examples/MergeSort.hs view
@@ -1,40 +1,24 @@ {-# LANGUAGE FlexibleContexts #-} +-- | This example generates two streams sorted in ascending order and merges+-- them in ascending order, concurrently.+--+-- Compile with '-threaded -with-rtsopts "-N"' GHC options to use the+-- parallelism.+ import Data.Word import System.Random (getStdGen, randoms) import Data.List (sort)+import Data.Ord (compare)+ import Streamly-import Streamly.Prelude (yieldM)-import qualified Streamly.Prelude as A+import qualified Streamly.Prelude as S getSorted :: Serial Word16 getSorted = do- g <- yieldM getStdGen+ g <- S.yieldM getStdGen let ls = take 100000 (randoms g) :: [Word16] foldMap return (sort ls) --- | merge two streams generating the elements from each in parallel-mergeAsync :: Ord a => Serial a -> Serial a -> Serial a-mergeAsync a b = do- x <- yieldM $ mkAsync a- y <- yieldM $ mkAsync b- merge x y--merge :: Ord a => Serial a -> Serial a -> Serial a-merge a b = do- a1 <- yieldM $ A.uncons a- case a1 of- Nothing -> b- Just (x, ma) -> do- b1 <- yieldM $ A.uncons b- case b1 of- Nothing -> return x <> ma- Just (y, mb) ->- if y < x- then return y <> merge (return x <> ma) mb- else return x <> merge ma (return y <> mb)- main :: IO ()-main = do- xs <- A.toList $ mergeAsync getSorted getSorted- print $ length xs+main = S.last (S.mergeAsyncBy compare getSorted getSorted) >>= print
src/Streamly.hs view
@@ -61,7 +61,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} #endif -#include "Streamly/Streams/inline.h"+#include "Streamly/Streams/inline.hs" module Streamly (@@ -89,8 +89,7 @@ , ZipAsyncM -- * Running Streams- , runStream-+ , P.runStream -- * Parallel Function Application -- $application , (|$)@@ -153,6 +152,7 @@ -- * Re-exports , Semigroup (..)+ -- * Deprecated , Streaming , runStreaming@@ -173,18 +173,18 @@ ) where -import Streamly.Streams.StreamK hiding (runStream, serial)-import Streamly.Streams.Serial-import Streamly.Streams.Async+import Data.Semigroup (Semigroup(..))+import Streamly.SVar (MonadAsync, Rate(..)) import Streamly.Streams.Ahead+import Streamly.Streams.Async+import Streamly.Streams.Combinators import Streamly.Streams.Parallel-import Streamly.Streams.Zip import Streamly.Streams.Prelude-import Streamly.Streams.SVar-import Streamly.SVar (MonadAsync, Rate (..))-import Data.Semigroup (Semigroup(..))+import Streamly.Streams.Serial+import Streamly.Streams.StreamK hiding (runStream, serial)+import Streamly.Streams.Zip -import qualified Streamly.Streams.StreamD as D+import qualified Streamly.Prelude as P import qualified Streamly.Streams.StreamK as K -- XXX This should perhaps be moved to Prelude.@@ -193,65 +193,54 @@ -- Eliminating a stream ------------------------------------------------------------------------------ --- | Run a streaming composition, discard the results. By default it interprets--- the stream as 'SerialT', to run other types of streams use the type adapting--- combinators for example @runStream . 'asyncly'@.------ @since 0.2.0-{-# INLINE_EARLY runStream #-}-runStream :: Monad m => SerialT m a -> m ()-runStream m = D.runStream $ D.fromStreamK (toStream m)-{-# RULES "runStream fallback to CPS" [1]- forall a. D.runStream (D.fromStreamK a) = K.runStream a #-}- -- | Same as 'runStream' -- -- @since 0.1.0 {-# DEPRECATED runStreaming "Please use runStream instead." #-} runStreaming :: (Monad m, IsStream t) => t m a -> m ()-runStreaming = runStream . K.adapt+runStreaming = P.runStream . K.adapt -- | Same as @runStream@. -- -- @since 0.1.0 {-# DEPRECATED runStreamT "Please use runStream instead." #-} runStreamT :: Monad m => SerialT m a -> m ()-runStreamT = runStream+runStreamT = P.runStream -- | Same as @runStream . wSerially@. -- -- @since 0.1.0 {-# DEPRECATED runInterleavedT "Please use 'runStream . interleaving' instead." #-} runInterleavedT :: Monad m => WSerialT m a -> m ()-runInterleavedT = runStream . K.adapt+runInterleavedT = P.runStream . K.adapt -- | Same as @runStream . parallely@. -- -- @since 0.1.0 {-# DEPRECATED runParallelT "Please use 'runStream . parallely' instead." #-} runParallelT :: Monad m => ParallelT m a -> m ()-runParallelT = runStream . K.adapt+runParallelT = P.runStream . K.adapt -- | Same as @runStream . asyncly@. -- -- @since 0.1.0 {-# DEPRECATED runAsyncT "Please use 'runStream . asyncly' instead." #-} runAsyncT :: Monad m => AsyncT m a -> m ()-runAsyncT = runStream . K.adapt+runAsyncT = P.runStream . K.adapt -- | Same as @runStream . zipping@. -- -- @since 0.1.0 {-# DEPRECATED runZipStream "Please use 'runStream . zipSerially instead." #-} runZipStream :: Monad m => ZipSerialM m a -> m ()-runZipStream = runStream . K.adapt+runZipStream = P.runStream . K.adapt -- | Same as @runStream . zippingAsync@. -- -- @since 0.1.0 {-# DEPRECATED runZipAsync "Please use 'runStream . zipAsyncly instead." #-} runZipAsync :: Monad m => ZipAsyncM m a -> m ()-runZipAsync = runStream . K.adapt+runZipAsync = P.runStream . K.adapt ------------------------------------------------------------------------------ -- Documentation
+ src/Streamly/Enumeration.hs view
@@ -0,0 +1,550 @@+{-# LANGUAGE CPP #-}++-- |+-- Module : Streamly.Enumeration+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com+-- Stability : experimental+-- Portability : GHC+--+-- The functions defined in this module should be rarely needed for direct use,+-- try to use the operations from the 'Enumerable' type class+-- instances instead.+--+-- This module provides an 'Enumerable' type class to enumerate 'Enum' types+-- into a stream. The operations in this type class correspond to similar+-- perations in the 'Enum' type class, the only difference is that they produce+-- a stream instead of a list. These operations cannot be defined generically+-- based on the 'Enum' type class. We provide instances for commonly used+-- types. If instances for other types are needed convenience functions defined+-- in this module can be used to define them. Alternatively, these functions+-- can be used directly.++module Streamly.Enumeration+ (+ Enumerable (..)++ -- ** Enumerating 'Bounded' 'Enum' Types+ , enumerate+ , enumerateTo+ , enumerateFromBounded++ -- ** Enumerating 'Enum' Types not larger than 'Int'+ , enumerateFromToSmall+ , enumerateFromThenToSmall+ , enumerateFromThenSmallBounded++ -- ** Enumerating 'Bounded' 'Integral' Types+ , enumerateFromIntegral+ , enumerateFromThenIntegral++ -- ** Enumerating 'Integral' Types+ , enumerateFromToIntegral+ , enumerateFromThenToIntegral++ -- ** Enumerating unbounded 'Integral' Types+ , enumerateFromStepIntegral++ -- ** Enumerating 'Fractional' Types+ , enumerateFromFractional+ , enumerateFromToFractional+ , enumerateFromThenFractional+ , enumerateFromThenToFractional+ )+where++import Data.Fixed+import Data.Int+import Data.Ratio+import Data.Word+import Numeric.Natural+import Data.Functor.Identity (Identity(..))++import Streamly.Streams.StreamD (fromStreamD)+import Streamly.Streams.StreamK (IsStream(..))++import qualified Streamly.Streams.StreamD as D+import qualified Streamly.Streams.Serial as Serial++-------------------------------------------------------------------------------+-- Enumeration of Integral types+-------------------------------------------------------------------------------+--+-- | @enumerateFromStepIntegral from step@ generates an infinite stream whose+-- first element is @from@ and the successive elements are in increments of+-- @step@.+--+-- CAUTION: This function is not safe for finite integral types. It does not+-- check for overflow, underflow or bounds.+--+-- @+-- > S.toList $ S.take 4 $ S.enumerateFromStepIntegral 0 2+-- [0,2,4,6]+-- > S.toList $ S.take 3 $ S.enumerateFromStepIntegral 0 (-2)+-- [0,-2,-4]+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromStepIntegral #-}+enumerateFromStepIntegral+ :: (IsStream t, Monad m, Integral a)+ => a -> a -> t m a+enumerateFromStepIntegral from stride =+ fromStreamD $ D.enumerateFromStepIntegral from stride++-- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a+-- stream whose first element is @from@ and the successive elements are in+-- increments of @1@. The stream is bounded by the size of the 'Integral' type.+--+-- @+-- > S.toList $ S.take 4 $ S.enumerateFromIntegral (0 :: Int)+-- [0,1,2,3]+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromIntegral #-}+enumerateFromIntegral+ :: (IsStream t, Monad m, Integral a, Bounded a)+ => a -> t m a+enumerateFromIntegral from = fromStreamD $ D.enumerateFromIntegral from++-- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from+-- then@ generates a stream whose first element is @from@, the second element+-- is @then@ and the successive elements are in increments of @then - from@.+-- The stream is bounded by the size of the 'Integral' type.+--+-- @+-- > S.toList $ S.take 4 $ S.enumerateFromThenIntegral (0 :: Int) 2+-- [0,2,4,6]+-- > S.toList $ S.take 4 $ S.enumerateFromThenIntegral (0 :: Int) (-2)+-- [0,-2,-4,-6]+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromThenIntegral #-}+enumerateFromThenIntegral+ :: (IsStream t, Monad m, Integral a, Bounded a)+ => a -> a -> t m a+enumerateFromThenIntegral from next =+ fromStreamD $ D.enumerateFromThenIntegral from next++-- | Enumerate an 'Integral' type up to a given limit.+-- @enumerateFromToIntegral from to@ generates a finite stream whose first+-- element is @from@ and successive elements are in increments of @1@ up to+-- @to@.+--+-- @+-- > S.toList $ S.enumerateFromToIntegral 0 4+-- [0,1,2,3,4]+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromToIntegral #-}+enumerateFromToIntegral :: (IsStream t, Monad m, Integral a) => a -> a -> t m a+enumerateFromToIntegral from to =+ fromStreamD $ D.enumerateFromToIntegral from to++-- | Enumerate an 'Integral' type in steps up to a given limit.+-- @enumerateFromThenToIntegral from then to@ generates a finite stream whose+-- first element is @from@, the second element is @then@ and the successive+-- elements are in increments of @then - from@ up to @to@.+--+-- @+-- > S.toList $ S.enumerateFromThenToIntegral 0 2 6+-- [0,2,4,6]+-- > S.toList $ S.enumerateFromThenToIntegral 0 (-2) (-6)+-- [0,-2,-4,-6]+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromThenToIntegral #-}+enumerateFromThenToIntegral+ :: (IsStream t, Monad m, Integral a)+ => a -> a -> a -> t m a+enumerateFromThenToIntegral from next to =+ fromStreamD $ D.enumerateFromThenToIntegral from next to++-------------------------------------------------------------------------------+-- Enumeration of Fractional types+-------------------------------------------------------------------------------+--+-- Even though the underlying implementation of enumerateFromFractional and+-- enumerateFromThenFractional works for any 'Num' we have restricted these to+-- 'Fractional' because these do not perform any bounds check, in contrast to+-- integral versions and are therefore not equivalent substitutes for those.+--+-- | Numerically stable enumeration from a 'Fractional' number in steps of size+-- @1@. @enumerateFromFractional from@ generates a stream whose first element+-- is @from@ and the successive elements are in increments of @1@. No overflow+-- or underflow checks are performed.+--+-- This is the equivalent to 'enumFrom' for 'Fractional' types. For example:+--+-- @+-- > S.toList $ S.take 4 $ S.enumerateFromFractional 1.1+-- [1.1,2.1,3.1,4.1]+-- @+--+--+-- @since 0.6.0+{-# INLINE enumerateFromFractional #-}+enumerateFromFractional :: (IsStream t, Monad m, Fractional a) => a -> t m a+enumerateFromFractional from = fromStreamD $ D.numFrom from++-- | Numerically stable enumeration from a 'Fractional' number in steps.+-- @enumerateFromThenFractional from then@ generates a stream whose first+-- element is @from@, the second element is @then@ and the successive elements+-- are in increments of @then - from@. No overflow or underflow checks are+-- performed.+--+-- This is the equivalent of 'enumFromThen' for 'Fractional' types. For+-- example:+--+-- @+-- > S.toList $ S.take 4 $ S.enumerateFromThenFractional 1.1 2.1+-- [1.1,2.1,3.1,4.1]+-- > S.toList $ S.take 4 $ S.enumerateFromThenFractional 1.1 (-2.1)+-- [1.1,-2.1,-5.300000000000001,-8.500000000000002]+-- @+--+-- @since 0.6.0+{-# INLINE enumerateFromThenFractional #-}+enumerateFromThenFractional+ :: (IsStream t, Monad m, Fractional a)+ => a -> a -> t m a+enumerateFromThenFractional from next = fromStreamD $ D.numFromThen from next++-- | Numerically stable enumeration from a 'Fractional' number to a given+-- limit. @enumerateFromToFractional from to@ generates a finite stream whose+-- first element is @from@ and successive elements are in increments of @1@ up+-- to @to@.+--+-- This is the equivalent of 'enumFromTo' for 'Fractional' types. For+-- example:+--+-- @+-- > S.toList $ S.enumerateFromToFractional 1.1 4+-- [1.1,2.1,3.1,4.1]+-- > S.toList $ S.enumerateFromToFractional 1.1 4.6+-- [1.1,2.1,3.1,4.1,5.1]+-- @+--+-- Notice that the last element is equal to the specified @to@ value after+-- rounding to the nearest integer.+--+-- @since 0.6.0+{-# INLINE enumerateFromToFractional #-}+enumerateFromToFractional+ :: (IsStream t, Monad m, Fractional a, Ord a)+ => a -> a -> t m a+enumerateFromToFractional from to =+ fromStreamD $ D.enumerateFromToFractional from to++-- | Numerically stable enumeration from a 'Fractional' number in steps up to a+-- given limit. @enumerateFromThenToFractional from then to@ generates a+-- finite stream whose first element is @from@, the second element is @then@+-- and the successive elements are in increments of @then - from@ up to @to@.+--+-- This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For+-- example:+--+-- @+-- > S.toList $ S.enumerateFromThenToFractional 0.1 2 6+-- [0.1,2.0,3.9,5.799999999999999]+-- > S.toList $ S.enumerateFromThenToFractional 0.1 (-2) (-6)+-- [0.1,-2.0,-4.1000000000000005,-6.200000000000001]+-- @+--+--+-- @since 0.6.0+{-# INLINE enumerateFromThenToFractional #-}+enumerateFromThenToFractional+ :: (IsStream t, Monad m, Fractional a, Ord a)+ => a -> a -> a -> t m a+enumerateFromThenToFractional from next to =+ fromStreamD $ D.enumerateFromThenToFractional from next to++-------------------------------------------------------------------------------+-- Enumeration of Enum types not larger than Int+-------------------------------------------------------------------------------+--+-- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'.+--+-- @since 0.6.0+{-# INLINE enumerateFromToSmall #-}+enumerateFromToSmall :: (IsStream t, Monad m, Enum a) => a -> a -> t m a+enumerateFromToSmall from to = Serial.map toEnum $+ enumerateFromToIntegral (fromEnum from) (fromEnum to)++-- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'.+--+-- @since 0.6.0+{-# INLINE enumerateFromThenToSmall #-}+enumerateFromThenToSmall :: (IsStream t, Monad m, Enum a)+ => a -> a -> a -> t m a+enumerateFromThenToSmall from next to = Serial.map toEnum $+ enumerateFromThenToIntegral (fromEnum from) (fromEnum next) (fromEnum to)++-- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'.+--+-- Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a+-- type is bounded but does not have a 'Bounded' instance then we can go on+-- enumerating it beyond the legal values of the type, resulting in the failure+-- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded'+-- instance for this function to be safely used.+--+-- @since 0.6.0+{-# INLINE enumerateFromThenSmallBounded #-}+enumerateFromThenSmallBounded :: (IsStream t, Monad m, Enumerable a, Bounded a)+ => a -> a -> t m a+enumerateFromThenSmallBounded from next =+ case fromEnum next >= fromEnum from of+ True -> enumerateFromThenTo from next maxBound+ False -> enumerateFromThenTo from next minBound++-------------------------------------------------------------------------------+-- Enumerable type class+-------------------------------------------------------------------------------+--+-- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream+-- enumerations like this:+--+-- {-# RULES "fromList enumFrom" [1]+-- forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-}+--+-- But this does not work because enumFrom is a class method and GHC rewrites+-- it quickly, so we do not get a chance to have our rule fired.++-- | Types that can be enumerated as a stream. The operations in this type+-- class are equivalent to those in the 'Enum' type class, except that these+-- generate a stream instead of a list. Use the functions in+-- "Streamly.Enumeration" module to define new instances.+--+-- @since 0.6.0+class Enum a => Enumerable a where+ -- | @enumerateFrom from@ generates a stream starting with the element+ -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or+ -- generating an infinite stream when the type is not 'Bounded'.+ --+ -- @+ -- > S.toList $ S.take 4 $ S.enumerateFrom (0 :: Int)+ -- [0,1,2,3]+ -- @+ --+ -- For 'Fractional' types, enumeration is numerically stable. However, no+ -- overflow or underflow checks are performed.+ --+ -- @+ -- > S.toList $ S.take 4 $ S.enumerateFrom 1.1+ -- [1.1,2.1,3.1,4.1]+ -- @+ --+ -- @since 0.6.0+ enumerateFrom :: (IsStream t, Monad m) => a -> t m a++ -- | Generate a finite stream starting with the element @from@, enumerating+ -- the type up to the value @to@. If @to@ is smaller than @from@ then an+ -- empty stream is returned.+ --+ -- @+ -- > S.toList $ S.enumerateFromTo 0 4+ -- [0,1,2,3,4]+ -- @+ --+ -- For 'Fractional' types, the last element is equal to the specified @to@+ -- value after rounding to the nearest integral value.+ --+ -- @+ -- > S.toList $ S.enumerateFromTo 1.1 4+ -- [1.1,2.1,3.1,4.1]+ -- > S.toList $ S.enumerateFromTo 1.1 4.6+ -- [1.1,2.1,3.1,4.1,5.1]+ -- @+ --+ -- @since 0.6.0+ enumerateFromTo :: (IsStream t, Monad m) => a -> a -> t m a++ -- | @enumerateFromThen from then@ generates a stream whose first element+ -- is @from@, the second element is @then@ and the successive elements are+ -- in increments of @then - from@. Enumeration can occur downwards or+ -- upwards depending on whether @then@ comes before or after @from@. For+ -- 'Bounded' types the stream ends when 'maxBound' is reached, for+ -- unbounded types it keeps enumerating infinitely.+ --+ -- @+ -- > S.toList $ S.take 4 $ S.enumerateFromThen 0 2+ -- [0,2,4,6]+ -- > S.toList $ S.take 4 $ S.enumerateFromThen 0 (-2)+ -- [0,-2,-4,-6]+ -- @+ --+ -- @since 0.6.0+ enumerateFromThen :: (IsStream t, Monad m) => a -> a -> t m a++ -- | @enumerateFromThenTo from then to@ generates a finite stream whose+ -- first element is @from@, the second element is @then@ and the successive+ -- elements are in increments of @then - from@ up to @to@. Enumeration can+ -- occur downwards or upwards depending on whether @then@ comes before or+ -- after @from@.+ --+ -- @+ -- > S.toList $ S.enumerateFromThenTo 0 2 6+ -- [0,2,4,6]+ -- > S.toList $ S.enumerateFromThenTo 0 (-2) (-6)+ -- [0,-2,-4,-6]+ -- @+ --+ -- @since 0.6.0+ enumerateFromThenTo :: (IsStream t, Monad m) => a -> a -> a -> t m a++-- MAYBE: Sometimes it is more convenient to know the count rather then the+-- ending or starting element. For those cases we can define the folllowing+-- APIs. All of these will work only for bounded types if we represent the+-- count by Int.+--+-- enumerateN+-- enumerateFromN+-- enumerateToN+-- enumerateFromStep+-- enumerateFromStepN++-------------------------------------------------------------------------------+-- Convenient functions for bounded types+-------------------------------------------------------------------------------+--+-- |+-- > enumerate = enumerateFrom minBound+--+-- Enumerate a 'Bounded' type from its 'minBound' to 'maxBound'+--+-- @since 0.6.0+{-# INLINE enumerate #-}+enumerate :: (IsStream t, Monad m, Bounded a, Enumerable a) => t m a+enumerate = enumerateFrom minBound++-- |+-- > enumerateTo = enumerateFromTo minBound+--+-- Enumerate a 'Bounded' type from its 'minBound' to specified value.+--+-- @since 0.6.0+{-# INLINE enumerateTo #-}+enumerateTo :: (IsStream t, Monad m, Bounded a, Enumerable a) => a -> t m a+enumerateTo = enumerateFromTo minBound++-- |+-- > enumerateFromBounded = enumerateFromTo from maxBound+--+-- 'enumerateFrom' for 'Bounded' 'Enum' types.+--+-- @since 0.6.0+{-# INLINE enumerateFromBounded #-}+enumerateFromBounded :: (IsStream t, Monad m, Enumerable a, Bounded a)+ => a -> t m a+enumerateFromBounded from = enumerateFromTo from maxBound++-------------------------------------------------------------------------------+-- Enumerable Instances+-------------------------------------------------------------------------------+--+-- For Enum types smaller than or equal to Int size.+#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE) \+instance Enumerable SMALL_TYPE where { \+ {-# INLINE enumerateFrom #-}; \+ enumerateFrom = enumerateFromBounded; \+ {-# INLINE enumerateFromThen #-}; \+ enumerateFromThen = enumerateFromThenSmallBounded; \+ {-# INLINE enumerateFromTo #-}; \+ enumerateFromTo = enumerateFromToSmall; \+ {-# INLINE enumerateFromThenTo #-}; \+ enumerateFromThenTo = enumerateFromThenToSmall }+++ENUMERABLE_BOUNDED_SMALL(())+ENUMERABLE_BOUNDED_SMALL(Bool)+ENUMERABLE_BOUNDED_SMALL(Ordering)+ENUMERABLE_BOUNDED_SMALL(Char)++-- For bounded Integral Enum types, may be larger than Int.+#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE) \+instance Enumerable INTEGRAL_TYPE where { \+ {-# INLINE enumerateFrom #-}; \+ enumerateFrom = enumerateFromIntegral; \+ {-# INLINE enumerateFromThen #-}; \+ enumerateFromThen = enumerateFromThenIntegral; \+ {-# INLINE enumerateFromTo #-}; \+ enumerateFromTo = enumerateFromToIntegral; \+ {-# INLINE enumerateFromThenTo #-}; \+ enumerateFromThenTo = enumerateFromThenToIntegral }++ENUMERABLE_BOUNDED_INTEGRAL(Int)+ENUMERABLE_BOUNDED_INTEGRAL(Int8)+ENUMERABLE_BOUNDED_INTEGRAL(Int16)+ENUMERABLE_BOUNDED_INTEGRAL(Int32)+ENUMERABLE_BOUNDED_INTEGRAL(Int64)+ENUMERABLE_BOUNDED_INTEGRAL(Word)+ENUMERABLE_BOUNDED_INTEGRAL(Word8)+ENUMERABLE_BOUNDED_INTEGRAL(Word16)+ENUMERABLE_BOUNDED_INTEGRAL(Word32)+ENUMERABLE_BOUNDED_INTEGRAL(Word64)++-- For unbounded Integral Enum types.+#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE) \+instance Enumerable INTEGRAL_TYPE where { \+ {-# INLINE enumerateFrom #-}; \+ enumerateFrom from = enumerateFromStepIntegral from 1; \+ {-# INLINE enumerateFromThen #-}; \+ enumerateFromThen from next = \+ enumerateFromStepIntegral from (next - from); \+ {-# INLINE enumerateFromTo #-}; \+ enumerateFromTo = enumerateFromToIntegral; \+ {-# INLINE enumerateFromThenTo #-}; \+ enumerateFromThenTo = enumerateFromThenToIntegral }++ENUMERABLE_UNBOUNDED_INTEGRAL(Integer)+ENUMERABLE_UNBOUNDED_INTEGRAL(Natural)++#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT) \+instance (CONSTRAINT) => Enumerable (FRACTIONAL_TYPE) where { \+ {-# INLINE enumerateFrom #-}; \+ enumerateFrom = enumerateFromFractional; \+ {-# INLINE enumerateFromThen #-}; \+ enumerateFromThen = enumerateFromThenFractional; \+ {-# INLINE enumerateFromTo #-}; \+ enumerateFromTo = enumerateFromToFractional; \+ {-# INLINE enumerateFromThenTo #-}; \+ enumerateFromThenTo = enumerateFromThenToFractional }++ENUMERABLE_FRACTIONAL(Float,)+ENUMERABLE_FRACTIONAL(Double,)+ENUMERABLE_FRACTIONAL(Fixed a,HasResolution a)+ENUMERABLE_FRACTIONAL(Ratio a,Integral a)++#if __GLASGOW_HASKELL__ >= 800+instance Enumerable a => Enumerable (Identity a) where+ {-# INLINE enumerateFrom #-}+ enumerateFrom (Identity from) = Serial.map Identity $+ enumerateFrom from+ {-# INLINE enumerateFromThen #-}+ enumerateFromThen (Identity from) (Identity next) = Serial.map Identity $+ enumerateFromThen from next+ {-# INLINE enumerateFromTo #-}+ enumerateFromTo (Identity from) (Identity to) = Serial.map Identity $+ enumerateFromTo from to+ {-# INLINE enumerateFromThenTo #-}+ enumerateFromThenTo (Identity from) (Identity next) (Identity to) =+ Serial.map Identity $ enumerateFromThenTo from next to+#endif++-- TODO+{-+instance Enumerable a => Enumerable (Last a)+instance Enumerable a => Enumerable (First a)+instance Enumerable a => Enumerable (Max a)+instance Enumerable a => Enumerable (Min a)+instance Enumerable a => Enumerable (Const a b)+instance Enumerable (f a) => Enumerable (Alt f a)+instance Enumerable (f a) => Enumerable (Ap f a)+-}
src/Streamly/Internal.hs view
@@ -16,4 +16,4 @@ ) where -import Streamly.Streams.SVar+import Streamly.Streams.Combinators (inspectMode)
+ src/Streamly/List.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} -- XXX+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module : Streamly.List+-- Copyright : (c) 2018 Composewell Technologies+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com+-- Stability : experimental+-- Portability : GHC+--+-- Lists are just a special case of monadic streams. The stream type @SerialT+-- Identity a@ can be used as a replacement for @[a]@. The 'List' type in this+-- module is just a newtype wrapper around @SerialT Identity@ for better type+-- inference when using the 'OverloadedLists' GHC extension. @List a@ provides+-- better performance compared to @[a]@. Standard list, string and list+-- comprehension syntax can be used with the 'List' type by enabling+-- 'OverloadedLists', 'OverloadedStrings' and 'MonadComprehensions' GHC+-- extensions. There would be a slight difference in the 'Show' and 'Read'+-- strings of streamly list as compared to regular lists.+--+-- Conversion to stream types is free, any stream combinator can be used on+-- lists by converting them to streams. However, for convenience, this module+-- provides combinators that work directly on the 'List' type.+--+--+-- @+-- List $ S.map (+ 1) $ toSerial (1 \`Cons\` Nil)+-- @+--+-- To convert a 'List' to regular lists, you can use any of the following:+--+-- * @toList . toSerial@ and @toSerial . fromList@+-- * 'Data.Foldable.toList' from "Data.Foldable"+-- * 'GHC.Exts.toList' and 'GHC.Exts.fromList' from 'IsList' in "GHC.Exts"+--+-- If you have made use of 'Nil' and 'Cons' constructors in the code and you+-- want to replace streamly lists with standard lists, all you need to do is+-- import these definitions:+--+-- @+-- type List = []+-- pattern Nil <- [] where Nil = []+-- pattern Cons x xs = x : xs+-- infixr 5 `Cons`+-- {-\# COMPLETE Cons, Nil #-}+-- @+--+-- See <src/docs/streamly-vs-lists.md> for more details and+-- <src/test/PureStreams.hs> for comprehensive usage examples.+--+module Streamly.List+ (+#if __GLASGOW_HASKELL__ >= 800+ List (.., Nil, Cons)+#else+ List (..)+ , pattern Nil+ , pattern Cons+#endif+ -- XXX we may want to use rebindable syntax for variants instead of using+ -- different types (applicative do and apWith).+ , ZipList (..)+ , fromZipList+ , toZipList+ )+where++import Control.Arrow (second)+import Control.DeepSeq (NFData(..), NFData1(..))+import Data.Functor.Identity (Identity, runIdentity)+import Data.Semigroup (Semigroup(..))+import GHC.Exts (IsList(..), IsString(..))++import Streamly.Streams.Serial (SerialT)+import Streamly.Streams.Zip (ZipSerialM)++import qualified Streamly.Streams.Prelude as P+import qualified Streamly.Streams.StreamK as K++-- We implement list as a newtype instead of a type synonym to make type+-- inference easier when using -XOverloadedLists and -XOverloadedStrings. When+-- using a stream type the programmer needs to specify the Monad otherwise the+-- type remains ambiguous.+--+-- XXX once we separate consM from IsStream or remove the MonadIO and+-- MonadBaseControlIO dependency from it, then we can make this an instance of+-- IsStream and use the regular polymorphic functions on Lists as well. Once+-- that happens we can change the Show and Read instances as well to use "1 >:+-- 2 >: nil" etc. or should we use a separate constructor indicating the "List"+-- type ":>" for better inference?+--+-- | @List a@ is a replacement for @[a]@.+--+-- @since 0.6.0+newtype List a = List { toSerial :: SerialT Identity a }+ deriving (Show, Read, Eq, Ord, NFData, NFData1+ , Semigroup, Monoid, Functor, Foldable+ , Applicative, Traversable, Monad)++instance (a ~ Char) => IsString (List a) where+ {-# INLINE fromString #-}+ fromString = List . P.fromList++-- GHC versions 8.0 and below cannot derive IsList+instance IsList (List a) where+ type (Item (List a)) = a+ {-# INLINE fromList #-}+ fromList = List . P.fromList+ {-# INLINE toList #-}+ toList = runIdentity . P.toList . toSerial++------------------------------------------------------------------------------+-- Patterns+------------------------------------------------------------------------------++-- Note: When using the OverloadedLists extension we should be able to pattern+-- match using the regular list contructors. OverloadedLists uses 'toList' to+-- perform the pattern match, it should not be too bad as it works lazily in+-- the Identity monad. We need these patterns only when not using that+-- extension.+--+-- | An empty list constructor and pattern that matches an empty 'List'.+-- Corresponds to '[]' for Haskell lists.+--+-- @since 0.6.0+pattern Nil :: List a+pattern Nil <- (runIdentity . K.null . toSerial -> True) where+ Nil = List K.nil++infixr 5 `Cons`++-- | A list constructor and pattern that deconstructs a 'List' into its head+-- and tail. Corresponds to ':' for Haskell lists.+--+-- @since 0.6.0+pattern Cons :: a -> List a -> List a+pattern Cons x xs <-+ (fmap (second List) . runIdentity . K.uncons . toSerial+ -> Just (x, xs)) where+ Cons x xs = List $ K.cons x (toSerial xs)++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE Nil, Cons #-}+#endif++------------------------------------------------------------------------------+-- ZipList+------------------------------------------------------------------------------++-- | Just like 'List' except that it has a zipping 'Applicative' instance+-- and no 'Monad' instance.+--+-- @since 0.6.0+newtype ZipList a = ZipList { toZipSerial :: ZipSerialM Identity a }+ deriving (Show, Read, Eq, Ord, NFData, NFData1+ , Semigroup, Monoid, Functor, Foldable+ , Applicative, Traversable)++instance (a ~ Char) => IsString (ZipList a) where+ {-# INLINE fromString #-}+ fromString = ZipList . P.fromList++-- GHC versions 8.0 and below cannot derive IsList+instance IsList (ZipList a) where+ type (Item (ZipList a)) = a+ {-# INLINE fromList #-}+ fromList = ZipList . P.fromList+ {-# INLINE toList #-}+ toList = runIdentity . P.toList . toZipSerial++-- | Convert a 'ZipList' to a regular 'List'+--+-- @since 0.6.0+fromZipList :: ZipList a -> List a+fromZipList = List . K.adapt . toZipSerial++-- | Convert a regular 'List' to a 'ZipList'+--+-- @since 0.6.0+toZipList :: List a -> ZipList a+toZipList = ZipList . K.adapt . toSerial
src/Streamly/Prelude.hs view
@@ -1,1039 +1,1849 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE UndecidableInstances #-} -- XXX--#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -Wno-orphans #-}-#endif--#include "Streams/inline.h"---- |--- Module : Streamly.Prelude--- Copyright : (c) 2017 Harendra Kumar------ License : BSD3--- Maintainer : harendra.kumar@gmail.com--- Stability : experimental--- Portability : GHC------ This module is designed to be imported qualified:------ @--- import qualified Streamly.Prelude as S--- @------ Functions with the suffix @M@ are general functions that work on monadic--- arguments. The corresponding functions without the suffix @M@ work on pure--- arguments and can in general be derived from their monadic versions but are--- provided for convenience and for consistency with other pure APIs in the--- @base@ package.------ Functions having a 'MonadAsync' constraint work concurrently when used with--- appropriate stream type combinator. Please be careful to not use 'parallely'--- with infinite streams.------ Deconstruction and folds accept a 'SerialT' type instead of a polymorphic--- type to ensure that streams always have a concrete monomorphic type by--- default, reducing type errors. In case you want to use any other type of--- stream you can use one of the type combinators provided in the "Streamly"--- module to convert the stream type.--module Streamly.Prelude- (- -- * Construction- -- | All other stream construction and generation combinators described- -- later, and even more custom combinators can be expressed in terms of- -- these primitives. However, the special versions provided in this module- -- can be more efficient in some situations.-- -- ** From Elements- -- | Primitives to construct a stream from pure values or monadic actions.- K.nil- , K.cons- , (K..:)- , consM- , (|:)- , yield- , yieldM-- -- ** From Streams- -- | You can construct streams by appending or merging existing streams.- -- When constructing streams from streams, '<>' and 'mempty' are the- -- intuitive equivalents of 'K.cons' and 'K.nil', respectively. These- -- primitives can be very useful when constructing your own custom stream- -- combinators. Also see the variants of '<>' defined in the "Streamly"- -- module. Note that appending streams is inexpensive, it is much more- -- efficient than appending lists.-- -- * Generation- -- ** Unfold and Iterate- -- | Note that the generative steps of unfold and iterate are inherently- -- serial as the next step depends on the result of the previous step.- -- However, consumption of the result from the previous step can happen in- -- parallel with the generation by the next step.- , unfoldr- , unfoldrM- , iterate- , iterateM-- -- ** Replicate and Repeat- -- | Generate a monadic stream from a seed value or function. Note that- -- these functions can generate a stream fully concurrently as, unlike- -- unfolds, there is no dependency between steps, therefore, an unbounded- -- number of steps can run concurrently. All of these can be expressed in- -- terms of 'K.cons' and 'K.nil' primitives.- , replicateM- , K.repeat- , repeatM-- -- ** Generate From- -- | Convert an input structure, container or source into a stream. All of- -- these can be expressed in terms of primitives.- , fromList- , fromListM- , K.fromFoldable- , fromFoldableM- , fromHandle-- -- * Deconstruction- , uncons-- -- * Elimination-- -- ** General Folds- -- | All the folds can be implemented in terms of 'uncons', however the- -- specific implementations provided here are generally more efficient.- -- Folds are inherently serial as each step needs to use the result of- -- the previous step.- , foldr- , foldr1- , foldrM- , foldl'- , foldl1'- , foldlM'- , foldx- , foldxM-- -- ** Specialized Folds- -- | These folds can be expressed in terms of the general fold routines but- -- the special versions here can be more efficient in many cases.-- -- Filtering folds: extract parts of the stream- , head- , tail- , last- , init-- -- Conditional folds: may terminate early based on a condition- , null- , elem- , elemIndex- , notElem- , lookup- , find- , findIndex- , all- , any- , and- , or-- -- Full folds - need to go through all elements- , length- , maximum- , minimum- , sum- , product-- -- ** Fold To- -- | Convert or divert a stream into an output structure, container or- -- sink.- , toList- , toHandle-- -- * Transformation- -- | One to one transformations, each element in the input stream is- -- transformed into a corresponding element in the output stream.- -- Therefore, the length of the stream and the ordering of elements in the- -- stream remains unchanged after the transformation.-- -- ** Scanning- -- | Scan is a transformation by continuously folding the result with the- -- next element of the stream. This is the generalized way to transform a- -- stream carrying state from previous transformation steps, other forms of- -- transformation like map can be expressed in terms of this.- , scanl'- , scanlM'- , scanx-- -- ** Mapping- -- | Map is a special form of scan where no state is carried from one step- -- to the next.- , Serial.map- , mapM-- -- ** Flattening- , sequence-- -- * Filtering and Insertion- -- | Adding or removing elements from the stream thus changing the length- -- of the stream.-- -- ** Filtering- , filter- , filterM- , take- , takeWhile- , takeWhileM- , drop- , dropWhile- , dropWhileM-- -- ** Inserting- , intersperseM-- -- * Reordering- , reverse-- -- * Hybrid Operations- -- ** Map and Fold- , mapM_-- -- ** Map and Filter- , mapMaybe- , mapMaybeM-- -- ** Scan and filter- , findIndices- , elemIndices-- -- * Zipping- , zipWith- , zipWithM- , Z.zipAsyncWith- , Z.zipAsyncWithM-- -- * Deprecated- , K.once- , each- , scan- , foldl- , foldlM- )-where--import Control.Monad.IO.Class (MonadIO(..))-import Data.Maybe (isJust, fromJust)-import Prelude- hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,- foldl, mapM, mapM_, sequence, all, any, sum, product, elem,- notElem, maximum, minimum, head, last, tail, length, null,- reverse, iterate, init, and, or, lookup, foldr1)-import qualified Prelude-import qualified System.IO as IO--import Streamly.SVar (MonadAsync, defState, rstState)-import Streamly.Streams.SVar (maxYields)-import Streamly.Streams.StreamK (IsStream(..))-import Streamly.Streams.Serial (SerialT)--import qualified Streamly.Streams.StreamK as K-import qualified Streamly.Streams.StreamD as D-import qualified Streamly.Streams.Zip as Z--#ifdef USE_STREAMK_ONLY-import qualified Streamly.Streams.StreamK as S-import qualified Streamly.Streams.Zip as S-#else-import qualified Streamly.Streams.StreamD as S-#endif--import qualified Streamly.Streams.Serial as Serial----------------------------------------------------------------------------------- Conversion to and from direct style stream----------------------------------------------------------------------------------- These definitions are dependent on what is imported as S-{-# INLINE fromStreamS #-}-fromStreamS :: (IsStream t, Monad m) => S.Stream m a -> t m a-fromStreamS = fromStream . S.toStreamK--{-# INLINE toStreamS #-}-toStreamS :: (IsStream t, Monad m) => t m a -> S.Stream m a-toStreamS = S.fromStreamK . toStream--{-# INLINE fromStreamD #-}-fromStreamD :: (IsStream t, Monad m) => D.Stream m a -> t m a-fromStreamD = fromStream . D.toStreamK--{-# INLINE toStreamD #-}-toStreamD :: (IsStream t, Monad m) => t m a -> D.Stream m a-toStreamD = D.fromStreamK . toStream----------------------------------------------------------------------------------- Deconstruction----------------------------------------------------------------------------------- | Decompose a stream into its head and tail. If the stream is empty, returns--- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is--- the head of the stream and @ma@ its tail.------ @since 0.1.0-uncons :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (a, t m a))-uncons m = K.uncons (K.adapt m)----------------------------------------------------------------------------------- Generation by Unfolding----------------------------------------------------------------------------------- | Build a stream by unfolding a /pure/ step function starting from a seed.--- The step function returns the next element in the stream and the next seed--- value. When it is done it returns 'Nothing' and the stream ends. For--- example,------ @--- let f b =--- if b > 3--- then Nothing--- else Just (b, b + 1)--- in toList $ unfoldr f 0--- @--- @--- [0,1,2,3]--- @------ unfoldr can be expressed in terms of 'yield' and '<>' as follows:------ @--- unfoldr step s =--- case step s of--- Nothing -> mempty--- Just (a, b) -> 'yield' a '<>' (unfoldr step b)--- @------ @since 0.1.0-{-# INLINE_EARLY unfoldr #-}-unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a-unfoldr step seed = fromStreamS (S.unfoldr step seed)-{-# RULES "unfoldr fallback to StreamK" [1]- forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}---- | Build a stream by unfolding a /monadic/ step function starting from a--- seed. The step function returns the next element in the stream and the next--- seed value. When it is done it returns 'Nothing' and the stream ends. For--- example,------ @--- let f b =--- if b > 3--- then return Nothing--- else print b >> return (Just (b, b + 1))--- in runStream $ unfoldrM f 0--- @--- @--- 0--- 1--- 2--- 3--- @--- When run concurrently, the next unfold step can run concurrently with the--- processing of the output of the previous step. Note that more than one step--- cannot run concurrently as the next step depends on the output of the--- previous step.------ @--- (asyncly $ S.unfoldrM (\\n -> liftIO (threadDelay 1000000) >> return (Just (n, n + 1))) 0)--- & S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()--- @------ /Concurrent/------ /Since: 0.1.0/-{-# INLINE_EARLY unfoldrM #-}-unfoldrM :: (IsStream t, MonadAsync m) => (b -> m (Maybe (a, b))) -> b -> t m a-unfoldrM = K.unfoldrM--{-# RULES "unfoldrM serial" unfoldrM = unfoldrMSerial #-}-{-# INLINE_EARLY unfoldrMSerial #-}-unfoldrMSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> SerialT m a-unfoldrMSerial step seed = fromStreamS (S.unfoldrM step seed)----------------------------------------------------------------------------------- Specialized Generation----------------------------------------------------------------------------------- Faster than yieldM because there is no bind.------ | Create a singleton stream from a pure value. Same as @a `cons` nil@ but--- slighly more efficient. Note that in monadic streams, 'yield' is the same--- as 'pure' or 'return', however, in Zip applicative streams it is not the--- same as 'pure' because in that case 'pure' is equivalent to 'repeat'--- instead. In all other stream types, 'yield' is the same as @yieldM . pure@--- but more efficient.------ @since 0.4.0-{-# INLINE yield #-}-yield :: IsStream t => a -> t m a-yield = K.yield---- | Create a singleton stream from a monadic action. Same as @m \`consM` nil@--- but more efficient.------ @--- > toList $ yieldM getLine--- hello--- ["hello"]--- @------ @since 0.4.0-{-# INLINE yieldM #-}-yieldM :: (Monad m, IsStream t) => m a -> t m a-yieldM = K.yieldM---- | Generate a stream by performing a monadic action @n@ times. Can be--- expressed as @stimes n (yieldM m)@.--------- @--- runStream $ serially $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)--- runStream $ asyncly $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)--- @------ /Concurrent/------ @since 0.1.1-replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a-replicateM n m = go n- where- go cnt = if cnt <= 0 then K.nil else m |: go (cnt - 1)---- | Generate a stream by repeatedly executing a monadic action forever. Can be--- expressed as @cycle1 . yieldM@.------ @--- runStream $ serially $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)--- runStream $ asyncly $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)--- @------ /Concurrent, infinite (do not use with 'parallely')/------ @since 0.2.0-repeatM :: (IsStream t, MonadAsync m) => m a -> t m a-repeatM = go- where go m = m |: go m---- | Iterate a pure function from a seed value, streaming the results forever.------ @since 0.1.2-iterate :: IsStream t => (a -> a) -> a -> t m a-iterate step = fromStream . go- where- go s = K.cons s (go (step s))---- | Iterate a monadic function from a seed value, streaming the results--- forever.------ When run concurrently, the next iteration can run concurrently with the--- processing of the previous iteration. Note that more than one iteration--- cannot run concurrently as the next iteration depends on the output of the--- previous iteration.------ @--- runStream $ serially $ S.take 10 $ S.iterateM--- (\\x -> threadDelay 1000000 >> print x >> return (x + 1)) 0------ runStream $ asyncly $ S.take 10 $ S.iterateM--- (\\x -> threadDelay 1000000 >> print x >> return (x + 1)) 0--- @------ /Concurrent/------ @since 0.1.2-iterateM :: (IsStream t, MonadAsync m) => (a -> m a) -> a -> t m a-iterateM step = go- where- go s = fromStream $ K.Stream $ \svr stp sng yld -> do- next <- step s- K.unStream (toStream (return s |: go next)) svr stp sng yld----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- | Construct a stream from a list containing pure values. More efficient list--- specific implementation of 'K.fromFoldable' as it works well with fusion--- optimization.------ @since 0.4.0-{-# INLINE_EARLY fromList #-}-fromList :: (Monad m, IsStream t) => [a] -> t m a-fromList = fromStreamS . S.fromList-{-# RULES "fromList fallback to StreamK" [1]- forall a. S.toStreamK (S.fromList a) = K.fromFoldable a #-}---- | Construct a stream from a list containing monadic actions. More efficient--- list specific implementation of 'fromFoldableM' especially for serial--- streams as it works well with fusion optimization.------ @since 0.4.0-{-# INLINE_EARLY fromListM #-}-fromListM :: (MonadAsync m, IsStream t) => [m a] -> t m a-fromListM = fromStreamD . D.fromListM-{-# RULES "fromListM fallback to StreamK" [1]- forall a. D.toStreamK (D.fromListM a) = fromFoldableM a #-}---- | Construct a stream from a 'Foldable' containing monadic actions. Same as--- @'Prelude.foldr' 'consM' 'K.nil'@.------ @--- runStream $ serially $ S.fromFoldableM $ replicate 10 (threadDelay 1000000 >> print 1)--- runStream $ asyncly $ S.fromFoldableM $ replicate 10 (threadDelay 1000000 >> print 1)--- @------ /Concurrent (do not use with 'parallely' on infinite containers)/------ @since 0.3.0-{-# INLINE fromFoldableM #-}-fromFoldableM :: (IsStream t, MonadAsync m, Foldable f) => f (m a) -> t m a-fromFoldableM = Prelude.foldr consM K.nil---- | Same as 'fromFoldable'.------ @since 0.1.0-{-# DEPRECATED each "Please use fromFoldable instead." #-}-{-# INLINE each #-}-each :: (IsStream t, Foldable f) => f a -> t m a-each = K.fromFoldable---- | Read lines from an IO Handle into a stream of Strings.------ @since 0.1.0-fromHandle :: (IsStream t, MonadIO m) => IO.Handle -> t m String-fromHandle h = fromStream go- where- go = K.Stream $ \_ stp _ yld -> do- eof <- liftIO $ IO.hIsEOF h- if eof- then stp- else do- str <- liftIO $ IO.hGetLine h- yld str go----------------------------------------------------------------------------------- Elimination by Folding----------------------------------------------------------------------------------- | Lazy right fold with a monadic step function. For example, to fold a--- stream into a list:------ @--- >> runIdentity $ foldrM (\\x xs -> return (x : xs)) [] (serially $ fromFoldable [1,2,3])--- [1,2,3]--- @------ @since 0.2.0-{-# INLINE foldrM #-}-foldrM :: Monad m => (a -> b -> m b) -> b -> SerialT m a -> m b-foldrM step acc m = S.foldrM step acc $ toStreamS m---- | Lazy right associative fold. For example, to fold a stream into a list:------ @--- >> runIdentity $ foldr (:) [] (serially $ fromFoldable [1,2,3])--- [1,2,3]--- @------ @since 0.1.0-{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> SerialT m a -> m b--- XXX somehow this definition does not perform well, need to investigate--- foldr step acc m = S.foldr step acc $ S.fromStreamK (toStream m)-foldr f = foldrM (\a b -> return (f a b))---- | Right fold, for non-empty streams, using first element as the starting--- value. Returns 'Nothing' if the stream is empty.------ @since 0.5.0-{-# INLINE foldr1 #-}-foldr1 :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)-foldr1 = K.foldr1---- | Strict left fold with an extraction function. Like the standard strict--- left fold, but applies a user supplied extraction function (the third--- argument) to the folded value at the end. This is designed to work with the--- @foldl@ library. The suffix @x@ is a mnemonic for extraction.------ @since 0.2.0-{-# INLINE foldx #-}-foldx :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b-foldx = K.foldx---- |--- @since 0.1.0-{-# DEPRECATED foldl "Please use foldx instead." #-}-foldl :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b-foldl = foldx---- | Strict left associative fold.------ @since 0.2.0-{-# INLINE foldl' #-}-foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b-foldl' step begin m = S.foldl' step begin $ toStreamS m---- | Strict left fold, for non-empty streams, using first element as the--- starting value. Returns 'Nothing' if the stream is empty.------ @since 0.5.0-foldl1' :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)-foldl1' step m = do- r <- uncons m- case r of- Nothing -> return Nothing- Just (h, t) -> do- res <- foldl' step h t- return $ Just res---- XXX replace the recursive "go" with explicit continuations.--- | Like 'foldx', but with a monadic step function.------ @since 0.2.0-foldxM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b-foldxM = K.foldxM---- |--- @since 0.1.0-{-# DEPRECATED foldlM "Please use foldxM instead." #-}-foldlM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b-foldlM = foldxM---- | Like 'foldl'' but with a monadic step function.------ @since 0.2.0-foldlM' :: Monad m => (b -> a -> m b) -> b -> SerialT m a -> m b-foldlM' step begin m = S.foldlM' step begin $ toStreamS m----------------------------------------------------------------------------------- Specialized folds----------------------------------------------------------------------------------- | Determine whether the stream is empty.------ @since 0.1.1-{-# INLINE null #-}-null :: Monad m => SerialT m a -> m Bool-null = K.null---- | Extract the first element of the stream, if any.------ @since 0.1.0-{-# INLINE head #-}-head :: Monad m => SerialT m a -> m (Maybe a)-head = K.head---- | Extract all but the first element of the stream, if any.------ @since 0.1.1-{-# INLINE tail #-}-tail :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))-tail m = K.tail (K.adapt m)---- | Extract all but the last element of the stream, if any.------ @since 0.5.0-{-# INLINE init #-}-init :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))-init m = K.init (K.adapt m)---- | Extract the last element of the stream, if any.------ @since 0.1.1-{-# INLINE last #-}-last :: Monad m => SerialT m a -> m (Maybe a)-last m = S.last $ toStreamS m---- | Determine whether an element is present in the stream.------ @since 0.1.0-{-# INLINE elem #-}-elem :: (Monad m, Eq a) => a -> SerialT m a -> m Bool-elem e m = S.elem e (toStreamS m)---- | Determine whether an element is not present in the stream.------ @since 0.1.0-{-# INLINE notElem #-}-notElem :: (Monad m, Eq a) => a -> SerialT m a -> m Bool-notElem e m = S.notElem e (toStreamS m)---- | Determine the length of the stream.------ @since 0.1.0-{-# INLINE length #-}-length :: Monad m => SerialT m a -> m Int-length = foldl' (\n _ -> n + 1) 0---- | Determine whether all elements of a stream satisfy a predicate.------ @since 0.1.0-{-# INLINE all #-}-all :: Monad m => (a -> Bool) -> SerialT m a -> m Bool-all p m = S.all p (toStreamS m)---- | Determine whether any of the elements of a stream satisfy a predicate.------ @since 0.1.0-{-# INLINE any #-}-any :: Monad m => (a -> Bool) -> SerialT m a -> m Bool-any p m = S.any p (toStreamS m)---- | Determines if all elements of a boolean stream are True.------ @since 0.5.0-{-# INLINE and #-}-and :: Monad m => SerialT m Bool -> m Bool-and = all (==True)---- | Determines wheter at least one element of a boolean stream is True.------ @since 0.5.0-{-# INLINE or #-}-or :: Monad m => SerialT m Bool -> m Bool-or = any (==True)---- | Determine the sum of all elements of a stream of numbers------ @since 0.1.0-{-# INLINE sum #-}-sum :: (Monad m, Num a) => SerialT m a -> m a-sum = foldl' (+) 0---- | Determine the product of all elements of a stream of numbers------ @since 0.1.1-{-# INLINE product #-}-product :: (Monad m, Num a) => SerialT m a -> m a-product = foldl' (*) 1---- | Determine the minimum element in a stream.------ @since 0.1.0-{-# INLINE minimum #-}-minimum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)-minimum m = S.minimum (toStreamS m)---- | Determine the maximum element in a stream.------ @since 0.1.0-{-# INLINE maximum #-}-maximum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)-maximum m = S.maximum (toStreamS m)---- | Looks the given key up, treating the given stream as an association list.------ @since 0.5.0-{-# INLINE lookup #-}-lookup :: (Monad m, Eq a) => a -> SerialT m (a, b) -> m (Maybe b)-lookup = K.lookup---- | Returns the first element of the stream satisfying the given predicate,--- if any.------ @since 0.5.0-{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe a)-find = K.find---- | Find all the indices where the element in the stream satisfies the given--- predicate.------ @since 0.5.0-{-# INLINE findIndices #-}-findIndices :: IsStream t => (a -> Bool) -> t m a -> t m Int-findIndices = K.findIndices---- | Gives the index of the first stream element satisfying the given--- preficate.------ @since 0.5.0-{-# INLINE findIndex #-}-findIndex :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe Int)-findIndex p = head . findIndices p---- | Find all the indices where the value of the element in the stream is equal--- to the given value.------ @since 0.5.0-{-# INLINE elemIndices #-}-elemIndices :: (IsStream t, Eq a) => a -> t m a -> t m Int-elemIndices a = findIndices (==a)---- | Gives the first index of an element in the stream, which equals the given.------ @since 0.5.0-{-# INLINE elemIndex #-}-elemIndex :: (Monad m, Eq a) => a -> SerialT m a -> m (Maybe Int)-elemIndex a = findIndex (==a)----------------------------------------------------------------------------------- Map and Fold----------------------------------------------------------------------------------- XXX this can utilize parallel mapping if we implement it as runStream . mapM--- | Apply a monadic action to each element of the stream and discard the--- output of the action.------ @since 0.1.0-{-# INLINE mapM_ #-}-mapM_ :: Monad m => (a -> m b) -> SerialT m a -> m ()-mapM_ f m = S.mapM_ f $ toStreamS m----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- | Convert a stream into a list in the underlying monad.------ @since 0.1.0-{-# INLINE toList #-}-toList :: Monad m => SerialT m a -> m [a]-toList m = S.toList $ toStreamS m---- | Write a stream of Strings to an IO Handle.------ @since 0.1.0-toHandle :: MonadIO m => IO.Handle -> SerialT m String -> m ()-toHandle h m = go (toStream m)- where- go m1 =- let stop = return ()- single a = liftIO (IO.hPutStrLn h a)- yieldk a r = liftIO (IO.hPutStrLn h a) >> go r- in K.unStream m1 defState stop single yieldk----------------------------------------------------------------------------------- Transformation by Folding (Scans)----------------------------------------------------------------------------------- | Strict left scan with an extraction function. Like 'scanl'', but applies a--- user supplied extraction function (the third argument) at each step. This is--- designed to work with the @foldl@ library. The suffix @x@ is a mnemonic for--- extraction.------ @since 0.2.0-{-# INLINE scanx #-}-scanx :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b-scanx = K.scanx---- |--- @since 0.1.1-{-# DEPRECATED scan "Please use scanx instead." #-}-scan :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b-scan = scanx---- | Like 'scanl'' but with a monadic step function.------ @since 0.4.0-{-# INLINE scanlM' #-}-scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b-scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m---- | Strict left scan. Like 'foldl'', but returns the folded value at each--- step, generating a stream of all intermediate fold results. The first--- element of the stream is the user supplied initial value, and the last--- element of the stream is the same as the result of 'foldl''.------ @since 0.2.0-{-# INLINE scanl' #-}-scanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b-scanl' step = scanlM' (\a b -> return (step a b))----------------------------------------------------------------------------------- Transformation by Filtering----------------------------------------------------------------------------------- | Include only those elements that pass a predicate.------ @since 0.1.0-{-# INLINE filter #-}-#if __GLASGOW_HASKELL__ != 802--- GHC 8.2.2 crashes with this code, when used with "stack"-filter :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a-filter p m = fromStreamS $ S.filter p $ toStreamS m-#else-filter :: IsStream t => (a -> Bool) -> t m a -> t m a-filter = K.filter-#endif---- | Same as 'filter' but with a monadic predicate.------ @since 0.4.0-{-# INLINE filterM #-}-filterM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a-filterM p m = fromStreamD $ D.filterM p $ toStreamD m---- | Take first 'n' elements from the stream and discard the rest.------ @since 0.1.0-{-# INLINE take #-}-take :: (IsStream t, Monad m) => Int -> t m a -> t m a-take n m = fromStreamS $ S.take n $ toStreamS- (maxYields (Just (fromIntegral n)) m)---- | End the stream as soon as the predicate fails on an element.------ @since 0.1.0-{-# INLINE takeWhile #-}-takeWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a-takeWhile p m = fromStreamS $ S.takeWhile p $ toStreamS m---- | Same as 'takeWhile' but with a monadic predicate.------ @since 0.4.0-{-# INLINE takeWhileM #-}-takeWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a-takeWhileM p m = fromStreamD $ D.takeWhileM p $ toStreamD m---- | Discard first 'n' elements from the stream and take the rest.------ @since 0.1.0-{-# INLINE drop #-}-drop :: (IsStream t, Monad m) => Int -> t m a -> t m a-drop n m = fromStreamS $ S.drop n $ toStreamS m---- | Drop elements in the stream as long as the predicate succeeds and then--- take the rest of the stream.------ @since 0.1.0-{-# INLINE dropWhile #-}-dropWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a-dropWhile p m = fromStreamS $ S.dropWhile p $ toStreamS m---- | Same as 'dropWhile' but with a monadic predicate.------ @since 0.4.0-{-# INLINE dropWhileM #-}-dropWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a-dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m----------------------------------------------------------------------------------- Transformation by Mapping----------------------------------------------------------------------------------- | Replace each element of the stream with the result of a monadic action--- applied on the element.------ @--- runStream $ S.replicateM 10 (return 1)--- & (serially . S.mapM (\\x -> threadDelay 1000000 >> print x))------ runStream $ S.replicateM 10 (return 1)--- & (asyncly . S.mapM (\\x -> threadDelay 1000000 >> print x))--- @------ /Concurrent (do not use with 'parallely' on infinite streams)/------ @since 0.1.0-{-# INLINE_EARLY mapM #-}-mapM :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m b-mapM = K.mapM--{-# RULES "mapM serial" mapM = mapMSerial #-}-{-# INLINE mapMSerial #-}-mapMSerial :: Monad m => (a -> m b) -> SerialT m a -> SerialT m b-mapMSerial = Serial.mapM---- | Reduce a stream of monadic actions to a stream of the output of those--- actions.------ @--- runStream $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)--- & (serially . S.sequence)------ runStream $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)--- & (asyncly . S.sequence)--- @------ /Concurrent (do not use with 'parallely' on infinite streams)/------ @since 0.1.0-{-# INLINE sequence #-}-sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a-sequence = K.sequence----------------------------------------------------------------------------------- Transformation by Map and Filter----------------------------------------------------------------------------------- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'--- elements, and return a stream of values extracted from 'Just'.------ @since 0.3.0-{-# INLINE mapMaybe #-}-mapMaybe :: (IsStream t, Monad m) => (a -> Maybe b) -> t m a -> t m b-mapMaybe f m = fromStreamS $ S.mapMaybe f $ toStreamS m---- | Like 'mapMaybe' but maps a monadic function.------ /Concurrent (do not use with 'parallely' on infinite streams)/------ @since 0.3.0-{-# INLINE mapMaybeM #-}-mapMaybeM :: (IsStream t, MonadAsync m, Functor (t m))- => (a -> m (Maybe b)) -> t m a -> t m b-mapMaybeM f = fmap fromJust . filter isJust . mapM f----------------------------------------------------------------------------------- Transformation by Reordering----------------------------------------------------------------------------------- XXX to scale this we need to use a slab allocated array backed--- representation for temporary storage.------ | Returns the elements of the stream in reverse order.--- The stream must be finite.------ @since 0.1.1-reverse :: (IsStream t) => t m a -> t m a-reverse m = fromStream $ go K.nil (toStream m)- where- go rev rest = K.Stream $ \st stp sng yld ->- let runIt x = K.unStream x (rstState st) stp sng yld- stop = runIt rev- single a = runIt $ a `K.cons` rev- yieldk a r = runIt $ go (a `K.cons` rev) r- in K.unStream rest (rstState st) stop single yieldk----------------------------------------------------------------------------------- Transformation by Inserting----------------------------------------------------------------------------------- | Generate a stream by performing the monadic action inbetween all elements--- of the given stream.------ @since 0.5.0-{-# INLINE intersperseM #-}-intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a-intersperseM = K.intersperseM----------------------------------------------------------------------------------- Zipping----------------------------------------------------------------------------------- | Zip two streams serially using a monadic zipping function.------ @since 0.4.0-{-# INLINABLE zipWithM #-}-zipWithM :: (IsStream t, Monad m) => (a -> b -> m c) -> t m a -> t m b -> t m c-zipWithM f m1 m2 = fromStreamS $ S.zipWithM f (toStreamS m1) (toStreamS m2)---- | Zip two streams serially using a pure zipping function.------ @since 0.1.0-{-# INLINABLE zipWith #-}-zipWith :: (IsStream t, Monad m) => (a -> b -> c) -> t m a -> t m b -> t m c-zipWith f m1 m2 = fromStreamS $ S.zipWith f (toStreamS m1) (toStreamS m2)++#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-orphans #-}+#endif++#include "Streams/inline.hs"++-- |+-- Module : Streamly.Prelude+-- Copyright : (c) 2017 Harendra Kumar+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com+-- Stability : experimental+-- Portability : GHC+--+-- This module is designed to be imported qualified:+--+-- @+-- import qualified Streamly.Prelude as S+-- @+--+-- Functions with the suffix @M@ are general functions that work on monadic+-- arguments. The corresponding functions without the suffix @M@ work on pure+-- arguments and can in general be derived from their monadic versions but are+-- provided for convenience and for consistency with other pure APIs in the+-- @base@ package.+--+-- In many cases, short definitions of the combinators are provided in the+-- documentation for illustration. The actual implementation may differ for+-- performance reasons.+--+-- Functions having a 'MonadAsync' constraint work concurrently when used with+-- appropriate stream type combinator. Please be careful to not use 'parallely'+-- with infinite streams.+--+-- Deconstruction and folds accept a 'SerialT' type instead of a polymorphic+-- type to ensure that streams always have a concrete monomorphic type by+-- default, reducing type errors. In case you want to use any other type of+-- stream you can use one of the type combinators provided in the "Streamly"+-- module to convert the stream type.++module Streamly.Prelude+ (+ -- * Construction+ -- ** Primitives+ -- | Primitives to construct a stream from pure values or monadic actions.+ -- All other stream construction and generation combinators described later+ -- can be expressed in terms of these primitives. However, the special+ -- versions provided in this module can be much more efficient in most+ -- cases. Users can create custom combinators using these primitives.++ K.nil+ , K.cons+ , (K..:)++ , consM+ , (|:)++ -- ** From Values+ -- | Generate a monadic stream from a seed value or values.+ , yield+ , yieldM+ , K.repeat+ , repeatM+ , replicate+ , replicateM++ -- Note: Using enumeration functions e.g. 'Prelude.enumFromThen' turns out+ -- to be slightly faster than the idioms like @[from, then..]@.+ --+ -- ** Enumeration+ -- | We can use the 'Enum' type class to enumerate a type producing a list+ -- and then convert it to a stream:+ --+ -- @+ -- 'fromList' $ 'Prelude.enumFromThen' from then+ -- @+ --+ -- However, this is not particularly efficient.+ -- The 'Enumerable' type class provides corresponding functions that+ -- generate a stream instead of a list, efficiently.++ , Enumerable (..)+ , enumerate+ , enumerateTo++ -- ** From Generators+ -- | Generate a monadic stream from a seed value and a generator function.+ , unfoldr+ , unfoldrM+ , iterate+ , iterateM+ , fromIndices+ , fromIndicesM++ -- ** From Containers+ -- | Convert an input structure, container or source into a stream. All of+ -- these can be expressed in terms of primitives.+ , P.fromList+ , fromListM+ , K.fromFoldable+ , fromFoldableM++ -- ** From External Containers+ , fromHandle++ -- * Elimination++ -- ** Primitives+ -- | It is easy to express all the folds in terms of the 'uncons' primitive,+ -- however the specific implementations provided later are generally more+ -- efficient. Folds are inherently serial as each step needs to use the+ -- result of the previous step.+ , uncons++ -- ** General Folds+-- | Right and left folds.+-- As a simple rule, always use lazy right fold for construction and strict+-- left fold for reduction. By construction we mean using a constructor as the+-- outermost operation in the fold function, by reduction we mean using a+-- function as the outermost operation in the fold function.+--+-- +-----------------------------------+--------------------------------------++-- | Right Fold | Left Fold |+-- +===================================+======================================++-- | Construction consumes input | Construction consumes all input, |+-- | lazily and streams it in FIFO | and constructs in reverse (LIFO) |+-- | order | order |+-- +-----------------------------------+--------------------------------------++-- | Reduction ends up buffering all | Strict reduction works |+-- | input before it can be reduced | incrementally, without buffering. |+-- +-----------------------------------+--------------------------------------++--+-- Almost always, we need lazy construction and strict reduction, therefore,+-- strict @foldr@ and lazy @foldl@ are rarely useful. If needed, strict @foldr@+-- and lazy @foldl@ can be expressed in terms of the available versions. For+-- example, a lazy @foldl@ can be replaced by a strict @foldl@ to reverse the+-- structure followed by a @foldr@.+--+-- The following equations may help understand the relation between the two+-- folds for lists:+--+-- @+-- foldr f z xs = foldl (flip f) z (reverse xs)+-- foldl f z xs = foldr (flip f) z (reverse xs)+-- @+--+-- More generally:+--+-- @+-- foldl f z xs = foldr g id xs z where g x k = k . flip f x+-- foldr f z xs = foldl g id xs z where g k x = k . f x+-- @++ , foldr+ , foldr1+ , foldrM+ , foldl'+ , foldl1'+ , foldlM'+ , foldx+ , foldxM++ -- ** Run Effects+ , runStream+ , runN+ , runWhile++ -- ** To Elements+ -- | Folds that extract selected elements of a stream or their properties.+ , (!!)+ , head+ , last+ , findM+ , find+ , lookup+ , findIndex+ , elemIndex++ -- ** To Parts+ -- | Folds that extract selected parts of a stream.+ , tail+ , init++ -- ** To Boolean+ -- | Folds that summarize the stream to a boolean value.+ , null+ , elem+ , notElem+ , all+ , any+ , and+ , or++ -- ** To Summary+ -- | Folds that summarize the stream to a single value.+ , length+ , sum+ , product++ -- ** To Summary (Maybe)+ -- | Folds that summarize a non-empty stream to a 'Just' value and return+ -- 'Nothing' for an empty stream.+ , maximumBy+ , maximum+ , minimumBy+ , minimum+ , the++ -- ** To Containers+ -- | Convert or divert a stream into an output structure, container or+ -- sink.+ , toList+ , toHandle++ -- * Transformation++ -- ** Scanning+ -- | Scans stream all the intermediate reduction steps of the corresponding+ -- folds. The following equations hold for lists:+ --+ -- > scanl f z xs == map (foldl f z) $ inits xs+ -- > scanr f z xs == map (foldr f z) $ tails+ --+ -- We do not provide a right associative scan, it can be recovered from a+ -- 'scanl'' as follows:+ --+ -- > scanr f z xs == reverse $ scanl' (flip f) z (reverse xs)+ --+ -- Scan is like a stateful map. If we discard the state, we get the map:+ --+ -- > S.drop 1 $ S.scanl' (\_ x -> f x) z xs == map f xs++ -- > S.postscanl' (\_ x -> f x) z xs == map f xs++ , scanl'+ , scanlM'+ -- , postscanl'+ -- , postscanlM'+ -- , prescanl'+ -- , prescanlM'+ , scanl1'+ , scanl1M'+ , scanx++ -- ** Mapping+ -- | Map is a strictly one-to-one transformation of stream elements. It+ -- cannot add or remove elements from the stream, just transforms them.+ , Serial.map++ -- ** Flattening+ , sequence+ , mapM++ -- ** Filtering+ -- | Filtering may remove some elements from the stream.++ , filter+ , filterM+ , take+ , takeWhile+ , takeWhileM+ , drop+ , dropWhile+ , dropWhileM+ , deleteBy+ , uniq++ -- ** Insertion+ -- | Insertion adds more elements to the stream.++ , insertBy+ , intersperseM++ -- ** Reordering+ , reverse++ -- * Hybrid Operations+ -- ** Map and Fold+ , mapM_++ -- ** Map and Filter+ , mapMaybe+ , mapMaybeM++ -- ** Scan and filter+ , findIndices+ , elemIndices++ -- * Multi-Stream Operations+ -- | New streams can be constructed by appending, merging or zipping+ -- existing streams.++ -- ** Appending+ -- | Streams form a 'Semigroup' and a 'Monoid' under the append+ -- operation.+ --+ -- @+ -- >> S.toList $ S.fromList [1,2] \<> S.fromList [3,4]+ -- [1,2,3,4]+ -- >> S.toList $ fold $ [S.fromList [1,2], S.fromList [3,4]]+ -- [1,2,3,4]+ -- @++ -- ** Merging+ -- | Streams form a commutative semigroup under the merge+ -- operation.++ -- , merge+ , mergeBy+ , mergeByM+ , mergeAsyncBy+ , mergeAsyncByM++ -- ** Zipping+ , zipWith+ , zipWithM+ , Z.zipAsyncWith+ , Z.zipAsyncWithM++ -- Special zips+ , indexed+ , indexedR++ -- ** Flattening+ , concatMapM+ , concatMap++ -- ** Folds+ , eqBy+ , cmpBy+ , isPrefixOf+ , isSubsequenceOf+ , stripPrefix++ -- * Deprecated+ , K.once+ , each+ , scan+ , foldl+ , foldlM+ )+where++import Control.Monad.IO.Class (MonadIO(..))+import Data.Maybe (isJust, fromJust)+import Prelude+ hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,+ foldl, mapM, mapM_, sequence, all, any, sum, product, elem,+ notElem, maximum, minimum, head, last, tail, length, null,+ reverse, iterate, init, and, or, lookup, foldr1, (!!),+ scanl, scanl1, replicate, concatMap)++import qualified Prelude+import qualified System.IO as IO++import Streamly.Enumeration (Enumerable(..), enumerate, enumerateTo)+import Streamly.SVar (MonadAsync, defState)+import Streamly.Streams.Async (mkAsync')+import Streamly.Streams.Combinators (maxYields)+import Streamly.Streams.Prelude (fromStreamS, toStreamS)+import Streamly.Streams.StreamD (fromStreamD, toStreamD)+import Streamly.Streams.StreamK (IsStream(..))+import Streamly.Streams.Serial (SerialT)++import qualified Streamly.Streams.Prelude as P+import qualified Streamly.Streams.StreamK as K+import qualified Streamly.Streams.StreamD as D+import qualified Streamly.Streams.Zip as Z++#ifdef USE_STREAMK_ONLY+import qualified Streamly.Streams.StreamK as S+import qualified Streamly.Streams.Zip as S+#else+import qualified Streamly.Streams.StreamD as S+#endif++import qualified Streamly.Streams.Serial as Serial++------------------------------------------------------------------------------+-- Deconstruction+------------------------------------------------------------------------------++-- | Decompose a stream into its head and tail. If the stream is empty, returns+-- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is+-- the head of the stream and @ma@ its tail.+--+-- @since 0.1.0+{-# INLINE uncons #-}+uncons :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (a, t m a))+uncons m = K.uncons (K.adapt m)++------------------------------------------------------------------------------+-- Generation by Unfolding+------------------------------------------------------------------------------++-- |+-- @+-- unfoldr step s =+-- case step s of+-- Nothing -> 'K.nil'+-- Just (a, b) -> a \`cons` unfoldr step b+-- @+--+-- Build a stream by unfolding a /pure/ step function @step@ starting from a+-- seed @s@. The step function returns the next element in the stream and the+-- next seed value. When it is done it returns 'Nothing' and the stream ends.+-- For example,+--+-- @+-- let f b =+-- if b > 3+-- then Nothing+-- else Just (b, b + 1)+-- in toList $ unfoldr f 0+-- @+-- @+-- [0,1,2,3]+-- @+--+-- @since 0.1.0+{-# INLINE_EARLY unfoldr #-}+unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a+unfoldr step seed = fromStreamS (S.unfoldr step seed)+{-# RULES "unfoldr fallback to StreamK" [1]+ forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}++-- | Build a stream by unfolding a /monadic/ step function starting from a+-- seed. The step function returns the next element in the stream and the next+-- seed value. When it is done it returns 'Nothing' and the stream ends. For+-- example,+--+-- @+-- let f b =+-- if b > 3+-- then return Nothing+-- else print b >> return (Just (b, b + 1))+-- in runStream $ unfoldrM f 0+-- @+-- @+-- 0+-- 1+-- 2+-- 3+-- @+-- When run concurrently, the next unfold step can run concurrently with the+-- processing of the output of the previous step. Note that more than one step+-- cannot run concurrently as the next step depends on the output of the+-- previous step.+--+-- @+-- (asyncly $ S.unfoldrM (\\n -> liftIO (threadDelay 1000000) >> return (Just (n, n + 1))) 0)+-- & S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()+-- @+--+-- /Concurrent/+--+-- /Since: 0.1.0/+{-# INLINE_EARLY unfoldrM #-}+unfoldrM :: (IsStream t, MonadAsync m) => (b -> m (Maybe (a, b))) -> b -> t m a+unfoldrM = K.unfoldrM++{-# RULES "unfoldrM serial" unfoldrM = unfoldrMSerial #-}+{-# INLINE_EARLY unfoldrMSerial #-}+unfoldrMSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> SerialT m a+unfoldrMSerial step seed = fromStreamS (S.unfoldrM step seed)++------------------------------------------------------------------------------+-- Specialized Generation+------------------------------------------------------------------------------++-- Faster than yieldM because there is no bind.+--+-- |+-- @+-- yield a = a \`cons` nil+-- @+--+-- Create a singleton stream from a pure value.+--+-- The following holds in monadic streams, but not in Zip streams:+--+-- @+-- yield = pure+-- yield = yieldM . pure+-- @+--+-- In Zip applicative streams 'yield' is not the same as 'pure' because in that+-- case 'pure' is equivalent to 'repeat' instead. 'yield' and 'pure' are+-- equally efficient, in other cases 'yield' may be slightly more efficient+-- than the other equivalent definitions.+--+-- @since 0.4.0+{-# INLINE yield #-}+yield :: IsStream t => a -> t m a+yield = K.yield++-- |+-- @+-- yieldM m = m \`consM` nil+-- @+--+-- Create a singleton stream from a monadic action.+--+-- @+-- > toList $ yieldM getLine+-- hello+-- ["hello"]+-- @+--+-- @since 0.4.0+{-# INLINE yieldM #-}+yieldM :: (Monad m, IsStream t) => m a -> t m a+yieldM = K.yieldM++-- |+-- @+-- fromIndices f = let g i = f i \`cons` g (i + 1) in g 0+-- @+--+-- Generate an infinite stream, whose values are the output of a function @f@+-- applied on the corresponding index. Index starts at 0.+--+-- @+-- > S.toList $ S.take 5 $ S.fromIndices id+-- [0,1,2,3,4]+-- @+--+-- @since 0.6.0+{-# INLINE fromIndices #-}+fromIndices :: (IsStream t, Monad m) => (Int -> a) -> t m a+fromIndices = fromStreamD . D.fromIndices++-- XXX this needs to be concurrent+--+-- |+-- @+-- fromIndicesM f = let g i = f i \`consM` g (i + 1) in g 0+-- @+--+-- Generate an infinite stream, whose values are the output of a monadic+-- function @f@ applied on the corresponding index. Index starts at 0.+--+-- @since 0.6.0+{-# INLINE fromIndicesM #-}+fromIndicesM :: (IsStream t, Monad m) => (Int -> m a) -> t m a+fromIndicesM = fromStreamD . D.fromIndicesM++-- |+-- @+-- replicateM = take n . repeatM+-- @+--+-- Generate a stream by performing a monadic action @n@ times. Same as:+--+-- @+-- runStream $ serially $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)+-- runStream $ asyncly $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)+-- @+--+-- /Concurrent/+--+-- @since 0.1.1+{-# INLINE_EARLY replicateM #-}+replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a+replicateM = K.replicateM++{-# RULES "replicateM serial" replicateM = replicateMSerial #-}+{-# INLINE replicateMSerial #-}+replicateMSerial :: MonadAsync m => Int -> m a -> SerialT m a+replicateMSerial n = fromStreamS . S.replicateM n++-- |+-- @+-- replicate = take n . repeat+-- @+--+-- Generate a stream of length @n@ by repeating a value @n@ times.+--+-- @since 0.6.0+replicate :: (IsStream t, Monad m) => Int -> a -> t m a+replicate n = fromStreamS . S.replicate n++-- |+-- @+-- repeatM = fix . consM+-- repeatM = cycle1 . yieldM+-- @+--+-- Generate a stream by repeatedly executing a monadic action forever.+--+-- @+-- runStream $ serially $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)+-- runStream $ asyncly $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)+-- @+--+-- /Concurrent, infinite (do not use with 'parallely')/+--+-- @since 0.2.0+repeatM :: (IsStream t, MonadAsync m) => m a -> t m a+repeatM = go+ where go m = m |: go m++-- |+-- @+-- iterate f x = x \`cons` iterate f x+-- @+--+-- Generate an infinite stream with @x@ as the first element and each+-- successive element derived by applying the function @f@ on the previous+-- element.+--+-- @+-- > S.toList $ S.take 5 $ S.iterate (+1) 1+-- [1,2,3,4,5]+-- @+--+-- @since 0.1.2+iterate :: IsStream t => (a -> a) -> a -> t m a+iterate step = fromStream . go+ where+ go s = K.cons s (go (step s))++-- |+-- @+-- iterateM f m = m \`consM` iterateM f m+-- @+--+-- Generate an infinite stream with the first element generated by the action+-- @m@ and each successive element derived by applying the monadic function+-- @f@ on the previous element.+--+-- When run concurrently, the next iteration can run concurrently with the+-- processing of the previous iteration. Note that more than one iteration+-- cannot run concurrently as the next iteration depends on the output of the+-- previous iteration.+--+-- @+-- runStream $ serially $ S.take 10 $ S.iterateM+-- (\\x -> threadDelay 1000000 >> print x >> return (x + 1)) 0+--+-- runStream $ asyncly $ S.take 10 $ S.iterateM+-- (\\x -> threadDelay 1000000 >> print x >> return (x + 1)) 0+-- @+--+-- /Concurrent/+--+-- @since 0.1.2+iterateM :: (IsStream t, MonadAsync m) => (a -> m a) -> a -> t m a+iterateM step = go+ where+ go s = K.mkStream $ \st stp sng yld -> do+ next <- step s+ K.foldStreamShared st stp sng yld (return s |: go next)++------------------------------------------------------------------------------+-- Conversions+------------------------------------------------------------------------------++-- |+-- @+-- fromListM = 'Prelude.foldr' 'K.consM' 'K.nil'+-- @+--+-- Construct a stream from a list of monadic actions. This is more efficient+-- than 'fromFoldableM' for serial streams.+--+-- @since 0.4.0+{-# INLINE_EARLY fromListM #-}+fromListM :: (MonadAsync m, IsStream t) => [m a] -> t m a+fromListM = fromStreamD . D.fromListM+{-# RULES "fromListM fallback to StreamK" [1]+ forall a. D.toStreamK (D.fromListM a) = fromFoldableM a #-}++-- |+-- @+-- fromFoldableM = 'Prelude.foldr' 'consM' 'K.nil'+-- @+--+-- Construct a stream from a 'Foldable' containing monadic actions.+--+-- @+-- runStream $ serially $ S.fromFoldableM $ replicateM 10 (threadDelay 1000000 >> print 1)+-- runStream $ asyncly $ S.fromFoldableM $ replicateM 10 (threadDelay 1000000 >> print 1)+-- @+--+-- /Concurrent (do not use with 'parallely' on infinite containers)/+--+-- @since 0.3.0+{-# INLINE fromFoldableM #-}+fromFoldableM :: (IsStream t, MonadAsync m, Foldable f) => f (m a) -> t m a+fromFoldableM = Prelude.foldr consM K.nil++-- | Same as 'fromFoldable'.+--+-- @since 0.1.0+{-# DEPRECATED each "Please use fromFoldable instead." #-}+{-# INLINE each #-}+each :: (IsStream t, Foldable f) => f a -> t m a+each = K.fromFoldable++-- | Read lines from an IO Handle into a stream of Strings.+--+-- @since 0.1.0+fromHandle :: (IsStream t, MonadIO m) => IO.Handle -> t m String+fromHandle h = go+ where+ go = K.mkStream $ \_ yld _ stp -> do+ eof <- liftIO $ IO.hIsEOF h+ if eof+ then stp+ else do+ str <- liftIO $ IO.hGetLine h+ yld str go++------------------------------------------------------------------------------+-- Elimination by Folding+------------------------------------------------------------------------------++-- | Lazy right fold with a monadic step function. For example, to fold a+-- stream into a list:+--+-- @+-- >> S.foldrM (\\x xs -> return (x : xs)) [] $ fromList [1,2,3]+-- [1,2,3]+-- @+--+-- @since 0.2.0+{-# INLINE foldrM #-}+foldrM :: Monad m => (a -> b -> m b) -> b -> SerialT m a -> m b+foldrM = P.foldrM++-- | Lazy right associative fold.+--+-- For lists a @foldr@ looks like:+--+-- @+-- foldr f z [] = z+-- foldr f z (x:xs) = x \`f` foldr f z xs+-- @+--+-- The recursive expression is the second argument of the fold step `f`.+-- Therefore, the evaluation of the recursive call depends on `f`. It can+-- terminate recursion by not inspecting the second argument based on a+-- condition. When expanded fully, it results in the following right associated+-- expression:+--+-- @+-- foldr f z xs == x1 \`f` (x2 \`f` ...(xn \`f` z))+-- @+--+-- When `f` is a constructor, we can see that the first deconstruction of this+-- expression would be @x1@ on the left and the recursive expression on the+-- right. Therefore, we can deconstruct it to access the input elements in the+-- first-in-first-out (FIFO) order and consume the reconstructed structure+-- lazily. The recursive expression on the right gets evaluated incrementall+-- as demanded by the consumer. For example:+--+-- @+-- > S.foldr (:) [] $ S.fromList [1,2,3,4]+-- [1,2,3,4]+-- @+--+-- When `f` is a function strict in its second argument, the right side of the+-- expression gets evaluated as follows:+--+-- @+-- foldr f z xs == x1 \`f` tail1+-- tail1 == x2 \`f` tail2+-- tail2 == x3 \`f` tail3+-- ...+-- tailn == xn \`f` z+-- @+--+-- In @foldl'@ we have both the arguments of `f` available at each step,+-- therefore, each step can be reduced immediately. However, in @foldr@ the+-- second argument to `f` is a recursive call, therefore, it ends up building+-- the whole expression in memory before it can be reduced, consuming the whole+-- input. This makes @foldr@ much less efficient for reduction compared to+-- @foldl'@. For example:+--+-- @+-- > S.foldr (+) 0 $ S.fromList [1,2,3,4]+-- 10+-- @+--+-- When the underlying monad @m@ is strict (e.g. IO), then @foldr@ ends up+-- evaluating all of its input because of strict evaluation of the recursive+-- call:+--+-- >> S.foldr (\_ _ -> []) [] $ S.fromList (1:undefined)+-- >*** Exception: Prelude.undefined+--+-- In a lazy monad, we can consume the input lazily, and terminate the fold+-- by conditionally not inspecting the recursive expression.+--+-- >> runIdentity $ S.foldr (\x rest -> if x == 3 then [] else x : rest) [] $ S.fromList (4:1:3:undefined)+-- >[4,1]+--+-- The arguments to the folding function (@a -> b -> b@) are in the head and+-- tail order of the output, @a@ is the head and @b@ is the tail. Remember, in+-- a right fold the zero is on the right, it is the tail end.+--+-- @since 0.1.0+{-# INLINE foldr #-}+foldr :: Monad m => (a -> b -> b) -> b -> SerialT m a -> m b+foldr = P.foldr++-- XXX This seems to be of limited use as it cannot be used to construct+-- recursive structures and for reduction foldl1' is better.+--+-- | Lazy right fold for non-empty streams, using first element as the starting+-- value. Returns 'Nothing' if the stream is empty.+--+-- @since 0.5.0+{-# INLINE foldr1 #-}+foldr1 :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)+foldr1 f m = S.foldr1 f (toStreamS m)++-- | Strict left fold with an extraction function. Like the standard strict+-- left fold, but applies a user supplied extraction function (the third+-- argument) to the folded value at the end. This is designed to work with the+-- @foldl@ library. The suffix @x@ is a mnemonic for extraction.+--+-- @since 0.2.0+{-# INLINE foldx #-}+foldx :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b+foldx = K.foldx++-- |+-- @since 0.1.0+{-# DEPRECATED foldl "Please use foldx instead." #-}+foldl :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b+foldl = foldx++-- | Strict left associative fold.+--+-- For lists a @foldl@ looks like:+--+-- @+-- foldl f z [] = z+-- foldl f z (x:xs) = foldl f (z \`f` x) xs+-- @+--+-- The recursive call at the head of the output expression is bound to be+-- evaluated until recursion terminates,+-- /deconstructing the whole input container/ and building the following left+-- associated expression:+--+-- @+-- foldl f z xs == (((z \`f` x1) \`f` x2) ...) \`f` xn+-- @+--+-- When `f` is a constructor, we can see that the first deconstruction of this+-- expression would be the recursive expression on the left and `xn` on the+-- right. Therefore, it can access the input elements only in the reverse+-- (LIFO) order. For example:+--+-- @+-- > S.foldl' (flip (:)) [] $ S.fromList [1,2,3,4]+-- [4,3,2,1]+-- @+--+-- The strict left fold @foldl'@ forces the reduction of its argument @z \`f`+-- x@ before using it, therefore it never builds the whole expression in+-- memory. Thus, @z \`f` x1@ would get reduced to @z1@ and then @z1 \`f` x2@+-- would get reduced to @z2@ and so on, incrementally reducing the expression+-- as it recurses. However, it evaluates the accumulator only to WHNF, it may+-- further help to use a strict data structure as accumulator. For example:+--+-- @+-- > S.foldl' (+) 0 $ S.fromList [1,2,3,4]+-- 10+-- @+--+-- @+-- 0 + 1+-- (0 + 1) + 2+-- ((0 + 1) + 2) + 3+-- (((0 + 1) + 2) + 3) + 4+-- @+--+-- @foldl@ strictly deconstructs the whole input container irrespective of+-- whether it needs it or not:+--+-- >> S.foldl' (\acc x -> if x == 3 then acc else x : acc) [] $ S.fromList (4:1:3:undefined)+-- >*** Exception: Prelude.undefined+--+-- However, evaluation of the items contained in the input container is lazy as+-- demanded by the fold step function:+--+-- >> S.foldl' (\acc x -> if x == 3 then acc else x : acc) [] $ S.fromList [4,1,3,undefined]+-- >[4,1]+--+-- To perform a left fold without consuming all the input one can use @scanl@+-- to stream the intermediate results of the fold and use them lazily.+--+-- In stateful or event-driven programming, we can consider @z@ as the initial+-- state and the stream being folded as a stream of events, thus @foldl'@+-- processes all the events in the stream updating the state on each event and+-- then ultimately returning the final state.+--+-- The arguments to the folding function (@b -> a -> b@) are in the head and+-- tail order of the output expression, @b@ is the head and @a@ is the tail.+-- Remember, in a left fold the zero is on the left, at the head of the+-- expression.+--+-- @since 0.2.0+{-# INLINE foldl' #-}+foldl' :: Monad m => (b -> a -> b) -> b -> SerialT m a -> m b+foldl' = P.foldl'++-- | Strict left fold, for non-empty streams, using first element as the+-- starting value. Returns 'Nothing' if the stream is empty.+--+-- @since 0.5.0+{-# INLINE foldl1' #-}+foldl1' :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)+foldl1' step m = do+ r <- uncons m+ case r of+ Nothing -> return Nothing+ Just (h, t) -> do+ res <- foldl' step h t+ return $ Just res++-- | Like 'foldx', but with a monadic step function.+--+-- @since 0.2.0+{-# INLINE foldxM #-}+foldxM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b+foldxM = K.foldxM++-- |+-- @since 0.1.0+{-# DEPRECATED foldlM "Please use foldxM instead." #-}+foldlM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b+foldlM = foldxM++-- | Like 'foldl'' but with a monadic step function.+--+-- @since 0.2.0+{-# INLINE foldlM' #-}+foldlM' :: Monad m => (b -> a -> m b) -> b -> SerialT m a -> m b+foldlM' step begin m = S.foldlM' step begin $ toStreamS m++------------------------------------------------------------------------------+-- Specialized folds+------------------------------------------------------------------------------++-- | Run a stream, discarding the results. By default it interprets the stream+-- as 'SerialT', to run other types of streams use the type adapting+-- combinators for example @runStream . 'asyncly'@.+--+-- @since 0.2.0+{-# INLINE runStream #-}+runStream :: Monad m => SerialT m a -> m ()+runStream = P.runStream++-- |+-- > runN n = runStream . take n+--+-- Run maximum up to @n@ iterations of a stream.+--+-- @since 0.6.0+{-# INLINE runN #-}+runN :: Monad m => Int -> SerialT m a -> m ()+runN n = runStream . take n++-- |+-- > runWhile p = runStream . takeWhile p+--+-- Run a stream as long as the predicate holds true.+--+-- @since 0.6.0+{-# INLINE runWhile #-}+runWhile :: Monad m => (a -> Bool) -> SerialT m a -> m ()+runWhile p = runStream . takeWhile p++-- | Determine whether the stream is empty.+--+-- @since 0.1.1+{-# INLINE null #-}+null :: Monad m => SerialT m a -> m Bool+null = K.null++-- | Extract the first element of the stream, if any.+--+-- > head = (!! 0)+--+-- @since 0.1.0+{-# INLINE head #-}+head :: Monad m => SerialT m a -> m (Maybe a)+head = K.head++-- | Extract all but the first element of the stream, if any.+--+-- @since 0.1.1+{-# INLINE tail #-}+tail :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))+tail m = K.tail (K.adapt m)++-- | Extract all but the last element of the stream, if any.+--+-- @since 0.5.0+{-# INLINE init #-}+init :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))+init m = K.init (K.adapt m)++-- | Extract the last element of the stream, if any.+--+-- > last xs = xs !! (length xs - 1)+--+-- @since 0.1.1+{-# INLINE last #-}+last :: Monad m => SerialT m a -> m (Maybe a)+last m = S.last $ toStreamS m++-- | Determine whether an element is present in the stream.+--+-- @since 0.1.0+{-# INLINE elem #-}+elem :: (Monad m, Eq a) => a -> SerialT m a -> m Bool+elem e m = S.elem e (toStreamS m)++-- | Determine whether an element is not present in the stream.+--+-- @since 0.1.0+{-# INLINE notElem #-}+notElem :: (Monad m, Eq a) => a -> SerialT m a -> m Bool+notElem e m = S.notElem e (toStreamS m)++-- | Determine the length of the stream.+--+-- @since 0.1.0+{-# INLINE length #-}+length :: Monad m => SerialT m a -> m Int+length = foldl' (\n _ -> n + 1) 0++-- | Determine whether all elements of a stream satisfy a predicate.+--+-- @since 0.1.0+{-# INLINE all #-}+all :: Monad m => (a -> Bool) -> SerialT m a -> m Bool+all p m = S.all p (toStreamS m)++-- | Determine whether any of the elements of a stream satisfy a predicate.+--+-- @since 0.1.0+{-# INLINE any #-}+any :: Monad m => (a -> Bool) -> SerialT m a -> m Bool+any p m = S.any p (toStreamS m)++-- | Determines if all elements of a boolean stream are True.+--+-- @since 0.5.0+{-# INLINE and #-}+and :: Monad m => SerialT m Bool -> m Bool+and = all (==True)++-- | Determines whether at least one element of a boolean stream is True.+--+-- @since 0.5.0+{-# INLINE or #-}+or :: Monad m => SerialT m Bool -> m Bool+or = any (==True)++-- | Determine the sum of all elements of a stream of numbers. Returns @0@ when+-- the stream is empty. Note that this is not numerically stable for floating+-- point numbers.+--+-- @since 0.1.0+{-# INLINE sum #-}+sum :: (Monad m, Num a) => SerialT m a -> m a+sum = foldl' (+) 0++-- | Determine the product of all elements of a stream of numbers. Returns @1@+-- when the stream is empty.+--+-- @since 0.1.1+{-# INLINE product #-}+product :: (Monad m, Num a) => SerialT m a -> m a+product = foldl' (*) 1++-- |+-- @+-- minimum = 'minimumBy' compare+-- @+--+-- Determine the minimum element in a stream.+--+-- @since 0.1.0+{-# INLINE minimum #-}+minimum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)+minimum m = S.minimum (toStreamS m)++-- | Determine the minimum element in a stream using the supplied comparison+-- function.+--+-- @since 0.6.0+{-# INLINE minimumBy #-}+minimumBy :: Monad m => (a -> a -> Ordering) -> SerialT m a -> m (Maybe a)+minimumBy cmp m = S.minimumBy cmp (toStreamS m)++-- |+-- @+-- maximum = 'maximumBy' compare+-- @+--+-- Determine the maximum element in a stream.+--+-- @since 0.1.0+{-# INLINE maximum #-}+maximum :: (Monad m, Ord a) => SerialT m a -> m (Maybe a)+maximum m = S.maximum (toStreamS m)++-- | Determine the maximum element in a stream using the supplied comparison+-- function.+--+-- @since 0.6.0+{-# INLINE maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> SerialT m a -> m (Maybe a)+maximumBy cmp m = S.maximumBy cmp (toStreamS m)++-- | Lookup the element at the given index.+--+-- @since 0.6.0+{-# INLINE (!!) #-}+(!!) :: Monad m => SerialT m a -> Int -> m (Maybe a)+m !! i = toStreamS m S.!! i++-- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the+-- first pair where the key equals the given value @a@.+--+-- > lookup = snd <$> find ((==) . fst)+--+-- @since 0.5.0+{-# INLINE lookup #-}+lookup :: (Monad m, Eq a) => a -> SerialT m (a, b) -> m (Maybe b)+lookup a m = S.lookup a (toStreamS m)++-- | Like 'findM' but with a non-monadic predicate.+--+-- > find p = findM (return . p)+--+-- @since 0.5.0+{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe a)+find p m = S.find p (toStreamS m)++-- | Returns the first element that satisfies the given predicate.+--+-- @since 0.6.0+{-# INLINE findM #-}+findM :: Monad m => (a -> m Bool) -> SerialT m a -> m (Maybe a)+findM p m = S.findM p (toStreamS m)++-- | Find all the indices where the element in the stream satisfies the given+-- predicate.+--+-- @since 0.5.0+{-# INLINE findIndices #-}+findIndices :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m Int+findIndices p m = fromStreamS $ S.findIndices p (toStreamS m)++-- | Returns the first index that satisfies the given predicate.+--+-- @since 0.5.0+{-# INLINE findIndex #-}+findIndex :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe Int)+findIndex p = head . findIndices p++-- | Find all the indices where the value of the element in the stream is equal+-- to the given value.+--+-- @since 0.5.0+{-# INLINE elemIndices #-}+elemIndices :: (IsStream t, Eq a, Monad m) => a -> t m a -> t m Int+elemIndices a = findIndices (==a)++-- | Returns the first index where a given value is found in the stream.+--+-- > elemIndex a = findIndex (== a)+--+-- @since 0.5.0+{-# INLINE elemIndex #-}+elemIndex :: (Monad m, Eq a) => a -> SerialT m a -> m (Maybe Int)+elemIndex a = findIndex (== a)++-- | Map each element to a stream and then flatten the results into a single+-- stream.+--+-- > concatMap f = concatMapM (return . f)+--+-- @since 0.6.0+{-# INLINE concatMap #-}+concatMap ::(IsStream t, Monad m) => (a -> t m b) -> t m a -> t m b+concatMap f m = fromStreamD $ D.concatMap (toStreamD . f) (toStreamD m)++-- | Map each element to a stream using a monadic function and then flatten the+-- results into a single stream.+--+-- @since 0.6.0+{-# INLINE concatMapM #-}+concatMapM :: (IsStream t, Monad m) => (a -> m (t m b)) -> t m a -> t m b+concatMapM f m = fromStreamD $ D.concatMapM (fmap toStreamD . f) (toStreamD m)++------------------------------------------------------------------------------+-- Substreams+------------------------------------------------------------------------------++-- | Returns 'True' if the first stream is the same as or a prefix of the+-- second.+--+-- @+-- > S.isPrefixOf (S.fromList "hello") (S.fromList "hello" :: SerialT IO Char)+-- True+-- @+--+-- @since 0.6.0+{-# INLINE isPrefixOf #-}+isPrefixOf :: (Eq a, IsStream t, Monad m) => t m a -> t m a -> m Bool+isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)++-- | Returns 'True' if all the elements of the first stream occur, in order, in+-- the second stream. The elements do not have to occur consecutively. A stream+-- is treated as a subsequence of itself.+--+-- @+-- > S.isSubsequenceOf (S.fromList "hlo") (S.fromList "hello" :: SerialT IO Char)+-- True+-- @+--+-- @since 0.6.0+{-# INLINE isSubsequenceOf #-}+isSubsequenceOf :: (Eq a, IsStream t, Monad m) => t m a -> t m a -> m Bool+isSubsequenceOf m1 m2 = D.isSubsequenceOf (toStreamD m1) (toStreamD m2)++-- | Drops the given prefix from a stream. Returns 'Nothing' if the stream does+-- not start with the given prefix. Returns @Just nil@ when the prefix is the+-- same as the stream.+--+-- @since 0.6.0+{-# INLINE stripPrefix #-}+stripPrefix+ :: (Eq a, IsStream t, Monad m)+ => t m a -> t m a -> m (Maybe (t m a))+stripPrefix m1 m2 = fmap fromStreamD <$>+ D.stripPrefix (toStreamD m1) (toStreamD m2)++------------------------------------------------------------------------------+-- Map and Fold+------------------------------------------------------------------------------++-- XXX this can utilize parallel mapping if we implement it as runStream . mapM+-- | Apply a monadic action to each element of the stream and discard the+-- output of the action.+--+-- @since 0.1.0+{-# INLINE mapM_ #-}+mapM_ :: Monad m => (a -> m b) -> SerialT m a -> m ()+mapM_ f m = S.mapM_ f $ toStreamS m++------------------------------------------------------------------------------+-- Conversions+------------------------------------------------------------------------------++-- |+-- @+-- toList = S.foldr (:) []+-- @+--+-- Convert a stream into a list in the underlying monad. Same as:+--+-- @since 0.1.0+{-# INLINE toList #-}+toList :: Monad m => SerialT m a -> m [a]+toList = P.toList++-- |+-- @+-- toHandle h = S.mapM_ $ hPutStrLn h+-- @+--+-- Write a stream of Strings to an IO Handle.+--+-- @since 0.1.0+toHandle :: MonadIO m => IO.Handle -> SerialT m String -> m ()+toHandle h m = go m+ where+ go m1 =+ let stop = return ()+ single a = liftIO (IO.hPutStrLn h a)+ yieldk a r = liftIO (IO.hPutStrLn h a) >> go r+ in K.foldStream defState yieldk single stop m1++------------------------------------------------------------------------------+-- Transformation by Folding (Scans)+------------------------------------------------------------------------------++-- | Strict left scan with an extraction function. Like 'scanl'', but applies a+-- user supplied extraction function (the third argument) at each step. This is+-- designed to work with the @foldl@ library. The suffix @x@ is a mnemonic for+-- extraction.+--+-- @since 0.2.0+{-# INLINE scanx #-}+scanx :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b+scanx = K.scanx++-- |+-- @since 0.1.1+{-# DEPRECATED scan "Please use scanx instead." #-}+scan :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b+scan = scanx++-- XXX this needs to be concurrent+-- | Like 'scanl'' but with a monadic fold function.+--+-- @since 0.4.0+{-# INLINE scanlM' #-}+scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b+scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m++-- | Strict left scan.+--+-- @+-- > S.toList $ S.scanl' (+) 0 $ fromList [1,2,3,4]+-- [0,1,3,6,10]+-- @+--+-- @+-- > S.toList $ S.scanl' (flip (:)) [] $ S.fromList [1,2,3,4]+-- [[],[1],[2,1],[3,2,1],[4,3,2,1]]+-- @+--+-- The output of 'scanl'' is the initial value of the accumulator followed by+-- all the intermediate steps and the final result of 'foldl''.+--+-- By streaming the accumulated state after each fold step, we can share the+-- state across multiple stages of stream composition. Each stage can modify or+-- extend the state, do some processing with it and emit it for the next stage,+-- thus modularizing the stream processing. This can be useful in+-- stateful or event-driven programming.+--+-- Consider the following example, computing the sum and the product of the+-- elements in a stream in one go using a @foldl'@:+--+-- @+-- > S.foldl' (\\(s, p) x -> (s + x, p * x)) (0,1) $ S.fromList \[1,2,3,4]+-- (10,24)+-- @+--+-- Using @scanl'@ we can compute the sum in the first stage and pass it down to+-- the next stage for computing the product:+--+-- @+-- > S.foldl' (\\(_, p) (s, x) -> (s, p * x)) (0,1)+-- $ S.scanl' (\\(s, _) x -> (s + x, x)) (0,1)+-- $ S.fromList \[1,2,3,4]+-- (10,24)+-- @+--+-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF. To avoid building+-- lazy expressions inside the accumulator, it is recommended that a strict+-- data structure is used for accumulator.+--+-- @since 0.2.0+{-# INLINE scanl' #-}+scanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b+scanl' step z m = fromStreamS $ S.scanl' step z $ toStreamS m++-- XXX enable once the signature (monadic zero) change is settled+-- | Like scanl' but does not stream the initial value of the accumulator.+--+-- > postscanl' f z xs = S.drop 1 $ scanl' f z xs+--+-- @since 0.6.0+{-# INLINE _postscanl' #-}+_postscanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b+_postscanl' step z m = fromStreamD $ D.postscanl' step z $ toStreamD m++-- XXX this needs to be concurrent+-- | Like postscanl' but with a monadic step function.+--+-- @since 0.6.0+{-# INLINE _postscanlM' #-}+_postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b+_postscanlM' step z m = fromStreamD $ D.postscanlM' step z $ toStreamD m++-- XXX prescanl does not sound very useful, enable only if there is a+-- compelling use case.+--+-- | Like scanl' but does not stream the final value of the accumulator.+--+-- @since 0.6.0+{-# INLINE _prescanl' #-}+_prescanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b+_prescanl' step z m = fromStreamD $ D.prescanl' step z $ toStreamD m++-- XXX this needs to be concurrent+-- | Like postscanl' but with a monadic step function.+--+-- @since 0.6.0+{-# INLINE _prescanlM' #-}+_prescanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b+_prescanlM' step z m = fromStreamD $ D.prescanlM' step z $ toStreamD m++-- XXX this needs to be concurrent+-- | Like 'scanl1'' but with a monadic step function.+--+-- @since 0.6.0+{-# INLINE scanl1M' #-}+scanl1M' :: (IsStream t, Monad m) => (a -> a -> m a) -> t m a -> t m a+scanl1M' step m = fromStreamD $ D.scanl1M' step $ toStreamD m++-- | Like 'scanl'' but for a non-empty stream. The first element of the stream+-- is used as the initial value of the accumulator. Does nothing if the stream+-- is empty.+--+-- @+-- > S.toList $ S.scanl1 (+) $ fromList [1,2,3,4]+-- [1,3,6,10]+-- @+--+-- @since 0.6.0+{-# INLINE scanl1' #-}+scanl1' :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> t m a+scanl1' step m = fromStreamD $ D.scanl1' step $ toStreamD m++------------------------------------------------------------------------------+-- Transformation by Filtering+------------------------------------------------------------------------------++-- | Include only those elements that pass a predicate.+--+-- @since 0.1.0+{-# INLINE filter #-}+#if __GLASGOW_HASKELL__ != 802+-- GHC 8.2.2 crashes with this code, when used with "stack"+filter :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a+filter p m = fromStreamS $ S.filter p $ toStreamS m+#else+filter :: IsStream t => (a -> Bool) -> t m a -> t m a+filter = K.filter+#endif++-- | Same as 'filter' but with a monadic predicate.+--+-- @since 0.4.0+{-# INLINE filterM #-}+filterM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a+filterM p m = fromStreamD $ D.filterM p $ toStreamD m++-- | Drop repeated elements that are adjacent to each other.+--+-- @since 0.6.0+{-# INLINE uniq #-}+uniq :: (Eq a, IsStream t, Monad m) => t m a -> t m a+uniq = fromStreamD . D.uniq . toStreamD++-- | Ensures that all the elements of the stream are identical and then returns+-- that unique element.+--+-- @since 0.6.0+{-# INLINE the #-}+the :: (Eq a, Monad m) => SerialT m a -> m (Maybe a)+the m = S.the (toStreamS m)++-- | Take first 'n' elements from the stream and discard the rest.+--+-- @since 0.1.0+{-# INLINE take #-}+take :: (IsStream t, Monad m) => Int -> t m a -> t m a+take n m = fromStreamS $ S.take n $ toStreamS+ (maxYields (Just (fromIntegral n)) m)++-- | End the stream as soon as the predicate fails on an element.+--+-- @since 0.1.0+{-# INLINE takeWhile #-}+takeWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a+takeWhile p m = fromStreamS $ S.takeWhile p $ toStreamS m++-- | Same as 'takeWhile' but with a monadic predicate.+--+-- @since 0.4.0+{-# INLINE takeWhileM #-}+takeWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a+takeWhileM p m = fromStreamD $ D.takeWhileM p $ toStreamD m++-- | Discard first 'n' elements from the stream and take the rest.+--+-- @since 0.1.0+{-# INLINE drop #-}+drop :: (IsStream t, Monad m) => Int -> t m a -> t m a+drop n m = fromStreamS $ S.drop n $ toStreamS m++-- | Drop elements in the stream as long as the predicate succeeds and then+-- take the rest of the stream.+--+-- @since 0.1.0+{-# INLINE dropWhile #-}+dropWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a+dropWhile p m = fromStreamS $ S.dropWhile p $ toStreamS m++-- | Same as 'dropWhile' but with a monadic predicate.+--+-- @since 0.4.0+{-# INLINE dropWhileM #-}+dropWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a+dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m++------------------------------------------------------------------------------+-- Transformation by Mapping+------------------------------------------------------------------------------++-- |+-- @+-- mapM f = sequence . map f+-- @+--+-- Apply a monadic function to each element of the stream and replace it with+-- the output of the resulting action.+--+-- @+-- > runStream $ S.mapM putStr $ S.fromList ["a", "b", "c"]+-- abc+--+-- runStream $ S.replicateM 10 (return 1)+-- & (serially . S.mapM (\\x -> threadDelay 1000000 >> print x))+--+-- runStream $ S.replicateM 10 (return 1)+-- & (asyncly . S.mapM (\\x -> threadDelay 1000000 >> print x))+-- @+--+-- /Concurrent (do not use with 'parallely' on infinite streams)/+--+-- @since 0.1.0+{-# INLINE_EARLY mapM #-}+mapM :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m b+mapM = K.mapM++{-# RULES "mapM serial" mapM = mapMSerial #-}+{-# INLINE mapMSerial #-}+mapMSerial :: Monad m => (a -> m b) -> SerialT m a -> SerialT m b+mapMSerial = Serial.mapM++-- |+-- @+-- sequence = mapM id+-- @+--+-- Replace the elements of a stream of monadic actions with the outputs of+-- those actions.+--+-- @+-- > runStream $ S.sequence $ S.fromList [putStr "a", putStr "b", putStrLn "c"]+-- abc+--+-- runStream $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)+-- & (serially . S.sequence)+--+-- runStream $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)+-- & (asyncly . S.sequence)+-- @+--+-- /Concurrent (do not use with 'parallely' on infinite streams)/+--+-- @since 0.1.0+{-# INLINE sequence #-}+sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a+sequence m = fromStreamS $ S.sequence (toStreamS m)++------------------------------------------------------------------------------+-- Transformation by Map and Filter+------------------------------------------------------------------------------++-- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'+-- elements, and return a stream of values extracted from 'Just'.+--+-- @since 0.3.0+{-# INLINE mapMaybe #-}+mapMaybe :: (IsStream t, Monad m) => (a -> Maybe b) -> t m a -> t m b+mapMaybe f m = fromStreamS $ S.mapMaybe f $ toStreamS m++-- | Like 'mapMaybe' but maps a monadic function.+--+-- /Concurrent (do not use with 'parallely' on infinite streams)/+--+-- @since 0.3.0+{-# INLINE_EARLY mapMaybeM #-}+mapMaybeM :: (IsStream t, MonadAsync m, Functor (t m))+ => (a -> m (Maybe b)) -> t m a -> t m b+mapMaybeM f = fmap fromJust . filter isJust . K.mapM f++{-# RULES "mapMaybeM serial" mapMaybeM = mapMaybeMSerial #-}+{-# INLINE mapMaybeMSerial #-}+mapMaybeMSerial :: Monad m => (a -> m (Maybe b)) -> SerialT m a -> SerialT m b+mapMaybeMSerial f m = fromStreamD $ D.mapMaybeM f $ toStreamD m++------------------------------------------------------------------------------+-- Transformation by Reordering+------------------------------------------------------------------------------++-- XXX to scale this we need to use a slab allocated array backed+-- representation for temporary storage.+--+-- | Returns the elements of the stream in reverse order.+-- The stream must be finite.+--+-- @since 0.1.1+reverse :: (IsStream t) => t m a -> t m a+reverse m = go K.nil m+ where+ go rev rest = K.mkStream $ \st yld sng stp ->+ let runIt x = K.foldStream st yld sng stp x+ stop = runIt rev+ single a = runIt $ a `K.cons` rev+ yieldk a r = runIt $ go (a `K.cons` rev) r+ in K.foldStream st yieldk single stop rest++------------------------------------------------------------------------------+-- Transformation by Inserting+------------------------------------------------------------------------------++-- | Generate a stream by performing a monadic action between consecutive+-- elements of the given stream.+--+-- /Concurrent (do not use with 'parallely' on infinite streams)/+--+-- @+-- > S.toList $ S.intersperseM (putChar \'a' >> return ',') $ S.fromList "hello"+-- aaaa"h,e,l,l,o"+-- @+--+-- @since 0.5.0+{-# INLINE intersperseM #-}+intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a+intersperseM = K.intersperseM++-- | @insertBy cmp elem stream@ inserts @elem@ before the first element in+-- @stream@ that is less than @elem@ when compared using @cmp@.+--+-- @+-- insertBy cmp x = 'mergeBy' cmp ('yield' x)+-- @+--+-- @+-- > S.toList $ S.insertBy compare 2 $ S.fromList [1,3,5]+-- [1,2,3,5]+-- @+--+-- @since 0.6.0+{-# INLINE insertBy #-}+insertBy ::+ (IsStream t, Monad m) => (a -> a -> Ordering) -> a -> t m a -> t m a+insertBy cmp x m = fromStreamS $ S.insertBy cmp x (toStreamS m)++------------------------------------------------------------------------------+-- Deleting+------------------------------------------------------------------------------++-- | Deletes the first occurence of the element in the stream that satisfies+-- the given equality predicate.+--+-- @+-- > S.toList $ S.deleteBy (==) 3 $ S.fromList [1,3,3,5]+-- [1,3,5]+-- @+--+-- @since 0.6.0+{-# INLINE deleteBy #-}+deleteBy :: (IsStream t, Monad m) => (a -> a -> Bool) -> a -> t m a -> t m a+deleteBy cmp x m = fromStreamS $ S.deleteBy cmp x (toStreamS m)++------------------------------------------------------------------------------+-- Zipping+------------------------------------------------------------------------------++-- |+-- > indexed = S.zipWith (,) (S.intFrom 0)+--+-- Pair each element in a stream with its index.+--+-- @+-- > S.toList $ S.indexed $ S.fromList "hello"+-- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]+-- @+--+-- @since 0.6.0+{-# INLINE indexed #-}+indexed :: (IsStream t, Monad m) => t m a -> t m (Int, a)+indexed = fromStreamD . D.indexed . toStreamD++-- |+-- > indexedR n = S.zipWith (,) (S.intFromThen n (n - 1))+--+-- Pair each element in a stream with its index, starting from the+-- given index @n@ and counting down.+--+-- @+-- > S.toList $ S.indexedR 10 $ S.fromList "hello"+-- [(9,'h'),(8,'e'),(7,'l'),(6,'l'),(5,'o')]+-- @+--+-- @since 0.6.0+{-# INLINE indexedR #-}+indexedR :: (IsStream t, Monad m) => Int -> t m a -> t m (Int, a)+indexedR n = fromStreamD . D.indexedR n . toStreamD++-- | Like 'zipWith' but using a monadic zipping function.+--+-- @since 0.4.0+{-# INLINABLE zipWithM #-}+zipWithM :: (IsStream t, Monad m) => (a -> b -> m c) -> t m a -> t m b -> t m c+zipWithM f m1 m2 = fromStreamS $ S.zipWithM f (toStreamS m1) (toStreamS m2)++-- | Zip two streams serially using a pure zipping function.+--+-- @+-- > S.toList $ S.zipWith (+) (S.fromList [1,2,3]) (S.fromList [4,5,6])+-- [5,7,9]+-- @+--+-- @since 0.1.0+{-# INLINABLE zipWith #-}+zipWith :: (IsStream t, Monad m) => (a -> b -> c) -> t m a -> t m b -> t m c+zipWith f m1 m2 = fromStreamS $ S.zipWith f (toStreamS m1) (toStreamS m2)++------------------------------------------------------------------------------+-- Comparison+------------------------------------------------------------------------------++-- | Compare two streams for equality using an equality function.+--+-- @since 0.6.0+{-# INLINABLE eqBy #-}+eqBy :: (IsStream t, Monad m) => (a -> b -> Bool) -> t m a -> t m b -> m Bool+eqBy = P.eqBy++-- | Compare two streams lexicographically using a comparison function.+--+-- @since 0.6.0+{-# INLINABLE cmpBy #-}+cmpBy+ :: (IsStream t, Monad m)+ => (a -> b -> Ordering) -> t m a -> t m b -> m Ordering+cmpBy = P.cmpBy++------------------------------------------------------------------------------+-- Merge+------------------------------------------------------------------------------++-- | Merge two streams using a comparison function. The head elements of both+-- the streams are compared and the smaller of the two elements is emitted, if+-- both elements are equal then the element from the first stream is used+-- first.+--+-- If the streams are sorted in ascending order, the resulting stream would+-- also remain sorted in ascending order.+--+-- @+-- > S.toList $ S.mergeBy compare (S.fromList [1,3,5]) (S.fromList [2,4,6,8])+-- [1,2,3,4,5,6,8]+-- @+--+-- @since 0.6.0+{-# INLINABLE mergeBy #-}+mergeBy ::+ (IsStream t, Monad m) => (a -> a -> Ordering) -> t m a -> t m a -> t m a+mergeBy f m1 m2 = fromStreamS $ S.mergeBy f (toStreamS m1) (toStreamS m2)++-- | Like 'mergeBy' but with a monadic comparison function.+--+-- Merge two streams randomly:+--+-- @+-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT+-- > S.toList $ S.mergeByM randomly (S.fromList [1,1,1,1]) (S.fromList [2,2,2,2])+-- [2,1,2,2,2,1,1,1]+-- @+--+-- Merge two streams in a proportion of 2:1:+--+-- @+-- proportionately m n = do+-- ref <- newIORef $ cycle $ concat [replicate m LT, replicate n GT]+-- return $ \\_ _ -> do+-- r <- readIORef ref+-- writeIORef ref $ tail r+-- return $ head r+--+-- main = do+-- f <- proportionately 2 1+-- xs <- S.toList $ S.mergeByM f (S.fromList [1,1,1,1,1,1]) (S.fromList [2,2,2])+-- print xs+-- @+-- @+-- [1,1,2,1,1,2,1,1,2]+-- @+--+-- @since 0.6.0+{-# INLINABLE mergeByM #-}+mergeByM+ :: (IsStream t, Monad m)+ => (a -> a -> m Ordering) -> t m a -> t m a -> t m a+mergeByM f m1 m2 = fromStreamS $ S.mergeByM f (toStreamS m1) (toStreamS m2)++-- Holding this back for now, we may want to use the name "merge" differently+{-+-- | Same as @'mergeBy' 'compare'@.+--+-- @+-- > S.toList $ S.merge (S.fromList [1,3,5]) (S.fromList [2,4,6,8])+-- [1,2,3,4,5,6,8]+-- @+--+-- @since 0.6.0+{-# INLINABLE merge #-}+merge ::+ (IsStream t, Monad m, Ord a) => t m a -> t m a -> t m a+merge = mergeBy compare+-}++-- | Like 'mergeBy' but merges concurrently (i.e. both the elements being+-- merged are generated concurrently).+--+-- @since 0.6.0+mergeAsyncBy :: (IsStream t, MonadAsync m)+ => (a -> a -> Ordering) -> t m a -> t m a -> t m a+mergeAsyncBy f m1 m2 = K.mkStream $ \st stp sng yld -> do+ ma <- mkAsync' st m1+ mb <- mkAsync' st m2+ K.foldStream st stp sng yld (K.mergeBy f ma mb)++-- | Like 'mergeByM' but merges concurrently (i.e. both the elements being+-- merged are generated concurrently).+--+-- @since 0.6.0+mergeAsyncByM :: (IsStream t, MonadAsync m)+ => (a -> a -> m Ordering) -> t m a -> t m a -> t m a+mergeAsyncByM f m1 m2 = K.mkStream $ \st stp sng yld -> do+ ma <- mkAsync' st m1+ mb <- mkAsync' st m2+ K.foldStream st stp sng yld (K.mergeByM f ma mb)
src/Streamly/SVar.hs view
@@ -31,7 +31,7 @@ , Limit (..) , State (streamVar) , defState- , rstState+ , adaptState , getMaxThreads , setMaxThreads , getMaxBuffer@@ -433,8 +433,15 @@ -- We can optimize this so that we clear it only if it is a Just value, it -- results in slightly better perf for zip/zipM but the performance of scan -- worsens a lot, it does not fuse.-rstState :: State t m a -> State t m b-rstState st = st+--+-- XXX This has a side effect of clearing the SVar and yieldLimit, therefore it+-- should not be used to convert from the same type to the same type, unless+-- you want to clear the SVar. For clearing the SVar you should be using the+-- appropriate unStream functions instead.+--+-- | Adapt the stream state from one type to another.+adaptState :: State t m a -> State t m b+adaptState st = st { streamVar = Nothing , _yieldLimit = Nothing }@@ -2009,6 +2016,7 @@ , svarStopTime = stpTime } +-- XXX remove polymorphism in t, inline f getAheadSVar :: MonadAsync m => State t m a -> ( IORef ([t m a], Int)
src/Streamly/Streams/Ahead.hs view
@@ -48,8 +48,8 @@ import Streamly.Streams.Serial (map) import Streamly.SVar import Streamly.Streams.StreamK- (IsStream(..), Stream(..), unstreamShared, unStreamIsolated,- runStreamSVar)+ (IsStream(..), Stream, mkStream, foldStream, foldStreamShared,+ foldStreamSVar) import qualified Streamly.Streams.StreamK as K import Prelude hiding (map)@@ -298,9 +298,11 @@ let stop = do liftIO (incrementYieldLimit sv) nextHeap seqNo- runStreamSVar sv r st stop- (singleStreamFromHeap seqNo)+ foldStreamSVar sv st (yieldStreamFromHeap seqNo)+ (singleStreamFromHeap seqNo)+ stop+ r else liftIO $ do let ent = Entry seqNo (AheadEntryStream r) liftIO $ requeueOnHeapTop heap ent seqNo@@ -348,9 +350,11 @@ -- we stop. toHeap AheadEntryNull - runStreamSVar sv m st stop- (toHeap . AheadEntryPure)+ foldStreamSVar sv st (\a r -> toHeap $ AheadEntryStream $ K.cons a r)+ (toHeap . AheadEntryPure)+ stop+ m where @@ -408,7 +412,7 @@ liftIO (incrementYieldLimit sv) loopWithToken (sno + 1) - runStreamSVar sv action st stop (singleOutput sno) (yieldOutput sno)+ foldStreamSVar sv st (yieldOutput sno) (singleOutput sno) stop action where @@ -431,9 +435,11 @@ let stop = do liftIO (incrementYieldLimit sv) loopWithToken (seqNo + 1)- runStreamSVar sv r st stop- (singleOutput seqNo)+ foldStreamSVar sv st (yieldOutput seqNo)+ (singleOutput seqNo)+ stop+ r else do let ent = Entry seqNo (AheadEntryStream r) liftIO $ requeueOnHeapTop heap ent seqNo@@ -460,9 +466,11 @@ let stop = do liftIO (incrementYieldLimit sv) loopWithToken (seqNo + 1)- runStreamSVar sv m st stop- (singleOutput seqNo)+ foldStreamSVar sv st (yieldOutput seqNo)+ (singleOutput seqNo)+ stop+ m else -- To avoid a race when another thread puts something -- on the heap and goes away, the consumer will not get@@ -543,32 +551,38 @@ -- The only difference between forkSVarAsync and this is that we run the left -- computation without a shared SVar.-forkSVarAhead :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-forkSVarAhead m1 m2 = Stream $ \st stp sng yld -> do- sv <- newAheadVar st (concurrently m1 m2) workLoopAhead- unStream (fromSVar sv) (rstState st) stp sng yld+forkSVarAhead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+forkSVarAhead m1 m2 = mkStream $ \st stp sng yld -> do+ sv <- newAheadVar st (concurrently (toStream m1) (toStream m2))+ workLoopAhead+ foldStream st stp sng yld (fromSVar sv) where- concurrently ma mb = Stream $ \st stp sng yld -> do+ concurrently ma mb = mkStream $ \st stp sng yld -> do liftIO $ enqueue (fromJust $ streamVar st) mb- unStream ma (rstState st) stp sng yld+ foldStream st stp sng yld ma -{-# INLINE aheadS #-}-aheadS :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-aheadS m1 m2 = Stream $ \st stp sng yld ->+-- | Polymorphic version of the 'Semigroup' operation '<>' of 'AheadT'.+-- Merges two streams sequentially but with concurrent lookahead.+--+-- @since 0.3.0+{-# INLINE ahead #-}+ahead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+ahead m1 m2 = mkStream $ \st stp sng yld -> case streamVar st of Just sv | svarStyle sv == AheadVar -> do- liftIO $ enqueue sv m2+ liftIO $ enqueue sv (toStream m2) -- Always run the left side on a new SVar to avoid complexity in -- sequencing results. This means the left side cannot further -- split into more ahead computations on the same SVar.- unStream m1 (rstState st) stp sng yld- _ -> unStream (forkSVarAhead m1 m2) st stp sng yld+ foldStream st stp sng yld m1+ _ -> foldStreamShared st stp sng yld (forkSVarAhead m1 m2) -- | XXX we can implement it more efficienty by directly implementing instead -- of combining streams using ahead. {-# INLINE consMAhead #-}-consMAhead :: MonadAsync m => m a -> Stream m a -> Stream m a-consMAhead m r = K.yieldM m `aheadS` r+{-# SPECIALIZE consMAhead :: IO a -> AheadT IO a -> AheadT IO a #-}+consMAhead :: MonadAsync m => m a -> AheadT m a -> AheadT m a+consMAhead m r = fromStream $ K.yieldM m `ahead` (toStream r) ------------------------------------------------------------------------------ -- AheadT@@ -636,30 +650,20 @@ instance IsStream AheadT where toStream = getAheadT fromStream = AheadT-- {-# INLINE consM #-}- {-# SPECIALIZE consM :: IO a -> AheadT IO a -> AheadT IO a #-}- consM m r = fromStream $ consMAhead m (toStream r)-- {-# INLINE (|:) #-}- {-# SPECIALIZE (|:) :: IO a -> AheadT IO a -> AheadT IO a #-}- (|:) = consM+ consM = consMAhead+ (|:) = consMAhead ------------------------------------------------------------------------------ -- Semigroup ------------------------------------------------------------------------------ --- | Polymorphic version of the 'Semigroup' operation '<>' of 'AheadT'.--- Merges two streams sequentially but with concurrent lookahead.------ @since 0.3.0-{-# INLINE ahead #-}-ahead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-ahead m1 m2 = fromStream $ Stream $ \st stp sng yld ->- unStream (aheadS (toStream m1) (toStream m2)) st stp sng yld+{-# INLINE mappendAhead #-}+{-# SPECIALIZE mappendAhead :: AheadT IO a -> AheadT IO a -> AheadT IO a #-}+mappendAhead :: MonadAsync m => AheadT m a -> AheadT m a -> AheadT m a+mappendAhead m1 m2 = fromStream $ ahead (toStream m1) (toStream m2) instance MonadAsync m => Semigroup (AheadT m a) where- (<>) = ahead+ (<>) = mappendAhead ------------------------------------------------------------------------------ -- Monoid@@ -673,31 +677,26 @@ -- Monad ------------------------------------------------------------------------------ -{-# INLINE aheadbind #-}-aheadbind- :: MonadAsync m- => Stream m a- -> (a -> Stream m b)- -> Stream m b-aheadbind m f = go m- where- go (Stream g) =- Stream $ \st stp sng yld ->- let runShared x = unstreamShared x st stp sng yld- runIsolated x = unStreamIsolated x st stp sng yld-- single a = runIsolated $ f a- yieldk a r = runShared $- K.isolateStream (f a) `aheadS` go r- in g (rstState st) stp single yieldk+{-# INLINE bindAhead #-}+{-# SPECIALIZE bindAhead :: AheadT IO a -> (a -> AheadT IO b) -> AheadT IO b #-}+bindAhead :: MonadAsync m => AheadT m a -> (a -> AheadT m b) -> AheadT m b+bindAhead m f = fromStream $ K.bindWith ahead (K.adapt m) (\a -> K.adapt $ f a) instance MonadAsync m => Monad (AheadT m) where return = pure- (AheadT m) >>= f = AheadT $ aheadbind m (getAheadT . f)+ (>>=) = bindAhead +{-# INLINE apAhead #-}+{-# SPECIALIZE apAhead :: AheadT IO (a -> b) -> AheadT IO a -> AheadT IO b #-}+apAhead :: MonadAsync m => AheadT m (a -> b) -> AheadT m a -> AheadT m b+apAhead mf m = ap (K.adapt mf) (K.adapt m)++instance (Monad m, MonadAsync m) => Applicative (AheadT m) where+ pure = AheadT . K.yield+ (<*>) = apAhead+ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------ -MONAD_APPLICATIVE_INSTANCE(AheadT,MONADPARALLEL) MONAD_COMMON_INSTANCES(AheadT, MONADPARALLEL)
src/Streamly/Streams/Async.hs view
@@ -57,7 +57,9 @@ import Streamly.Streams.SVar (fromSVar) import Streamly.Streams.Serial (map) import Streamly.SVar-import Streamly.Streams.StreamK (IsStream(..), Stream(..), adapt, runStreamSVar)+import Streamly.Streams.StreamK+ (IsStream(..), Stream, mkStream, foldStream, adapt, foldStreamShared,+ foldStreamSVar) import qualified Streamly.Streams.StreamK as K #include "Instances.hs"@@ -82,7 +84,7 @@ work <- dequeue case work of Nothing -> liftIO $ sendStop sv winfo- Just m -> runStreamSVar sv m st run single yieldk+ Just m -> foldStreamSVar sv st yieldk single run m single a = do res <- liftIO $ sendYield sv winfo (ChildYield a)@@ -91,7 +93,7 @@ yieldk a r = do res <- liftIO $ sendYield sv winfo (ChildYield a) if res- then runStreamSVar sv r st run single yieldk+ then foldStreamSVar sv st yieldk single run r else liftIO $ do enqueueLIFO sv q r sendStop sv winfo@@ -132,7 +134,7 @@ if yieldLimitOk then do let stop = liftIO (incrementYieldLimit sv) >> run- runStreamSVar sv m st stop single yieldk+ foldStreamSVar sv st yieldk single stop m -- Avoid any side effects, undo the yield limit decrement if we -- never yielded anything. else liftIO $ do@@ -151,7 +153,7 @@ yieldLimitOk <- liftIO $ decrementYieldLimit sv let stop = liftIO (incrementYieldLimit sv) >> run if res && yieldLimitOk- then runStreamSVar sv r st stop single yieldk+ then foldStreamSVar sv st yieldk single stop r else liftIO $ do incrementYieldLimit sv enqueueLIFO sv q r@@ -183,7 +185,7 @@ work <- liftIO $ tryPopR q case work of Nothing -> liftIO $ sendStop sv winfo- Just m -> runStreamSVar sv m st run single yieldk+ Just m -> foldStreamSVar sv st yieldk single run m single a = do res <- liftIO $ sendYield sv winfo (ChildYield a)@@ -192,7 +194,7 @@ yieldk a r = do res <- liftIO $ sendYield sv winfo (ChildYield a) if res- then runStreamSVar sv r st run single yieldk+ then foldStreamSVar sv st yieldk single run r else liftIO $ do enqueueFIFO sv q r sendStop sv winfo@@ -218,7 +220,7 @@ if yieldLimitOk then do let stop = liftIO (incrementYieldLimit sv) >> run- runStreamSVar sv m st stop single yieldk+ foldStreamSVar sv st yieldk single stop m else liftIO $ do enqueueFIFO sv q m incrementYieldLimit sv@@ -233,7 +235,7 @@ yieldLimitOk <- liftIO $ decrementYieldLimit sv let stop = liftIO (incrementYieldLimit sv) >> run if res && yieldLimitOk- then runStreamSVar sv r st stop single yieldk+ then foldStreamSVar sv st yieldk single stop r else liftIO $ do incrementYieldLimit sv enqueueFIFO sv q r@@ -526,36 +528,33 @@ -- composition and vice-versa we create a new SVar to isolate the scheduling -- of the two. -forkSVarAsync :: MonadAsync m- => SVarStyle -> Stream m a -> Stream m a -> Stream m a-forkSVarAsync style m1 m2 = Stream $ \st stp sng yld -> do+forkSVarAsync :: (IsStream t, MonadAsync m)+ => SVarStyle -> t m a -> t m a -> t m a+forkSVarAsync style m1 m2 = mkStream $ \st stp sng yld -> do sv <- case style of- AsyncVar -> newAsyncVar st (concurrently m1 m2)- WAsyncVar -> newWAsyncVar st (concurrently m1 m2)+ AsyncVar -> newAsyncVar st (concurrently (toStream m1) (toStream m2))+ WAsyncVar -> newWAsyncVar st (concurrently (toStream m1) (toStream m2)) _ -> error "illegal svar type"- unStream (fromSVar sv) (rstState st) stp sng yld+ foldStream st stp sng yld $ fromSVar sv where- concurrently ma mb = Stream $ \st stp sng yld -> do+ concurrently ma mb = mkStream $ \st stp sng yld -> do liftIO $ enqueue (fromJust $ streamVar st) mb- unStream ma st stp sng yld+ foldStreamShared st stp sng yld ma {-# INLINE joinStreamVarAsync #-}-joinStreamVarAsync :: MonadAsync m- => SVarStyle -> Stream m a -> Stream m a -> Stream m a-joinStreamVarAsync style m1 m2 = Stream $ \st stp sng yld ->+joinStreamVarAsync :: (IsStream t, MonadAsync m)+ => SVarStyle -> t m a -> t m a -> t m a+joinStreamVarAsync style m1 m2 = mkStream $ \st stp sng yld -> case streamVar st of- Just sv | svarStyle sv == style ->- liftIO (enqueue sv m2) >> unStream m1 st stp sng yld- _ -> unStream (forkSVarAsync style m1 m2) st stp sng yld+ Just sv | svarStyle sv == style -> do+ liftIO $ enqueue sv (toStream m2)+ foldStreamShared st stp sng yld m1+ _ -> foldStreamShared st stp sng yld (forkSVarAsync style m1 m2) ------------------------------------------------------------------------------ -- Semigroup and Monoid style compositions for parallel actions ------------------------------------------------------------------------------ -{-# INLINE asyncS #-}-asyncS :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-asyncS = joinStreamVarAsync AsyncVar- -- | Polymorphic version of the 'Semigroup' operation '<>' of 'AsyncT'. -- Merges two streams possibly concurrently, preferring the -- elements from the left one when available.@@ -563,9 +562,7 @@ -- @since 0.2.0 {-# INLINE async #-} async :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-async m1 m2 = fromStream $ Stream $ \st stp sng yld ->- unStream (joinStreamVarAsync AsyncVar (toStream m1) (toStream m2))- st stp sng yld+async = joinStreamVarAsync AsyncVar -- | Same as 'async'. --@@ -575,11 +572,16 @@ (<|) :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a (<|) = async +-- IMPORTANT: using a monomorphically typed and SPECIALIZED consMAsync makes a+-- huge difference in the performance of consM in IsStream instance even we+-- have a SPECIALIZE in the instance.+-- -- | XXX we can implement it more efficienty by directly implementing instead -- of combining streams using async. {-# INLINE consMAsync #-}-consMAsync :: MonadAsync m => m a -> Stream m a -> Stream m a-consMAsync m r = K.yieldM m `asyncS` r+{-# SPECIALIZE consMAsync :: IO a -> AsyncT IO a -> AsyncT IO a #-}+consMAsync :: MonadAsync m => m a -> AsyncT m a -> AsyncT m a+consMAsync m r = fromStream $ K.yieldM m `async` (toStream r) ------------------------------------------------------------------------------ -- AsyncT@@ -652,21 +654,22 @@ instance IsStream AsyncT where toStream = getAsyncT fromStream = AsyncT-- {-# INLINE consM #-}- {-# SPECIALIZE consM :: IO a -> AsyncT IO a -> AsyncT IO a #-}- consM m r = fromStream $ consMAsync m (toStream r)-- {-# INLINE (|:) #-}- {-# SPECIALIZE (|:) :: IO a -> AsyncT IO a -> AsyncT IO a #-}- (|:) = consM+ consM = consMAsync+ (|:) = consMAsync ------------------------------------------------------------------------------ -- Semigroup ------------------------------------------------------------------------------ +-- Monomorphically typed version of "async" for better performance of Semigroup+-- instance.+{-# INLINE mappendAsync #-}+{-# SPECIALIZE mappendAsync :: AsyncT IO a -> AsyncT IO a -> AsyncT IO a #-}+mappendAsync :: MonadAsync m => AsyncT m a -> AsyncT m a -> AsyncT m a+mappendAsync m1 m2 = fromStream $ async (toStream m1) (toStream m2)+ instance MonadAsync m => Semigroup (AsyncT m a) where- (<>) = async+ (<>) = mappendAsync ------------------------------------------------------------------------------ -- Monoid@@ -680,30 +683,40 @@ -- Monad ------------------------------------------------------------------------------ +{-# INLINE bindAsync #-}+{-# SPECIALIZE bindAsync :: AsyncT IO a -> (a -> AsyncT IO b) -> AsyncT IO b #-}+bindAsync :: MonadAsync m => AsyncT m a -> (a -> AsyncT m b) -> AsyncT m b+bindAsync m f = fromStream $ K.bindWith async (adapt m) (\a -> adapt $ f a)+ instance MonadAsync m => Monad (AsyncT m) where return = pure- (AsyncT m) >>= f = AsyncT $ K.bindWith asyncS m (getAsyncT . f)+ (>>=) = bindAsync +{-# INLINE apAsync #-}+{-# SPECIALIZE apAsync :: AsyncT IO (a -> b) -> AsyncT IO a -> AsyncT IO b #-}+apAsync :: MonadAsync m => AsyncT m (a -> b) -> AsyncT m a -> AsyncT m b+apAsync mf m = ap (adapt mf) (adapt m)++instance (Monad m, MonadAsync m) => Applicative (AsyncT m) where+ pure = AsyncT . K.yield+ (<*>) = apAsync+ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------ -MONAD_APPLICATIVE_INSTANCE(AsyncT,MONADPARALLEL) MONAD_COMMON_INSTANCES(AsyncT, MONADPARALLEL) ------------------------------------------------------------------------------ -- WAsyncT ------------------------------------------------------------------------------ -{-# INLINE wAsyncS #-}-wAsyncS :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-wAsyncS = joinStreamVarAsync WAsyncVar- -- | XXX we can implement it more efficienty by directly implementing instead -- of combining streams using wAsync. {-# INLINE consMWAsync #-}-consMWAsync :: MonadAsync m => m a -> Stream m a -> Stream m a-consMWAsync m r = K.yieldM m `wAsyncS` r+{-# SPECIALIZE consMWAsync :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}+consMWAsync :: MonadAsync m => m a -> WAsyncT m a -> WAsyncT m a+consMWAsync m r = fromStream $ K.yieldM m `wAsync` (toStream r) -- | Polymorphic version of the 'Semigroup' operation '<>' of 'WAsyncT'. -- Merges two streams concurrently choosing elements from both fairly.@@ -711,8 +724,7 @@ -- @since 0.2.0 {-# INLINE wAsync #-} wAsync :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-wAsync m1 m2 = fromStream $ Stream $ \st stp sng yld ->- unStream (wAsyncS (toStream m1) (toStream m2)) st stp sng yld+wAsync = joinStreamVarAsync WAsyncVar -- | Wide async composition or async composition with breadth first traversal. -- The Semigroup instance of 'WAsyncT' concurrently /traverses/ the composed@@ -779,21 +791,20 @@ instance IsStream WAsyncT where toStream = getWAsyncT fromStream = WAsyncT-- {-# INLINE consM #-}- {-# SPECIALIZE consM :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}- consM m r = fromStream $ consMWAsync m (toStream r)-- {-# INLINE (|:) #-}- {-# SPECIALIZE (|:) :: IO a -> WAsyncT IO a -> WAsyncT IO a #-}- (|:) = consM+ consM = consMWAsync+ (|:) = consMWAsync ------------------------------------------------------------------------------ -- Semigroup ------------------------------------------------------------------------------ +{-# INLINE mappendWAsync #-}+{-# SPECIALIZE mappendWAsync :: WAsyncT IO a -> WAsyncT IO a -> WAsyncT IO a #-}+mappendWAsync :: MonadAsync m => WAsyncT m a -> WAsyncT m a -> WAsyncT m a+mappendWAsync m1 m2 = fromStream $ wAsync (toStream m1) (toStream m2)+ instance MonadAsync m => Semigroup (WAsyncT m a) where- (<>) = wAsync+ (<>) = mappendWAsync ------------------------------------------------------------------------------ -- Monoid@@ -807,14 +818,26 @@ -- Monad ------------------------------------------------------------------------------ +{-# INLINE bindWAsync #-}+{-# SPECIALIZE bindWAsync :: WAsyncT IO a -> (a -> WAsyncT IO b) -> WAsyncT IO b #-}+bindWAsync :: MonadAsync m => WAsyncT m a -> (a -> WAsyncT m b) -> WAsyncT m b+bindWAsync m f = fromStream $ K.bindWith wAsync (adapt m) (\a -> adapt $ f a)+ instance MonadAsync m => Monad (WAsyncT m) where return = pure- (WAsyncT m) >>= f =- WAsyncT $ K.bindWith wAsyncS m (getWAsyncT . f)+ (>>=) = bindWAsync +{-# INLINE apWAsync #-}+{-# SPECIALIZE apWAsync :: WAsyncT IO (a -> b) -> WAsyncT IO a -> WAsyncT IO b #-}+apWAsync :: MonadAsync m => WAsyncT m (a -> b) -> WAsyncT m a -> WAsyncT m b+apWAsync mf m = ap (adapt mf) (adapt m)++instance (Monad m, MonadAsync m) => Applicative (WAsyncT m) where+ pure = WAsyncT . K.yield+ (<*>) = apWAsync+ ------------------------------------------------------------------------------ -- Other instances ------------------------------------------------------------------------------ -MONAD_APPLICATIVE_INSTANCE(WAsyncT,MONADPARALLEL) MONAD_COMMON_INSTANCES(WAsyncT, MONADPARALLEL)
+ src/Streamly/Streams/Combinators.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE CPP #-}++#include "inline.hs"++-- |+-- Module : Streamly.Streams.Combinators+-- Copyright : (c) 2017 Harendra Kumar+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com+-- Stability : experimental+-- Portability : GHC+--+--+module Streamly.Streams.Combinators+ ( maxThreads+ , maxBuffer+ , maxYields+ , rate+ , avgRate+ , minRate+ , maxRate+ , constRate+ , inspectMode+ , printState+ )+where++import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Int (Int64)++import Streamly.SVar+import Streamly.Streams.StreamK+import Streamly.Streams.Serial (SerialT)++-------------------------------------------------------------------------------+-- Concurrency control+-------------------------------------------------------------------------------+--+-- XXX need to write these in direct style otherwise they will break fusion.+--+-- | Specify the maximum number of threads that can be spawned concurrently for+-- any concurrent combinator in a stream.+-- A value of 0 resets the thread limit to default, a negative value means+-- there is no limit. The default value is 1500.+--+-- When the actions in a stream are IO bound, having blocking IO calls, this+-- option can be used to control the maximum number of in-flight IO requests.+-- When the actions are CPU bound this option can be used to+-- control the amount of CPU used by the stream.+--+-- @since 0.4.0+{-# INLINE_NORMAL maxThreads #-}+maxThreads :: IsStream t => Int -> t m a -> t m a+maxThreads n m = mkStream $ \st stp sng yld ->+ foldStreamShared (setMaxThreads n st) stp sng yld m++{-+{-# RULES "maxThreadsSerial serial" maxThreads = maxThreadsSerial #-}+maxThreadsSerial :: Int -> SerialT m a -> SerialT m a+maxThreadsSerial _ = id+-}++-- | Specify the maximum size of the buffer for storing the results from+-- concurrent computations. If the buffer becomes full we stop spawning more+-- concurrent tasks until there is space in the buffer.+-- A value of 0 resets the buffer size to default, a negative value means+-- there is no limit. The default value is 1500.+--+-- CAUTION! using an unbounded 'maxBuffer' value (i.e. a negative value)+-- coupled with an unbounded 'maxThreads' value is a recipe for disaster in+-- presence of infinite streams, or very large streams. Especially, it must+-- not be used when 'pure' is used in 'ZipAsyncM' streams as 'pure' in+-- applicative zip streams generates an infinite stream causing unbounded+-- concurrent generation with no limit on the buffer or threads.+--+-- @since 0.4.0+{-# INLINE_NORMAL maxBuffer #-}+maxBuffer :: IsStream t => Int -> t m a -> t m a+maxBuffer n m = mkStream $ \st stp sng yld ->+ foldStreamShared (setMaxBuffer n st) stp sng yld m++{-+{-# RULES "maxBuffer serial" maxBuffer = maxBufferSerial #-}+maxBufferSerial :: Int -> SerialT m a -> SerialT m a+maxBufferSerial _ = id+-}++-- | Specify the pull rate of a stream.+-- A 'Nothing' value resets the rate to default which is unlimited. When the+-- rate is specified, concurrent production may be ramped up or down+-- automatically to achieve the specified yield rate. The specific behavior for+-- different styles of 'Rate' specifications is documented under 'Rate'. The+-- effective maximum production rate achieved by a stream is governed by:+--+-- * The 'maxThreads' limit+-- * The 'maxBuffer' limit+-- * The maximum rate that the stream producer can achieve+-- * The maximum rate that the stream consumer can achieve+--+-- @since 0.5.0+{-# INLINE_NORMAL rate #-}+rate :: IsStream t => Maybe Rate -> t m a -> t m a+rate r m = mkStream $ \st stp sng yld ->+ case r of+ Just (Rate low goal _ _) | goal < low ->+ error "rate: Target rate cannot be lower than minimum rate."+ Just (Rate _ goal high _) | goal > high ->+ error "rate: Target rate cannot be greater than maximum rate."+ Just (Rate low _ high _) | low > high ->+ error "rate: Minimum rate cannot be greater than maximum rate."+ _ -> foldStreamShared (setStreamRate r st) stp sng yld m++-- XXX implement for serial streams as well, as a simple delay++{-+{-# RULES "rate serial" rate = yieldRateSerial #-}+yieldRateSerial :: Double -> SerialT m a -> SerialT m a+yieldRateSerial _ = id+-}++-- | Same as @rate (Just $ Rate (r/2) r (2*r) maxBound)@+--+-- Specifies the average production rate of a stream in number of yields+-- per second (i.e. @Hertz@). Concurrent production is ramped up or down+-- automatically to achieve the specified average yield rate. The rate can+-- go down to half of the specified rate on the lower side and double of+-- the specified rate on the higher side.+--+-- @since 0.5.0+avgRate :: IsStream t => Double -> t m a -> t m a+avgRate r = rate (Just $ Rate (r/2) r (2*r) maxBound)++-- | Same as @rate (Just $ Rate r r (2*r) maxBound)@+--+-- Specifies the minimum rate at which the stream should yield values. As+-- far as possible the yield rate would never be allowed to go below the+-- specified rate, even though it may possibly go above it at times, the+-- upper limit is double of the specified rate.+--+-- @since 0.5.0+minRate :: IsStream t => Double -> t m a -> t m a+minRate r = rate (Just $ Rate r r (2*r) maxBound)++-- | Same as @rate (Just $ Rate (r/2) r r maxBound)@+--+-- Specifies the maximum rate at which the stream should yield values. As+-- far as possible the yield rate would never be allowed to go above the+-- specified rate, even though it may possibly go below it at times, the+-- lower limit is half of the specified rate. This can be useful in+-- applications where certain resource usage must not be allowed to go+-- beyond certain limits.+--+-- @since 0.5.0+maxRate :: IsStream t => Double -> t m a -> t m a+maxRate r = rate (Just $ Rate (r/2) r r maxBound)++-- | Same as @rate (Just $ Rate r r r 0)@+--+-- Specifies a constant yield rate. If for some reason the actual rate+-- goes above or below the specified rate we do not try to recover it by+-- increasing or decreasing the rate in future. This can be useful in+-- applications like graphics frame refresh where we need to maintain a+-- constant refresh rate.+--+-- @since 0.5.0+constRate :: IsStream t => Double -> t m a -> t m a+constRate r = rate (Just $ Rate r r r 0)++-- | Specify the average latency, in nanoseconds, of a single threaded action+-- in a concurrent composition. Streamly can measure the latencies, but that is+-- possible only after at least one task has completed. This combinator can be+-- used to provide a latency hint so that rate control using 'rate' can take+-- that into account right from the beginning. When not specified then a+-- default behavior is chosen which could be too slow or too fast, and would be+-- restricted by any other control parameters configured.+-- A value of 0 indicates default behavior, a negative value means there is no+-- limit i.e. zero latency.+-- This would normally be useful only in high latency and high throughput+-- cases.+--+{-# INLINE_NORMAL _serialLatency #-}+_serialLatency :: IsStream t => Int -> t m a -> t m a+_serialLatency n m = mkStream $ \st stp sng yld ->+ foldStreamShared (setStreamLatency n st) stp sng yld m++{-+{-# RULES "serialLatency serial" _serialLatency = serialLatencySerial #-}+serialLatencySerial :: Int -> SerialT m a -> SerialT m a+serialLatencySerial _ = id+-}++-- Stop concurrent dispatches after this limit. This is useful in API's like+-- "take" where we want to dispatch only upto the number of elements "take"+-- needs. This value applies only to the immediate next level and is not+-- inherited by everything in enclosed scope.+{-# INLINE_NORMAL maxYields #-}+maxYields :: IsStream t => Maybe Int64 -> t m a -> t m a+maxYields n m = mkStream $ \st stp sng yld ->+ foldStreamShared (setYieldLimit n st) stp sng yld m++{-# RULES "maxYields serial" maxYields = maxYieldsSerial #-}+maxYieldsSerial :: Maybe Int64 -> SerialT m a -> SerialT m a+maxYieldsSerial _ = id++printState :: MonadIO m => State Stream m a -> m ()+printState st = liftIO $ do+ let msv = streamVar st+ case msv of+ Just sv -> dumpSVar sv >>= putStrLn+ Nothing -> putStrLn "No SVar"++-- | Print debug information about an SVar when the stream ends+inspectMode :: IsStream t => t m a -> t m a+inspectMode m = mkStream $ \st stp sng yld ->+ foldStreamShared (setInspectMode st) stp sng yld m
src/Streamly/Streams/Instances.hs view
@@ -41,3 +41,81 @@ put x = lift (put x); \ state k = lift (state k) } +------------------------------------------------------------------------------+-- Lists+------------------------------------------------------------------------------++-- Serial streams can act like regular lists using the Identity monad++-- XXX Show instance is 10x slower compared to read, we can do much better.+-- The list show instance itself is really slow.++-- XXX The default definitions of "<" in the Ord instance etc. do not perform+-- well, because they do not get inlined. Need to add INLINE in Ord class in+-- base?++#define LIST_INSTANCES(STREAM) \+instance IsList (STREAM Identity a) where { \+ type (Item (STREAM Identity a)) = a; \+ {-# INLINE fromList #-}; \+ fromList = P.fromList; \+ {-# INLINE toList #-}; \+ toList = runIdentity . P.toList }; \+ \+instance Eq a => Eq (STREAM Identity a) where { \+ {-# INLINE (==) #-}; \+ (==) xs ys = runIdentity $ P.eqBy (==) xs ys }; \+ \+instance Ord a => Ord (STREAM Identity a) where { \+ {-# INLINE compare #-}; \+ compare xs ys = runIdentity $ P.cmpBy compare xs ys; \+ {-# INLINE (<) #-}; \+ x < y = case compare x y of { LT -> True; _ -> False }; \+ {-# INLINE (<=) #-}; \+ x <= y = case compare x y of { GT -> False; _ -> True }; \+ {-# INLINE (>) #-}; \+ x > y = case compare x y of { GT -> True; _ -> False }; \+ {-# INLINE (>=) #-}; \+ x >= y = case compare x y of { LT -> False; _ -> True }; \+ {-# INLINE max #-}; \+ max x y = if x <= y then y else x; \+ {-# INLINE min #-}; \+ min x y = if x <= y then x else y; }; \+ \+instance Show a => Show (STREAM Identity a) where { \+ showsPrec p dl = showParen (p > 10) $ \+ showString "fromList " . shows (toList dl) }; \+ \+instance Read a => Read (STREAM Identity a) where { \+ readPrec = parens $ prec 10 $ do { \+ Ident "fromList" <- lexP; \+ fromList <$> readPrec }; \+ readListPrec = readListPrecDefault }; \+ \+instance (a ~ Char) => IsString (STREAM Identity a) where { \+ {-# INLINE fromString #-}; \+ fromString = P.fromList }; \+ \+instance NFData a => NFData (STREAM Identity a) where { rnf = rnf1 }; \+instance NFData1 (STREAM Identity) where { \+ {-# INLINE liftRnf #-}; \+ liftRnf r = runIdentity . P.foldl' (\_ x -> r x) () }++-------------------------------------------------------------------------------+-- Foldable+-------------------------------------------------------------------------------++#define FOLDABLE_INSTANCE(STREAM) \+instance (Foldable m, Monad m) => Foldable (STREAM m) where { \+ {-# INLINE foldMap #-}; \+ foldMap f = fold . P.foldr mappend mempty . fmap f }++-------------------------------------------------------------------------------+-- Traversable+-------------------------------------------------------------------------------++#define TRAVERSABLE_INSTANCE(STREAM) \+instance Traversable (STREAM Identity) where { \+ {-# INLINE traverse #-}; \+ traverse f s = runIdentity $ P.foldr consA (pure mempty) s \+ where { consA x ys = liftA2 K.cons (f x) ys }}
src/Streamly/Streams/Parallel.hs view
@@ -49,7 +49,8 @@ import Streamly.Streams.SVar (fromSVar) import Streamly.Streams.Serial (map) import Streamly.SVar-import Streamly.Streams.StreamK (IsStream(..), Stream(..), adapt)+import Streamly.Streams.StreamK (IsStream(..), Stream, mkStream, foldStream,+ foldStreamShared, adapt) import qualified Streamly.Streams.StreamK as K #include "Instances.hs"@@ -62,7 +63,7 @@ runOne :: MonadIO m => State Stream m a -> Stream m a -> Maybe WorkerInfo -> m ()-runOne st m winfo = unStream m st stop single yieldk+runOne st m winfo = foldStreamShared st yieldk single stop m where @@ -87,32 +88,29 @@ >> withLimitCheck (void $ liftIO $ mrun $ runOne st r winfo) {-# NOINLINE forkSVarPar #-}-forkSVarPar :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-forkSVarPar m r = Stream $ \st stp sng yld -> do+forkSVarPar :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+forkSVarPar m r = mkStream $ \st yld sng stp -> do sv <- newParallelVar st- pushWorkerPar sv (runOne st{streamVar = Just sv} m)- pushWorkerPar sv (runOne st{streamVar = Just sv} r)- unStream (fromSVar sv) (rstState st) stp sng yld+ pushWorkerPar sv (runOne st{streamVar = Just sv} $ toStream m)+ pushWorkerPar sv (runOne st{streamVar = Just sv} $ toStream r)+ foldStream st yld sng stp (fromSVar sv) {-# INLINE joinStreamVarPar #-}-joinStreamVarPar :: MonadAsync m- => SVarStyle -> Stream m a -> Stream m a -> Stream m a-joinStreamVarPar style m1 m2 = Stream $ \st stp sng yld ->+joinStreamVarPar :: (IsStream t, MonadAsync m)+ => SVarStyle -> t m a -> t m a -> t m a+joinStreamVarPar style m1 m2 = mkStream $ \st yld sng stp -> case streamVar st of Just sv | svarStyle sv == style -> do- pushWorkerPar sv (runOne st m1)- unStream m2 st stp sng yld- _ -> unStream (forkSVarPar m1 m2) st stp sng yld--{-# INLINE parallelStream #-}-parallelStream :: MonadAsync m => Stream m a -> Stream m a -> Stream m a-parallelStream = joinStreamVarPar ParallelVar+ pushWorkerPar sv (runOne st $ toStream m1)+ foldStreamShared st yld sng stp m2+ _ -> foldStreamShared st yld sng stp (forkSVarPar m1 m2) -- | XXX we can implement it more efficienty by directly implementing instead -- of combining streams using parallel. {-# INLINE consMParallel #-}-consMParallel :: MonadAsync m => m a -> Stream m a -> Stream m a-consMParallel m r = K.yieldM m `parallelStream` r+{-# SPECIALIZE consMParallel :: IO a -> ParallelT IO a -> ParallelT IO a #-}+consMParallel :: MonadAsync m => m a -> ParallelT m a -> ParallelT m a+consMParallel m r = fromStream $ K.yieldM m `parallel` (toStream r) -- | Polymorphic version of the 'Semigroup' operation '<>' of 'ParallelT' -- Merges two streams concurrently.@@ -120,9 +118,7 @@ -- @since 0.2.0 {-# INLINE parallel #-} parallel :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-parallel m1 m2 = fromStream $ Stream $ \st stp sng yld ->- unStream (parallelStream (toStream m1) (toStream m2))- st stp sng yld+parallel = joinStreamVarPar ParallelVar ------------------------------------------------------------------------------ -- Convert a stream to parallel@@ -140,10 +136,10 @@ {-# INLINE applyWith #-} applyWith :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> t m a -> t m b-applyWith f m = fromStream $ Stream $ \st stp sng yld -> do- sv <- newParallelVar (rstState st)+applyWith f m = mkStream $ \st yld sng stp -> do+ sv <- newParallelVar (adaptState st) pushWorkerPar sv (runOne st{streamVar = Just sv} (toStream m))- unStream (toStream $ f $ fromSVar sv) (rstState st) stp sng yld+ foldStream st yld sng stp $ f $ fromSVar sv ------------------------------------------------------------------------------ -- Stream runner concurrent function application@@ -345,7 +341,7 @@ {-# INLINE consM #-} {-# SPECIALIZE consM :: IO a -> ParallelT IO a -> ParallelT IO a #-}- consM m r = fromStream $ consMParallel m (toStream r)+ consM = consMParallel {-# INLINE (|:) #-} {-# SPECIALIZE (|:) :: IO a -> ParallelT IO a -> ParallelT IO a #-}@@ -355,8 +351,13 @@ -- Semigroup ------------------------------------------------------------------------------ +{-# INLINE mappendParallel #-}+{-# SPECIALIZE mappendParallel :: ParallelT IO a -> ParallelT IO a -> ParallelT IO a #-}+mappendParallel :: MonadAsync m => ParallelT m a -> ParallelT m a -> ParallelT m a+mappendParallel m1 m2 = fromStream $ parallel (toStream m1) (toStream m2)+ instance MonadAsync m => Semigroup (ParallelT m a) where- (<>) = parallel+ (<>) = mappendParallel ------------------------------------------------------------------------------ -- Monoid@@ -370,10 +371,16 @@ -- Monad ------------------------------------------------------------------------------ +{-# INLINE bindParallel #-}+{-# SPECIALIZE bindParallel :: ParallelT IO a -> (a -> ParallelT IO b) -> ParallelT IO b #-}+bindParallel :: MonadAsync m => ParallelT m a -> (a -> ParallelT m b) -> ParallelT m b+bindParallel m f = fromStream $ K.bindWith parallel (K.adapt m) (\a -> K.adapt $ f a)+ instance MonadAsync m => Monad (ParallelT m) where return = pure- (ParallelT m) >>= f- = ParallelT $ K.bindWith parallelStream m (getParallelT . f)+ (>>=) = bindParallel++-- XXX Specialize the applicative instance ------------------------------------------------------------------------------ -- Other instances
src/Streamly/Streams/Prelude.hs view
@@ -1,12 +1,11 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE UndecidableInstances #-} -- XXX +#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -Wno-orphans #-}+#endif++#include "inline.hs"+ -- | -- Module : Streamly.Streams.Prelude -- Copyright : (c) 2017 Harendra Kumar@@ -19,17 +18,135 @@ -- module Streamly.Streams.Prelude (+ -- * Stream Conversion+ fromStreamS+ , toStreamS++ -- * Running Effects+ , runStream++ -- * Conversion operations+ , fromList+ , toList++ -- * Fold operations+ , foldrM+ , foldr+ , foldl'++ -- * Zip style operations+ , eqBy+ , cmpBy+ -- * Fold Utilities- foldWith+ , foldWith , foldMapWith , forEachWith ) where +import Prelude hiding (foldr)+import qualified Prelude++#ifdef USE_STREAMK_ONLY+import qualified Streamly.Streams.StreamK as S+#else+import qualified Streamly.Streams.StreamD as S+#endif+ import Streamly.Streams.StreamK (IsStream(..)) import qualified Streamly.Streams.StreamK as K+import qualified Streamly.Streams.StreamD as D ------------------------------------------------------------------------------+-- Conversion to and from direct style stream+------------------------------------------------------------------------------++-- These definitions are dependent on what is imported as S+{-# INLINE fromStreamS #-}+fromStreamS :: (IsStream t, Monad m) => S.Stream m a -> t m a+fromStreamS = fromStream . S.toStreamK++{-# INLINE toStreamS #-}+toStreamS :: (IsStream t, Monad m) => t m a -> S.Stream m a+toStreamS = S.fromStreamK . toStream++------------------------------------------------------------------------------+-- Conversions+------------------------------------------------------------------------------++{-# INLINE_EARLY runStream #-}+runStream :: (IsStream t, Monad m) => t m a -> m ()+runStream m = D.runStream $ D.fromStreamK (toStream m)+{-# RULES "runStream fallback to CPS" [1]+ forall a. D.runStream (D.fromStreamK a) = K.runStream a #-}++------------------------------------------------------------------------------+-- Conversions+------------------------------------------------------------------------------++-- |+-- @+-- fromList = 'Prelude.foldr' 'K.cons' 'K.nil'+-- @+--+-- Construct a stream from a list of pure values. This is more efficient than+-- 'K.fromFoldable' for serial streams.+--+-- @since 0.4.0+{-# INLINE_EARLY fromList #-}+fromList :: (Monad m, IsStream t) => [a] -> t m a+fromList = fromStreamS . S.fromList+{-# RULES "fromList fallback to StreamK" [1]+ forall a. S.toStreamK (S.fromList a) = K.fromFoldable a #-}++-- | Convert a stream into a list in the underlying monad.+--+-- @since 0.1.0+{-# INLINE toList #-}+toList :: (Monad m, IsStream t) => t m a -> m [a]+toList m = S.toList $ toStreamS m++------------------------------------------------------------------------------+-- Folds+------------------------------------------------------------------------------++{-# INLINE foldrM #-}+foldrM :: (Monad m, IsStream t) => (a -> b -> m b) -> b -> t m a -> m b+foldrM step acc m = S.foldrM step acc $ toStreamS m++{-# INLINE foldr #-}+foldr :: (Monad m, IsStream t) => (a -> b -> b) -> b -> t m a -> m b+foldr f = foldrM (\a b -> return (f a b))++-- | Strict left associative fold.+--+-- @since 0.2.0+{-# INLINE foldl' #-}+foldl' :: (Monad m, IsStream t) => (b -> a -> b) -> b -> t m a -> m b+foldl' step begin m = S.foldl' step begin $ toStreamS m++------------------------------------------------------------------------------+-- Comparison+------------------------------------------------------------------------------++-- | Compare two streams for equality+--+-- @since 0.5.3+{-# INLINE eqBy #-}+eqBy :: (IsStream t, Monad m) => (a -> b -> Bool) -> t m a -> t m b -> m Bool+eqBy f m1 m2 = D.eqBy f (D.toStreamD m1) (D.toStreamD m2)++-- | Compare two streams+--+-- @since 0.5.3+{-# INLINE cmpBy #-}+cmpBy+ :: (IsStream t, Monad m)+ => (a -> b -> Ordering) -> t m a -> t m b -> m Ordering+cmpBy f m1 m2 = D.cmpBy f (D.toStreamD m1) (D.toStreamD m2)++------------------------------------------------------------------------------ -- Fold Utilities ------------------------------------------------------------------------------ @@ -42,7 +159,7 @@ {-# INLINABLE foldWith #-} foldWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-foldWith f = foldr f K.nil+foldWith f = Prelude.foldr f K.nil -- | A variant of 'foldMap' that allows you to map a monadic streaming action -- on a 'Foldable' container and then fold it using the specified stream sum@@ -54,7 +171,7 @@ {-# INLINABLE foldMapWith #-} foldMapWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-foldMapWith f g = foldr (f . g) K.nil+foldMapWith f g = Prelude.foldr (f . g) K.nil -- | Like 'foldMapWith' but with the last two arguments reversed i.e. the -- monadic streaming function is the last argument.@@ -63,4 +180,4 @@ {-# INLINABLE forEachWith #-} forEachWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-forEachWith f xs g = foldr (f . g) K.nil xs+forEachWith f xs g = Prelude.foldr (f . g) K.nil xs
src/Streamly/Streams/SVar.hs view
@@ -1,13 +1,5 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE UndecidableInstances #-} -- XXX -#include "inline.h"- -- | -- Module : Streamly.Streams.SVar -- Copyright : (c) 2017 Harendra Kumar@@ -19,19 +11,8 @@ -- -- module Streamly.Streams.SVar- (- fromSVar+ ( fromSVar , toSVar- , maxThreads- , maxBuffer- , maxYields- , rate- , avgRate- , minRate- , maxRate- , constRate- , inspectMode- , printState ) where @@ -39,7 +20,6 @@ import Control.Monad (when) import Control.Monad.Catch (throwM) import Control.Monad.IO.Class (MonadIO(liftIO))-import Data.Int (Int64) import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef) import Data.Maybe (isNothing) import Data.Semigroup ((<>))@@ -49,29 +29,21 @@ import Streamly.SVar import Streamly.Streams.StreamK-import Streamly.Streams.Serial (SerialT) printSVar :: SVar t m a -> String -> IO () printSVar sv how = do svInfo <- dumpSVar sv hPutStrLn stderr $ "\n" <> how <> "\n" <> svInfo -printState :: MonadIO m => State Stream m a -> m ()-printState st = liftIO $ do- let msv = streamVar st- case msv of- Just sv -> dumpSVar sv >>= putStrLn- Nothing -> putStrLn "No SVar"- -- | Pull a stream from an SVar. {-# NOINLINE fromStreamVar #-} fromStreamVar :: MonadAsync m => SVar Stream m a -> Stream m a-fromStreamVar sv = Stream $ \st stp sng yld -> do+fromStreamVar sv = mkStream $ \st yld sng stp -> do list <- readOutputQ sv -- Reversing the output is important to guarantee that we process the -- outputs in the same order as they were generated by the constituent -- streams.- unStream (processEvents $ reverse list) (rstState st) stp sng yld+ foldStream st yld sng stp $ processEvents $ reverse list where @@ -83,36 +55,37 @@ stp {-# INLINE processEvents #-}- processEvents [] = Stream $ \st stp sng yld -> do+ processEvents [] = mkStream $ \st yld sng stp -> do done <- postProcess sv if done then allDone stp- else unStream (fromStreamVar sv) (rstState st) stp sng yld+ else foldStream st yld sng stp $ fromStreamVar sv - processEvents (ev : es) = Stream $ \st stp sng yld -> do+ processEvents (ev : es) = mkStream $ \st yld sng stp -> do let rest = processEvents es case ev of ChildYield a -> yld a rest ChildStop tid e -> do accountThread sv tid case e of- Nothing -> unStream rest (rstState st) stp sng yld+ Nothing -> foldStream st yld sng stp rest Just ex -> case fromException ex of Just ThreadAbort ->- unStream rest (rstState st) stp sng yld+ foldStream st yld sng stp rest Nothing -> liftIO (cleanupSVar sv) >> throwM ex {-# INLINE fromSVar #-} fromSVar :: (MonadAsync m, IsStream t) => SVar Stream m a -> t m a fromSVar sv =- fromStream $ Stream $ \st stp sng yld -> do+ mkStream $ \st yld sng stp -> do ref <- liftIO $ newIORef () _ <- liftIO $ mkWeakIORef ref hook -- We pass a copy of sv to fromStreamVar, so that we know that it has -- no other references, when that copy gets garbage collected "ref" -- will get garbage collected and our hook will be called.- unStream (fromStreamVar sv{svarRef = Just ref}) st stp sng yld+ foldStreamShared st yld sng stp $+ fromStream $ fromStreamVar sv{svarRef = Just ref} where hook = do@@ -129,178 +102,3 @@ -- be read back from the SVar using 'fromSVar'. toSVar :: (IsStream t, MonadAsync m) => SVar Stream m a -> t m a -> m () toSVar sv m = toStreamVar sv (toStream m)------------------------------------------------------------------------------------ Concurrency control-------------------------------------------------------------------------------------- XXX need to write these in direct style otherwise they will break fusion.------ | Specify the maximum number of threads that can be spawned concurrently for--- any concurrent combinator in a stream.--- A value of 0 resets the thread limit to default, a negative value means--- there is no limit. The default value is 1500.------ When the actions in a stream are IO bound, having blocking IO calls, this--- option can be used to control the maximum number of in-flight IO requests.--- When the actions are CPU bound this option can be used to--- control the amount of CPU used by the stream.------ @since 0.4.0-{-# INLINE_NORMAL maxThreads #-}-maxThreads :: IsStream t => Int -> t m a -> t m a-maxThreads n m = fromStream $ Stream $ \st stp sng yld ->- unStream (toStream m) (setMaxThreads n st) stp sng yld--{--{-# RULES "maxThreadsSerial serial" maxThreads = maxThreadsSerial #-}-maxThreadsSerial :: Int -> SerialT m a -> SerialT m a-maxThreadsSerial _ = id--}---- | Specify the maximum size of the buffer for storing the results from--- concurrent computations. If the buffer becomes full we stop spawning more--- concurrent tasks until there is space in the buffer.--- A value of 0 resets the buffer size to default, a negative value means--- there is no limit. The default value is 1500.------ CAUTION! using an unbounded 'maxBuffer' value (i.e. a negative value)--- coupled with an unbounded 'maxThreads' value is a recipe for disaster in--- presence of infinite streams, or very large streams. Especially, it must--- not be used when 'pure' is used in 'ZipAsyncM' streams as 'pure' in--- applicative zip streams generates an infinite stream causing unbounded--- concurrent generation with no limit on the buffer or threads.------ @since 0.4.0-{-# INLINE_NORMAL maxBuffer #-}-maxBuffer :: IsStream t => Int -> t m a -> t m a-maxBuffer n m = fromStream $ Stream $ \st stp sng yld ->- unStream (toStream m) (setMaxBuffer n st) stp sng yld--{--{-# RULES "maxBuffer serial" maxBuffer = maxBufferSerial #-}-maxBufferSerial :: Int -> SerialT m a -> SerialT m a-maxBufferSerial _ = id--}---- | Specify the pull rate of a stream.--- A 'Nothing' value resets the rate to default which is unlimited. When the--- rate is specified, concurrent production may be ramped up or down--- automatically to achieve the specified yield rate. The specific behavior for--- different styles of 'Rate' specifications is documented under 'Rate'. The--- effective maximum production rate achieved by a stream is governed by:------ * The 'maxThreads' limit--- * The 'maxBuffer' limit--- * The maximum rate that the stream producer can achieve--- * The maximum rate that the stream consumer can achieve------ @since 0.5.0-{-# INLINE_NORMAL rate #-}-rate :: IsStream t => Maybe Rate -> t m a -> t m a-rate r m = fromStream $ Stream $ \st stp sng yld ->- case r of- Just (Rate low goal _ _) | goal < low ->- error "rate: Target rate cannot be lower than minimum rate."- Just (Rate _ goal high _) | goal > high ->- error "rate: Target rate cannot be greater than maximum rate."- Just (Rate low _ high _) | low > high ->- error "rate: Minimum rate cannot be greater than maximum rate."- _ -> unStream (toStream m) (setStreamRate r st) stp sng yld---- XXX implement for serial streams as well, as a simple delay--{--{-# RULES "rate serial" rate = yieldRateSerial #-}-yieldRateSerial :: Double -> SerialT m a -> SerialT m a-yieldRateSerial _ = id--}---- | Same as @rate (Just $ Rate (r/2) r (2*r) maxBound)@------ Specifies the average production rate of a stream in number of yields--- per second (i.e. @Hertz@). Concurrent production is ramped up or down--- automatically to achieve the specified average yield rate. The rate can--- go down to half of the specified rate on the lower side and double of--- the specified rate on the higher side.------ @since 0.5.0-avgRate :: IsStream t => Double -> t m a -> t m a-avgRate r = rate (Just $ Rate (r/2) r (2*r) maxBound)---- | Same as @rate (Just $ Rate r r (2*r) maxBound)@------ Specifies the minimum rate at which the stream should yield values. As--- far as possible the yield rate would never be allowed to go below the--- specified rate, even though it may possibly go above it at times, the--- upper limit is double of the specified rate.------ @since 0.5.0-minRate :: IsStream t => Double -> t m a -> t m a-minRate r = rate (Just $ Rate r r (2*r) maxBound)---- | Same as @rate (Just $ Rate (r/2) r r maxBound)@------ Specifies the maximum rate at which the stream should yield values. As--- far as possible the yield rate would never be allowed to go above the--- specified rate, even though it may possibly go below it at times, the--- lower limit is half of the specified rate. This can be useful in--- applications where certain resource usage must not be allowed to go--- beyond certain limits.------ @since 0.5.0-maxRate :: IsStream t => Double -> t m a -> t m a-maxRate r = rate (Just $ Rate (r/2) r r maxBound)---- | Same as @rate (Just $ Rate r r r 0)@------ Specifies a constant yield rate. If for some reason the actual rate--- goes above or below the specified rate we do not try to recover it by--- increasing or decreasing the rate in future. This can be useful in--- applications like graphics frame refresh where we need to maintain a--- constant refresh rate.------ @since 0.5.0-constRate :: IsStream t => Double -> t m a -> t m a-constRate r = rate (Just $ Rate r r r 0)---- | Specify the average latency, in nanoseconds, of a single threaded action--- in a concurrent composition. Streamly can measure the latencies, but that is--- possible only after at least one task has completed. This combinator can be--- used to provide a latency hint so that rate control using 'rate' can take--- that into account right from the beginning. When not specified then a--- default behavior is chosen which could be too slow or too fast, and would be--- restricted by any other control parameters configured.--- A value of 0 indicates default behavior, a negative value means there is no--- limit i.e. zero latency.--- This would normally be useful only in high latency and high throughput--- cases.----{-# INLINE_NORMAL _serialLatency #-}-_serialLatency :: IsStream t => Int -> t m a -> t m a-_serialLatency n m = fromStream $ Stream $ \st stp sng yld ->- unStream (toStream m) (setStreamLatency n st) stp sng yld--{--{-# RULES "serialLatency serial" _serialLatency = serialLatencySerial #-}-serialLatencySerial :: Int -> SerialT m a -> SerialT m a-serialLatencySerial _ = id--}---- Stop concurrent dispatches after this limit. This is useful in API's like--- "take" where we want to dispatch only upto the number of elements "take"--- needs. This value applies only to the immediate next level and is not--- inherited by everything in enclosed scope.-{-# INLINE_NORMAL maxYields #-}-maxYields :: IsStream t => Maybe Int64 -> t m a -> t m a-maxYields n m = fromStream $ Stream $ \st stp sng yld ->- unStream (toStream m) (setYieldLimit n st) stp sng yld--{-# RULES "maxYields serial" maxYields = maxYieldsSerial #-}-maxYieldsSerial :: Maybe Int64 -> SerialT m a -> SerialT m a-maxYieldsSerial _ = id---- | Print debug information about an SVar when the stream ends-inspectMode :: IsStream t => t m a -> t m a-inspectMode m = fromStream $ Stream $ \st stp sng yld ->- unStream (toStream m) (setInspectMode st) stp sng yld
src/Streamly/Streams/Serial.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving#-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- XXX -- |@@ -23,7 +24,7 @@ SerialT , StreamT -- deprecated , Serial- , serial+ , K.serial , serially -- * Serial interleaving stream@@ -41,6 +42,8 @@ ) where +import Control.Applicative (liftA2)+import Control.DeepSeq (NFData(..), NFData1(..), rnf1) import Control.Monad (ap) import Control.Monad.Base (MonadBase(..), liftBaseDefault) import Control.Monad.Catch (MonadThrow, throwM)@@ -49,16 +52,22 @@ import Control.Monad.Reader.Class (MonadReader(..)) import Control.Monad.State.Class (MonadState(..)) import Control.Monad.Trans.Class (MonadTrans(lift))+import Data.Functor.Identity (Identity(..), runIdentity)+import Data.Foldable (fold) import Data.Semigroup (Semigroup(..))+import GHC.Exts (IsList(..), IsString(..))+import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec,+ readListPrecDefault) import Prelude hiding (map, mapM) -import Streamly.SVar (rstState)-import Streamly.Streams.StreamK (IsStream(..), adapt, Stream(..))+import Streamly.Streams.StreamK (IsStream(..), adapt, Stream, mkStream,+ foldStream)+import qualified Streamly.Streams.Prelude as P import qualified Streamly.Streams.StreamK as K import qualified Streamly.Streams.StreamD as D #include "Instances.hs"-#include "inline.h"+#include "inline.hs" ------------------------------------------------------------------------------ -- SerialT@@ -140,34 +149,16 @@ serially :: IsStream t => SerialT m a -> t m a serially = adapt +{-# INLINE consMSerial #-}+{-# SPECIALIZE consMSerial :: IO a -> SerialT IO a -> SerialT IO a #-}+consMSerial :: Monad m => m a -> SerialT m a -> SerialT m a+consMSerial m ms = fromStream $ K.consMStream m (toStream ms)+ instance IsStream SerialT where toStream = getSerialT fromStream = SerialT-- {-# INLINE consM #-}- {-# SPECIALIZE consM :: IO a -> SerialT IO a -> SerialT IO a #-}- consM :: Monad m => m a -> SerialT m a -> SerialT m a- consM m r = fromStream $ K.consMSerial m (toStream r)-- {-# INLINE (|:) #-}- {-# SPECIALIZE (|:) :: IO a -> SerialT IO a -> SerialT IO a #-}- (|:) :: Monad m => m a -> SerialT m a -> SerialT m a- m |: r = fromStream $ K.consMSerial m (toStream r)----------------------------------------------------------------------------------- Semigroup----------------------------------------------------------------------------------- | Polymorphic version of the 'Semigroup' operation '<>' of 'SerialT'.--- Appends two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.------ @since 0.2.0-{-# INLINE serial #-}-serial :: IsStream t => t m a -> t m a -> t m a-serial m1 m2 = fromStream $ Stream $ \st stp sng yld ->- unStream (K.serial (toStream m1) (toStream m2))- (rstState st) stp sng yld+ consM = consMSerial+ (|:) = consMSerial ------------------------------------------------------------------------------ -- Monad@@ -175,11 +166,7 @@ instance Monad m => Monad (SerialT m) where return = pure- (SerialT (Stream m)) >>= f = SerialT $ Stream $ \st stp sng yld ->- let run x = unStream x (rstState st) stp sng yld- single a = run $ toStream (f a)- yieldk a r = run $ toStream $ f a <> (fromStream r >>= f)- in m (rstState st) stp single yieldk+ (>>=) = K.bindWith K.serial ------------------------------------------------------------------------------ -- Other instances@@ -189,8 +176,18 @@ mapM :: (IsStream t, Monad m) => (a -> m b) -> t m a -> t m b mapM f m = fromStream $ D.toStreamK $ D.mapM f $ D.fromStreamK (toStream m) --- | Same as 'fmap'.+-- |+-- @+-- map = fmap+-- @ --+-- Same as 'fmap'.+--+-- @+-- > S.toList $ S.map (+1) $ S.fromList [1,2,3]+-- [2,3,4]+-- @+-- -- @since 0.4.0 {-# INLINE map #-} map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b@@ -198,6 +195,9 @@ MONAD_APPLICATIVE_INSTANCE(SerialT,) MONAD_COMMON_INSTANCES(SerialT,)+LIST_INSTANCES(SerialT)+FOLDABLE_INSTANCE(SerialT)+TRAVERSABLE_INSTANCE(SerialT) ------------------------------------------------------------------------------ -- WSerialT@@ -267,6 +267,9 @@ interleaving :: IsStream t => WSerialT m a -> t m a interleaving = wSerially +consMWSerial :: Monad m => m a -> WSerialT m a -> WSerialT m a+consMWSerial m ms = fromStream $ K.consMStream m (toStream ms)+ instance IsStream WSerialT where toStream = getWSerialT fromStream = WSerialT@@ -274,34 +277,28 @@ {-# INLINE consM #-} {-# SPECIALIZE consM :: IO a -> WSerialT IO a -> WSerialT IO a #-} consM :: Monad m => m a -> WSerialT m a -> WSerialT m a- consM m r = fromStream $ K.consMSerial m (toStream r)+ consM = consMWSerial {-# INLINE (|:) #-} {-# SPECIALIZE (|:) :: IO a -> WSerialT IO a -> WSerialT IO a #-} (|:) :: Monad m => m a -> WSerialT m a -> WSerialT m a- m |: r = fromStream $ K.consMSerial m (toStream r)+ (|:) = consMWSerial ------------------------------------------------------------------------------ -- Semigroup ------------------------------------------------------------------------------ -{-# INLINE interleave #-}-interleave :: Stream m a -> Stream m a -> Stream m a-interleave m1 m2 = Stream $ \st stp sng yld -> do- let stop = unStream m2 (rstState st) stp sng yld- single a = yld a m2- yieldk a r = yld a (interleave m2 r)- unStream m1 (rstState st) stop single yieldk- -- | Polymorphic version of the 'Semigroup' operation '<>' of 'WSerialT'. -- Interleaves two streams, yielding one element from each stream alternately. -- -- @since 0.2.0 {-# INLINE wSerial #-} wSerial :: IsStream t => t m a -> t m a -> t m a-wSerial m1 m2 = fromStream $ Stream $ \st stp sng yld ->- unStream (interleave (toStream m1) (toStream m2))- (rstState st) stp sng yld+wSerial m1 m2 = mkStream $ \st yld sng stp -> do+ let stop = foldStream st yld sng stp m2+ single a = yld a m2+ yieldk a r = yld a (wSerial m2 r)+ foldStream st yieldk single stop m1 instance Semigroup (WSerialT m a) where (<>) = wSerial@@ -330,11 +327,7 @@ instance Monad m => Monad (WSerialT m) where return = pure- (WSerialT (Stream m)) >>= f = WSerialT $ Stream $ \st stp sng yld ->- let run x = unStream x (rstState st) stp sng yld- single a = run $ toStream (f a)- yieldk a r = run $ toStream $ f a <> (fromStream r >>= f)- in m (rstState st) stp single yieldk+ (>>=) = K.bindWith wSerial ------------------------------------------------------------------------------ -- Other instances@@ -342,3 +335,6 @@ MONAD_APPLICATIVE_INSTANCE(WSerialT,) MONAD_COMMON_INSTANCES(WSerialT,)+LIST_INSTANCES(WSerialT)+FOLDABLE_INSTANCE(WSerialT)+TRAVERSABLE_INSTANCE(WSerialT)
src/Streamly/Streams/StreamD.hs view
@@ -5,665 +5,1460 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}--#include "inline.h"---- |--- Module : Streamly.Streams.StreamD--- Copyright : (c) 2018 Harendra Kumar------ License : BSD3--- Maintainer : harendra.kumar@gmail.com--- Stability : experimental--- Portability : GHC------ Direct style re-implementation of CPS style stream in StreamK module. The--- symbol or suffix 'D' in this module denotes the "Direct" style. GHC is able--- to INLINE and fuse direct style better, providing better performance than--- CPS implementation.------ @--- import qualified Streamly.Streams.StreamD as D--- @---- Some of functions in this file have been adapted from the vector--- library, https://hackage.haskell.org/package/vector.--module Streamly.Streams.StreamD- (- -- * The stream type- Step (..)- , Stream (..)-- -- * Construction- , nil- , cons-- -- * Deconstruction- , uncons-- -- * Generation- -- ** Unfolds- , unfoldr- , unfoldrM-- -- ** Specialized Generation- -- | Generate a monadic stream from a seed.- , repeat- , enumFromStepN-- -- ** Conversions- -- | Transform an input structure into a stream.- -- | Direct style stream does not support @fromFoldable@.- , yield- , yieldM- , fromList- , fromListM- , fromStreamK-- -- * Elimination- -- ** General Folds- , foldr- , foldrM- , foldl'- , foldlM'-- -- ** Specialized Folds- , runStream- , null- , head- , tail- , last- , elem- , notElem- , all- , any- , maximum- , minimum-- -- ** Map and Fold- , mapM_-- -- ** Conversions- -- | Transform a stream into another type.- , toList- , toStreamK-- -- * Transformation- -- ** By folding (scans)- , scanlM'-- -- * Filtering- , filter- , filterM- , take- , takeWhile- , takeWhileM- , drop- , dropWhile- , dropWhileM-- -- * Mapping- , map- , mapM-- -- ** Map and Filter- , mapMaybe- , mapMaybeM-- -- * Zipping- , zipWith- , zipWithM- )-where--import Data.Maybe (fromJust, isJust)-import GHC.Types ( SPEC(..) )-import Prelude- hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,- takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,- notElem, null, head, tail, zipWith)--import Streamly.SVar (MonadAsync, State(..), defState, rstState)-import qualified Streamly.Streams.StreamK as K----------------------------------------------------------------------------------- The direct style stream type----------------------------------------------------------------------------------- | A stream is a succession of 'Step's. A 'Yield' produces a single value and--- the next state of the stream. 'Stop' indicates there are no more values in--- the stream.-data Step s a = Yield a s | Stop--instance Functor (Step s) where- {-# INLINE fmap #-}- fmap f (Yield x s) = Yield (f x) s- fmap _ Stop = Stop---- gst = global state--- | A stream consists of a step function that generates the next step given a--- current state, and the current state.-data Stream m a = forall s. Stream (State K.Stream m a -> s -> m (Step s a)) s----------------------------------------------------------------------------------- Construction----------------------------------------------------------------------------------- | An empty 'Stream'.-{-# INLINE_NORMAL nil #-}-nil :: Monad m => Stream m a-nil = Stream (\_ _ -> return Stop) ()---- | Can fuse but has O(n^2) complexity.-cons :: Monad m => a -> Stream m a -> Stream m a-cons x (Stream step state) = Stream step1 Nothing- where- step1 _ Nothing = return $ Yield x (Just state)- step1 gst (Just st) = do- r <- step (rstState gst) st- case r of- Yield a s -> return $ Yield a (Just s)- Stop -> return Stop------------------------------------------------------------------------------------ Deconstruction------------------------------------------------------------------------------------ Does not fuse, has the same performance as the StreamK version.-{-# INLINE_NORMAL uncons #-}-uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))-uncons (Stream step state) = go state- where- go st = do- r <- step defState st- return $ case r of- Yield x s -> Just (x, Stream step s)- Stop -> Nothing----------------------------------------------------------------------------------- Generation by unfold---------------------------------------------------------------------------------{-# INLINE_NORMAL unfoldrM #-}-unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-unfoldrM next state = Stream step state- where- {-# INLINE_LATE step #-}- step _ st = do- r <- next st- return $ case r of- Just (x, s) -> Yield x s- Nothing -> Stop--{-# INLINE_LATE unfoldr #-}-unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a-unfoldr f = unfoldrM (return . f)----------------------------------------------------------------------------------- Specialized Generation---------------------------------------------------------------------------------repeat :: Monad m => a -> Stream m a-repeat x = Stream (\_ _ -> return $ Yield x ()) ()--{-# INLINE_NORMAL enumFromStepN #-}-enumFromStepN :: (Num a, Monad m) => a -> a -> Int -> Stream m a-enumFromStepN from stride n =- from `seq` stride `seq` n `seq` Stream step (from, n)- where- {-# INLINE_LATE step #-}- step _ (x, i) | i > 0 = return $ Yield x (x + stride, i - 1)- | otherwise = return Stop------------------------------------------------------------------------------------ Generation by Conversion------------------------------------------------------------------------------------ | Create a singleton 'Stream' from a pure value.-{-# INLINE_NORMAL yield #-}-yield :: Monad m => a -> Stream m a-yield x = Stream (\_ s -> return $ step undefined s) True- where- {-# INLINE_LATE step #-}- step _ True = Yield x False- step _ False = Stop---- | Create a singleton 'Stream' from a monadic action.-{-# INLINE_NORMAL yieldM #-}-yieldM :: Monad m => m a -> Stream m a-yieldM m = Stream step True- where- {-# INLINE_LATE step #-}- step _ True = m >>= \x -> return $ Yield x False- step _ False = return Stop---- XXX we need the MonadAsync constraint because of a rewrite rule.--- | Convert a list of monadic actions to a 'Stream'-{-# INLINE_LATE fromListM #-}-fromListM :: MonadAsync m => [m a] -> Stream m a-fromListM = Stream step- where- {-# INLINE_LATE step #-}- step _ (m:ms) = m >>= \x -> return $ Yield x ms- step _ [] = return Stop---- | Convert a list of pure values to a 'Stream'-{-# INLINE_LATE fromList #-}-fromList :: Monad m => [a] -> Stream m a-fromList = Stream step- where- {-# INLINE_LATE step #-}- step _ (x:xs) = return $ Yield x xs- step _ [] = return Stop---- XXX pass the state to streamD-{-# INLINE_LATE fromStreamK #-}-fromStreamK :: Monad m => K.Stream m a -> Stream m a-fromStreamK = Stream step- where- step gst m1 =- let stop = return Stop- single a = return $ Yield a K.nil- yieldk a r = return $ Yield a r- in K.unStream m1 gst stop single yieldk----------------------------------------------------------------------------------- Elimination by Folds---------------------------------------------------------------------------------{-# INLINE_NORMAL foldrM #-}-foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b-foldrM f z (Stream step state) = go SPEC state- where- go !_ st = do- r <- step defState st- case r of- Yield x s -> go SPEC s >>= f x- Stop -> return z--{-# INLINE_NORMAL foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b-foldr f = foldrM (\a b -> return (f a b))--{-# INLINE_NORMAL foldlM' #-}-foldlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b-foldlM' fstep begin (Stream step state) = go SPEC begin state- where- go !_ acc st = acc `seq` do- r <- step defState st- case r of- Yield x s -> do- acc' <- fstep acc x- go SPEC acc' s- Stop -> return acc--{-# INLINE foldl' #-}-foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b-foldl' fstep = foldlM' (\b a -> return (fstep b a))----------------------------------------------------------------------------------- Specialized Folds----------------------------------------------------------------------------------- | Run a streaming composition, discard the results.-{-# INLINE_LATE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream (Stream step state) = go SPEC state- where- go !_ st = do- r <- step defState st- case r of- Yield _ s -> go SPEC s- Stop -> return ()--{-# INLINE_NORMAL null #-}-null :: Monad m => Stream m a -> m Bool-null (Stream step state) = go state- where- go st = do- r <- step defState st- case r of- Yield _ _ -> return False- Stop -> return True---- XXX SPEC?-{-# INLINE_NORMAL head #-}-head :: Monad m => Stream m a -> m (Maybe a)-head (Stream step state) = go state- where- go st = do- r <- step defState st- case r of- Yield x _ -> return (Just x)- Stop -> return Nothing---- Does not fuse, has the same performance as the StreamK version.-{-# INLINE_NORMAL tail #-}-tail :: Monad m => Stream m a -> m (Maybe (Stream m a))-tail (Stream step state) = go state- where- go st = do- r <- step defState st- case r of- Yield _ s -> return (Just $ Stream step s)- Stop -> return Nothing---- XXX will it fuse? need custom impl?-{-# INLINE_NORMAL last #-}-last :: Monad m => Stream m a -> m (Maybe a)-last = foldl' (\_ y -> Just y) Nothing--{-# INLINE_NORMAL elem #-}-elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-elem e (Stream step state) = go state- where- go st = do- r <- step defState st- case r of- Yield x s ->- if x == e- then return True- else go s- Stop -> return False--{-# INLINE_NORMAL notElem #-}-notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-notElem e (Stream step state) = go state- where- go st = do- r <- step defState st- case r of- Yield x s ->- if x == e- then return False- else go s- Stop -> return True--{-# INLINE_NORMAL all #-}-all :: Monad m => (a -> Bool) -> Stream m a -> m Bool-all p (Stream step state) = go state- where- go st = do- r <- step defState st- case r of- Yield x s ->- if p x- then go s- else return False- Stop -> return True--{-# INLINE_NORMAL any #-}-any :: Monad m => (a -> Bool) -> Stream m a -> m Bool-any p (Stream step state) = go state- where- go st = do- r <- step defState st- case r of- Yield x s ->- if p x- then return True- else go s- Stop -> return False--{-# INLINE_NORMAL maximum #-}-maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)-maximum (Stream step state) = go Nothing state- where- go Nothing st = do- r <- step defState st- case r of- Yield x s -> go (Just x) s- Stop -> return Nothing- go (Just acc) st = do- r <- step defState st- case r of- Yield x s ->- if acc <= x- then go (Just x) s- else go (Just acc) s- Stop -> return (Just acc)--{-# INLINE_NORMAL minimum #-}-minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)-minimum (Stream step state) = go Nothing state- where- go Nothing st = do- r <- step defState st- case r of- Yield x s -> go (Just x) s- Stop -> return Nothing- go (Just acc) st = do- r <- step defState st- case r of- Yield x s ->- if acc <= x- then go (Just acc) s- else go (Just x) s- Stop -> return (Just acc)----------------------------------------------------------------------------------- Map and Fold----------------------------------------------------------------------------------- | Execute a monadic action for each element of the 'Stream'-{-# INLINE_NORMAL mapM_ #-}-mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()-mapM_ m = runStream . mapM m----------------------------------------------------------------------------------- Converting folds---------------------------------------------------------------------------------{-# INLINE toList #-}-toList :: Monad m => Stream m a -> m [a]-toList = foldr (:) []---- Convert a direct stream to and from CPS encoded stream-{-# INLINE_LATE toStreamK #-}-toStreamK :: Monad m => Stream m a -> K.Stream m a-toStreamK (Stream step state) = go state- where- go st = K.Stream $ \gst stp _ yld -> do- r <- step gst st- case r of- Yield x s -> yld x (go s)- Stop -> stp--#ifndef DISABLE_FUSION-{-# RULES "fromStreamK/toStreamK fusion"- forall s. toStreamK (fromStreamK s) = s #-}-{-# RULES "toStreamK/fromStreamK fusion"- forall s. fromStreamK (toStreamK s) = s #-}-#endif----------------------------------------------------------------------------------- Transformation by Folding (Scans)---------------------------------------------------------------------------------{-# INLINE_NORMAL postscanlM' #-}-postscanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b-postscanlM' fstep begin (Stream step state) =- begin `seq` Stream step' (state, begin)- where- {-# INLINE_LATE step' #-}- step' gst (st, acc) = acc `seq` do- r <- step (rstState gst) st- case r of- Yield x s -> do- y <- fstep acc x- y `seq` return (Yield y (s, y))- Stop -> return Stop--{-# INLINE scanlM' #-}-scanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b-scanlM' fstep begin s = begin `seq` (begin `cons` postscanlM' fstep begin s)------------------------------------------------------------------------------------ Filtering----------------------------------------------------------------------------------{-# INLINE_NORMAL take #-}-take :: Monad m => Int -> Stream m a -> Stream m a-take n (Stream step state) = n `seq` Stream step' (state, 0)- where- {-# INLINE_LATE step' #-}- step' gst (st, i) | i < n = do- r <- step (rstState gst) st- return $ case r of- Yield x s -> Yield x (s, i + 1)- Stop -> Stop- step' _ (_, _) = return Stop--{-# INLINE_NORMAL takeWhileM #-}-takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-takeWhileM f (Stream step state) = Stream step' state- where- {-# INLINE_LATE step' #-}- step' gst st = do- r <- step (rstState gst) st- case r of- Yield x s -> do- b <- f x- return $ if b then Yield x s else Stop- Stop -> return Stop--{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-takeWhile f = takeWhileM (return . f)--{-# INLINE_NORMAL drop #-}-drop :: Monad m => Int -> Stream m a -> Stream m a-drop n (Stream step state) = Stream step' (state, n)- where- {-# INLINE_LATE step' #-}- step' gst (st, i) = do- r <- step (rstState gst) st- case r of- Yield _ s | i > 0 -> step' gst (s, i - 1)- Yield x s -> return $ Yield x (s, 0)- Stop -> return Stop--data DropWhileState s a- = DropWhileDrop s- | DropWhileYield a s- | DropWhileNext s--{-# INLINE_NORMAL dropWhileM #-}-dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)- where- {-# INLINE_LATE step' #-}- step' gst (DropWhileDrop st) = do- r <- step (rstState gst) st- case r of- Yield x s -> do- b <- f x- if b- then step' gst (DropWhileDrop s)- else step' gst (DropWhileYield x s)- Stop -> return Stop-- step' gst (DropWhileNext st) = do- r <- step (rstState gst) st- case r of- Yield x s -> step' gst (DropWhileYield x s)- Stop -> return Stop-- step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)--{-# INLINE dropWhile #-}-dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-dropWhile f = dropWhileM (return . f)--{-# INLINE_NORMAL filterM #-}-filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-filterM f (Stream step state) = Stream step' state- where- {-# INLINE_LATE step' #-}- step' gst st = do- r <- step (rstState gst) st- case r of- Yield x s -> do- b <- f x- if b- then return $ Yield x s- else step' gst s- Stop -> return Stop--{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-filter f = filterM (return . f)----------------------------------------------------------------------------------- Transformation by Mapping----------------------------------------------------------------------------------- | Map a monadic function over a 'Stream'-{-# INLINE_NORMAL mapM #-}-mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b-mapM f (Stream step state) = Stream step' state- where- {-# INLINE_LATE step' #-}- step' gst st = do- r <- step (rstState gst) st- case r of- Yield x s -> f x >>= \a -> return $ Yield a s- Stop -> return Stop--{-# INLINE map #-}-map :: Monad m => (a -> b) -> Stream m a -> Stream m b-map f = mapM (return . f)----------------------------------------------------------------------------------- Transformation by Map and Filter----------------------------------------------------------------------------------- XXX Will this always fuse properly?-{-# INLINE_NORMAL mapMaybe #-}-mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b-mapMaybe f = fmap fromJust . filter isJust . map f--{-# INLINE_NORMAL mapMaybeM #-}-mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b-mapMaybeM f = fmap fromJust . filter isJust . mapM f----------------------------------------------------------------------------------- Instances---------------------------------------------------------------------------------{-# INLINE_NORMAL zipWithM #-}-zipWithM :: Monad m- => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c-zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)- where- {-# INLINE_LATE step #-}- step gst (sa, sb, Nothing) = do- r <- stepa (rstState gst) sa- case r of- Yield x sa' -> step gst (sa', sb, Just x)- Stop -> return Stop-- step gst (sa, sb, Just x) = do- r <- stepb (rstState gst) sb- case r of- Yield y sb' -> do- z <- f x y- return $ Yield z (sa, sb', Nothing)- Stop -> return Stop--{-# RULES "zipWithM xs xs"- forall f xs. zipWithM f xs xs = mapM (\x -> f x x) xs #-}--{-# INLINE zipWith #-}-zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-zipWith f = zipWithM (\a b -> return (f a b))----------------------------------------------------------------------------------- Instances---------------------------------------------------------------------------------instance Monad m => Functor (Stream m) where- {-# INLINE fmap #-}- fmap = map+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RankNTypes #-}++#include "inline.hs"++-- |+-- Module : Streamly.Streams.StreamD+-- Copyright : (c) 2018 Harendra Kumar+-- Copyright : (c) Roman Leshchinskiy 2008-2010+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com+-- Stability : experimental+-- Portability : GHC+--+-- Direct style re-implementation of CPS style stream in StreamK module. The+-- symbol or suffix 'D' in this module denotes the "Direct" style. GHC is able+-- to INLINE and fuse direct style better, providing better performance than+-- CPS implementation.+--+-- @+-- import qualified Streamly.Streams.StreamD as D+-- @++-- Some of the functions in this file have been adapted from the vector+-- library, https://hackage.haskell.org/package/vector.++module Streamly.Streams.StreamD+ (+ -- * The stream type+ Step (..)+ , Stream (..)++ -- * Construction+ , nil+ , cons++ -- * Deconstruction+ , uncons++ -- * Generation+ -- ** Unfolds+ , unfoldr+ , unfoldrM++ -- ** Specialized Generation+ -- | Generate a monadic stream from a seed.+ , repeat+ , replicate+ , replicateM+ , fromIndices+ , fromIndicesM+ , generate+ , generateM++ -- ** Enumerations+ , enumerateFromStepIntegral+ , enumerateFromIntegral+ , enumerateFromThenIntegral+ , enumerateFromToIntegral+ , enumerateFromThenToIntegral++ , enumerateFromStepNum+ , numFrom+ , numFromThen+ , enumerateFromToFractional+ , enumerateFromThenToFractional++ -- ** Conversions+ -- | Transform an input structure into a stream.+ -- | Direct style stream does not support @fromFoldable@.+ , yield+ , yieldM+ , fromList+ , fromListM+ , fromStreamK+ , fromStreamD++ -- * Elimination+ -- ** General Folds+ , foldr+ , foldrM+ , foldr1+ , foldl'+ , foldlM'++ -- ** Specialized Folds+ , runStream+ , null+ , head+ , tail+ , last+ , elem+ , notElem+ , all+ , any+ , maximum+ , maximumBy+ , minimum+ , minimumBy+ , findIndices+ , lookup+ , findM+ , find+ , (!!)+ , concatMapM+ , concatMap++ -- ** Substreams+ , isPrefixOf+ , isSubsequenceOf+ , stripPrefix++ -- ** Map and Fold+ , mapM_++ -- ** Conversions+ -- | Transform a stream into another type.+ , toList+ , toStreamK+ , toStreamD++ -- * Transformation+ -- ** By folding (scans)+ , scanlM'+ , scanl'+ , scanlM+ , scanl+ , scanl1M'+ , scanl1'+ , scanl1M+ , scanl1++ , prescanl'+ , prescanlM'+ , postscanl+ , postscanlM+ , postscanl'+ , postscanlM'++ -- * Filtering+ , filter+ , filterM+ , uniq+ , take+ , takeWhile+ , takeWhileM+ , drop+ , dropWhile+ , dropWhileM++ -- * Mapping+ , map+ , mapM+ , sequence++ -- * Inserting+ , insertBy++ -- * Deleting+ , deleteBy++ -- ** Map and Filter+ , mapMaybe+ , mapMaybeM++ -- * Zipping+ , indexed+ , indexedR+ , zipWith+ , zipWithM++ -- * Comparisions+ , eqBy+ , cmpBy++ -- * Merging+ , mergeBy+ , mergeByM++ -- * Transformation comprehensions+ , the+ )+where++import Data.Maybe (fromJust, isJust)+import GHC.Types ( SPEC(..) )+import Prelude+ hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,+ takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,+ notElem, null, head, tail, zipWith, lookup, foldr1, sequence,+ (!!), scanl, scanl1, concatMap, replicate, enumFromTo)++import Streamly.SVar (MonadAsync, defState, adaptState)++import Streamly.Streams.StreamD.Type+import qualified Streamly.Streams.StreamK as K++------------------------------------------------------------------------------+-- Construction+------------------------------------------------------------------------------++-- | An empty 'Stream'.+{-# INLINE_NORMAL nil #-}+nil :: Monad m => Stream m a+nil = Stream (\_ _ -> return Stop) ()++-- | Can fuse but has O(n^2) complexity.+{-# INLINE_NORMAL cons #-}+cons :: Monad m => a -> Stream m a -> Stream m a+cons x (Stream step state) = Stream step1 Nothing+ where+ {-# INLINE_LATE step1 #-}+ step1 _ Nothing = return $ Yield x (Just state)+ step1 gst (Just st) = do+ r <- step gst st+ return $+ case r of+ Yield a s -> Yield a (Just s)+ Skip s -> Skip (Just s)+ Stop -> Stop++-------------------------------------------------------------------------------+-- Deconstruction+-------------------------------------------------------------------------------++-- Does not fuse, has the same performance as the StreamK version.+{-# INLINE_NORMAL uncons #-}+uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))+uncons (UnStream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield x s -> return $ Just (x, Stream step s)+ Skip s -> go s+ Stop -> return Nothing++------------------------------------------------------------------------------+-- Generation by unfold+------------------------------------------------------------------------------++{-# INLINE_NORMAL unfoldrM #-}+unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a+unfoldrM next state = Stream step state+ where+ {-# INLINE_LATE step #-}+ step _ st = do+ r <- next st+ return $ case r of+ Just (x, s) -> Yield x s+ Nothing -> Stop++{-# INLINE_LATE unfoldr #-}+unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a+unfoldr f = unfoldrM (return . f)++------------------------------------------------------------------------------+-- Specialized Generation+------------------------------------------------------------------------------++repeat :: Monad m => a -> Stream m a+repeat x = Stream (\_ _ -> return $ Yield x ()) ()++{-# INLINE_NORMAL replicateM #-}+replicateM :: Monad m => Int -> m a -> Stream m a+replicateM n p = Stream step n+ where+ {-# INLINE_LATE step #-}+ step _ i | i <= 0 = return Stop+ | otherwise = do+ x <- p+ return $ Yield x (i - 1)++{-# INLINE_NORMAL replicate #-}+replicate :: Monad m => Int -> a -> Stream m a+replicate n x = replicateM n (return x)++-- This would not work properly for floats, therefore we put an Integral+-- constraint.+-- | Can be used to enumerate unbounded integrals. This does not check for+-- overflow or underflow for bounded integrals.+{-# INLINE_NORMAL enumerateFromStepIntegral #-}+enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a+enumerateFromStepIntegral from stride =+ from `seq` stride `seq` Stream step from+ where+ {-# INLINE_LATE step #-}+ step _ !x = return $ Yield x $! (x + stride)++-- We are assuming that "to" is constrained by the type to be within+-- max/min bounds.+{-# INLINE enumerateFromToIntegral #-}+enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a+enumerateFromToIntegral from to =+ takeWhile (<= to) $ enumerateFromStepIntegral from 1++{-# INLINE enumerateFromIntegral #-}+enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => a -> Stream m a+enumerateFromIntegral from = enumerateFromToIntegral from maxBound++data EnumState a = EnumInit | EnumYield a a a | EnumStop++{-# INLINE_NORMAL enumerateFromThenToIntegralUp #-}+enumerateFromThenToIntegralUp+ :: (Monad m, Integral a)+ => a -> a -> a -> Stream m a+enumerateFromThenToIntegralUp from next to = Stream step EnumInit+ where+ {-# INLINE_LATE step #-}+ step _ EnumInit =+ return $+ if to < next+ then if to < from+ then Stop+ else Yield from EnumStop+ else -- from <= next <= to+ let stride = next - from+ in Skip $ EnumYield from stride (to - stride)++ step _ (EnumYield x stride toMinus) =+ return $+ if x > toMinus+ then Yield x EnumStop+ else Yield x $ EnumYield (x + stride) stride toMinus++ step _ EnumStop = return Stop++{-# INLINE_NORMAL enumerateFromThenToIntegralDn #-}+enumerateFromThenToIntegralDn+ :: (Monad m, Integral a)+ => a -> a -> a -> Stream m a+enumerateFromThenToIntegralDn from next to = Stream step EnumInit+ where+ {-# INLINE_LATE step #-}+ step _ EnumInit =+ return $ if to > next+ then if to > from+ then Stop+ else Yield from EnumStop+ else -- from >= next >= to+ let stride = next - from+ in Skip $ EnumYield from stride (to - stride)++ step _ (EnumYield x stride toMinus) =+ return $+ if x < toMinus+ then Yield x EnumStop+ else Yield x $ EnumYield (x + stride) stride toMinus++ step _ EnumStop = return Stop++{-# INLINE_NORMAL enumerateFromThenToIntegral #-}+enumerateFromThenToIntegral+ :: (Monad m, Integral a)+ => a -> a -> a -> Stream m a+enumerateFromThenToIntegral from next to+ | next >= from = enumerateFromThenToIntegralUp from next to+ | otherwise = enumerateFromThenToIntegralDn from next to++{-# INLINE_NORMAL enumerateFromThenIntegral #-}+enumerateFromThenIntegral+ :: (Monad m, Integral a, Bounded a)+ => a -> a -> Stream m a+enumerateFromThenIntegral from next =+ if next > from+ then enumerateFromThenToIntegralUp from next maxBound+ else enumerateFromThenToIntegralDn from next minBound++-- For floating point numbers if the increment is less than the precision then+-- it just gets lost. Therefore we cannot always increment it correctly by just+-- repeated addition.+-- 9007199254740992 + 1 + 1 :: Double => 9.007199254740992e15+-- 9007199254740992 + 2 :: Double => 9.007199254740994e15++-- Instead we accumulate the increment counter and compute the increment+-- everytime before adding it to the starting number.+--+-- This works for Integrals as well as floating point numbers, but+-- enumerateFromStepIntegral is faster for integrals.+{-# INLINE_NORMAL enumerateFromStepNum #-}+enumerateFromStepNum :: (Monad m, Num a) => a -> a -> Stream m a+enumerateFromStepNum from stride = Stream step 0+ where+ {-# INLINE_LATE step #-}+ step _ !i = return $ (Yield $! (from + i * stride)) $! (i + 1)++{-# INLINE_NORMAL numFrom #-}+numFrom :: (Monad m, Num a) => a -> Stream m a+numFrom from = enumerateFromStepNum from 1++{-# INLINE_NORMAL numFromThen #-}+numFromThen :: (Monad m, Num a) => a -> a -> Stream m a+numFromThen from next = enumerateFromStepNum from (next - from)++-- We cannot write a general function for Num. The only way to write code+-- portable between the two is to use a 'Real' constraint and convert between+-- Fractional and Integral using fromRational which is horribly slow.+{-# INLINE_NORMAL enumerateFromToFractional #-}+enumerateFromToFractional+ :: (Monad m, Fractional a, Ord a)+ => a -> a -> Stream m a+enumerateFromToFractional from to =+ takeWhile (<= to + 1 / 2) $ enumerateFromStepNum from 1++{-# INLINE_NORMAL enumerateFromThenToFractional #-}+enumerateFromThenToFractional+ :: (Monad m, Fractional a, Ord a)+ => a -> a -> a -> Stream m a+enumerateFromThenToFractional from next to =+ takeWhile predicate $ numFromThen from next+ where+ mid = (next - from) / 2+ predicate | next >= from = (<= to + mid)+ | otherwise = (>= to + mid)++-------------------------------------------------------------------------------+-- Generation by Conversion+-------------------------------------------------------------------------------++-- | Create a singleton 'Stream' from a pure value.+{-# INLINE_NORMAL yield #-}+yield :: Monad m => a -> Stream m a+yield x = Stream (\_ s -> return $ step undefined s) True+ where+ {-# INLINE_LATE step #-}+ step _ True = Yield x False+ step _ False = Stop++-- | Create a singleton 'Stream' from a monadic action.+{-# INLINE_NORMAL yieldM #-}+yieldM :: Monad m => m a -> Stream m a+yieldM m = Stream step True+ where+ {-# INLINE_LATE step #-}+ step _ True = m >>= \x -> return $ Yield x False+ step _ False = return Stop++{-# INLINE_NORMAL fromIndicesM #-}+fromIndicesM :: Monad m => (Int -> m a) -> Stream m a+fromIndicesM gen = Stream step 0+ where+ {-# INLINE_LATE step #-}+ step _ i = do+ x <- gen i+ return $ Yield x (i + 1)++{-# INLINE fromIndices #-}+fromIndices :: Monad m => (Int -> a) -> Stream m a+fromIndices gen = fromIndicesM (return . gen)++{-# INLINE_NORMAL generateM #-}+generateM :: Monad m => Int -> (Int -> m a) -> Stream m a+generateM n gen = n `seq` Stream step 0+ where+ {-# INLINE_LATE step #-}+ step _ i | i < n = do+ x <- gen i+ return $ Yield x (i + 1)+ | otherwise = return Stop++{-# INLINE generate #-}+generate :: Monad m => Int -> (Int -> a) -> Stream m a+generate n gen = generateM n (return . gen)++-- XXX we need the MonadAsync constraint because of a rewrite rule.+-- | Convert a list of monadic actions to a 'Stream'+{-# INLINE_LATE fromListM #-}+fromListM :: MonadAsync m => [m a] -> Stream m a+fromListM = Stream step+ where+ {-# INLINE_LATE step #-}+ step _ (m:ms) = m >>= \x -> return $ Yield x ms+ step _ [] = return Stop++-- | Convert a list of pure values to a 'Stream'+{-# INLINE_LATE fromList #-}+fromList :: Monad m => [a] -> Stream m a+fromList = Stream step+ where+ {-# INLINE_LATE step #-}+ step _ (x:xs) = return $ Yield x xs+ step _ [] = return Stop++{-# INLINE_LATE fromStreamK #-}+fromStreamK :: Monad m => K.Stream m a -> Stream m a+fromStreamK = Stream step+ where+ step gst m1 =+ let stop = return Stop+ single a = return $ Yield a K.nil+ yieldk a r = return $ Yield a r+ in K.foldStreamShared gst yieldk single stop m1++{-# INLINE toStreamD #-}+toStreamD :: (K.IsStream t, Monad m) => t m a -> Stream m a+toStreamD = fromStreamK . K.toStream++------------------------------------------------------------------------------+-- Elimination by Folds+------------------------------------------------------------------------------++{-# INLINE_NORMAL foldrM #-}+foldrM :: Monad m => (a -> b -> m b) -> b -> Stream m a -> m b+foldrM f z (Stream step state) = go SPEC state+ where+ go !_ st = do+ r <- step defState st+ case r of+ Yield x s -> go SPEC s >>= f x+ Skip s -> go SPEC s+ Stop -> return z++{-# INLINE_NORMAL foldr #-}+foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b+foldr f = foldrM (\a b -> return (f a b))++{-# INLINE_NORMAL foldr1 #-}+foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a)+foldr1 f m = do+ r <- uncons m+ case r of+ Nothing -> return Nothing+ Just (h, t) -> fmap Just (foldr f h t)++{-# INLINE_NORMAL foldlM' #-}+foldlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b+foldlM' fstep begin (Stream step state) = go SPEC begin state+ where+ go !_ acc st = acc `seq` do+ r <- step defState st+ case r of+ Yield x s -> do+ acc' <- fstep acc x+ go SPEC acc' s+ Skip s -> go SPEC acc s+ Stop -> return acc++{-# INLINE foldl' #-}+foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b+foldl' fstep = foldlM' (\b a -> return (fstep b a))++------------------------------------------------------------------------------+-- Specialized Folds+------------------------------------------------------------------------------++-- | Run a streaming composition, discard the results.+{-# INLINE_LATE runStream #-}+runStream :: Monad m => Stream m a -> m ()+runStream (Stream step state) = go SPEC state+ where+ go !_ st = do+ r <- step defState st+ case r of+ Yield _ s -> go SPEC s+ Skip s -> go SPEC s+ Stop -> return ()++{-# INLINE_NORMAL null #-}+null :: Monad m => Stream m a -> m Bool+null (Stream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield _ _ -> return False+ Skip s -> go s+ Stop -> return True++-- XXX SPEC?+{-# INLINE_NORMAL head #-}+head :: Monad m => Stream m a -> m (Maybe a)+head (Stream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield x _ -> return (Just x)+ Skip s -> go s+ Stop -> return Nothing++-- Does not fuse, has the same performance as the StreamK version.+{-# INLINE_NORMAL tail #-}+tail :: Monad m => Stream m a -> m (Maybe (Stream m a))+tail (UnStream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield _ s -> return (Just $ Stream step s)+ Skip s -> go s+ Stop -> return Nothing++-- XXX will it fuse? need custom impl?+{-# INLINE_NORMAL last #-}+last :: Monad m => Stream m a -> m (Maybe a)+last = foldl' (\_ y -> Just y) Nothing++{-# INLINE_NORMAL elem #-}+elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+elem e (Stream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield x s+ | x == e -> return True+ | otherwise -> go s+ Skip s -> go s+ Stop -> return False++{-# INLINE_NORMAL notElem #-}+notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+notElem e s = fmap not (elem e s)++{-# INLINE_NORMAL all #-}+all :: Monad m => (a -> Bool) -> Stream m a -> m Bool+all p (Stream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield x s+ | p x -> go s+ | otherwise -> return False+ Skip s -> go s+ Stop -> return True++{-# INLINE_NORMAL any #-}+any :: Monad m => (a -> Bool) -> Stream m a -> m Bool+any p (Stream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield x s+ | p x -> return True+ | otherwise -> go s+ Skip s -> go s+ Stop -> return False++{-# INLINE_NORMAL maximum #-}+maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+maximum (Stream step state) = go Nothing state+ where+ go Nothing st = do+ r <- step defState st+ case r of+ Yield x s -> go (Just x) s+ Skip s -> go Nothing s+ Stop -> return Nothing+ go (Just acc) st = do+ r <- step defState st+ case r of+ Yield x s+ | acc <= x -> go (Just x) s+ | otherwise -> go (Just acc) s+ Skip s -> go (Just acc) s+ Stop -> return (Just acc)++{-# INLINE_NORMAL maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+maximumBy cmp (Stream step state) = go Nothing state+ where+ go Nothing st = do+ r <- step defState st+ case r of+ Yield x s -> go (Just x) s+ Skip s -> go Nothing s+ Stop -> return Nothing+ go (Just acc) st = do+ r <- step defState st+ case r of+ Yield x s -> case cmp acc x of+ GT -> go (Just acc) s+ _ -> go (Just x) s+ Skip s -> go (Just acc) s+ Stop -> return (Just acc)++{-# INLINE_NORMAL minimum #-}+minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+minimum (Stream step state) = go Nothing state+ where+ go Nothing st = do+ r <- step defState st+ case r of+ Yield x s -> go (Just x) s+ Skip s -> go Nothing s+ Stop -> return Nothing+ go (Just acc) st = do+ r <- step defState st+ case r of+ Yield x s+ | acc <= x -> go (Just acc) s+ | otherwise -> go (Just x) s+ Skip s -> go (Just acc) s+ Stop -> return (Just acc)++{-# INLINE_NORMAL minimumBy #-}+minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+minimumBy cmp (Stream step state) = go Nothing state+ where+ go Nothing st = do+ r <- step defState st+ case r of+ Yield x s -> go (Just x) s+ Skip s -> go Nothing s+ Stop -> return Nothing+ go (Just acc) st = do+ r <- step defState st+ case r of+ Yield x s -> case cmp acc x of+ GT -> go (Just x) s+ _ -> go (Just acc) s+ Skip s -> go (Just acc) s+ Stop -> return (Just acc)++{-# INLINE_NORMAL (!!) #-}+(!!) :: (Monad m) => Stream m a -> Int -> m (Maybe a)+(Stream step state) !! i = go i state+ where+ go n st = do+ r <- step defState st+ case r of+ Yield x s | n < 0 -> return Nothing+ | n == 0 -> return $ Just x+ | otherwise -> go (n - 1) s+ Skip s -> go n s+ Stop -> return Nothing++{-# INLINE_NORMAL lookup #-}+lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)+lookup e (Stream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield (a, b) s -> if e == a then return (Just b) else go s+ Skip s -> go s+ Stop -> return Nothing++{-# INLINE_NORMAL findM #-}+findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)+findM p (Stream step state) = go SPEC state+ where+ go !_ st = do+ r <- step defState st+ case r of+ Yield x s -> do+ b <- p x+ if b then return (Just x) else go SPEC s+ Skip s -> go SPEC s+ Stop -> return Nothing++{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)+find p = findM (return . p)++{-# INLINE_NORMAL findIndices #-}+findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int+findIndices p (Stream step state) = Stream step' (state, 0)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, i) = do+ r <- step (adaptState gst) st+ return $ case r of+ Yield x s -> if p x then Yield i (s, i+1) else Skip (s, i+1)+ Skip s -> Skip (s, i+1)+ Stop -> Stop++{-# INLINE_NORMAL concatMapM #-}+concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+concatMapM f (Stream step state) = Stream step' (Left state)+ where+ {-# INLINE_LATE step' #-}+ step' gst (Left st) = do+ r <- step (adaptState gst) st+ case r of+ Yield a s -> do+ b_stream <- f a+ return $ Skip (Right (b_stream, s))+ Skip s -> return $ Skip (Left s)+ Stop -> return Stop++ -- XXX using the pattern synonym Stream causes a major performance issue+ -- here even if the synonym does not include a adaptState call. Need to+ -- find out why. Is that something to be fixed in GHC?+ step' _ (Right (UnStream inner_step inner_st, st)) = do+ r <- inner_step defState inner_st+ case r of+ Yield b inner_s ->+ return $ Yield b (Right (Stream inner_step inner_s, st))+ Skip inner_s ->+ return $ Skip (Right (Stream inner_step inner_s, st))+ Stop -> return $ Skip (Left st)++{-# INLINE concatMap #-}+concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+concatMap f = concatMapM (return . f)++------------------------------------------------------------------------------+-- Substreams+------------------------------------------------------------------------------++{-# INLINE_NORMAL isPrefixOf #-}+isPrefixOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool+isPrefixOf (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)+ where+ go (sa, sb, Nothing) = do+ r <- stepa defState sa+ case r of+ Yield x sa' -> go (sa', sb, Just x)+ Skip sa' -> go (sa', sb, Nothing)+ Stop -> return True++ go (sa, sb, Just x) = do+ r <- stepb defState sb+ case r of+ Yield y sb' ->+ if x == y+ then go (sa, sb', Nothing)+ else return False+ Skip sb' -> go (sa, sb', Just x)+ Stop -> return False++{-# INLINE_NORMAL isSubsequenceOf #-}+isSubsequenceOf :: (Eq a, Monad m) => Stream m a -> Stream m a -> m Bool+isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)+ where+ go (sa, sb, Nothing) = do+ r <- stepa defState sa+ case r of+ Yield x sa' -> go (sa', sb, Just x)+ Skip sa' -> go (sa', sb, Nothing)+ Stop -> return True++ go (sa, sb, Just x) = do+ r <- stepb defState sb+ case r of+ Yield y sb' ->+ if x == y+ then go (sa, sb', Nothing)+ else go (sa, sb', Just x)+ Skip sb' -> go (sa, sb', Just x)+ Stop -> return False++{-# INLINE_NORMAL stripPrefix #-}+stripPrefix+ :: (Eq a, Monad m)+ => Stream m a -> Stream m a -> m (Maybe (Stream m a))+stripPrefix (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)+ where+ go (sa, sb, Nothing) = do+ r <- stepa defState sa+ case r of+ Yield x sa' -> go (sa', sb, Just x)+ Skip sa' -> go (sa', sb, Nothing)+ Stop -> return $ Just (Stream stepb sb)++ go (sa, sb, Just x) = do+ r <- stepb defState sb+ case r of+ Yield y sb' ->+ if x == y+ then go (sa, sb', Nothing)+ else return Nothing+ Skip sb' -> go (sa, sb', Just x)+ Stop -> return Nothing++------------------------------------------------------------------------------+-- Map and Fold+------------------------------------------------------------------------------++-- | Execute a monadic action for each element of the 'Stream'+{-# INLINE_NORMAL mapM_ #-}+mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()+mapM_ m = runStream . mapM m++------------------------------------------------------------------------------+-- Converting folds+------------------------------------------------------------------------------++{-# INLINE toList #-}+toList :: Monad m => Stream m a -> m [a]+toList = foldr (:) []++-- Convert a direct stream to and from CPS encoded stream+{-# INLINE_LATE toStreamK #-}+toStreamK :: Monad m => Stream m a -> K.Stream m a+toStreamK (Stream step state) = go state+ where+ go st = K.mkStream $ \gst yld sng stp -> do+ r <- step gst st+ case r of+ Yield x s -> yld x (go s)+ Skip s -> K.foldStreamShared gst yld sng stp $ go s+ Stop -> stp++#ifndef DISABLE_FUSION+{-# RULES "fromStreamK/toStreamK fusion"+ forall s. toStreamK (fromStreamK s) = s #-}+{-# RULES "toStreamK/fromStreamK fusion"+ forall s. fromStreamK (toStreamK s) = s #-}+#endif++{-# INLINE fromStreamD #-}+fromStreamD :: (K.IsStream t, Monad m) => Stream m a -> t m a+fromStreamD = K.fromStream . toStreamK++------------------------------------------------------------------------------+-- Transformation by Folding (Scans)+------------------------------------------------------------------------------++-- XXX Is a prescan useful, discarding the last step does not sound useful? I+-- am not sure about the utility of this function, so this is implemented but+-- not exposed. We can expose it if someone provides good reasons why this is+-- useful.+--+-- XXX We have to execute the stream one step ahead to know that we are at the+-- last step. The vector implementation of prescan executes the last fold step+-- but does not yield the result. This means we have executed the effect but+-- discarded value. This does not sound right. In this implementation we are+-- not executing the last fold step.+{-# INLINE_NORMAL prescanlM' #-}+prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+prescanlM' f mz (Stream step state) = Stream step' (state, mz)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, prev) = do+ r <- step (adaptState gst) st+ case r of+ Yield x s -> do+ acc <- prev+ return $ Yield acc (s, f acc x)+ Skip s -> return $ Skip (s, prev)+ Stop -> return Stop++{-# INLINE prescanl' #-}+prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+prescanl' f z = prescanlM' (\a b -> return (f a b)) (return z)++-- XXX if we make the initial value of the accumulator monadic then should we+-- execute it even if the stream is empty? In that case we would have generated+-- the effect but discarded the value, but that is what a fold does when the+-- stream is empty. Whatever we decide, need to reconcile this with prescan.+-- If we execute the initial value here without even using it then it is ok to+-- execute the last step there as well without using the value.+-- Looking at the duality with right fold, in case of right fold we always+-- perform the action when the construction terminates, so in case of left fold+-- we should perform it only when the reduction starts.+{-# INLINE_NORMAL postscanlM' #-}+postscanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b+postscanlM' fstep begin (Stream step state) =+ begin `seq` Stream step' (state, begin)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, acc) = acc `seq` do+ r <- step (adaptState gst) st+ case r of+ Yield x s -> do+ y <- fstep acc x+ y `seq` return (Yield y (s, y))+ Skip s -> return $ Skip (s, acc)+ Stop -> return Stop++{-# INLINE_NORMAL postscanl' #-}+postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+postscanl' f = postscanlM' (\a b -> return (f a b))++{-# INLINE_NORMAL postscanlM #-}+postscanlM :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b+postscanlM fstep begin (Stream step state) = Stream step' (state, begin)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, acc) = do+ r <- step (adaptState gst) st+ case r of+ Yield x s -> do+ y <- fstep acc x+ return (Yield y (s, y))+ Skip s -> return $ Skip (s, acc)+ Stop -> return Stop++{-# INLINE_NORMAL postscanl #-}+postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+postscanl f = postscanlM (\a b -> return (f a b))++{-# INLINE_NORMAL scanlM' #-}+scanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b+scanlM' fstep begin s = begin `seq` (begin `cons` postscanlM' fstep begin s)++{-# INLINE scanl' #-}+scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+scanl' f = scanlM' (\a b -> return (f a b))++{-# INLINE_NORMAL scanlM #-}+scanlM :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b+scanlM fstep begin s = begin `cons` postscanlM fstep begin s++{-# INLINE scanl #-}+scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+scanl f = scanlM (\a b -> return (f a b))++{-# INLINE_NORMAL scanl1M #-}+scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+scanl1M fstep (Stream step state) = Stream step' (state, Nothing)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, Nothing) = do+ r <- step gst st+ case r of+ Yield x s -> return $ Yield x (s, Just x)+ Skip s -> return $ Skip (s, Nothing)+ Stop -> return Stop++ step' gst (st, Just acc) = do+ r <- step gst st+ case r of+ Yield y s -> do+ z <- fstep acc y+ return $ Yield z (s, Just z)+ Skip s -> return $ Skip (s, Just acc)+ Stop -> return Stop++{-# INLINE scanl1 #-}+scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+scanl1 f = scanl1M (\x y -> return (f x y))++{-# INLINE_NORMAL scanl1M' #-}+scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+scanl1M' fstep (Stream step state) = Stream step' (state, Nothing)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, Nothing) = do+ r <- step gst st+ case r of+ Yield x s -> x `seq` return $ Yield x (s, Just x)+ Skip s -> return $ Skip (s, Nothing)+ Stop -> return Stop++ step' gst (st, Just acc) = acc `seq` do+ r <- step gst st+ case r of+ Yield y s -> do+ z <- fstep acc y+ z `seq` return $ Yield z (s, Just z)+ Skip s -> return $ Skip (s, Just acc)+ Stop -> return Stop++{-# INLINE scanl1' #-}+scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+scanl1' f = scanl1M' (\x y -> return (f x y))++-------------------------------------------------------------------------------+-- Filtering+-------------------------------------------------------------------------------++{-# INLINE_NORMAL take #-}+take :: Monad m => Int -> Stream m a -> Stream m a+take n (Stream step state) = n `seq` Stream step' (state, 0)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, i) | i < n = do+ r <- step gst st+ return $ case r of+ Yield x s -> Yield x (s, i + 1)+ Skip s -> Skip (s, i)+ Stop -> Stop+ step' _ (_, _) = return Stop++{-# INLINE_NORMAL takeWhileM #-}+takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+takeWhileM f (Stream step state) = Stream step' state+ where+ {-# INLINE_LATE step' #-}+ step' gst st = do+ r <- step gst st+ case r of+ Yield x s -> do+ b <- f x+ return $ if b then Yield x s else Stop+ Skip s -> return $ Skip s+ Stop -> return Stop++{-# INLINE takeWhile #-}+takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+takeWhile f = takeWhileM (return . f)++{-# INLINE_NORMAL drop #-}+drop :: Monad m => Int -> Stream m a -> Stream m a+drop n (Stream step state) = Stream step' (state, Just n)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, Just i)+ | i > 0 = do+ r <- step gst st+ return $+ case r of+ Yield _ s -> Skip (s, Just (i - 1))+ Skip s -> Skip (s, Just i)+ Stop -> Stop+ | otherwise = return $ Skip (st, Nothing)++ step' gst (st, Nothing) = do+ r <- step gst st+ return $+ case r of+ Yield x s -> Yield x (s, Nothing)+ Skip s -> Skip (s, Nothing)+ Stop -> Stop++data DropWhileState s a+ = DropWhileDrop s+ | DropWhileYield a s+ | DropWhileNext s++{-# INLINE_NORMAL dropWhileM #-}+dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)+ where+ {-# INLINE_LATE step' #-}+ step' gst (DropWhileDrop st) = do+ r <- step gst st+ case r of+ Yield x s -> do+ b <- f x+ if b+ then return $ Skip (DropWhileDrop s)+ else return $ Skip (DropWhileYield x s)+ Skip s -> return $ Skip (DropWhileDrop s)+ Stop -> return Stop++ step' gst (DropWhileNext st) = do+ r <- step gst st+ case r of+ Yield x s -> return $ Skip (DropWhileYield x s)+ Skip s -> return $ Skip (DropWhileNext s)+ Stop -> return Stop++ step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)++{-# INLINE dropWhile #-}+dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+dropWhile f = dropWhileM (return . f)++{-# INLINE_NORMAL filterM #-}+filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+filterM f (Stream step state) = Stream step' state+ where+ {-# INLINE_LATE step' #-}+ step' gst st = do+ r <- step gst st+ case r of+ Yield x s -> do+ b <- f x+ return $ if b+ then Yield x s+ else Skip s+ Skip s -> return $ Skip s+ Stop -> return Stop++{-# INLINE filter #-}+filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+filter f = filterM (return . f)++{-# INLINE_NORMAL uniq #-}+uniq :: (Eq a, Monad m) => Stream m a -> Stream m a+uniq (Stream step state) = Stream step' (Nothing, state)+ where+ {-# INLINE_LATE step' #-}+ step' gst (Nothing, st) = do+ r <- step gst st+ case r of+ Yield x s -> return $ Yield x (Just x, s)+ Skip s -> return $ Skip (Nothing, s)+ Stop -> return Stop+ step' gst (Just x, st) = do+ r <- step gst st+ case r of+ Yield y s | x == y -> return $ Skip (Just x, s)+ | otherwise -> return $ Yield x (Just y, s)+ Skip s -> return $ Skip (Just x, s)+ Stop -> return Stop++------------------------------------------------------------------------------+-- Transformation by Mapping+------------------------------------------------------------------------------++{-# INLINE_NORMAL sequence #-}+sequence :: Monad m => Stream m (m a) -> Stream m a+sequence (Stream step state) = Stream step' state+ where+ {-# INLINE_LATE step' #-}+ step' gst st = do+ r <- step (adaptState gst) st+ case r of+ Yield x s -> x >>= \a -> return (Yield a s)+ Skip s -> return $ Skip s+ Stop -> return Stop++------------------------------------------------------------------------------+-- Inserting+------------------------------------------------------------------------------++{-# INLINE_NORMAL insertBy #-}+insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a+insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, False, _) = do+ r <- step gst st+ case r of+ Yield x s -> case cmp a x of+ GT -> return $ Yield x (s, False, Nothing)+ _ -> return $ Yield a (s, True, Just x)+ Skip s -> return $ Skip (s, False, Nothing)+ Stop -> return $ Yield a (st, True, Nothing)++ step' _ (_, True, Nothing) = return Stop++ step' gst (st, True, Just prev) = do+ r <- step gst st+ case r of+ Yield x s -> return $ Yield prev (s, True, Just x)+ Skip s -> return $ Skip (s, True, Just prev)+ Stop -> return $ Yield prev (st, True, Nothing)++------------------------------------------------------------------------------+-- Deleting+------------------------------------------------------------------------------++{-# INLINE_NORMAL deleteBy #-}+deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a+deleteBy eq x (Stream step state) = Stream step' (state, False)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, False) = do+ r <- step gst st+ case r of+ Yield y s -> return $+ if eq x y then Skip (s, True) else Yield y (s, False)+ Skip s -> return $ Skip (s, False)+ Stop -> return Stop++ step' gst (st, True) = do+ r <- step gst st+ case r of+ Yield y s -> return $ Yield y (s, True)+ Skip s -> return $ Skip (s, True)+ Stop -> return Stop++------------------------------------------------------------------------------+-- Transformation by Map and Filter+------------------------------------------------------------------------------++-- XXX Will this always fuse properly?+{-# INLINE_NORMAL mapMaybe #-}+mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b+mapMaybe f = fmap fromJust . filter isJust . map f++{-# INLINE_NORMAL mapMaybeM #-}+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b+mapMaybeM f = fmap fromJust . filter isJust . mapM f++------------------------------------------------------------------------------+-- Zipping+------------------------------------------------------------------------------++{-# INLINE_NORMAL indexed #-}+indexed :: Monad m => Stream m a -> Stream m (Int, a)+indexed (Stream step state) = Stream step' (state, 0)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, i) = i `seq` do+ r <- step (adaptState gst) st+ case r of+ Yield x s -> return $ Yield (i, x) (s, i+1)+ Skip s -> return $ Skip (s, i)+ Stop -> return Stop++{-# INLINE_NORMAL indexedR #-}+indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)+indexedR m (Stream step state) = Stream step' (state, m)+ where+ {-# INLINE_LATE step' #-}+ step' gst (st, i) = i `seq` do+ r <- step (adaptState gst) st+ case r of+ Yield x s -> let i' = i - 1+ in+ return $ Yield (i', x) (s, i')+ Skip s -> return $ Skip (s, i)+ Stop -> return Stop++{-# INLINE_NORMAL zipWithM #-}+zipWithM :: Monad m+ => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)+ where+ {-# INLINE_LATE step #-}+ step gst (sa, sb, Nothing) = do+ r <- stepa (adaptState gst) sa+ return $+ case r of+ Yield x sa' -> Skip (sa', sb, Just x)+ Skip sa' -> Skip (sa', sb, Nothing)+ Stop -> Stop++ step gst (sa, sb, Just x) = do+ r <- stepb (adaptState gst) sb+ case r of+ Yield y sb' -> do+ z <- f x y+ return $ Yield z (sa, sb', Nothing)+ Skip sb' -> return $ Skip (sa, sb', Just x)+ Stop -> return Stop++{-# RULES "zipWithM xs xs"+ forall f xs. zipWithM f xs xs = mapM (\x -> f x x) xs #-}++{-# INLINE zipWith #-}+zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+zipWith f = zipWithM (\a b -> return (f a b))++------------------------------------------------------------------------------+-- Comparisions+------------------------------------------------------------------------------++{-# INLINE_NORMAL eqBy #-}+eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool+eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2+ where+ eq_loop0 !_ s1 s2 = do+ r <- step1 defState s1+ case r of+ Yield x s1' -> eq_loop1 SPEC x s1' s2+ Skip s1' -> eq_loop0 SPEC s1' s2+ Stop -> eq_null s2++ eq_loop1 !_ x s1 s2 = do+ r <- step2 defState s2+ case r of+ Yield y s2'+ | eq x y -> eq_loop0 SPEC s1 s2'+ | otherwise -> return False+ Skip s2' -> eq_loop1 SPEC x s1 s2'+ Stop -> return False++ eq_null s2 = do+ r <- step2 defState s2+ case r of+ Yield _ _ -> return False+ Skip s2' -> eq_null s2'+ Stop -> return True++-- | Compare two streams lexicographically+{-# INLINE_NORMAL cmpBy #-}+cmpBy+ :: Monad m+ => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering+cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2+ where+ cmp_loop0 !_ s1 s2 = do+ r <- step1 defState s1+ case r of+ Yield x s1' -> cmp_loop1 SPEC x s1' s2+ Skip s1' -> cmp_loop0 SPEC s1' s2+ Stop -> cmp_null s2++ cmp_loop1 !_ x s1 s2 = do+ r <- step2 defState s2+ case r of+ Yield y s2' -> case x `cmp` y of+ EQ -> cmp_loop0 SPEC s1 s2'+ c -> return c+ Skip s2' -> cmp_loop1 SPEC x s1 s2'+ Stop -> return GT++ cmp_null s2 = do+ r <- step2 defState s2+ case r of+ Yield _ _ -> return LT+ Skip s2' -> cmp_null s2'+ Stop -> return EQ++------------------------------------------------------------------------------+-- Merging+------------------------------------------------------------------------------++{-# INLINE_NORMAL mergeByM #-}+mergeByM+ :: (Monad m)+ => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+mergeByM cmp (Stream stepa ta) (Stream stepb tb) =+ Stream step (Just ta, Just tb, Nothing, Nothing)+ where+ {-# INLINE_LATE step #-}++ -- one of the values is missing, and the corresponding stream is running+ step gst (Just sa, sb, Nothing, b) = do+ r <- stepa gst sa+ return $ case r of+ Yield a sa' -> Skip (Just sa', sb, Just a, b)+ Skip sa' -> Skip (Just sa', sb, Nothing, b)+ Stop -> Skip (Nothing, sb, Nothing, b)++ step gst (sa, Just sb, a, Nothing) = do+ r <- stepb gst sb+ return $ case r of+ Yield b sb' -> Skip (sa, Just sb', a, Just b)+ Skip sb' -> Skip (sa, Just sb', a, Nothing)+ Stop -> Skip (sa, Nothing, a, Nothing)++ -- both the values are available+ step _ (sa, sb, Just a, Just b) = do+ res <- cmp a b+ return $ case res of+ GT -> Yield b (sa, sb, Just a, Nothing)+ _ -> Yield a (sa, sb, Nothing, Just b)++ -- one of the values is missing, corresponding stream is done+ step _ (Nothing, sb, Nothing, Just b) =+ return $ Yield b (Nothing, sb, Nothing, Nothing)++ step _ (sa, Nothing, Just a, Nothing) =+ return $ Yield a (sa, Nothing, Nothing, Nothing)++ step _ (Nothing, Nothing, Nothing, Nothing) = return Stop++{-# INLINE mergeBy #-}+mergeBy+ :: (Monad m)+ => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+mergeBy cmp = mergeByM (\a b -> return $ cmp a b)++------------------------------------------------------------------------------+-- Transformation comprehensions+------------------------------------------------------------------------------++{-# INLINE_NORMAL the #-}+the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)+the (Stream step state) = go state+ where+ go st = do+ r <- step defState st+ case r of+ Yield x s -> go' x s+ Skip s -> go s+ Stop -> return Nothing+ go' n st = do+ r <- step defState st+ case r of+ Yield x s | x == n -> go' n s+ | otherwise -> return Nothing+ Skip s -> go' n s+ Stop -> return (Just n)
+ src/Streamly/Streams/StreamD/Type.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RankNTypes #-}++#include "../inline.hs"++-- |+-- Module : Streamly.Streams.StreamD.Type+-- Copyright : (c) 2018 Harendra Kumar+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com+-- Stability : experimental+-- Portability : GHC++module Streamly.Streams.StreamD.Type+ (+ -- * The stream type+ Step (..)+ -- XXX UnStream is exported to avoid a performance issue in concatMap if we+ -- use the pattern synonym "Stream".+#if __GLASGOW_HASKELL__ >= 800+ , Stream (Stream, UnStream)+#else+ , Stream (UnStream)+ , pattern Stream+#endif+ , map+ , mapM+ )+where++import Streamly.SVar (State(..), adaptState)+import qualified Streamly.Streams.StreamK as K+import Prelude hiding (map, mapM)++------------------------------------------------------------------------------+-- The direct style stream type+------------------------------------------------------------------------------++-- | A stream is a succession of 'Step's. A 'Yield' produces a single value and+-- the next state of the stream. 'Stop' indicates there are no more values in+-- the stream.+data Step s a = Yield a s | Skip s | Stop++instance Functor (Step s) where+ {-# INLINE fmap #-}+ fmap f (Yield x s) = Yield (f x) s+ fmap _ (Skip s) = Skip s+ fmap _ Stop = Stop++-- gst = global state+-- | A stream consists of a step function that generates the next step given a+-- current state, and the current state.+data Stream m a =+ forall s. UnStream (State K.Stream m a -> s -> m (Step s a)) s++unShare :: Stream m a -> Stream m a+unShare (UnStream step state) = UnStream step' state+ where step' gst = step (adaptState gst)++pattern Stream :: (State K.Stream m a -> s -> m (Step s a)) -> s -> Stream m a+pattern Stream step state <- (unShare -> UnStream step state)+ where Stream = UnStream++#if __GLASGOW_HASKELL__ >= 802+{-# COMPLETE Stream #-}+#endif++------------------------------------------------------------------------------+-- Instances+------------------------------------------------------------------------------++-- | Map a monadic function over a 'Stream'+{-# INLINE_NORMAL mapM #-}+mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b+mapM f (Stream step state) = Stream step' state+ where+ {-# INLINE_LATE step' #-}+ step' gst st = do+ r <- step (adaptState gst) st+ case r of+ Yield x s -> f x >>= \a -> return $ Yield a s+ Skip s -> return $ Skip s+ Stop -> return Stop++{-# INLINE map #-}+map :: Monad m => (a -> b) -> Stream m a -> Stream m b+map f = mapM (return . f)++instance Monad m => Functor (Stream m) where+ {-# INLINE fmap #-}+ fmap = map
src/Streamly/Streams/StreamK.hs view
@@ -6,8 +6,11 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} -- XXX +#include "inline.hs"+ -- | -- Module : Streamly.Streams.StreamK -- Copyright : (c) 2017 Harendra Kumar@@ -32,23 +35,22 @@ , adapt -- * The stream type- , Stream (..)- , unStreamIsolated- , isolateStream- , unstreamShared- , runStreamSVar+ , Stream - -- * Construction+ -- * Construction Primitives , mkStream , nil , cons , (.:) - -- * Asynchronous construction- , nilK- , yieldK- , consK+ -- * Elimination Primitives+ , foldStream+ , foldStreamShared+ , foldStreamSVar + -- * Transformation Primitives+ , unShare+ -- * Deconstruction , uncons @@ -59,6 +61,8 @@ -- ** Specialized Generation , repeat+ , replicate+ , replicateM -- ** Conversions , yield@@ -69,7 +73,6 @@ -- * Elimination -- ** General Folds- , foldStream , foldr , foldrM , foldr1@@ -90,10 +93,14 @@ , any , last , minimum+ , minimumBy , maximum+ , maximumBy , findIndices , lookup+ , findM , find+ , (!!) -- ** Map and Fold , mapM_@@ -121,7 +128,11 @@ -- ** Inserting , intersperseM+ , insertBy + -- ** Deleting+ , deleteBy+ -- ** Map and Filter , mapMaybe @@ -129,11 +140,18 @@ , zipWith , zipWithM + -- ** Merging+ , mergeBy+ , mergeByM++ -- ** Transformation comprehensions+ , the+ -- * Semigroup Style Composition , serial -- * Utilities- , consMSerial+ , consMStream , bindWith , withLocal @@ -144,194 +162,27 @@ where import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Reader.Class (MonadReader(..))-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Semigroup (Semigroup(..)) import Prelude hiding (foldl, foldr, last, map, mapM, mapM_, repeat, sequence, take, filter, all, any, takeWhile, drop, dropWhile, minimum, maximum, elem, notElem, null, head, tail, init, zipWith, lookup,- foldr1)+ foldr1, (!!), replicate) import qualified Prelude import Streamly.SVar----------------------------------------------------------------------------------- The basic stream type----------------------------------------------------------------------------------- | The type @Stream m a@ represents a monadic stream of values of type 'a'--- constructed using actions in monad 'm'. It uses stop, singleton and yield--- continuations equivalent to the following direct style type:------ @--- data Stream m a = Stop | Singleton a | Yield a (Stream m a)--- @------ To facilitate parallel composition we maintain a local state in an 'SVar'--- that is shared across and is used for synchronization of the streams being--- composed.------ The singleton case can be expressed in terms of stop and yield but we have--- it as a separate case to optimize composition operations for streams with--- single element. We build singleton streams in the implementation of 'pure'--- for Applicative and Monad, and in 'lift' for MonadTrans.----newtype Stream m a =- Stream {- unStream :: forall r.- State Stream m a -- state- -> m r -- stop- -> (a -> m r) -- singleton- -> (a -> Stream m a -> m r) -- yield- -> m r- }---- XXX make this the default "unStream"--- | unwraps the Stream type producing the stream function that can be run with--- continuations.-{-# INLINE unStreamIsolated #-}-unStreamIsolated ::- Stream m a- -> State Stream m a -- state- -> m r -- stop- -> (a -> m r) -- singleton- -> (a -> Stream m a -> m r) -- yield- -> m r-unStreamIsolated x st = unStream x (rstState st)--{-# INLINE isolateStream #-}-isolateStream :: Stream m a -> Stream m a-isolateStream x = Stream $ \st stp sng yld ->- unStreamIsolated x st stp sng yld---- | Like unstream, but passes a shared SVar across continuations.-{-# INLINE unstreamShared #-}-unstreamShared ::- Stream m a- -> State Stream m a -- state- -> m r -- stop- -> (a -> m r) -- singleton- -> (a -> Stream m a -> m r) -- yield- -> m r-unstreamShared = unStream---- Run the stream using a run function associated with the SVar that runs the--- streams with a captured snapshot of the monadic state.-{-# INLINE runStreamSVar #-}-runStreamSVar- :: MonadIO m- => SVar Stream m a- -> Stream m a- -> State Stream m a -- state- -> m r -- stop- -> (a -> m r) -- singleton- -> (a -> Stream m a -> m r) -- yield- -> m ()-runStreamSVar sv m st stp sng yld =- let mrun = runInIO $ svarMrun sv- in void $ liftIO $ mrun $ unStream m st stp sng yld----------------------------------------------------------------------------------- Types that can behave as a Stream---------------------------------------------------------------------------------infixr 5 `consM`-infixr 5 |:---- | Class of types that can represent a stream of elements of some type 'a' in--- some monad 'm'.------ @since 0.2.0-class IsStream t where- toStream :: t m a -> Stream m a- fromStream :: Stream m a -> t m a- -- | Constructs a stream by adding a monadic action at the head of an- -- existing stream. For example:- --- -- @- -- > toList $ getLine \`consM` getLine \`consM` nil- -- hello- -- world- -- ["hello","world"]- -- @- --- -- /Concurrent (do not use 'parallely' to construct infinite streams)/- --- -- @since 0.2.0- consM :: MonadAsync m => m a -> t m a -> t m a- -- | Operator equivalent of 'consM'. We can read it as "@parallel colon@"- -- to remember that @|@ comes before ':'.- --- -- @- -- > toList $ getLine |: getLine |: nil- -- hello- -- world- -- ["hello","world"]- -- @- --- -- @- -- let delay = threadDelay 1000000 >> print 1- -- runStream $ serially $ delay |: delay |: delay |: nil- -- runStream $ parallely $ delay |: delay |: delay |: nil- -- @- --- -- /Concurrent (do not use 'parallely' to construct infinite streams)/- --- -- @since 0.2.0- (|:) :: MonadAsync m => m a -> t m a -> t m a- -- We can define (|:) just as 'consM' but it is defined explicitly for each- -- type because we want to use SPECIALIZE pragma on the definition.---- | Same as 'IsStream'.------ @since 0.1.0-{-# DEPRECATED Streaming "Please use IsStream instead." #-}-type Streaming = IsStream------------------------------------------------------------------------------------ Type adapting combinators------------------------------------------------------------------------------------ | Adapt any specific stream type to any other specific stream type.------ @since 0.1.0-adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a-adapt = fromStream . toStream----------------------------------------------------------------------------------- Building a stream-------------------------------------------------------------------------------+import Streamly.Streams.StreamK.Type --- | Build a stream from an 'SVar', a stop continuation, a singleton stream--- continuation and a yield continuation.-mkStream:: IsStream t- => (forall r. State Stream m a- -> m r- -> (a -> m r)- -> (a -> t m a -> m r)- -> m r)- -> t m a-mkStream k = fromStream $ Stream $ \st stp sng yld ->- let yieldk a r = yld a (toStream r)- in k (rstState st) stp sng yieldk+-- | Detach a stream from an SVar+{-# INLINE unShare #-}+unShare :: IsStream t => t m a -> t m a+unShare x = mkStream $ \st yld sng stp ->+ foldStream st yld sng stp x ------------------------------------------------------------------------------ -- Construction ------------------------------------------------------------------------------ --- | An empty stream.------ @--- > toList nil--- []--- @------ @since 0.1.0-nil :: IsStream t => t m a-nil = fromStream $ Stream $ \_ stp _ _ -> stp- infixr 5 `cons` -- faster than consM because there is no bind.@@ -346,8 +197,9 @@ -- @ -- -- @since 0.1.0+{-# INLINE cons #-} cons :: IsStream t => a -> t m a -> t m a-cons a r = fromStream $ Stream $ \_ _ _ yld -> yld a (toStream r)+cons a r = mkStream $ \_ yld _ _ -> yld a r infixr 5 .: @@ -359,51 +211,11 @@ -- @ -- -- @since 0.1.1+{-# INLINE (.:) #-} (.:) :: IsStream t => a -> t m a -> t m a (.:) = cons -{-# INLINE consMSerial #-}-consMSerial :: (Monad m) => m a -> Stream m a -> Stream m a-consMSerial m r = Stream $ \_ _ _ yld -> m >>= \a -> yld a r----------------------------------------------------------------------------------- Asynchronous construction----------------------------------------------------------------------------------- | Make an empty stream from a callback function.-nilK :: IsStream t => (forall r. m r -> m r) -> t m a-nilK k = fromStream $ Stream $ \_ stp _ _ -> k stp---- | Make a singleton stream from a one shot callback function.-yieldK :: IsStream t => (forall r. (a -> m r) -> m r) -> t m a-yieldK k = fromStream $ Stream $ \_ _ sng _ -> k sng---- | Construct a stream from a callback function.-consK :: IsStream t => (forall r. (a -> m r) -> m r) -> t m a -> t m a-consK k r = fromStream $ Stream $ \_ _ _ yld -> k (\x -> yld x (toStream r))---- XXX consK with concurrent callbacks--- XXX Build a stream from a repeating callback function.- ---------------------------------------------------------------------------------- IsStream Stream----------------------------------------------------------------------------------instance IsStream Stream where- toStream = id- fromStream = id-- {-# INLINE consM #-}- {-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}- consM :: Monad m => m a -> Stream m a -> Stream m a- consM = consMSerial-- {-# INLINE (|:) #-}- {-# SPECIALIZE (|:) :: IO a -> Stream IO a -> Stream IO a #-}- (|:) :: Monad m => m a -> Stream m a -> Stream m a- (|:) = consMSerial--------------------------------------------------------------------------------- -- Deconstruction ------------------------------------------------------------------------------- @@ -412,43 +224,56 @@ uncons m = let stop = return Nothing single a = return (Just (a, nil))- yieldk a r = return (Just (a, fromStream r))- in unStream (toStream m) defState stop single yieldk+ yieldk a r = return (Just (a, r))+ in foldStream defState yieldk single stop m ------------------------------------------------------------------------------- -- Generation ------------------------------------------------------------------------------- +{-# INLINE_NORMAL build #-}+build :: IsStream t => forall a. (forall b. (a -> b -> b) -> b -> b) -> t m a+build g = g cons nil++{-# INLINE_NORMAL _augment #-}+_augment+ :: IsStream t+ => forall a. (forall b. (a -> b -> b) -> b -> b) -> t m a -> t m a+_augment g xs = g cons xs++{-# INLINE_NORMAL _buildM #-}+_buildM+ :: (IsStream t, MonadAsync m)+ => forall a. ((m a -> t m a -> t m a) -> t m a -> t m a) -> t m a+_buildM g = g consM nil+ {-# INLINE unfoldr #-} unfoldr :: IsStream t => (b -> Maybe (a, b)) -> b -> t m a-unfoldr step = fromStream . go- where- go s = Stream $ \_ stp _ yld ->- case step s of- Nothing -> stp- Just (a, b) -> yld a (go b)+unfoldr step b0 = build $ \cns nl ->+ let go s =+ case step s of+ Just (a, b) -> a `cns` go b+ Nothing -> nl+ in go b0 {-# INLINE unfoldrM #-} unfoldrM :: (IsStream t, MonadAsync m) => (b -> m (Maybe (a, b))) -> b -> t m a unfoldrM step = go where- go s = fromStream $ Stream $ \svr stp sng yld -> do+ go s = mkStream $ \st yld sng stp -> do mayb <- step s case mayb of Nothing -> stp Just (a, b) ->- unStream (toStream (return a |: go b)) svr stp sng yld+ foldStreamShared st yld sng stp $ return a |: go b ------------------------------------------------------------------------------- -- Special generation ------------------------------------------------------------------------------- +{-# INLINE yield #-} yield :: IsStream t => a -> t m a-yield a = fromStream $ Stream $ \_ _ single _ -> single a--{-# INLINE yieldM #-}-yieldM :: (Monad m, IsStream t) => m a -> t m a-yieldM m = fromStream $ Stream $ \_ _ single _ -> m >>= single+yield a = mkStream $ \_ _ single _ -> single a -- | Same as yieldM --@@ -458,20 +283,42 @@ once :: (Monad m, IsStream t) => m a -> t m a once = yieldM --- | Generate an infinite stream by repeating a pure value.--- Can be expressed as @cycle1 . yield@.+-- |+-- @+-- repeatM = fix . cons+-- repeatM = cycle1 . yield+-- @ --+-- Generate an infinite stream by repeating a pure value.+-- -- @since 0.4.0+{-# INLINE repeat #-} repeat :: IsStream t => a -> t m a repeat a = let x = cons a x in x +{-# INLINE replicateM #-}+replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a+replicateM n m = go n+ where+ go cnt = if cnt <= 0 then nil else m |: go (cnt - 1)++{-# INLINE replicate #-}+replicate :: IsStream t => Int -> a -> t m a+replicate n a = go n+ where+ go cnt = if cnt <= 0 then nil else a `cons` go (cnt - 1)+ ------------------------------------------------------------------------------- -- Conversions ------------------------------------------------------------------------------- --- | Construct a stream from a 'Foldable' containing pure values. Same as--- @'Prelude.foldr' 'cons' 'nil'@.+-- |+-- @+-- fromFoldable = 'Prelude.foldr' 'cons' 'nil'+-- @ --+-- Construct a stream from a 'Foldable' containing pure values:+-- -- @since 0.2.0 {-# INLINE fromFoldable #-} fromFoldable :: (IsStream t, Foldable f) => f a -> t m a@@ -482,47 +329,34 @@ fromList = fromFoldable {-# INLINE fromStreamK #-}-fromStreamK :: Stream m a -> Stream m a-fromStreamK = id+fromStreamK :: IsStream t => Stream m a -> t m a+fromStreamK = fromStream ------------------------------------------------------------------------------- -- Elimination by Folding ------------------------------------------------------------------------------- --- | Fold a stream by providing an SVar, a stop continuation, a singleton--- continuation and a yield continuation.-foldStream- :: IsStream t- => State Stream m a- -> m r- -> (a -> m r)- -> (a -> t m a -> m r)- -> t m a- -> m r-foldStream st blank single step m =- let yieldk a x = step a (fromStream x)- in unStream (toStream m) st blank single yieldk- -- | Lazy right associative fold.+{-# INLINE foldr #-} foldr :: (IsStream t, Monad m) => (a -> b -> b) -> b -> t m a -> m b-foldr step acc m = go (toStream m)+foldr step acc m = go m where go m1 = let stop = return acc single a = return (step a acc) yieldk a r = go r >>= \b -> return (step a b)- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 -- | Lazy right fold with a monadic step function. {-# INLINE foldrM #-} foldrM :: (IsStream t, Monad m) => (a -> b -> m b) -> b -> t m a -> m b-foldrM step acc m = go (toStream m)+foldrM step acc m = go m where go m1 = let stop = return acc single a = step a acc yieldk a r = go r >>= step a- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 {-# INLINE foldr1 #-} foldr1 :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> m (Maybe a)@@ -530,39 +364,46 @@ r <- uncons m case r of Nothing -> return Nothing- Just (h, t) -> fmap Just (go h (toStream t))+ Just (h, t) -> fmap Just (go h t) where go p m1 = let stp = return p single a = return $ step a p yieldk a r = fmap (step p) (go a r)- in unStream m1 defState stp single yieldk+ in foldStream defState yieldk single stp m1 -- | Strict left fold with an extraction function. Like the standard strict -- left fold, but applies a user supplied extraction function (the third -- argument) to the folded value at the end. This is designed to work with the -- @foldl@ library. The suffix @x@ is a mnemonic for extraction.+--+-- Note that the accumulator is always evaluated including the initial value. {-# INLINE foldx #-}-foldx :: (IsStream t, Monad m)+foldx :: forall t m a b x. (IsStream t, Monad m) => (x -> a -> x) -> x -> (x -> b) -> t m a -> m b-foldx step begin done m = get $ go (toStream m) begin+foldx step begin done m = get $ go m begin where {-# NOINLINE get #-}+ get :: t m x -> m b get m1 =+ -- XXX we are not strictly evaluating the accumulator here. Is this+ -- okay? let single = return . done- in unStream m1 undefined undefined single undefined+ -- XXX this is foldSingleton. why foldStreamShared?+ in foldStreamShared undefined undefined single undefined m1 -- Note, this can be implemented by making a recursive call to "go", -- however that is more expensive because of unnecessary recursion -- that cannot be tail call optimized. Unfolding recursion explicitly via -- continuations is much more efficient.- go m1 !acc = Stream $ \_ _ sng yld ->+ go :: t m a -> x -> t m x+ go m1 !acc = mkStream $ \_ yld sng _ -> let stop = sng acc single a = sng $ step acc a- yieldk a r =- let stream = go r (step acc a)- in unStream stream defState undefined sng yld- in unStream m1 defState stop single yieldk+ -- XXX this is foldNonEmptyStream+ yieldk a r = foldStream defState yld sng undefined $+ go r (step acc a)+ in foldStream defState yieldk single stop m1 -- | Strict left associative fold. {-# INLINE foldl' #-}@@ -571,17 +412,19 @@ -- XXX replace the recursive "go" with explicit continuations. -- | Like 'foldx', but with a monadic step function.+{-# INLINABLE foldxM #-} foldxM :: (IsStream t, Monad m) => (x -> a -> m x) -> m x -> (x -> m b) -> t m a -> m b-foldxM step begin done m = go begin (toStream m)+foldxM step begin done m = go begin m where go !acc m1 = let stop = acc >>= done single a = acc >>= \b -> step b a >>= done yieldk a r = acc >>= \b -> step b a >>= \x -> go (return x) r- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 -- | Like 'foldl'' but with a monadic step function.+{-# INLINE foldlM' #-} foldlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> m b foldlM' step begin = foldxM step (return begin) return @@ -589,15 +432,18 @@ -- Specialized folds ------------------------------------------------------------------------------ +-- |+-- > runStream = foldl' (\_ _ -> ()) ()+-- > runStream = mapM_ (\_ -> return ()) {-# INLINE runStream #-} runStream :: (Monad m, IsStream t) => t m a -> m ()-runStream m = go (toStream m)+runStream = go where go m1 = let stop = return () single _ = return ()- yieldk _ r = go (toStream r)- in unStream m1 defState stop single yieldk+ yieldk _ r = go r+ in foldStream defState yieldk single stop m1 {-# INLINE null #-} null :: (IsStream t, Monad m) => t m a -> m Bool@@ -605,7 +451,7 @@ let stop = return True single _ = return False yieldk _ _ = return False- in unStream (toStream m) defState stop single yieldk+ in foldStream defState yieldk single stop m {-# INLINE head #-} head :: (IsStream t, Monad m) => t m a -> m (Maybe a)@@ -613,69 +459,71 @@ let stop = return Nothing single a = return (Just a) yieldk a _ = return (Just a)- in unStream (toStream m) defState stop single yieldk+ in foldStream defState yieldk single stop m {-# INLINE tail #-} tail :: (IsStream t, Monad m) => t m a -> m (Maybe (t m a)) tail m = let stop = return Nothing single _ = return $ Just nil- yieldk _ r = return $ Just $ fromStream r- in unStream (toStream m) defState stop single yieldk+ yieldk _ r = return $ Just r+ in foldStream defState yieldk single stop m {-# INLINE init #-} init :: (IsStream t, Monad m) => t m a -> m (Maybe (t m a))-init m = go1 (toStream m)+init m = go1 m where go1 m1 = do r <- uncons m1 case r of Nothing -> return Nothing- Just (h, t) -> return . Just . fromStream $ go h t- go p m1 = Stream $ \_ stp sng yld ->+ Just (h, t) -> return . Just $ go h t+ go p m1 = mkStream $ \_ yld sng stp -> let single _ = sng p yieldk a x = yld p $ go a x- in unStream m1 defState stp single yieldk+ in foldStream defState yieldk single stp m1 {-# INLINE elem #-} elem :: (IsStream t, Monad m, Eq a) => a -> t m a -> m Bool-elem e m = go (toStream m)+elem e m = go m where go m1 = let stop = return False single a = return (a == e) yieldk a r = if a == e then return True else go r- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 {-# INLINE notElem #-} notElem :: (IsStream t, Monad m, Eq a) => a -> t m a -> m Bool-notElem e m = go (toStream m)+notElem e m = go m where go m1 = let stop = return True single a = return (a /= e) yieldk a r = if a == e then return False else go r- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 +{-# INLINABLE all #-} all :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m Bool-all p m = go (toStream m)+all p m = go m where go m1 = let single a | p a = return True | otherwise = return False yieldk a r | p a = go r | otherwise = return False- in unStream m1 defState (return True) single yieldk+ in foldStream defState yieldk single (return True) m1 +{-# INLINABLE any #-} any :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m Bool-any p m = go (toStream m)+any p m = go m where go m1 = let single a | p a = return True | otherwise = return False yieldk a r | p a = return True | otherwise = go r- in unStream m1 defState (return False) single yieldk+ in foldStream defState yieldk single (return False) m1 -- | Extract the last element of the stream, if any. {-# INLINE last #-}@@ -684,13 +532,13 @@ {-# INLINE minimum #-} minimum :: (IsStream t, Monad m, Ord a) => t m a -> m (Maybe a)-minimum m = go Nothing (toStream m)+minimum m = go Nothing m where go Nothing m1 = let stop = return Nothing single a = return (Just a) yieldk a r = go (Just a) r- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 go (Just res) m1 = let stop = return (Just res)@@ -702,17 +550,39 @@ if res <= a then go (Just res) r else go (Just a) r- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 +{-# INLINE minimumBy #-}+minimumBy+ :: (IsStream t, Monad m)+ => (a -> a -> Ordering) -> t m a -> m (Maybe a)+minimumBy cmp m = go Nothing m+ where+ go Nothing m1 =+ let stop = return Nothing+ single a = return (Just a)+ yieldk a r = go (Just a) r+ in foldStream defState yieldk single stop m1++ go (Just res) m1 =+ let stop = return (Just res)+ single a = case cmp res a of+ GT -> return (Just a)+ _ -> return (Just res)+ yieldk a r = case cmp res a of+ GT -> go (Just a) r+ _ -> go (Just res) r+ in foldStream defState yieldk single stop m1+ {-# INLINE maximum #-} maximum :: (IsStream t, Monad m, Ord a) => t m a -> m (Maybe a)-maximum m = go Nothing (toStream m)+maximum m = go Nothing m where go Nothing m1 = let stop = return Nothing single a = return (Just a) yieldk a r = go (Just a) r- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 go (Just res) m1 = let stop = return (Just res)@@ -724,40 +594,79 @@ if res <= a then go (Just a) r else go (Just res) r- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 +{-# INLINE maximumBy #-}+maximumBy :: (IsStream t, Monad m) => (a -> a -> Ordering) -> t m a -> m (Maybe a)+maximumBy cmp m = go Nothing m+ where+ go Nothing m1 =+ let stop = return Nothing+ single a = return (Just a)+ yieldk a r = go (Just a) r+ in foldStream defState yieldk single stop m1++ go (Just res) m1 =+ let stop = return (Just res)+ single a = case cmp res a of+ GT -> return (Just res)+ _ -> return (Just a)+ yieldk a r = case cmp res a of+ GT -> go (Just res) r+ _ -> go (Just a) r+ in foldStream defState yieldk single stop m1++{-# INLINE (!!) #-}+(!!) :: (IsStream t, Monad m) => t m a -> Int -> m (Maybe a)+m !! i = go i m+ where+ go n m1 =+ let single a | n == 0 = return $ Just a+ | otherwise = return Nothing+ yieldk a x | n < 0 = return Nothing+ | n == 0 = return $ Just a+ | otherwise = go (n - 1) x+ in foldStream defState yieldk single (return Nothing) m1+ {-# INLINE lookup #-} lookup :: (IsStream t, Monad m, Eq a) => a -> t m (a, b) -> m (Maybe b)-lookup e m = go (toStream m)+lookup e m = go m where go m1 = let single (a, b) | a == e = return $ Just b | otherwise = return Nothing yieldk (a, b) x | a == e = return $ Just b | otherwise = go x- in unStream m1 defState (return Nothing) single yieldk+ in foldStream defState yieldk single (return Nothing) m1 -{-# INLINE find #-}-find :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m (Maybe a)-find p m = go (toStream m)+{-# INLINE findM #-}+findM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> m (Maybe a)+findM p m = go m where go m1 =- let single a | p a = return $ Just a- | otherwise = return Nothing- yieldk a x | p a = return $ Just a- | otherwise = go x- in unStream m1 defState (return Nothing) single yieldk+ let single a = do+ b <- p a+ if b then return $ Just a else return Nothing+ yieldk a x = do+ b <- p a+ if b then return $ Just a else go x+ in foldStream defState yieldk single (return Nothing) m1 +{-# INLINE find #-}+find :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m (Maybe a)+find p = findM (return . p)+ {-# INLINE findIndices #-} findIndices :: IsStream t => (a -> Bool) -> t m a -> t m Int-findIndices p = fromStream . go 0 . toStream+findIndices p = go 0 where- go offset m1 = Stream $ \st stp sng yld ->+ go offset m1 = mkStream $ \st yld sng stp -> let single a | p a = sng offset | otherwise = stp yieldk a x | p a = yld offset $ go (offset + 1) x- | otherwise = unStream (go (offset + 1) x) st stp sng yld- in unStream m1 (rstState st) stp single yieldk+ | otherwise = foldStream (adaptState st) yld sng stp $+ go (offset + 1) x+ in foldStream (adaptState st) yieldk single stp m1 ------------------------------------------------------------------------------ -- Map and Fold@@ -765,14 +674,15 @@ -- | Apply a monadic action to each element of the stream and discard the -- output of the action.+{-# INLINE mapM_ #-} mapM_ :: (IsStream t, Monad m) => (a -> m b) -> t m a -> m ()-mapM_ f m = go (toStream m)+mapM_ f m = go m where go m1 = let stop = return () single a = void (f a) yieldk a r = f a >> go r- in unStream m1 defState stop single yieldk+ in foldStream defState yieldk single stop m1 ------------------------------------------------------------------------------ -- Converting folds@@ -793,14 +703,14 @@ {-# INLINE scanx #-} scanx :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b scanx step begin done m =- cons (done begin) $ fromStream $ go (toStream m) begin+ cons (done begin) $ go m begin where- go m1 !acc = Stream $ \st stp sng yld ->+ go m1 !acc = mkStream $ \st yld sng stp -> let single a = sng (done $ step acc a) yieldk a r = let s = step acc a in yld (done s) (go r s)- in unStream m1 (rstState st) stp single yieldk+ in foldStream (adaptState st) yieldk single stp m1 {-# INLINE scanl' #-} scanl' :: IsStream t => (b -> a -> b) -> b -> t m a -> t m b@@ -812,91 +722,84 @@ {-# INLINE filter #-} filter :: IsStream t => (a -> Bool) -> t m a -> t m a-filter p m = fromStream $ go (toStream m)+filter p m = go m where- go m1 = Stream $ \st stp sng yld ->+ go m1 = mkStream $ \st yld sng stp -> let single a | p a = sng a | otherwise = stp yieldk a r | p a = yld a (go r)- | otherwise = unStream r (rstState st) stp single yieldk- in unStream m1 (rstState st) stp single yieldk+ | otherwise = foldStream st yieldk single stp r+ in foldStream st yieldk single stp m1 {-# INLINE take #-} take :: IsStream t => Int -> t m a -> t m a-take n m = fromStream $ go n (toStream m)+take n m = go n m where- go n1 m1 = Stream $ \st stp sng yld ->+ go n1 m1 = mkStream $ \st yld sng stp -> let yieldk a r = yld a (go (n1 - 1) r) in if n1 <= 0 then stp- else unStream m1 (rstState st) stp sng yieldk+ else foldStream st yieldk sng stp m1 {-# INLINE takeWhile #-} takeWhile :: IsStream t => (a -> Bool) -> t m a -> t m a-takeWhile p m = fromStream $ go (toStream m)+takeWhile p m = go m where- go m1 = Stream $ \st stp sng yld ->+ go m1 = mkStream $ \st yld sng stp -> let single a | p a = sng a | otherwise = stp yieldk a r | p a = yld a (go r) | otherwise = stp- in unStream m1 (rstState st) stp single yieldk+ in foldStream st yieldk single stp m1 +{-# INLINE drop #-} drop :: IsStream t => Int -> t m a -> t m a-drop n m = fromStream $ Stream $ \st stp sng yld ->- unStream (go n (toStream m)) (rstState st) stp sng yld+drop n m = fromStream $ unShare (go n (toStream m)) where- go n1 m1 = Stream $ \st stp sng yld ->+ go n1 m1 = mkStream $ \st yld sng stp -> let single _ = stp- yieldk _ r = (unStream $ go (n1 - 1) r) st stp sng yld+ yieldk _ r = foldStreamShared st yld sng stp $ go (n1 - 1) r -- Somehow "<=" check performs better than a ">" in if n1 <= 0- then unStream m1 st stp sng yld- else unStream m1 st stp single yieldk+ then foldStreamShared st yld sng stp m1+ else foldStreamShared st yieldk single stp m1 {-# INLINE dropWhile #-} dropWhile :: IsStream t => (a -> Bool) -> t m a -> t m a-dropWhile p m = fromStream $ go (toStream m)+dropWhile p m = go m where- go m1 = Stream $ \st stp sng yld ->+ go m1 = mkStream $ \st yld sng stp -> let single a | p a = stp | otherwise = sng a- yieldk a r | p a = unStream r (rstState st) stp single yieldk+ yieldk a r | p a = foldStream st yieldk single stp r | otherwise = yld a r- in unStream m1 (rstState st) stp single yieldk+ in foldStream st yieldk single stp m1 ------------------------------------------------------------------------------- -- Mapping ------------------------------------------------------------------------------- -{-# INLINE map #-}-map :: (IsStream t, Monad m) => (a -> b) -> t m a -> t m b-map f m = fromStream $ Stream $ \st stp sng yld ->- let single = sng . f- yieldk a r = yld (f a) (fmap f r)- in unStream (toStream m) (rstState st) stp single yieldk- -- Be careful when modifying this, this uses a consM (|:) deliberately to allow -- other stream types to overload it. {-# INLINE mapM #-} mapM :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m b-mapM f m = go (toStream m)+mapM f m = go m where- go m1 = fromStream $ Stream $ \st stp sng yld ->+ go m1 = mkStream $ \st yld sng stp -> let single a = f a >>= sng- yieldk a r = unStream (toStream (f a |: go r)) st stp sng yld- in unStream m1 (rstState st) stp single yieldk+ yieldk a r = foldStreamShared st yld sng stp $ f a |: go r+ in foldStream (adaptState st) yieldk single stp m1 -- Be careful when modifying this, this uses a consM (|:) deliberately to allow -- other stream types to overload it. {-# INLINE sequence #-} sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a-sequence m = go (toStream m)+sequence m = go m where- go m1 = fromStream $ Stream $ \st stp sng yld ->+ go m1 = mkStream $ \st yld sng stp -> let single ma = ma >>= sng- yieldk ma r = unStream (toStream $ ma |: go r) st stp sng yld- in unStream m1 (rstState st) stp single yieldk+ yieldk ma r = foldStreamShared st yld sng stp $ ma |: go r+ in foldStream (adaptState st) yieldk single stp m1 ------------------------------------------------------------------------------- -- Inserting@@ -904,106 +807,152 @@ {-# INLINE intersperseM #-} intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a-intersperseM a m = fromStream $ prependingStart (toStream m)+intersperseM a m = prependingStart m where- prependingStart m1 = Stream $ \st stp sng yld ->- let yieldk i x = unStream (return i |: go x) st stp sng yld- in unStream m1 (rstState st) stp sng yieldk- go m2 = fromStream $ Stream $ \st stp sng yld ->- let single i = unStream (a |: yield i) st stp sng yld- yieldk i x = unStream (a |: return i |: go x) st stp sng yld- in unStream m2 (rstState st) stp single yieldk+ prependingStart m1 = mkStream $ \st yld sng stp ->+ let yieldk i x = foldStreamShared st yld sng stp $ return i |: go x+ in foldStream st yieldk sng stp m1+ go m2 = mkStream $ \st yld sng stp ->+ let single i = foldStreamShared st yld sng stp $ a |: yield i+ yieldk i x = foldStreamShared st yld sng stp $ a |: return i |: go x+ in foldStream st yieldk single stp m2 +{-# INLINE insertBy #-}+insertBy :: IsStream t => (a -> a -> Ordering) -> a -> t m a -> t m a+insertBy cmp x m = go m+ where+ go m1 = mkStream $ \st yld _ _ ->+ let single a = case cmp x a of+ GT -> yld a (yield x)+ _ -> yld x (yield a)+ stop = yld x nil+ yieldk a r = case cmp x a of+ GT -> yld a (go r)+ _ -> yld x (a `cons` r)+ in foldStream st yieldk single stop m1++------------------------------------------------------------------------------+-- Deleting+------------------------------------------------------------------------------++{-# INLINE deleteBy #-}+deleteBy :: IsStream t => (a -> a -> Bool) -> a -> t m a -> t m a+deleteBy eq x m = go m+ where+ go m1 = mkStream $ \st yld sng stp ->+ let single a = if eq x a then stp else sng a+ yieldk a r = if eq x a+ then foldStream st yld sng stp r+ else yld a (go r)+ in foldStream st yieldk single stp m1+ ------------------------------------------------------------------------------- -- Map and Filter ------------------------------------------------------------------------------- {-# INLINE mapMaybe #-} mapMaybe :: IsStream t => (a -> Maybe b) -> t m a -> t m b-mapMaybe f m = go (toStream m)+mapMaybe f m = go m where- go m1 = fromStream $ Stream $ \st stp sng yld ->+ go m1 = mkStream $ \st yld sng stp -> let single a = case f a of Just b -> sng b Nothing -> stp yieldk a r = case f a of- Just b -> yld b (toStream $ go r)- Nothing -> unStream r (rstState st) stp single yieldk- in unStream m1 (rstState st) stp single yieldk+ Just b -> yld b $ go r+ Nothing -> foldStream (adaptState st) yieldk single stp r+ in foldStream (adaptState st) yieldk single stp m1 ------------------------------------------------------------------------------ -- Serial Zipping ------------------------------------------------------------------------------ -{-# INLINE zipWithS #-}-zipWithS :: (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-zipWithS f = go+-- | Zip two streams serially using a pure zipping function.+--+-- @since 0.1.0+{-# INLINABLE zipWith #-}+zipWith :: IsStream t => (a -> b -> c) -> t m a -> t m b -> t m c+zipWith f = go where- go mx my = Stream $ \st stp sng yld -> do+ go mx my = mkStream $ \st yld sng stp -> do let merge a ra = let single2 b = sng (f a b) yield2 b rb = yld (f a b) (go ra rb)- in unStream my (rstState st) stp single2 yield2+ in foldStream (adaptState st) yield2 single2 stp my let single1 a = merge a nil yield1 = merge- unStream mx (rstState st) stp single1 yield1---- | Zip two streams serially using a pure zipping function.------ @since 0.1.0-{-# INLINABLE zipWith #-}-zipWith :: IsStream t => (a -> b -> c) -> t m a -> t m b -> t m c-zipWith f m1 m2 = fromStream $ zipWithS f (toStream m1) (toStream m2)+ foldStream (adaptState st) yield1 single1 stp mx -- | Zip two streams serially using a monadic zipping function. -- -- @since 0.1.0+{-# INLINABLE zipWithM #-} zipWithM :: (IsStream t, Monad m) => (a -> b -> m c) -> t m a -> t m b -> t m c-zipWithM f m1 m2 = fromStream $ go (toStream m1) (toStream m2)+zipWithM f m1 m2 = go m1 m2 where- go mx my = Stream $ \st stp sng yld -> do+ go mx my = mkStream $ \st yld sng stp -> do let merge a ra =- let runIt x = unStream x (rstState st) stp sng yld+ let runIt x = foldStream st yld sng stp x single2 b = f a b >>= sng yield2 b rb = f a b >>= \x -> runIt (x `cons` go ra rb)- in unStream my (rstState st) stp single2 yield2+ in foldStream (adaptState st) yield2 single2 stp my let single1 a = merge a nil yield1 = merge- unStream mx (rstState st) stp single1 yield1+ foldStream (adaptState st) yield1 single1 stp mx --------------------------------------------------------------------------------- Semigroup+-- Merging ------------------------------------------------------------------------------ --- | Concatenates two streams sequentially i.e. the first stream is--- exhausted completely before yielding any element from the second stream.-{-# INLINE serial #-}-serial :: Stream m a -> Stream m a -> Stream m a-serial m1 m2 = go m1+{-# INLINE mergeByM #-}+mergeByM+ :: (IsStream t, Monad m)+ => (a -> a -> m Ordering) -> t m a -> t m a -> t m a+mergeByM cmp = go where- go (Stream m) = Stream $ \st stp sng yld ->- let stop = unStream m2 (rstState st) stp sng yld- single a = yld a m2- yieldk a r = yld a (go r)- in m (rstState st) stop single yieldk+ go mx my = mkStream $ \st yld sng stp -> do+ let mergeWithY a ra =+ let stop2 = foldStream st yld sng stp mx+ single2 b = do+ r <- cmp a b+ case r of+ GT -> yld b (go (a `cons` ra) nil)+ _ -> yld a (go ra (b `cons` nil))+ yield2 b rb = do+ r <- cmp a b+ case r of+ GT -> yld b (go (a `cons` ra) rb)+ _ -> yld a (go ra (b `cons` rb))+ in foldStream st yield2 single2 stop2 my+ let stopX = foldStream st yld sng stp my+ singleX a = mergeWithY a nil+ yieldX = mergeWithY+ foldStream st yieldX singleX stopX mx -instance Semigroup (Stream m a) where- (<>) = serial+{-# INLINABLE mergeBy #-}+mergeBy+ :: (IsStream t, Monad m)+ => (a -> a -> Ordering) -> t m a -> t m a -> t m a+mergeBy cmp = mergeByM (\a b -> return $ cmp a b) --------------------------------------------------------------------------------- Monoid+-- Transformation comprehensions ------------------------------------------------------------------------------ -instance Monoid (Stream m a) where- mempty = nil- mappend = (<>)------------------------------------------------------------------------------------ Functor----------------------------------------------------------------------------------instance Monad m => Functor (Stream m) where- fmap = map+{-# INLINE the #-}+the :: (Eq a, IsStream t, Monad m) => t m a -> m (Maybe a)+the m = do+ r <- uncons m+ case r of+ Nothing -> return Nothing+ Just (h, t) -> go h t+ where+ go h m1 =+ let single a | h == a = return $ Just h+ | otherwise = return Nothing+ yieldk a r | h == a = go h r+ | otherwise = return Nothing+ in foldStream defState yieldk single (return $ Just h) m1 ------------------------------------------------------------------------------- -- Bind utility@@ -1011,40 +960,40 @@ {-# INLINE bindWith #-} bindWith- :: (forall c. Stream m c -> Stream m c -> Stream m c)- -> Stream m a- -> (a -> Stream m b)- -> Stream m b-bindWith par m f = go m+ :: IsStream t+ => (forall c. t m c -> t m c -> t m c)+ -> t m a+ -> (a -> t m b)+ -> t m b+bindWith par m1 f = go m1 where- go (Stream g) =- Stream $ \st stp sng yld ->- let runShared x = unstreamShared x st stp sng yld- runIsolated x = unStreamIsolated x st stp sng yld-- single a = runIsolated $ f a- yieldk a r = runShared $ isolateStream (f a) `par` go r- in g (rstState st) stp single yieldk+ go m =+ mkStream $ \st yld sng stp ->+ let foldShared = foldStreamShared st yld sng stp+ single a = foldShared $ unShare (f a)+ yieldk a r = foldShared $ unShare (f a) `par` go r+ in foldStream (adaptState st) yieldk single stp m ------------------------------------------------------------------------------ -- Alternative & MonadPlus ------------------------------------------------------------------------------ _alt :: Stream m a -> Stream m a -> Stream m a-_alt m1 m2 = Stream $ \st stp sng yld ->- let stop = unStream m2 (rstState st) stp sng yld- in unStream m1 (rstState st) stop sng yld+_alt m1 m2 = mkStream $ \st yld sng stp ->+ let stop = foldStream st yld sng stp m2+ in foldStream st yld sng stop m1 ------------------------------------------------------------------------------ -- MonadReader ------------------------------------------------------------------------------ +{-# INLINABLE withLocal #-} withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a withLocal f m =- Stream $ \st stp sng yld ->+ mkStream $ \st yld sng stp -> let single = local f . sng yieldk a r = local f $ yld a (withLocal f r)- in unStream m (rstState st) (local f stp) single yieldk+ in foldStream st yieldk single (local f stp) m ------------------------------------------------------------------------------ -- MonadError@@ -1056,16 +1005,9 @@ :: MonadError e m => Stream m a -> (e -> Stream m a) -> Stream m a withCatchError m h =- Stream $ \_ stp sng yld ->+ mkStream $ \_ stp sng yld -> let run x = unStream x Nothing stp sng yieldk handle r = r `catchError` \e -> run $ h e yieldk a r = yld a (withCatchError r h) in handle $ run m -}------------------------------------------------------------------------------------ Transformers----------------------------------------------------------------------------------instance MonadTrans Stream where- lift = yieldM
+ src/Streamly/Streams/StreamK/Type.hs view
@@ -0,0 +1,418 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UndecidableInstances #-} -- XXX++#include "../inline.hs"++-- |+-- Module : Streamly.Streams.StreamK.Type+-- Copyright : (c) 2017 Harendra Kumar+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com+-- Stability : experimental+-- Portability : GHC+--+--+-- Continuation passing style (CPS) stream implementation. The symbol 'K' below+-- denotes a function as well as a Kontinuation.+--+module Streamly.Streams.StreamK.Type+ (+ -- * A class for streams+ IsStream (..)+ , adapt++ -- * The stream type+ , Stream ()++ -- * Construction+ , mkStream+ , fromStopK+ , fromYieldK+ , consK++ -- * Elimination+ , foldStream+ , foldStreamShared+ , foldStreamSVar++ -- instances+ , consMStream++ , nil+ , serial+ , map+ , yieldM++ , Streaming -- deprecated+ )+where++import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Trans.Class (MonadTrans(lift))+import Data.Semigroup (Semigroup(..))+import Prelude hiding (map)++import Streamly.SVar++------------------------------------------------------------------------------+-- Basic stream type+------------------------------------------------------------------------------++-- | The type @Stream m a@ represents a monadic stream of values of type 'a'+-- constructed using actions in monad 'm'. It uses stop, singleton and yield+-- continuations equivalent to the following direct style type:+--+-- @+-- data Stream m a = Stop | Singleton a | Yield a (Stream m a)+-- @+--+-- To facilitate parallel composition we maintain a local state in an 'SVar'+-- that is shared across and is used for synchronization of the streams being+-- composed.+--+-- The singleton case can be expressed in terms of stop and yield but we have+-- it as a separate case to optimize composition operations for streams with+-- single element. We build singleton streams in the implementation of 'pure'+-- for Applicative and Monad, and in 'lift' for MonadTrans.+--+-- XXX remove the Stream type parameter from State as it is always constant.+-- We can remove it from SVar as well+--+newtype Stream m a =+ MkStream (forall r.+ State Stream m a -- state+ -> (a -> Stream m a -> m r) -- yield+ -> (a -> m r) -- singleton+ -> m r -- stop+ -> m r+ )++------------------------------------------------------------------------------+-- Types that can behave as a Stream+------------------------------------------------------------------------------++infixr 5 `consM`+infixr 5 |:++-- XXX Use a different SVar based on the stream type. But we need to make sure+-- that we do not lose performance due to polymorphism.+--+-- | Class of types that can represent a stream of elements of some type 'a' in+-- some monad 'm'.+--+-- @since 0.2.0+class IsStream t where+ toStream :: t m a -> Stream m a+ fromStream :: Stream m a -> t m a+ -- | Constructs a stream by adding a monadic action at the head of an+ -- existing stream. For example:+ --+ -- @+ -- > toList $ getLine \`consM` getLine \`consM` nil+ -- hello+ -- world+ -- ["hello","world"]+ -- @+ --+ -- /Concurrent (do not use 'parallely' to construct infinite streams)/+ --+ -- @since 0.2.0+ consM :: MonadAsync m => m a -> t m a -> t m a+ -- | Operator equivalent of 'consM'. We can read it as "@parallel colon@"+ -- to remember that @|@ comes before ':'.+ --+ -- @+ -- > toList $ getLine |: getLine |: nil+ -- hello+ -- world+ -- ["hello","world"]+ -- @+ --+ -- @+ -- let delay = threadDelay 1000000 >> print 1+ -- runStream $ serially $ delay |: delay |: delay |: nil+ -- runStream $ parallely $ delay |: delay |: delay |: nil+ -- @+ --+ -- /Concurrent (do not use 'parallely' to construct infinite streams)/+ --+ -- @since 0.2.0+ (|:) :: MonadAsync m => m a -> t m a -> t m a+ -- We can define (|:) just as 'consM' but it is defined explicitly for each+ -- type because we want to use SPECIALIZE pragma on the definition.++-- | Same as 'IsStream'.+--+-- @since 0.1.0+{-# DEPRECATED Streaming "Please use IsStream instead." #-}+type Streaming = IsStream++-------------------------------------------------------------------------------+-- Type adapting combinators+-------------------------------------------------------------------------------++-- XXX Move/reset the State here by reconstructing the stream with cleared+-- state. Can we make sure we do not do that when t1 = t2? If we do this then+-- we do not need to do that explicitly using svarStyle. It would act as+-- unShare when the stream type is the same.+--+-- | Adapt any specific stream type to any other specific stream type.+--+-- @since 0.1.0+adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a+adapt = fromStream . toStream++------------------------------------------------------------------------------+-- Building a stream+------------------------------------------------------------------------------++-- XXX The State is always parameterized by "Stream" which means State is not+-- different for different stream types. So we have to manually make sure that+-- when converting from one stream to another we migrate the state correctly.+-- This can be fixed if we use a different SVar type for different streams.+-- Currently we always use "SVar Stream" and therefore a different State type+-- parameterized by that stream.+--+-- XXX Since t is coercible we should be able to coerce k+-- mkStream k = fromStream $ MkStream $ coerce k+--+-- | Build a stream from an 'SVar', a stop continuation, a singleton stream+-- continuation and a yield continuation.+{-# INLINE_EARLY mkStream #-}+mkStream :: IsStream t+ => (forall r. State Stream m a+ -> (a -> t m a -> m r)+ -> (a -> m r)+ -> m r+ -> m r)+ -> t m a+mkStream k = fromStream $ MkStream $ \st yld sng stp ->+ let yieldk a r = yld a (toStream r)+ in k st yieldk sng stp++{-# RULES "mkStream from stream" mkStream = mkStreamFromStream #-}+mkStreamFromStream :: IsStream t+ => (forall r. State Stream m a+ -> (a -> Stream m a -> m r)+ -> (a -> m r)+ -> m r+ -> m r)+ -> t m a+mkStreamFromStream k = fromStream $ MkStream k++{-# RULES "mkStream stream" mkStream = mkStreamStream #-}+mkStreamStream+ :: (forall r. State Stream m a+ -> (a -> Stream m a -> m r)+ -> (a -> m r)+ -> m r+ -> m r)+ -> Stream m a+mkStreamStream = MkStream++-- | A terminal function that has no continuation to follow.+type StopK m = forall r. m r -> m r++-- | A monadic continuation, it is a function that yields a value of type "a"+-- and calls the argument (a -> m r) as a continuation with that value. We can+-- also think of it as a callback with a handler (a -> m r). Category+-- theorists call it a codensity type, a special type of right kan extension.+type YieldK m a = forall r. (a -> m r) -> m r++_wrapM :: Monad m => m a -> YieldK m a+_wrapM m = \k -> m >>= k++-- | Make an empty stream from a stop function.+fromStopK :: IsStream t => StopK m -> t m a+fromStopK k = mkStream $ \_ _ _ stp -> k stp++-- | Make a singleton stream from a yield function.+fromYieldK :: IsStream t => YieldK m a -> t m a+fromYieldK k = mkStream $ \_ _ sng _ -> k sng++-- | Add a yield function at the head of the stream.+consK :: IsStream t => YieldK m a -> t m a -> t m a+consK k r = mkStream $ \_ yld _ _ -> k (\x -> yld x r)++-- XXX Build a stream from a repeating callback function.++------------------------------------------------------------------------------+-- Folding a stream+------------------------------------------------------------------------------++-- | Fold a stream by providing an SVar, a stop continuation, a singleton+-- continuation and a yield continuation. The stream would share the current+-- SVar passed via the State.+{-# INLINE_EARLY foldStreamShared #-}+foldStreamShared+ :: IsStream t+ => State Stream m a+ -> (a -> t m a -> m r)+ -> (a -> m r)+ -> m r+ -> t m a+ -> m r+foldStreamShared st yld sng stp m =+ let yieldk a x = yld a (fromStream x)+ MkStream k = toStream m+ in k st yieldk sng stp++-- XXX write a similar rule for foldStream as well?+{-# RULES "foldStreamShared from stream"+ foldStreamShared = foldStreamSharedStream #-}+foldStreamSharedStream+ :: State Stream m a+ -> (a -> Stream m a -> m r)+ -> (a -> m r)+ -> m r+ -> Stream m a+ -> m r+foldStreamSharedStream st yld sng stp m =+ let MkStream k = toStream m+ in k st yld sng stp++-- | Fold a stream by providing a State, stop continuation, a singleton+-- continuation and a yield continuation. The stream will not use the SVar+-- passed via State.+{-# INLINE foldStream #-}+foldStream+ :: IsStream t+ => State Stream m a+ -> (a -> t m a -> m r)+ -> (a -> m r)+ -> m r+ -> t m a+ -> m r+foldStream st yld sng stp m =+ let yieldk a x = yld a (fromStream x)+ MkStream k = toStream m+ in k (adaptState st) yieldk sng stp++-- Run the stream using a run function associated with the SVar that runs the+-- streams with a captured snapshot of the monadic state.+{-# INLINE foldStreamSVar #-}+foldStreamSVar+ :: (IsStream t, MonadIO m)+ => SVar Stream m a+ -> State Stream m a -- state+ -> (a -> t m a -> m r) -- yield+ -> (a -> m r) -- singleton+ -> m r -- stop+ -> t m a+ -> m ()+foldStreamSVar sv st yld sng stp m =+ let mrun = runInIO $ svarMrun sv+ in void $ liftIO $ mrun $ foldStreamShared st yld sng stp m++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++-- NOTE: specializing the function outside the instance definition seems to+-- improve performance quite a bit at times, even if we have the same+-- SPECIALIZE in the instance definition.+{-# INLINE consMStream #-}+{-# SPECIALIZE consMStream :: IO a -> Stream IO a -> Stream IO a #-}+consMStream :: (Monad m) => m a -> Stream m a -> Stream m a+consMStream m r = MkStream $ \_ yld _ _ -> m >>= \a -> yld a r++-------------------------------------------------------------------------------+-- IsStream Stream+-------------------------------------------------------------------------------++instance IsStream Stream where+ toStream = id+ fromStream = id++ {-# INLINE consM #-}+ {-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}+ consM :: Monad m => m a -> Stream m a -> Stream m a+ consM = consMStream++ {-# INLINE (|:) #-}+ {-# SPECIALIZE (|:) :: IO a -> Stream IO a -> Stream IO a #-}+ (|:) :: Monad m => m a -> Stream m a -> Stream m a+ (|:) = consMStream++------------------------------------------------------------------------------+-- Semigroup+------------------------------------------------------------------------------++-- | Polymorphic version of the 'Semigroup' operation '<>' of 'SerialT'.+-- Appends two streams sequentially, yielding all elements from the first+-- stream, and then all elements from the second stream.+--+-- @since 0.2.0+{-# INLINE serial #-}+serial :: IsStream t => t m a -> t m a -> t m a+serial m1 m2 = go m1+ where+ go m = mkStream $ \st yld sng stp ->+ let stop = foldStream st yld sng stp m2+ single a = yld a m2+ yieldk a r = yld a (go r)+ in foldStream st yieldk single stop m++instance Semigroup (Stream m a) where+ (<>) = serial++------------------------------------------------------------------------------+-- Monoid+------------------------------------------------------------------------------++-- | An empty stream.+--+-- @+-- > toList nil+-- []+-- @+--+-- @since 0.1.0+{-# INLINE nil #-}+nil :: IsStream t => t m a+nil = mkStream $ \_ _ _ stp -> stp++instance Monoid (Stream m a) where+ mempty = nil+ mappend = (<>)++-------------------------------------------------------------------------------+-- Functor+-------------------------------------------------------------------------------++{-# INLINE map #-}+map :: IsStream t => (a -> b) -> t m a -> t m b+map f m = go m+ where+ go m1 =+ mkStream $ \st yld sng stp ->+ let single = sng . f+ yieldk a r = yld (f a) (go r)+ in foldStream (adaptState st) yieldk single stp m1++-- in fact use the Stream type everywhere and only use polymorphism in the high+-- level modules/prelude.+instance Monad m => Functor (Stream m) where+ fmap = map++-------------------------------------------------------------------------------+-- Transformers+-------------------------------------------------------------------------------++{-# INLINE yieldM #-}+yieldM :: (Monad m, IsStream t) => m a -> t m a+yieldM m = fromStream $ mkStream $ \_ _ single _ -> m >>= single++instance MonadTrans Stream where+ lift = yieldM
src/Streamly/Streams/Zip.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving#-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- XXX -- |@@ -37,14 +38,22 @@ ) where +import Control.Applicative (liftA2)+import Control.DeepSeq (NFData(..), NFData1(..), rnf1)+import Data.Functor.Identity (Identity, runIdentity)+import Data.Foldable (fold) import Data.Semigroup (Semigroup(..))+import GHC.Exts (IsList(..), IsString(..))+import Text.Read (Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec,+ readListPrecDefault) import Prelude hiding (map, repeat, zipWith) -import Streamly.Streams.StreamK (IsStream(..), Stream(..))+import Streamly.Streams.StreamK (IsStream(..), Stream, mkStream, foldStream) import Streamly.Streams.Async (mkAsync') import Streamly.Streams.Serial (map)-import Streamly.SVar (MonadAsync, rstState)+import Streamly.SVar (MonadAsync, adaptState) +import qualified Streamly.Streams.Prelude as P import qualified Streamly.Streams.StreamK as K #include "Instances.hs"@@ -97,6 +106,9 @@ zipping :: IsStream t => ZipSerialM m a -> t m a zipping = zipSerially +consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a+consMZip m ms = fromStream $ K.consMStream m (toStream ms)+ instance IsStream ZipSerialM where toStream = getZipSerialM fromStream = ZipSerialM@@ -104,45 +116,52 @@ {-# INLINE consM #-} {-# SPECIALIZE consM :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-} consM :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a- consM m r = fromStream $ K.consMSerial m (toStream r)+ consM = consMZip {-# INLINE (|:) #-} {-# SPECIALIZE (|:) :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-} (|:) :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a- m |: r = fromStream $ K.consMSerial m (toStream r)+ (|:) = consMZip +LIST_INSTANCES(ZipSerialM)+ instance Monad m => Functor (ZipSerialM m) where fmap = map instance Monad m => Applicative (ZipSerialM m) where pure = ZipSerialM . K.repeat- m1 <*> m2 = fromStream $ K.zipWith id (toStream m1) (toStream m2)+ (<*>) = K.zipWith id +FOLDABLE_INSTANCE(ZipSerialM)+TRAVERSABLE_INSTANCE(ZipSerialM)+ ------------------------------------------------------------------------------ -- Parallel Zipping ------------------------------------------------------------------------------ --- | Zip two streams concurrently (i.e. both the elements being zipped are--- generated concurrently) using a pure zipping function.+-- | Like 'zipWith' but zips concurrently i.e. both the streams being zipped+-- are generated concurrently. -- -- @since 0.1.0+{-# INLINABLE zipAsyncWith #-} zipAsyncWith :: (IsStream t, MonadAsync m) => (a -> b -> c) -> t m a -> t m b -> t m c-zipAsyncWith f m1 m2 = fromStream $ Stream $ \st stp sng yld -> do- ma <- mkAsync' (rstState st) m1- mb <- mkAsync' (rstState st) m2- unStream (toStream (K.zipWith f ma mb)) (rstState st) stp sng yld+zipAsyncWith f m1 m2 = mkStream $ \st stp sng yld -> do+ ma <- mkAsync' (adaptState st) m1+ mb <- mkAsync' (adaptState st) m2+ foldStream st stp sng yld (K.zipWith f ma mb) --- | Zip two streams asyncly (i.e. both the elements being zipped are generated--- concurrently) using a monadic zipping function.+-- | Like 'zipWithM' but zips concurrently i.e. both the streams being zipped+-- are generated concurrently. -- -- @since 0.4.0+{-# INLINABLE zipAsyncWithM #-} zipAsyncWithM :: (IsStream t, MonadAsync m) => (a -> b -> m c) -> t m a -> t m b -> t m c-zipAsyncWithM f m1 m2 = fromStream $ Stream $ \st stp sng yld -> do- ma <- mkAsync' (rstState st) m1- mb <- mkAsync' (rstState st) m2- unStream (toStream (K.zipWithM f ma mb)) (rstState st) stp sng yld+zipAsyncWithM f m1 m2 = mkStream $ \st stp sng yld -> do+ ma <- mkAsync' (adaptState st) m1+ mb <- mkAsync' (adaptState st) m2+ foldStream st stp sng yld (K.zipWithM f ma mb) ------------------------------------------------------------------------------ -- Parallely Zipping Streams@@ -185,6 +204,10 @@ {-# DEPRECATED zippingAsync "Please use zipAsyncly instead." #-} zippingAsync :: IsStream t => ZipAsyncM m a -> t m a zippingAsync = zipAsyncly++consMZipAsync :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a+consMZipAsync m ms = fromStream $ K.consMStream m (toStream ms)+ instance IsStream ZipAsyncM where toStream = getZipAsyncM fromStream = ZipAsyncM@@ -192,12 +215,12 @@ {-# INLINE consM #-} {-# SPECIALIZE consM :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-} consM :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a- consM m r = fromStream $ K.consMSerial m (toStream r)+ consM = consMZipAsync {-# INLINE (|:) #-} {-# SPECIALIZE (|:) :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-} (|:) :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a- m |: r = fromStream $ K.consMSerial m (toStream r)+ (|:) = consMZipAsync instance Monad m => Functor (ZipAsyncM m) where fmap = map
− src/Streamly/Streams/inline.h
@@ -1,3 +0,0 @@-#define INLINE_EARLY INLINE [2]-#define INLINE_NORMAL INLINE [1]-#define INLINE_LATE INLINE [0]
+ src/Streamly/Streams/inline.hs view
@@ -0,0 +1,27 @@+-- We use fromStreamK/toStreamK to convert the direct style stream to CPS+-- style. In the first phase we try fusing the fromStreamK/toStreamK using:+--+-- {-# RULES "fromStreamK/toStreamK fusion"+-- forall s. toStreamK (fromStreamK s) = s #-}+--+-- If for some reason some of the operations could not be fused then we have+-- fallback rules in the second phase. For example:+--+-- {-# INLINE_EARLY unfoldr #-}+-- unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a+-- unfoldr step seed = fromStreamS (S.unfoldr step seed)+-- {-# RULES "unfoldr fallback to StreamK" [1]+-- forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}```+--+-- Then, fromStreamK/toStreamK are inlined in the last phase:+--+-- {-# INLINE_LATE toStreamK #-}+-- toStreamK :: Monad m => Stream m a -> K.Stream m a```+--+-- The fallback rules make sure that if we could not fuse the direct style+-- operations then better use the CPS style operation, because unfused direct+-- style would have worse performance than the CPS style ops.++#define INLINE_EARLY INLINE [2]+#define INLINE_NORMAL INLINE [1]+#define INLINE_LATE INLINE [0]
+ src/Streamly/String.hs view
@@ -0,0 +1,28 @@+-- |+-- Module : Streamly.String+-- Copyright : (c) 2018 Composewell Technologies+--+-- License : BSD3+-- Maintainer : harendra.kumar@gmail.com+-- Stability : experimental+-- Portability : GHC+--+-- The 'String' type in this module is just a synonym for the type @List Char@.+-- It provides better performance compared to the standard Haskell @String@+-- type and can be used almost as a drop-in replacement, especially when used+-- with @OverloadedStrings@ extension, with little differences.+--+-- See "Streamly.List", <src/docs/streamly-vs-lists.md> for more details and+-- <src/test/PureStreams.hs> for comprehensive usage examples.+--+--+module Streamly.String+ (+ String+ )+where++import Streamly.List (List)+import Prelude hiding (String)++type String = List Char
src/Streamly/Tutorial.hs view
@@ -9,7 +9,7 @@ -- Streamly is a general computing framework based on streaming IO. The IO -- monad and pure lists are a special case of streamly. On one hand, streamly -- extends the lists of pure values to lists of monadic actions, on the other--- hand it extends the IO monad with concurrrent non-determinism. In simple+-- hand it extends the IO monad with concurrent non-determinism. In simple -- imperative terms we can say that streamly extends the IO monad with @for@ -- loops and nested @for@ loops with concurrency support. You can understand -- this analogy better once you can go through this tutorial.@@ -87,8 +87,9 @@ -- *** Parallel Asynchronous Composition ('Parallel') -- $parallel - -- *** Custom composition- -- $custom+ -- XXX we should deprecate and remove the mkAsync API+ -- Custom composition+ -- custom -- ** Monoid Style -- $monoid@@ -199,13 +200,19 @@ -- $concurrentStreams ----- Streams can be generated concurrently, even infnite streams can be generated--- concurrently using controlled concurrency, streams can be merged--- concurrently, multiple stages in a streaming pipeline can run concurrently,--- streams can be mapped concurrently, they can be zipped concurrently, and in--- a monadic composition they combine like a list transformer providing--- concurrent non-determinism.+-- Many stream operations can be done concurrently: --+-- * Streams can be generated concurrently.+--+-- * Streams can be merged concurrently.+--+-- * Multiple stages in a streaming pipeline can run concurrently.+--+-- * Streams can be mapped and zipped concurrently.+--+-- * In monadic composition they combine like a list transformer,+-- providing concurrent non-determinism.+-- -- There are three basic concurrent stream styles, 'Ahead', 'Async', and -- 'Parallel'. The 'Ahead' style streams are similar to 'Serial' except that -- they can speculatively execute multiple stream actions concurrently in@@ -229,35 +236,37 @@ -- asynchronous consumption the outputs are consumed as they arrive i.e. first -- come first serve order. ----- @ -- +------------+--------------+--------------+--------------+ -- | Type | Execution | Consumption | Concurrency | -- +============+==============+==============+==============+--- | 'Serial' | Serial | Serial | None |+-- | 'Serial' | Serial | Serial | None | -- +------------+--------------+--------------+--------------+--- | 'Ahead' | Asynchronous | Serial | bounded |+-- | 'Ahead' | Asynchronous | Serial | bounded | -- +------------+--------------+--------------+--------------+--- | 'Async' | Asynchronous | Asynchronous | bounded |+-- | 'Async' | Asynchronous | Asynchronous | bounded | -- +------------+--------------+--------------+--------------+--- | 'Parallel' | Asynchronous | Asynchronous | unbounded |+-- | 'Parallel' | Asynchronous | Asynchronous | unbounded | -- +------------+--------------+--------------+--------------+--- @ -- -- All these types can be freely inter-converted using type conversion--- combinators or type annotations without any cost, to acheive the desired--- composition style. To force a particular type of composition we coerce the+-- combinators or type annotations, without any cost, to achieve the desired+-- composition style. To force a particular type of composition, we coerce the -- stream type using the corresponding type adapting combinator from -- 'serially', 'aheadly', 'asyncly', or 'parallely'. The default stream type -- is inferred as 'Serial' unless you change it by using one of the combinators--- or using a type annotation.+-- or by using a type annotation. -- $flavors ----- Streams can be combined using semigroup or monoid composition to form a--- composite stream. Traversal of a composition of streams could be @deep@ or--- @wide@. Deep goes depth first i.e. each stream is traversed fully before--- we traverse the next stream. Wide goes breadth first i.e. one element from--- each stream is traversed before coming back to the first stream again.+-- Streams can be combined using '<>' or 'mappend' to form a+-- composite. Composite streams can be interpreted in a depth first or+-- breadth first manner using an appropriate type conversion before+-- consumption. Deep (e.g. 'Serial') stream type variants traverse a+-- composite stream in a depth first manner, such that each stream is+-- traversed fully before traversing the next stream. Wide+-- (e.g. 'WSerial') stream types traverse it in a breadth first+-- manner, such that one element from each stream is traversed before+-- coming back to the first stream again. -- -- Each stream type has a wide traversal variant prefixed by 'W'. The wide -- variant differs only in the Semigroup\/Monoid, Applicative\/Monad@@ -384,12 +393,12 @@ -- $generatingConcurrently ----- Monadic construction and generation functions e.g. 'consM', 'unfoldrM',--- 'replicateM', 'repeatM', 'iterateM' and 'fromFoldableM' etc work--- concurrently when used with appropriate stream type combinator. The pure--- versions of these APIs are not concurrent, however you can use the monadic--- versions even for pure computations by wrapping the pure value in a monad to--- get the concurrent generation capability where required.+-- Monadic construction and generation functions like 'consM', 'unfoldrM',+-- 'replicateM', 'repeatM', 'iterateM' and 'fromFoldableM' work concurrently+-- when used with appropriate stream type combinator. The pure versions of+-- these APIs are not concurrent, however you can use the monadic versions even+-- for pure computations by wrapping the pure value in a monad to get the+-- concurrent generation capability where required. -- -- The following code finishes in 3 seconds (6 seconds when serial): --@@ -521,7 +530,7 @@ -- The 'Semigroup' operation '<>' of the 'Serial' type combines the two streams -- in a /serial depth first/ manner. We use the 'serially' type combinator to -- effect 'Serial' style of composition. We can also use an explicit 'Serial'--- type annotation for the stream to acheive the same effect. However, since+-- type annotation for the stream to achieve the same effect. However, since -- 'Serial' is the default type unless explicitly specified by using a -- combinator, we can omit using an explicit combinator or type annotation for -- this style of composition.@@ -570,11 +579,11 @@ -- The 'Semigroup' operation '<>' of the 'WSerial' type combines the two -- streams in a /serial breadth first/ manner. We use the 'wSerially' type -- combinator to effect 'WSerial' style of composition. We can also use the--- 'WSerial' type annotation for the stream to acheive the same effect.+-- 'WSerial' type annotation for the stream to achieve the same effect. -- -- When two streams with multiple elements are combined in this manner, we -- traverse all the streams in a breadth first manner i.e. one action from each--- stream is peformed and yielded to the resulting stream before we come back+-- stream is performed and yielded to the resulting stream before we come back -- to the first stream again and so on. -- The following example prints the sequence 1, 3, 2, 4 --@@ -625,7 +634,7 @@ -- The 'Semigroup' operation '<>' of the 'Ahead' type combines two streams in a -- /serial depth first/ manner with concurrent lookahead. We use the 'aheadly' -- type combinator to effect 'Ahead' style of composition. We can also use an--- explicit 'Ahead' type annotation for the stream to acheive the same effect.+-- explicit 'Ahead' type annotation for the stream to achieve the same effect. -- -- When two streams are combined in this manner, the streams are traversed in -- depth first manner just like 'Serial', however it can execute the next@@ -658,7 +667,7 @@ -- The 'Semigroup' operation '<>' of the 'Async' type combines the two -- streams in a depth first manner with parallel look ahead. We use the -- 'asyncly' type combinator to effect 'Async' style of composition. We--- can also use the 'Async' type annotation for the stream type to acheive+-- can also use the 'Async' type annotation for the stream type to achieve -- the same effect. -- -- When two streams with multiple elements are combined in this manner, the@@ -839,7 +848,7 @@ -- streams in a fairly concurrent manner with round robin scheduling. We use -- the 'parallely' type combinator to effect 'Parallel' style of composition. -- We can also use the 'Parallel' type annotation for the stream type to--- acheive the same effect.+-- achieve the same effect. -- -- When two streams with multiple elements are combined in this manner, the -- monadic actions in both the streams are performed concurrently with a fair@@ -884,6 +893,7 @@ -- number of streams, as it will lead to an infinite sized scheduling queue. -- +-- XXX to be removed -- $custom -- -- The 'mkAsync' API can be used to create references to asynchronously running@@ -1274,7 +1284,7 @@ -- [(1,3),(1,4),(2,3),(2,4)] -- @ ----- Similalrly 'WSerial' applicative runs the iterations in an interleaved+-- Similarly 'WSerial' applicative runs the iterations in an interleaved -- order but since it is serial it takes a total of 17 seconds: -- -- @@@ -1306,7 +1316,7 @@ -- [(1,3),(2,3),(1,4),(2,4)] -- @ ----- Similalrly 'WAsync' as well can run the iterations concurrently and+-- Similarly 'WAsync' as well can run the iterations concurrently and -- therefore takes a total of 10 seconds (1 + 2 + 3 + 4): -- -- @@@ -1431,7 +1441,9 @@ -- and operators instead of the ugly pragmas. -- -- For more concurrent programming examples see,--- "ListDir.hs", "MergeSort.hs" and "SearchQuery.hs" in the examples directory.+-- <src/examples/ListDir.hs ListDir.hs>,+-- <src/examples/MergeSort.hs MergeSort.hs> and+-- <src/examples/SearchQuery.hs SearchQuery.hs> in the examples directory. -- $reactive --@@ -1454,52 +1466,65 @@ -- {-\# LANGUAGE FlexibleContexts #-} -- -- import "Streamly"--- import Streamly.Prelude as S--- import Control.Monad (when)--- import Control.Monad.IO.Class (MonadIO(..))--- import Control.Monad.State (MonadState, get, modify, runStateT)+-- import "Streamly.Prelude" as S+-- import Control.Monad (void, when)+-- import Control.Monad.IO.Class (MonadIO(liftIO))+-- import Control.Monad.State (MonadState, get, modify, runStateT, put) ----- data Event = Harm Int | Heal Int | Quit deriving (Show)+-- data Event = Quit | Harm Int | Heal Int deriving (Show) -- -- userAction :: MonadAsync m => 'SerialT' m Event--- userAction = S.repeatM $ liftIO askUser+-- userAction = S.'repeatM' $ liftIO askUser -- where -- askUser = do -- command <- getLine -- case command of -- "potion" -> return (Heal 10)--- "quit" -> return Quit--- _ -> putStrLn "What?" >> askUser+-- "harm" -> return (Harm 10)+-- "quit" -> return Quit+-- _ -> putStrLn "Type potion or harm or quit" >> askUser ----- acidRain :: MonadAsync m => SerialT m Event--- acidRain = asyncly $ constRate 1 $ S.repeatM $ liftIO $ return $ Harm 1+-- acidRain :: MonadAsync m => 'SerialT' m Event+-- acidRain = 'asyncly' $ 'constRate' 1 $ S.'repeatM' $ liftIO $ return $ Harm 1 ----- game :: ('MonadAsync' m, MonadState Int m) => 'SerialT' m ()--- game = do+-- data Result = Check | Done+--+-- runEvents :: (MonadAsync m, MonadState Int m) => 'SerialT' m Result+-- runEvents = do -- event \<- userAction \`parallel` acidRain -- case event of--- Harm n -> modify $ \\h -> h - n--- Heal n -> modify $ \\h -> h + n--- Quit -> fail "quit"+-- Harm n -> modify (\\h -> h - n) >> return Check+-- Heal n -> modify (\\h -> h + n) >> return Check+-- Quit -> return Done ----- h <- get--- when (h <= 0) $ fail "You die!"--- liftIO $ putStrLn $ "Health = " ++ show h+-- data Status = Alive | GameOver deriving Eq --+-- getStatus :: (MonadAsync m, MonadState Int m) => Result -> m Status+-- getStatus result =+-- case result of+-- Done -> liftIO $ putStrLn "You quit!" >> return GameOver+-- Check -> do+-- h <- get+-- liftIO $ if (h <= 0)+-- then putStrLn "You die!" >> return GameOver+-- else putStrLn ("Health = " <> show h) >> return Alive+--+-- main :: IO () -- main = do -- putStrLn "Your health is deteriorating due to acid rain,\\ -- \\ type \\"potion\\" or \\"quit\\""--- _ <- runStateT ('runStream' game) 60--- return ()+-- let runGame = S.'runWhile' (== Alive) $ S.'mapM' getStatus runEvents+-- void $ runStateT runGame 60 -- @ -- -- You can also find the source of this example in the examples directory as--- "AcidRain.hs". It has been adapted from Gabriel's+-- <src/examples/AcidRain.hs AcidRain.hs>. It has been adapted from Gabriel's -- <https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html pipes-concurrency> -- package. -- This is much simpler compared to the pipes version because of the builtin -- concurrency in streamly. You can also find a SDL based reactive programming--- example adapted from Yampa in "Streamly.Examples.CirclingSquare".+-- example adapted from Yampa in+-- <src/examples/CirclingSquare.hs CirclingSquare.hs>. -- $performance --@@ -1684,7 +1709,7 @@ -- comparison to transient streamly has a first class streaming interface and -- is a monad transformer that can be used universally in any Haskell monad -- transformer stack. Streamly was in fact originally inspired by the--- concurrency implementation in @transient@ though it has no resemblence with+-- concurrency implementation in @transient@ though it has no resemblance with -- that and takes a lazy pull approach versus transient's strict push approach. -- -- The non-determinism, concurrency and streaming combination make streamly a
stack-7.10.yaml view
@@ -12,6 +12,7 @@ - SDL-0.6.5.1 - gauge-0.2.4 - basement-0.0.7+ - deepseq-1.4.4.0 flags: {} extra-package-dbs: [] # For mac ports installed SDL library on Mac OS X
stack-8.0.yaml view
@@ -8,6 +8,7 @@ - SDL-0.6.5.1 - gauge-0.2.4 - basement-0.0.4+ - deepseq-1.4.4.0 flags: {} extra-package-dbs: [] rebuild-ghc-options: true
stack.yaml view
@@ -1,14 +1,16 @@ resolver: lts-12.11 packages: - '.'-allow-newer: true extra-deps: - SDL-0.6.6.0 - gauge-0.2.4 - Chart-1.9 - Chart-diagrams-1.9 - SVGFonts-1.6.0.3- - bench-show-0.2.1+ - bench-show-0.2.2+ - statistics-0.15.0.0+ - dense-linear-algebra-0.1.0.0+ - math-functions-0.3.0.2 flags: {} extra-package-dbs: []
streamly.cabal view
@@ -1,5 +1,5 @@ name: streamly-version: 0.5.2+version: 0.6.0 synopsis: Beautiful Streaming, Concurrent and Reactive Composition description: Streamly, short for streaming concurrently, provides monadic streams, with a@@ -15,7 +15,6 @@ . The basic streaming functionality of streamly is equivalent to that provided by streaming libraries like- <https://hackage.haskell.org/package/vector vector>, <https://hackage.haskell.org/package/streaming streaming>, <https://hackage.haskell.org/package/pipes pipes>, and <https://hackage.haskell.org/package/conduit conduit>.@@ -31,8 +30,8 @@ . For file IO, currently the library provides only one API to stream the lines in the file as Strings. Future versions will provide better streaming file- IO options. Streamly interworks with the popular streaming libraries, see- the interworking section in "Streamly.Tutorial".+ IO options. Streamly interoperates with the popular streaming libraries, see+ the interoperation section in "Streamly.Tutorial". . Why use streamly? .@@ -69,7 +68,10 @@ bug-reports: https://github.com/composewell/streamly/issues license: BSD3 license-file: LICENSE-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3+tested-with: GHC==7.10.3+ , GHC==8.0.2+ , GHC==8.4.4+ , GHC==8.6.3 author: Harendra Kumar maintainer: harendra.kumar@gmail.com copyright: 2017 Harendra Kumar@@ -88,7 +90,7 @@ stack-8.0.yaml stack.yaml src/Streamly/Streams/Instances.hs- src/Streamly/Streams/inline.h+ src/Streamly/Streams/inline.hs source-repository head type: git@@ -126,15 +128,25 @@ library hs-source-dirs: src other-modules: Streamly.SVar++ -- Base streams+ , Streamly.Streams.StreamK.Type , Streamly.Streams.StreamK+ , Streamly.Streams.StreamD.Type , Streamly.Streams.StreamD- , Streamly.Streams.Serial+ , Streamly.Streams.Prelude++ -- Higher level streams , Streamly.Streams.SVar+ , Streamly.Streams.Serial , Streamly.Streams.Async , Streamly.Streams.Parallel , Streamly.Streams.Ahead , Streamly.Streams.Zip- , Streamly.Streams.Prelude+ , Streamly.Streams.Combinators+ , Streamly.List+ , Streamly.String+ , Streamly.Enumeration exposed-modules: Streamly.Prelude , Streamly.Time@@ -143,7 +155,7 @@ , Streamly.Internal default-language: Haskell2010- ghc-options: -Wall+ ghc-options: -Wall -fspec-constr-recursive=10 if flag(streamk) cpp-options: -DUSE_STREAMK_ONLY@@ -167,6 +179,7 @@ build-depends: base >= 4.8 && < 5 , ghc-prim >= 0.2 && < 0.6+ , deepseq >= 1.4.3 && < 1.5 , containers >= 0.5 && < 0.7 , heaps >= 0.3 && < 0.4 @@ -220,6 +233,55 @@ , exceptions >= 0.8 && < 0.11 default-language: Haskell2010 +-- test-suite pure-streams-base+-- type: exitcode-stdio-1.0+-- main-is: PureStreams.hs+-- hs-source-dirs: test+-- ghc-options: -O0 -Wall -threaded -with-rtsopts=-N -fno-ignore-asserts+-- if flag(dev)+-- cpp-options: -DDEVBUILD+-- ghc-options: -Wmissed-specialisations+-- -Wall-missed-specialisations+-- if impl(ghc >= 8.0)+-- ghc-options: -Wcompat+-- -Wunrecognised-warning-flags+-- -Widentities+-- -Wincomplete-record-updates+-- -Wincomplete-uni-patterns+-- -Wredundant-constraints+-- -Wnoncanonical-monad-instances+-- -Wnoncanonical-monadfail-instances+-- build-depends:+-- streamly+-- , base >= 4.8 && < 5+-- , hspec >= 2.0 && < 3+-- default-language: Haskell2010+-- +-- test-suite pure-streams-streamly+-- type: exitcode-stdio-1.0+-- main-is: PureStreams.hs+-- hs-source-dirs: test+-- cpp-options: -DUSE_STREAMLY_LIST+-- ghc-options: -O0 -Wall -threaded -with-rtsopts=-N -fno-ignore-asserts+-- if flag(dev)+-- cpp-options: -DDEVBUILD+-- ghc-options: -Wmissed-specialisations+-- -Wall-missed-specialisations+-- if impl(ghc >= 8.0)+-- ghc-options: -Wcompat+-- -Wunrecognised-warning-flags+-- -Widentities+-- -Wincomplete-record-updates+-- -Wincomplete-uni-patterns+-- -Wredundant-constraints+-- -Wnoncanonical-monad-instances+-- -Wnoncanonical-monadfail-instances+-- build-depends:+-- streamly+-- , base >= 4.8 && < 5+-- , hspec >= 2.0 && < 3+-- default-language: Haskell2010+ test-suite properties type: exitcode-stdio-1.0 main-is: Prop.hs@@ -261,7 +323,7 @@ , base >= 4.8 && < 5 , clock >= 0.7.1 && < 0.8 , hspec >= 2.0 && < 3- , random >= 1.0.0 && < 1.2+ , random >= 1.0.0 && < 2 else buildable: False @@ -284,7 +346,7 @@ build-Depends: streamly , base >= 4.8 && < 5- , random >= 1.0.0 && < 1.2+ , random >= 1.0.0 && < 2 test-suite parallel-loops type: exitcode-stdio-1.0@@ -295,7 +357,7 @@ build-Depends: streamly , base >= 4.8 && < 5- , random >= 1.0.0 && < 1.2+ , random >= 1.0.0 && < 2 ------------------------------------------------------------------------------- -- Benchmarks@@ -307,7 +369,7 @@ main-is: Linear.hs other-modules: LinearOps default-language: Haskell2010- ghc-options: -O2 -Wall+ ghc-options: -O2 -Wall -fspec-constr-recursive=10 if flag(dev) ghc-options: -Wmissed-specialisations -Wall-missed-specialisations@@ -324,7 +386,7 @@ build-depends: streamly , base >= 4.8 && < 5- , deepseq >= 1.4.0 && < 1.5+ , deepseq >= 1.4.3 && < 1.5 , random >= 1.0 && < 2.0 , gauge >= 0.2.4 && < 0.3 @@ -334,7 +396,7 @@ main-is: LinearAsync.hs other-modules: LinearOps default-language: Haskell2010- ghc-options: -O2 -Wall+ ghc-options: -O2 -Wall -fspec-constr-recursive=10 cpp-options: -DLINEAR_ASYNC if flag(dev) ghc-options: -Wmissed-specialisations@@ -352,7 +414,7 @@ build-depends: streamly , base >= 4.8 && < 5- , deepseq >= 1.4.0 && < 1.5+ , deepseq >= 1.4.3 && < 1.5 , random >= 1.0 && < 2.0 , gauge >= 0.2.4 && < 0.3 @@ -362,7 +424,7 @@ main-is: LinearRate.hs other-modules: LinearOps default-language: Haskell2010- ghc-options: -O2 -Wall+ ghc-options: -O2 -Wall -fspec-constr-recursive=10 if flag(dev) ghc-options: -Wmissed-specialisations -Wall-missed-specialisations@@ -379,7 +441,7 @@ build-depends: streamly , base >= 4.8 && < 5- , deepseq >= 1.4.0 && < 1.5+ , deepseq >= 1.4.3 && < 1.5 , random >= 1.0 && < 2.0 , gauge >= 0.2.4 && < 0.3 @@ -389,7 +451,7 @@ main-is: Nested.hs other-modules: NestedOps default-language: Haskell2010- ghc-options: -O2 -Wall+ ghc-options: -O2 -Wall -fspec-constr-recursive=10 if flag(dev) ghc-options: -Wmissed-specialisations -Wall-missed-specialisations@@ -406,7 +468,7 @@ build-depends: streamly , base >= 4.8 && < 5- , deepseq >= 1.4.0 && < 1.5+ , deepseq >= 1.4.3 && < 1.5 , random >= 1.0 && < 2.0 , gauge >= 0.2.4 && < 0.3 @@ -422,7 +484,9 @@ hs-source-dirs: benchmark, src main-is: BaseStreams.hs other-modules: Streamly.SVar+ , Streamly.Streams.StreamK.Type , Streamly.Streams.StreamK+ , Streamly.Streams.StreamD.Type , Streamly.Streams.StreamD , Streamly.Streams.Prelude @@ -430,7 +494,7 @@ , StreamKOps default-language: Haskell2010- ghc-options: -O2 -Wall+ ghc-options: -O2 -Wall -fspec-constr-recursive=10 if flag(dev) ghc-options: -Wmissed-specialisations -Wall-missed-specialisations@@ -445,31 +509,84 @@ -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances - build-depends:- base >= 4.8 && < 5- , deepseq >= 1.4.0 && < 1.5- , random >= 1.0 && < 2.0- , gauge >= 0.2.4 && < 0.3+ if flag(dev)+ buildable: True+ build-depends:+ base >= 4.8 && < 5+ , deepseq >= 1.4.3 && < 1.5+ , random >= 1.0 && < 2.0+ , gauge >= 0.2.4 && < 0.3 - , ghc-prim >= 0.2 && < 0.6- , containers >= 0.5 && < 0.7- , heaps >= 0.3 && < 0.4+ , ghc-prim >= 0.2 && < 0.6+ , containers >= 0.5 && < 0.7+ , heaps >= 0.3 && < 0.4 - -- concurrency- , atomic-primops >= 0.8 && < 0.9- , lockfree-queue >= 0.2.3 && < 0.3- , clock >= 0.7.1 && < 0.8+ -- concurrency+ , atomic-primops >= 0.8 && < 0.9+ , lockfree-queue >= 0.2.3 && < 0.3+ , clock >= 0.7.1 && < 0.8 - , exceptions >= 0.8 && < 0.11- , monad-control >= 1.0 && < 2- , mtl >= 2.2 && < 3- , transformers >= 0.4 && < 0.6- , transformers-base >= 0.4 && < 0.5+ , exceptions >= 0.8 && < 0.11+ , monad-control >= 1.0 && < 2+ , mtl >= 2.2 && < 3+ , transformers >= 0.4 && < 0.6+ , transformers-base >= 0.4 && < 0.5 - if impl(ghc < 8.0)- build-depends:- semigroups >= 0.18 && < 0.19+ if impl(ghc < 8.0)+ build-depends:+ semigroups >= 0.18 && < 0.19+ else+ buildable: False +executable nano-bench+ hs-source-dirs: benchmark, src+ main-is: NanoBenchmarks.hs+ other-modules: Streamly.SVar+ , Streamly.Streams.StreamK.Type+ , Streamly.Streams.StreamK+ , Streamly.Streams.StreamD.Type+ , Streamly.Streams.StreamD+ default-language: Haskell2010+ ghc-options: -O2 -Wall++ if flag(dev)+ buildable: True+ build-depends:+ base >= 4.8 && < 5+ , gauge >= 0.2.4 && < 0.3+ , ghc-prim >= 0.2 && < 0.6+ , containers >= 0.5 && < 0.7+ , heaps >= 0.3 && < 0.4+ , random >= 1.0 && < 2.0++ -- concurrency+ , atomic-primops >= 0.8 && < 0.9+ , lockfree-queue >= 0.2.3 && < 0.3+ , clock >= 0.7.1 && < 0.8++ , exceptions >= 0.8 && < 0.11+ , monad-control >= 1.0 && < 2+ , mtl >= 2.2 && < 3+ , transformers >= 0.4 && < 0.6+ else+ buildable: False++executable adaptive+ hs-source-dirs: benchmark+ main-is: Adaptive.hs+ default-language: Haskell2010+ ghc-options: -O2 -Wall++ if flag(dev)+ buildable: True+ build-depends:+ streamly+ , base >= 4.8 && < 5+ , gauge >= 0.2.4 && < 0.3+ , random >= 1.0 && < 2.0+ else+ buildable: False+ executable chart default-language: Haskell2010 hs-source-dirs: benchmark@@ -510,7 +627,7 @@ build-Depends: streamly , base >= 4.8 && < 5- , path-io >= 0.1.0 && < 1.4+ , path-io >= 0.1.0 && < 1.5 if impl(ghc < 8.0) build-depends: transformers >= 0.4 && < 0.6@@ -526,7 +643,7 @@ build-Depends: streamly , base >= 4.8 && < 5- , random >= 1.0.0 && < 1.2+ , random >= 1.0.0 && < 2 else buildable: False
test/Prop.hs view
@@ -13,12 +13,15 @@ import Data.IORef (readIORef, modifyIORef, newIORef) import Data.List (sort, foldl', scanl', findIndices, findIndex, elemIndices,- elemIndex, find, intersperse, foldl1', (\\))+ elemIndex, find, insertBy, intersperse, foldl1', (\\),+ maximumBy, minimumBy, deleteBy, isPrefixOf, isSubsequenceOf,+ stripPrefix) import Data.Maybe (mapMaybe) import GHC.Word (Word8) import Test.Hspec.QuickCheck-import Test.QuickCheck (counterexample, Property, withMaxSuccess)+import Test.QuickCheck+ (counterexample, Property, withMaxSuccess, forAll, choose) import Test.QuickCheck.Monadic (run, monadicIO, monitor, assert, PropertyM) import Test.Hspec as H@@ -72,32 +75,87 @@ ) assert (stream `eq` list) -constructWithReplicateM- :: IsStream t- => (t IO Int -> SerialT IO Int)+-------------------------------------------------------------------------------+-- Construction operations+-------------------------------------------------------------------------------++constructWithLen+ :: (Show a, Eq a)+ => (Int -> t IO a)+ -> (Int -> [a])+ -> (t IO a -> SerialT IO a) -> Word8 -> Property-constructWithReplicateM op len = withMaxSuccess maxTestCount $+constructWithLen mkStream mkList op len = withMaxSuccess maxTestCount $ monadicIO $ do- let x = return (1 :: Int)- stream <- run $ (S.toList . op) (S.replicateM (fromIntegral len) x)- list <- run $ replicateM (fromIntegral len) x+ stream <- run $ (S.toList . op) (mkStream (fromIntegral len))+ let list = mkList (fromIntegral len) listEquals (==) stream list -transformFromList- :: (Eq b, Show b) =>- ([a] -> t IO a)- -> ([b] -> [b] -> Bool)- -> ([a] -> [b])- -> (t IO a -> SerialT IO b)- -> [a]+constructWithLenM+ :: (Int -> t IO Int)+ -> (Int -> IO [Int])+ -> (t IO Int -> SerialT IO Int)+ -> Word8 -> Property-transformFromList constr eq listOp op a =+constructWithLenM mkStream mkList op len = withMaxSuccess maxTestCount $ monadicIO $ do- stream <- run ((S.toList . op) (constr a))- let list = listOp a- listEquals eq stream list+ stream <- run $ (S.toList . op) (mkStream (fromIntegral len))+ list <- run $ mkList (fromIntegral len)+ listEquals (==) stream list +constructWithReplicate, constructWithReplicateM, constructWithIntFromThenTo+ :: IsStream t+ => (t IO Int -> SerialT IO Int)+ -> Word8+ -> Property++constructWithReplicateM = constructWithLenM stream list+ where list = flip replicateM (return 1 :: IO Int)+ stream = flip S.replicateM (return 1 :: IO Int)++constructWithReplicate = constructWithLen stream list+ where list = flip replicate (1 :: Int)+ stream = flip S.replicate (1 :: Int)++constructWithIntFromThenTo op l =+ forAll (choose (minBound, maxBound)) $ \from ->+ forAll (choose (minBound, maxBound)) $ \next ->+ forAll (choose (minBound, maxBound)) $ \to ->+ let list len = take len [from,next..to]+ stream len = S.take len $ S.enumerateFromThenTo from next to+ in constructWithLen stream list op l++#if __GLASGOW_HASKELL__ >= 806+-- XXX try very small steps close to 0+constructWithDoubleFromThenTo+ :: IsStream t+ => (t IO Double -> SerialT IO Double)+ -> Word8+ -> Property+constructWithDoubleFromThenTo op l =+ forAll (choose (-9007199254740999,9007199254740999)) $ \from ->+ forAll (choose (-9007199254740999,9007199254740999)) $ \next ->+ forAll (choose (-9007199254740999,9007199254740999)) $ \to ->+ let list len = take len [from,next..to]+ stream len = S.take len $ S.enumerateFromThenTo from next to+ in constructWithLen stream list op l+#endif++constructWithIterate :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec+constructWithIterate t = do+ it "iterate" $+ (S.toList . t . S.take 100) (S.iterate (+ 1) (0 :: Int))+ `shouldReturn` take 100 (iterate (+ 1) 0)+ it "iterateM" $ do+ let addM y = return (y + 1)+ S.toList . t . S.take 100 $ S.iterateM addM (0 :: Int)+ `shouldReturn` take 100 (iterate (+ 1) 0)++-------------------------------------------------------------------------------+-- Concurrent generation+-------------------------------------------------------------------------------+ mvarExcHandler :: String -> BlockedIndefinitelyOnMVar -> IO () mvarExcHandler label BlockedIndefinitelyOnMVar = error $ label <> " " <> "BlockedIndefinitelyOnMVar\n"@@ -199,6 +257,32 @@ return x listEquals eq stream list +concurrentOps+ :: IsStream t+ => ([Word8] -> t IO Word8)+ -> String+ -> ([Word8] -> [Word8] -> Bool)+ -> (t IO Word8 -> SerialT IO Word8)+ -> Spec+concurrentOps constr desc eq t = do+ let prop1 d p = prop d $ withMaxSuccess maxTestCount p++ prop1 (desc <> " fromFoldableM") $ concurrentFromFoldable eq t+ prop1 (desc <> " unfoldrM") $ concurrentUnfoldrM eq t+ -- we pass it the length of the stream n and an mvar mv.+ -- The stream is [0..n]. The threads communicate in such a way that the+ -- actions coming first in the stream are dependent on the last action. So+ -- if the stream is not processed concurrently it will block forever.+ -- Note that if the size of the stream is bigger than the thread limit+ -- then it will block even if it is concurrent.+ prop1 (desc <> " mapM") $+ concurrentMapM constr eq $ \n mv stream ->+ t $ S.mapM (mvarSequenceOp mv n) stream++-------------------------------------------------------------------------------+-- Concurrent Application+-------------------------------------------------------------------------------+ concurrentApplication :: IsStream t => ([Word8] -> [Word8] -> Bool) -> (t IO Word8 -> SerialT IO Word8)@@ -255,6 +339,10 @@ sourceUnfoldrM1 n |&. S.foldrM (\x xs -> return (x : xs)) [] listEquals (==) stream list +-------------------------------------------------------------------------------+-- Transformation operations+-------------------------------------------------------------------------------+ transformCombineFromList :: Semigroup (t IO Int) => ([Int] -> t IO Int)@@ -274,129 +362,13 @@ let list = a <> listOp (b <> c) listEquals eq stream list -foldFromList- :: ([Int] -> t IO Int)- -> (t IO Int -> SerialT IO Int)- -> ([Int] -> [Int] -> Bool)- -> [Int]- -> Property-foldFromList constr op eq = transformFromList constr eq id op--eliminateOp- :: (Show a, Eq a)- => ([s] -> t IO s)- -> ([s] -> a)- -> (t IO s -> IO a)- -> [s]- -> Property-eliminateOp constr listOp op a =- monadicIO $ do- stream <- run $ op (constr a)- let list = listOp a- equals (==) stream list--elemOp- :: ([Word8] -> t IO Word8)- -> (t IO Word8 -> SerialT IO Word8)- -> (Word8 -> SerialT IO Word8 -> IO Bool)- -> (Word8 -> [Word8] -> Bool)- -> (Word8, [Word8])- -> Property-elemOp constr op streamOp listOp (x, xs) =- monadicIO $ do- stream <- run $ (streamOp x . op) (constr xs)- let list = listOp x xs- equals (==) stream list--functorOps- :: Functor (t IO)- => ([Int] -> t IO Int)- -> String- -> ([Int] -> [Int] -> Bool)- -> (t IO Int -> SerialT IO Int)- -> Spec-functorOps constr desc eq t = do- prop (desc <> " id") $ transformFromList constr eq id t- prop (desc <> " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . fmap (+1)--transformOps- :: IsStream t- => ([Int] -> t IO Int)- -> String- -> ([Int] -> [Int] -> Bool)- -> (t IO Int -> SerialT IO Int)- -> Spec-transformOps constr desc eq t = do- let transform = transformFromList constr eq- -- Filtering- prop (desc <> " filter False") $- transform (filter (const False)) $ t . S.filter (const False)- prop (desc <> " filter True") $- transform (filter (const True)) $ t . S.filter (const True)- prop (desc <> " filter even") $- transform (filter even) $ t . S.filter even-- prop (desc <> " take maxBound") $- transform (take maxBound) $ t . S.take maxBound- prop (desc <> " take 0") $ transform (take 0) $ t . S.take 0- prop (desc <> " take 1") $ transform (take 1) $ t . S.take 1- prop (desc <> " take 10") $ transform (take 10) $ t . S.take 10-- prop (desc <> " takeWhile True") $- transform (takeWhile (const True)) $ t . S.takeWhile (const True)- prop (desc <> " takeWhile False") $- transform (takeWhile (const False)) $ t . S.takeWhile (const False)- prop (desc <> " takeWhile > 0") $- transform (takeWhile (> 0)) $ t . S.takeWhile (> 0)-- let f x = if odd x then Just (x + 100) else Nothing- prop (desc <> " mapMaybe") $ transform (mapMaybe f) $ t . S.mapMaybe f-- prop (desc <> " drop maxBound") $- transform (drop maxBound) $ t . S.drop maxBound- prop (desc <> " drop 0") $ transform (drop 0) $ t . S.drop 0- prop (desc <> " drop 1") $ transform (drop 1) $ t . S.drop 1- prop (desc <> " drop 10") $ transform (drop 10) $ t . S.drop 10-- prop (desc <> " dropWhile True") $- transform (dropWhile (const True)) $ t . S.dropWhile (const True)- prop (desc <> " dropWhile False") $- transform (dropWhile (const False)) $ t . S.dropWhile (const False)- prop (desc <> " dropWhile > 0") $- transform (dropWhile (> 0)) $ t . S.dropWhile (> 0)- prop (desc <> " scan") $ transform (scanl' (+) 0) $ t . S.scanl' (+) 0- prop (desc <> " reverse") $ transform reverse $ t . S.reverse-- prop (desc <> " findIndices") $ transform (findIndices odd) $ t . S.findIndices odd- prop (desc <> " elemIndices") $ transform (elemIndices 3) $ t . S.elemIndices 3-- prop (desc <> " intersperseM") $ transform (intersperse 3) $ t . S.intersperseM (return 3)---concurrentOps- :: IsStream t- => ([Word8] -> t IO Word8)- -> String- -> ([Word8] -> [Word8] -> Bool)- -> (t IO Word8 -> SerialT IO Word8)- -> Spec-concurrentOps constr desc eq t = do- let prop1 d p = prop d $ withMaxSuccess maxTestCount p-- prop1 (desc <> " fromFoldableM") $ concurrentFromFoldable eq t- prop1 (desc <> " unfoldrM") $ concurrentUnfoldrM eq t- -- we pass it the length of the stream n and an mvar mv.- -- The stream is [0..n]. The threads communicate in such a way that the- -- actions coming first in the stream are dependent on the last action. So- -- if the stream is not processed concurrently it will block forever.- -- Note that if the size of the stream is bigger than the thread limit- -- then it will block even if it is concurrent.- prop1 (desc <> " mapM") $- concurrentMapM constr eq $ \n mv stream ->- t $ S.mapM (mvarSequenceOp mv n) stream- -- XXX add tests for MonadReader and MonadError etc. In case an SVar is -- accidentally passed through them.+--+-- This tests transform ops along with detecting illegal sharing of SVar across+-- conurrent streams. These tests work for all stream types whereas+-- transformCombineOpsOrdered work only for ordered stream types i.e. excluding+-- the Async type. transformCombineOpsCommon :: (IsStream t, Semigroup (t IO Int)) => ([Int] -> t IO Int)@@ -406,6 +378,7 @@ -> Spec transformCombineOpsCommon constr desc eq t = do let transform = transformCombineFromList constr eq+ -- Filtering prop (desc <> " filter False") $ transform (filter (const False)) t (S.filter (const False))@@ -449,18 +422,49 @@ prop (desc <> " dropWhileM False") $ transform (dropWhile (const False)) t (S.dropWhileM (const $ return False)) + prop (desc <> " deleteBy (<=) maxBound") $+ transform (deleteBy (<=) maxBound) t (S.deleteBy (<=) maxBound)+ prop (desc <> " deleteBy (==) 4") $+ transform (deleteBy (==) 4) t (S.deleteBy (==) 4)++ -- transformation prop (desc <> " mapM (+1)") $ transform (fmap (+1)) t (S.mapM (\x -> return (x + 1))) - prop (desc <> " scan") $ transform (scanl' (flip const) 0) t+ prop (desc <> " scanl'") $ transform (scanl' (flip const) 0) t (S.scanl' (flip const) 0) prop (desc <> " scanlM'") $ transform (scanl' (flip const) 0) t (S.scanlM' (\_ a -> return a) 0)+ prop (desc <> " scanl") $ transform (scanl' (flip const) 0) t+ (S.scanl' (flip const) 0)+ prop (desc <> " scanl1'") $ transform (scanl1 (flip const)) t+ (S.scanl1' (flip const))+ prop (desc <> " scanl1M'") $ transform (scanl1 (flip const)) t+ (S.scanl1M' (\_ a -> return a))++ let f x = if odd x then Just (x + 100) else Nothing+ prop (desc <> " mapMaybe") $ transform (mapMaybe f) t (S.mapMaybe f)++ -- reordering prop (desc <> " reverse") $ transform reverse t S.reverse + -- inserting prop (desc <> " intersperseM") $- transform (intersperse 3) t (S.intersperseM $ return 3)+ forAll (choose (minBound, maxBound)) $ \n ->+ transform (intersperse n) t (S.intersperseM $ return n)+ prop (desc <> " insertBy 0") $+ forAll (choose (minBound, maxBound)) $ \n ->+ transform (insertBy compare n) t (S.insertBy compare n) + -- multi-stream+ prop (desc <> " concatMap") $+ forAll (choose (0, 100)) $ \n ->+ transform (concatMap (const [1..n]))+ t (S.concatMap (const (S.fromList [1..n])))++-- transformation tests that can only work reliably for ordered streams i.e.+-- Serial, Ahead and Zip. For example if we use "take 1" on an async stream, it+-- might yield a different result every time. transformCombineOpsOrdered :: (IsStream t, Semigroup (t IO Int)) => ([Int] -> t IO Int)@@ -470,6 +474,7 @@ -> Spec transformCombineOpsOrdered constr desc eq t = do let transform = transformCombineFromList constr eq+ -- Filtering prop (desc <> " take 1") $ transform (take 1) t (S.take 1) #ifdef DEVBUILD@@ -490,18 +495,49 @@ transform (dropWhile (> 0)) t (S.dropWhile (> 0)) prop (desc <> " scan") $ transform (scanl' (+) 0) t (S.scanl' (+) 0) - -- XXX this does not fail when the SVar is shared, need to fix.- prop (desc <> " concurrent application") $- transform (& fmap (+1)) t (|& S.map (+1))+ -- XXX add uniq+ prop (desc <> " deleteBy (<=) 0") $+ transform (deleteBy (<=) 0) t (S.deleteBy (<=) 0) prop (desc <> " findIndices") $ transform (findIndices odd) t (S.findIndices odd) prop (desc <> " elemIndices") $ transform (elemIndices 0) t (S.elemIndices 0) + -- XXX this does not fail when the SVar is shared, need to fix.+ prop (desc <> " concurrent application") $+ transform (& fmap (+1)) t (|& S.map (+1))++-------------------------------------------------------------------------------+-- Elimination operations+-------------------------------------------------------------------------------++eliminateOp+ :: (Show a, Eq a)+ => ([s] -> t IO s)+ -> ([s] -> a)+ -> (t IO s -> IO a)+ -> [s]+ -> Property+eliminateOp constr listOp op a =+ monadicIO $ do+ stream <- run $ op (constr a)+ let list = listOp a+ equals (==) stream list+ wrapMaybe :: ([a1] -> a2) -> [a1] -> Maybe a2 wrapMaybe f x = if null x then Nothing else Just (f x) +wrapOutOfBounds :: ([a1] -> Int -> a2) -> Int -> [a1] -> Maybe a2+wrapOutOfBounds f i x | null x = Nothing+ | i >= length x = Nothing+ | otherwise = Just (f x i)++wrapThe :: Eq a => [a] -> Maybe a+wrapThe (x:xs) | all (x ==) xs = Just x+ | otherwise = Nothing+wrapThe [] = Nothing+ eliminationOps :: ([Int] -> t IO Int) -> String@@ -526,25 +562,60 @@ prop (desc <> " sum") $ eliminateOp constr sum $ S.sum . t prop (desc <> " product") $ eliminateOp constr product $ S.product . t - prop (desc <> " maximum") $ eliminateOp constr (wrapMaybe maximum) $ S.maximum . t- prop (desc <> " minimum") $ eliminateOp constr (wrapMaybe minimum) $ S.minimum . t+ prop (desc <> " maximum") $+ eliminateOp constr (wrapMaybe maximum) $ S.maximum . t+ prop (desc <> " minimum") $+ eliminateOp constr (wrapMaybe minimum) $ S.minimum . t - prop (desc <> " findIndex") $ eliminateOp constr (findIndex odd) $ S.findIndex odd . t- prop (desc <> " elemIndex") $ eliminateOp constr (elemIndex 3) $ S.elemIndex 3 . t+ prop (desc <> " maximumBy compare") $+ eliminateOp constr (wrapMaybe $ maximumBy compare) $+ S.maximumBy compare . t+ prop (desc <> " maximumBy flip compare") $+ eliminateOp constr (wrapMaybe $ maximumBy $ flip compare) $+ S.maximumBy (flip compare) . t+ prop (desc <> " minimumBy compare") $+ eliminateOp constr (wrapMaybe $ minimumBy compare) $+ S.minimumBy compare . t+ prop (desc <> " minimumBy flip compare") $+ eliminateOp constr (wrapMaybe $ minimumBy $ flip compare) $+ S.minimumBy (flip compare) . t + prop (desc <> " findIndex") $+ eliminateOp constr (findIndex odd) $ S.findIndex odd . t+ prop (desc <> " elemIndex") $+ eliminateOp constr (elemIndex 3) $ S.elemIndex 3 . t++ prop (desc <> " !! 5") $+ eliminateOp constr (wrapOutOfBounds (!!) 5) $ (S.!! 5) . t+ prop (desc <> " !! 4") $+ eliminateOp constr (wrapOutOfBounds (!!) 0) $ (S.!! 0) . t+ prop (desc <> " find") $ eliminateOp constr (find even) $ S.find even . t prop (desc <> " lookup") $ eliminateOp constr (lookup 3 . flip zip [1..]) $ S.lookup 3 . S.zipWith (\a b -> (b, a)) (S.fromList [(1::Int)..]) . t+ prop (desc <> " the") $ eliminateOp constr wrapThe $ S.the . t + -- Multi-stream eliminations+ -- Add eqBy, cmpBy+ -- XXX Write better tests for substreams.+ prop (desc <> " isPrefixOf 10") $ eliminateOp constr (isPrefixOf [1..10]) $+ S.isPrefixOf (S.fromList [(1::Int)..10]) . t+ prop (desc <> " isSubsequenceOf 10") $+ eliminateOp constr (isSubsequenceOf $ filter even [1..10]) $+ S.isSubsequenceOf (S.fromList $ filter even [(1::Int)..10]) . t+ prop (desc <> " stripPrefix 10") $ eliminateOp constr (stripPrefix [1..10]) $+ (\s -> s >>= maybe (return Nothing) (fmap Just . S.toList)) .+ S.stripPrefix (S.fromList [(1::Int)..10]) . t+ -- head/tail/last may depend on the order in case of parallel streams -- so we test these only for serial streams.-serialEliminationOps+eliminationOpsOrdered :: ([Int] -> t IO Int) -> String -> (t IO Int -> SerialT IO Int) -> Spec-serialEliminationOps constr desc t = do+eliminationOpsOrdered constr desc t = do prop (desc <> " head") $ eliminateOp constr (wrapMaybe head) $ S.head . t prop (desc <> " tail") $ eliminateOp constr (wrapMaybe tail) $ \x -> do r <- S.tail (t x)@@ -558,15 +629,54 @@ Nothing -> return Nothing Just s -> Just <$> S.toList s -transformOpsWord8+elemOp :: ([Word8] -> t IO Word8)+ -> (t IO Word8 -> SerialT IO Word8)+ -> (Word8 -> SerialT IO Word8 -> IO Bool)+ -> (Word8 -> [Word8] -> Bool)+ -> (Word8, [Word8])+ -> Property+elemOp constr op streamOp listOp (x, xs) =+ monadicIO $ do+ stream <- run $ (streamOp x . op) (constr xs)+ let list = listOp x xs+ equals (==) stream list++eliminationOpsWord8+ :: ([Word8] -> t IO Word8) -> String -> (t IO Word8 -> SerialT IO Word8) -> Spec-transformOpsWord8 constr desc t = do+eliminationOpsWord8 constr desc t = do prop (desc <> " elem") $ elemOp constr t S.elem elem- prop (desc <> " elem") $ elemOp constr t S.notElem notElem+ prop (desc <> " notElem") $ elemOp constr t S.notElem notElem +-------------------------------------------------------------------------------+-- Semigroup operations+-------------------------------------------------------------------------------++transformFromList+ :: (Eq b, Show b) =>+ ([a] -> t IO a)+ -> ([b] -> [b] -> Bool)+ -> ([a] -> [b])+ -> (t IO a -> SerialT IO b)+ -> [a]+ -> Property+transformFromList constr eq listOp op a =+ monadicIO $ do+ stream <- run ((S.toList . op) (constr a))+ let list = listOp a+ listEquals eq stream list++foldFromList+ :: ([Int] -> t IO Int)+ -> (t IO Int -> SerialT IO Int)+ -> ([Int] -> [Int] -> Bool)+ -> [Int]+ -> Property+foldFromList constr op eq = transformFromList constr eq id op+ -- XXX concatenate streams of multiple elements rather than single elements semigroupOps :: (IsStream t@@ -583,6 +693,25 @@ prop (desc <> " <>") $ foldFromList (foldMapWith (<>) singleton) t eq prop (desc <> " mappend") $ foldFromList (foldMapWith mappend singleton) t eq +-------------------------------------------------------------------------------+-- Functor operations+-------------------------------------------------------------------------------++functorOps+ :: Functor (t IO)+ => ([Int] -> t IO Int)+ -> String+ -> ([Int] -> [Int] -> Bool)+ -> (t IO Int -> SerialT IO Int)+ -> Spec+functorOps constr desc eq t = do+ prop (desc <> " id") $ transformFromList constr eq id t+ prop (desc <> " fmap (+1)") $ transformFromList constr eq (fmap (+1)) $ t . fmap (+1)++-------------------------------------------------------------------------------+-- Applicative operations+-------------------------------------------------------------------------------+ applicativeOps :: Applicative (t IO) => ([Int] -> t IO Int)@@ -596,6 +725,10 @@ let list = (,) <$> a <*> b listEquals eq stream list +-------------------------------------------------------------------------------+-- Zip operations+-------------------------------------------------------------------------------+ zipApplicative :: (IsStream t, Applicative (t IO)) => ([Int] -> t IO Int)@@ -650,6 +783,10 @@ listEquals eq stream1 list listEquals eq stream2 list +-------------------------------------------------------------------------------+-- Monad operations+-------------------------------------------------------------------------------+ monadThen :: Monad (t IO) => ([Int] -> t IO Int)@@ -678,16 +815,6 @@ let list = a >>= \x -> (+ x) <$> b listEquals eq stream list -constructWithIterate :: IsStream t => (t IO Int -> SerialT IO Int) -> Spec-constructWithIterate t = do- it "iterate" $- (S.toList . t . S.take 100) (S.iterate (+ 1) (0 :: Int))- `shouldReturn` take 100 (iterate (+ 1) 0)- it "iterateM" $ do- let addM y = return (y + 1)- S.toList . t . S.take 100 $ S.iterateM addM (0 :: Int)- `shouldReturn` take 100 (iterate (+ 1) 0)- main :: IO () main = hspec $ H.parallel@@ -761,14 +888,24 @@ zipAsyncOps spec = mapOps spec $ makeOps zipAsyncly describe "Construction" $ do+ serialOps $ prop "serially replicate" . constructWithReplicate+ serialOps $ prop "serially replicateM" . constructWithReplicateM wSerialOps $ prop "wSerially replicateM" . constructWithReplicateM aheadOps $ prop "aheadly replicateM" . constructWithReplicateM asyncOps $ prop "asyncly replicateM" . constructWithReplicateM wAsyncOps $ prop "wAsyncly replicateM" . constructWithReplicateM parallelOps $ prop "parallely replicateM" . constructWithReplicateM++ serialOps $ prop "serially intFromThenTo" .+ constructWithIntFromThenTo+#if __GLASGOW_HASKELL__ >= 806+ serialOps $ prop "serially DoubleFromThenTo" .+ constructWithDoubleFromThenTo+#endif -- XXX test for all types of streams constructWithIterate serially+ -- XXX add tests for fromIndices describe "Functor operations" $ do serialOps $ functorOps S.fromFoldable "serially" (==)@@ -814,6 +951,7 @@ wAsyncOps $ prop "wAsyncly applicative folded" . applicativeOps folded sortEq parallelOps $ prop "parallely applicative folded" . applicativeOps folded sortEq + -- XXX add tests for indexed/indexedR describe "Zip operations" $ do zipSerialOps $ prop "zipSerially applicative" . zipApplicative S.fromFoldable (==) zipSerialOps $ prop "zipSerially applicative folded" . zipApplicative folded (==)@@ -836,6 +974,11 @@ parallelOps $ prop "zip monadic parallely" . zipMonadic S.fromFoldable (==) parallelOps $ prop "zip monadic parallely folded" . zipMonadic folded (==) + -- XXX add merge tests like zip tests+ -- for mergeBy, we can split a list randomly into two lists and+ -- then merge them, it should result in original list+ -- describe "Merge operations" $ do+ describe "Monad operations" $ do serialOps $ prop "serially monad then" . monadThen S.fromFoldable (==) wSerialOps $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq@@ -865,43 +1008,6 @@ wAsyncOps $ prop "wAsyncly monad bind folded" . monadBind folded sortEq parallelOps $ prop "parallely monad bind folded" . monadBind folded sortEq - describe "Stream transform operations" $ do- serialOps $ transformOps S.fromFoldable "serially" (==)- wSerialOps $ transformOps S.fromFoldable "wSerially" (==)- aheadOps $ transformOps S.fromFoldable "aheadly" (==)- asyncOps $ transformOps S.fromFoldable "asyncly" sortEq- wAsyncOps $ transformOps S.fromFoldable "wAsyncly" sortEq- parallelOps $ transformOps S.fromFoldable "parallely" sortEq- zipSerialOps $ transformOps S.fromFoldable "zipSerially" (==)- zipAsyncOps $ transformOps S.fromFoldable "zipAsyncly" (==)-- serialOps $ transformOps folded "serially folded" (==)- wSerialOps $ transformOps folded "wSerially folded" (==)- aheadOps $ transformOps folded "aheadly folded" (==)- asyncOps $ transformOps folded "asyncly folded" sortEq- wAsyncOps $ transformOps folded "wAsyncly folded" sortEq- parallelOps $ transformOps folded "parallely folded" sortEq- zipSerialOps $ transformOps folded "zipSerially folded" (==)- zipAsyncOps $ transformOps folded "zipAsyncly folded" (==)-- serialOps $ transformOpsWord8 S.fromFoldable "serially"- wSerialOps $ transformOpsWord8 S.fromFoldable "wSerially"- aheadOps $ transformOpsWord8 S.fromFoldable "aheadly"- asyncOps $ transformOpsWord8 S.fromFoldable "asyncly"- wAsyncOps $ transformOpsWord8 S.fromFoldable "wAsyncly"- parallelOps $ transformOpsWord8 S.fromFoldable "parallely"- zipSerialOps $ transformOpsWord8 S.fromFoldable "zipSerially"- zipAsyncOps $ transformOpsWord8 S.fromFoldable "zipAsyncly"-- serialOps $ transformOpsWord8 folded "serially folded"- wSerialOps $ transformOpsWord8 folded "wSerially folded"- aheadOps $ transformOpsWord8 folded "aheadly folded"- asyncOps $ transformOpsWord8 folded "asyncly folded"- wAsyncOps $ transformOpsWord8 folded "wAsyncly folded"- parallelOps $ transformOpsWord8 folded "parallely folded"- zipSerialOps $ transformOpsWord8 folded "zipSerially folded"- zipAsyncOps $ transformOpsWord8 folded "zipAsyncly folded"- -- These tests won't work with maxBuffer or maxThreads set to 1, so we -- exclude those cases from these. let mkOps t =@@ -937,8 +1043,6 @@ prop "concurrent foldl application" $ withMaxSuccess maxTestCount concurrentFoldlApplication - -- These tests are specifically targeted towards detecting illegal sharing- -- of SVar across conurrent streams. All transform ops must be added here. describe "Stream transform and combine operations" $ do serialOps $ transformCombineOpsCommon S.fromFoldable "serially" (==) wSerialOps $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq@@ -987,17 +1091,35 @@ zipSerialOps $ eliminationOps folded "zipSerially folded" zipAsyncOps $ eliminationOps folded "zipAsyncly folded" + serialOps $ eliminationOpsWord8 S.fromFoldable "serially"+ wSerialOps $ eliminationOpsWord8 S.fromFoldable "wSerially"+ aheadOps $ eliminationOpsWord8 S.fromFoldable "aheadly"+ asyncOps $ eliminationOpsWord8 S.fromFoldable "asyncly"+ wAsyncOps $ eliminationOpsWord8 S.fromFoldable "wAsyncly"+ parallelOps $ eliminationOpsWord8 S.fromFoldable "parallely"+ zipSerialOps $ eliminationOpsWord8 S.fromFoldable "zipSerially"+ zipAsyncOps $ eliminationOpsWord8 S.fromFoldable "zipAsyncly"++ serialOps $ eliminationOpsWord8 folded "serially folded"+ wSerialOps $ eliminationOpsWord8 folded "wSerially folded"+ aheadOps $ eliminationOpsWord8 folded "aheadly folded"+ asyncOps $ eliminationOpsWord8 folded "asyncly folded"+ wAsyncOps $ eliminationOpsWord8 folded "wAsyncly folded"+ parallelOps $ eliminationOpsWord8 folded "parallely folded"+ zipSerialOps $ eliminationOpsWord8 folded "zipSerially folded"+ zipAsyncOps $ eliminationOpsWord8 folded "zipAsyncly folded"+ -- XXX Add a test where we chain all transformation APIs and make sure that -- the state is being passed through all of them. describe "Stream serial elimination operations" $ do- serialOps $ serialEliminationOps S.fromFoldable "serially"- wSerialOps $ serialEliminationOps S.fromFoldable "wSerially"- aheadOps $ serialEliminationOps S.fromFoldable "aheadly"- zipSerialOps $ serialEliminationOps S.fromFoldable "zipSerially"- zipAsyncOps $ serialEliminationOps S.fromFoldable "zipAsyncly"+ serialOps $ eliminationOpsOrdered S.fromFoldable "serially"+ wSerialOps $ eliminationOpsOrdered S.fromFoldable "wSerially"+ aheadOps $ eliminationOpsOrdered S.fromFoldable "aheadly"+ zipSerialOps $ eliminationOpsOrdered S.fromFoldable "zipSerially"+ zipAsyncOps $ eliminationOpsOrdered S.fromFoldable "zipAsyncly" - serialOps $ serialEliminationOps folded "serially folded"- wSerialOps $ serialEliminationOps folded "wSerially folded"- aheadOps $ serialEliminationOps folded "aheadly folded"- zipSerialOps $ serialEliminationOps folded "zipSerially folded"- zipAsyncOps $ serialEliminationOps folded "zipAsyncly folded"+ serialOps $ eliminationOpsOrdered folded "serially folded"+ wSerialOps $ eliminationOpsOrdered folded "wSerially folded"+ aheadOps $ eliminationOpsOrdered folded "aheadly folded"+ zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"+ zipAsyncOps $ eliminationOpsOrdered folded "zipAsyncly folded"